https://gcc.gnu.org/bugzilla/show_bug.cgi?id=64578
paul.richard.thomas at gmail dot com <paul.richard.thomas at gmail dot com>
changed:
What |Removed |Added
----------------------------------------------------------------------------
CC| |paul.richard.thomas at gmail
dot c
| |om
--- Comment #8 from paul.richard.thomas at gmail dot com <paul.richard.thomas
at gmail dot com> ---
(In reply to janus from comment #6)
> Reduced test case for the ICE:
>
> print *, associated(return_pointer()) ! ICE
> contains
> function return_pointer()
> class(*), pointer :: return_pointer(:)
> end function
> end
>
> ICEs with 4.8, 4.9, trunk. Rejected by 4.7, because class(*) is not
> supported.
The above ICE is fixed with:
Index: /svn/trunk/gcc/fortran/trans-intrinsic.c
===================================================================
*** /svn/trunk/gcc/fortran/trans-intrinsic.c (revision 219297)
--- /svn/trunk/gcc/fortran/trans-intrinsic.c (working copy)
*************** gfc_conv_associated (gfc_se *se, gfc_exp
*** 6544,6550 ****
--- 6544,6554 ----
arg1se.expr = build_fold_indirect_ref_loc (input_location,
arg1se.expr);
if (arg1->expr->ts.type == BT_CLASS)
+ {
tmp2 = gfc_class_data_get (arg1se.expr);
+ if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp2)))
+ tmp2 = gfc_conv_descriptor_data_get (tmp2);
+ }
else
tmp2 = arg1se.expr;
}
such that
type foo
integer :: i
end type
logical :: l
class(foo), pointer :: ptr(:)
print *, associated(return_pointer()) ! ICE
print *, associated(return_pointer1()) ! ICE
ptr => return_pointer1 ()
select type (ptr)
type is (foo)
print *, ptr%i
end select
contains
function return_pointer()
class(foo), pointer :: return_pointer(:)
return_pointer => NULL()
end function
function return_pointer1()
class(foo), pointer :: return_pointer1(:)
allocate (return_pointer1(2), source = foo(99))
end function
end
does the right thing....
[pault@localhost pr55901]# ./a.out
F
T
99 99
The runtime segfault remains because the code for the call to return_pointer in
the full example is
{
struct __class__STAR_1_0p ptrtemp.12;
struct __class_MAIN___Foo_t class.11;
ptrtemp.12 = return_pointer (&class.11);
(struct __vtype__STAR *) ptr._vptr = (struct __vtype__STAR *)
ptrtemp.12._vptr;
ptr._data = ptrtemp.12._data;
}
ie. bizarrely, none of the fields in class.11 are set. I'll see if I can
understand why.
Cheers
Paul
