Hi Harald,
Let's try again :-)
OK for trunk?
Regards
Paul
Fortran: Enable class expressions in structure constructors [PR49213]
2023-06-27 Paul Thomas
gcc/fortran
PR fortran/49213
* expr.cc (gfc_is_ptr_fcn): Remove reference to class_pointer.
* resolve.cc (resolve_assoc_var): Call gfc_is_ptr_fcn to allow
associate names with pointer function targets to be used in
variable definition context.
* trans-decl.cc (get_symbol_decl): Remove extraneous line.
* trans-expr.cc (alloc_scalar_allocatable_subcomponent): Obtain
size of intrinsic and character expressions.
(gfc_trans_subcomponent_assign): Expand assignment to class
components to include intrinsic and character expressions.
gcc/testsuite/
PR fortran/49213
* gfortran.dg/pr49213.f90 : New test
On Sat, 24 Jun 2023 at 20:50, Harald Anlauf wrote:
>
> Hi Paul!
>
> On 6/24/23 15:18, Paul Richard Thomas via Gcc-patches wrote:
> > I have included the adjustment to 'gfc_is_ptr_fcn' and eliminating the
> > extra blank line, introduced by my last patch. I played safe and went
> > exclusively for class functions with attr.class_pointer set on the
> > grounds that these have had all the accoutrements checked and built
> > (ie. class_ok). I am still not sure if this is necessary or not.
>
> maybe it is my fault, but I find the version in the patch confusing:
>
> @@ -816,7 +816,7 @@ bool
> gfc_is_ptr_fcn (gfc_expr *e)
> {
> return e != NULL && e->expr_type == EXPR_FUNCTION
> - && (gfc_expr_attr (e).pointer
> + && ((e->ts.type != BT_CLASS && gfc_expr_attr (e).pointer)
>|| (e->ts.type == BT_CLASS
>&& CLASS_DATA (e)->attr.class_pointer));
> }
>
> The caller 'gfc_is_ptr_fcn' has e->expr_type == EXPR_FUNCTION, so
> gfc_expr_attr (e) boils down to:
>
>if (e->value.function.esym && e->value.function.esym->result)
> {
> gfc_symbol *sym = e->value.function.esym->result;
> attr = sym->attr;
> if (sym->ts.type == BT_CLASS && sym->attr.class_ok)
> {
> attr.dimension = CLASS_DATA (sym)->attr.dimension;
> attr.pointer = CLASS_DATA (sym)->attr.class_pointer;
> attr.allocatable = CLASS_DATA (sym)->attr.allocatable;
> }
> }
> ...
>else if (e->symtree)
> attr = gfc_variable_attr (e, NULL);
>
> So I thought this should already do what you want if you do
>
> gfc_is_ptr_fcn (gfc_expr *e)
> {
>return e != NULL && e->expr_type == EXPR_FUNCTION && gfc_expr_attr
> (e).pointer;
> }
>
> or what am I missing? The additional checks in gfc_expr_attr are
> there to avoid ICEs in case CLASS_DATA (sym) has issues, and we all
> know Gerhard who showed that he is an expert in exploiting this.
>
> To sum up, I'd prefer to use the safer form if it works. If it
> doesn't, I would expect a latent issue.
>
> The rest of the code looked good to me, but I was suspicious about
> the handling of CHARACTER.
>
> Nasty as I am, I modified the testcase to use character(kind=4)
> instead of kind=1 (see attached). This either fails here (stop 10),
> or if I activate the marked line
>
> !cont = tContainer('hello!') ! ### ICE! ###
>
> I get an ICE.
>
> Can you have another look?
>
> Thanks,
> Harald
>
> >
>
> > OK for trunk?
> >
> > Paul
> >
> > Fortran: Enable class expressions in structure constructors [PR49213]
> >
> > 2023-06-24 Paul Thomas
> >
> > gcc/fortran
> > PR fortran/49213
> > * expr.cc (gfc_is_ptr_fcn): Guard pointer attribute to exclude
> > class expressions.
> > * resolve.cc (resolve_assoc_var): Call gfc_is_ptr_fcn to allow
> > associate names with pointer function targets to be used in
> > variable definition context.
> > * trans-decl.cc (get_symbol_decl): Remove extraneous line.
> > * trans-expr.cc (alloc_scalar_allocatable_subcomponent): Obtain
> > size of intrinsic and character expressions.
> > (gfc_trans_subcomponent_assign): Expand assignment to class
> > components to include intrinsic and character expressions.
> >
> > gcc/testsuite/
> > PR fortran/49213
> > * gfortran.dg/pr49213.f90 : New test
--
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein
! { dg-do run }
!
! Contributed by Neil Carlson
!
program main
character(2) :: c
type :: S
integer :: n
end type
type(S) :: Sobj
type, extends(S) :: S2
integer :: m
end type
type(S2) :: S2obj
type :: T
class(S), allocatable :: x
end type
type tContainer
class(*), allocatable :: x
end type
type(T) :: Tobj
Sobj = S(1)
Tobj = T(Sobj)
S2obj = S2(1,2)
Tobj = T(S2obj)! Failed here
select type (x => Tobj%x)
type is (S2)
if ((x%n .ne. 1) .or. (x%m .ne. 2)) stop 1
class default
stop 2
end select
c = " "
call pass_it (T(Sobj))
if (c .ne. "S ") stop 3
call pass_it (T(S2obj))! and here
if (c .ne. "S2") stop 4
call bar
contains
subroutine pass_it (foo)
type(T), intent(i
