http://gcc.gnu.org/bugzilla/show_bug.cgi?id=54618
--- Comment #3 from Tobias Burnus <burnus at gcc dot gnu.org> 2012-09-19
17:31:06 UTC ---
There seem to be other issues with OPTIONAL as well. The following code prints
twice 'T' when it should print 'F' and it segfaults for one version.
I haven't dared to combine it with INTENT(OUT) and/or ALLOCATABLE.
The following program gives the same result with 4.7 as with 4.8 + my patch:
type t
end type t
type(t) :: y, y2(2)
class(t), allocatable :: z, z2(:)
allocate (t :: z)
allocate (t :: z2(2))
!print *, 'Scalars, expected: F F T T T T'
call s1() ! OK
call s1a() ! -> should print 'F', prints 'T'
call s1(y) ! OK
call s1a(y) ! OK
call s1(z) ! OK
call s1a(z) ! OK
!print *, 'Arrays, expected: F F T T T T'
! call sa1() ! Segfault
call sa1a() ! -> should print 'F', prints 'T'
call sa1(y2) ! OK
call sa1a(y2) ! OK
call sa1(z2) ! OK
call sa1a(z2) ! OK
contains
subroutine s1(x)
class(t), optional :: x
call s2(x)
end subroutine s1
subroutine s1a(x)
type(t), optional :: x
call s2(x)
end subroutine s1a
subroutine s2(x)
class(t), optional :: x
print *, present(x)
end subroutine s2
subroutine sa1(x)
class(t), optional :: x(:)
call sa2(x)
end subroutine sa1
subroutine sa1a(x)
type(t), optional :: x(:)
call sa2(x)
end subroutine sa1a
subroutine sa2(x)
class(t), optional :: x(:)
print *, present(x)
end subroutine sa2
end
* * *
The missing bits for the patch in comment 2 are fixable as follows, which
completes the scalar version of the second issue.
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -3923,2 +3940,15 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
+ if (fsym->ts.type == BT_CLASS)
+ {
+ gfc_symbol *vtab;
+ gcc_assert (fsym->ts.u.derived == e->ts.u.derived);
+ vtab = gfc_find_derived_vtab (fsym->ts.u.derived);
+ tmp = gfc_get_symbol_decl (vtab);
+ tmp = gfc_build_addr_expr (NULL_TREE, tmp);
+ ptr = gfc_class_vptr_get (parmse.expr);
+ gfc_add_modify (&block, ptr,
+ fold_convert (TREE_TYPE (ptr), tmp));
+ gfc_add_expr_to_block (&block, tmp);
+ }
+
if (fsym->attr.optional
