* [Patch, fortran] PR49213 - [OOP] gfortran rejects structure constructor expression @ 2023-06-24 13:18 Paul Richard Thomas 2023-06-24 19:50 ` Harald Anlauf 0 siblings, 1 reply; 7+ messages in thread From: Paul Richard Thomas @ 2023-06-24 13:18 UTC (permalink / raw) To: fortran, gcc-patches, Harald Anlauf [-- Attachment #1: Type: text/plain, Size: 1456 bytes --] Hi All, I was looking through Neil Carlson's collection of gfortran bugs and was shocked to find this rather fundamental PR. At 12 years old, it is certainly a "golden oldie"! The patch is rather straightforward and seems to do the job of admitting derived, intrinsic and character expressions to allocatable class components in structure constructors. 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. OK for trunk? Paul Fortran: Enable class expressions in structure constructors [PR49213] 2023-06-24 Paul Thomas <pault@gcc.gnu.org> 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 [-- Attachment #2: pr49213.diff --] [-- Type: text/x-patch, Size: 5161 bytes --] diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc index c960dfeabd9..92061d69781 100644 --- a/gcc/fortran/expr.cc +++ b/gcc/fortran/expr.cc @@ -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)); } diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 82e6ac53aa1..217d69d4e0b 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -1350,6 +1350,9 @@ resolve_structure_cons (gfc_expr *expr, int init) && CLASS_DATA (comp)->as) rank = CLASS_DATA (comp)->as->rank; + if (comp->ts.type == BT_CLASS && cons->expr->ts.type == BT_DERIVED) + gfc_find_derived_vtab (cons->expr->ts.u.derived); + if (cons->expr->expr_type != EXPR_NULL && rank != cons->expr->rank && (comp->attr.allocatable || cons->expr->rank)) { @@ -1381,7 +1384,7 @@ resolve_structure_cons (gfc_expr *expr, int init) gfc_basic_typename (comp->ts.type)); t = false; } - else + else if (!UNLIMITED_POLY (comp)) { bool t2 = gfc_convert_type (cons->expr, &comp->ts, 1); if (t) diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc index 18589e17843..b0fd25e92a3 100644 --- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -1915,7 +1915,6 @@ gfc_get_symbol_decl (gfc_symbol * sym) gcc_assert (!sym->value || sym->value->expr_type == EXPR_NULL); } - gfc_finish_var_decl (decl, sym); if (sym->ts.type == BT_CHARACTER) diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 3c209bcde97..5a1ff0c1d21 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -8781,6 +8781,7 @@ alloc_scalar_allocatable_subcomponent (stmtblock_t *block, tree comp, tree size; tree size_in_bytes; tree lhs_cl_size = NULL_TREE; + gfc_se se; if (!comp) return; @@ -8815,16 +8816,26 @@ alloc_scalar_allocatable_subcomponent (stmtblock_t *block, tree comp, } else if (cm->ts.type == BT_CLASS) { - gcc_assert (expr2->ts.type == BT_CLASS || expr2->ts.type == BT_DERIVED); - if (expr2->ts.type == BT_DERIVED) + if (expr2->ts.type != BT_CLASS) { - tmp = gfc_get_symbol_decl (expr2->ts.u.derived); - size = TYPE_SIZE_UNIT (tmp); + if (expr2->ts.type == BT_CHARACTER) + { + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, expr2); + size = fold_convert (size_type_node, se.string_length); + } + else + { + if (expr2->ts.type == BT_DERIVED) + tmp = gfc_get_symbol_decl (expr2->ts.u.derived); + else + tmp = gfc_typenode_for_spec (&expr2->ts); + size = TYPE_SIZE_UNIT (tmp); + } } else { gfc_expr *e2vtab; - gfc_se se; e2vtab = gfc_find_and_cut_at_last_class_ref (expr2); gfc_add_vptr_component (e2vtab); gfc_add_size_component (e2vtab); @@ -8975,6 +8986,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, { gfc_init_se (&se, NULL); gfc_conv_expr (&se, expr); + tree size; /* Take care about non-array allocatable components here. The alloc_* routine below is motivated by the alloc_scalar_allocatable_for_ @@ -8990,7 +9002,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, && expr->symtree->n.sym->attr.dummy) se.expr = build_fold_indirect_ref_loc (input_location, se.expr); - if (cm->ts.type == BT_CLASS && expr->ts.type == BT_DERIVED) + if (cm->ts.type == BT_CLASS) { tmp = gfc_class_data_get (dest); tmp = build_fold_indirect_ref_loc (input_location, tmp); @@ -9005,7 +9017,6 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, /* For deferred strings insert a memcpy. */ if (cm->ts.type == BT_CHARACTER && cm->ts.deferred) { - tree size; gcc_assert (se.string_length || expr->ts.u.cl->backend_decl); size = size_of_string_in_bytes (cm->ts.kind, se.string_length ? se.string_length @@ -9013,6 +9024,29 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, tmp = gfc_build_memcpy_call (tmp, se.expr, size); gfc_add_expr_to_block (&block, tmp); } + else if (cm->ts.type == BT_CLASS) + { + /* Fix the expression for memcpy. */ + if (expr->expr_type != EXPR_VARIABLE) + se.expr = gfc_evaluate_now (se.expr, &block); + + if (expr->ts.type == BT_CHARACTER) + size = fold_convert (size_type_node, se.string_length); + else + size = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&expr->ts)); + + /* Now copy the expression to the constructor component _data. */ + gfc_add_expr_to_block (&block, + gfc_build_memcpy_call (tmp, se.expr, size)); + + /* Fill the unlimited polymorphic _len field. */ + if (UNLIMITED_POLY (cm)) + { + tmp = gfc_class_len_get (gfc_get_class_from_expr (tmp)); + gfc_add_modify (&block, tmp, + fold_convert (TREE_TYPE (tmp), size)); + } + } else gfc_add_modify (&block, tmp, fold_convert (TREE_TYPE (tmp), se.expr)); [-- Attachment #3: pr49213.f90 --] [-- Type: text/x-fortran, Size: 1893 bytes --] ! { dg-do run } ! ! Contributed by Neil Carlson <neil.n.carlson@gmail.com> ! 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(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(in) :: foo select type (x => foo%x) type is (S) c = "S " if (x%n .ne. 1) stop 5 type is (S2) c = "S2" if ((x%n .ne. 1) .or. (x%m .ne. 2)) stop 6 class default stop 7 end select end subroutine subroutine bar ! Test from comment #29 of the PR - due to Janus Weil type tContainer class(*), allocatable :: x end type integer, parameter :: i = 0 character(7) :: chr = "goodbye" type(tContainer) :: cont cont%x = i ! linker error: undefined reference to `__copy_INTEGER_4_.3804' cont = tContainer(i+42) ! Failed here select type (z => cont%x) type is (integer) if (z .ne. 42) stop 8 class default stop 9 end select cont = tContainer('hello!') select type (z => cont%x) type is (character(*)) if (z .ne. 'hello!') stop 10 class default stop 11 end select cont = tContainer(chr) select type (z => cont%x) type is (character(*)) if (z .ne. 'goodbye') stop 12 class default stop 13 end select end subroutine bar end program ^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [Patch, fortran] PR49213 - [OOP] gfortran rejects structure constructor expression 2023-06-24 13:18 [Patch, fortran] PR49213 - [OOP] gfortran rejects structure constructor expression Paul Richard Thomas @ 2023-06-24 19:50 ` Harald Anlauf 2023-06-24 19:50 ` Harald Anlauf 2023-06-27 10:30 ` Paul Richard Thomas 0 siblings, 2 replies; 7+ messages in thread From: Harald Anlauf @ 2023-06-24 19:50 UTC (permalink / raw) To: Paul Richard Thomas, fortran, gcc-patches [-- Attachment #1: Type: text/plain, Size: 3165 bytes --] 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 <pault@gcc.gnu.org> > > 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 [-- Attachment #2: pr49213-kind4.f90 --] [-- Type: text/x-fortran, Size: 2013 bytes --] ! { dg-do run } ! ! Contributed by Neil Carlson <neil.n.carlson@gmail.com> ! program main ! character(2) :: c character(2,kind=4) :: 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(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 = 4_" " call pass_it (T(Sobj)) if (c .ne. 4_"S ") stop 3 call pass_it (T(S2obj)) ! and here if (c .ne. 4_"S2") stop 4 call bar contains subroutine pass_it (foo) type(T), intent(in) :: foo select type (x => foo%x) type is (S) c = 4_"S " if (x%n .ne. 1) stop 5 type is (S2) c = 4_"S2" if ((x%n .ne. 1) .or. (x%m .ne. 2)) stop 6 class default stop 7 end select end subroutine subroutine bar ! Test from comment #29 of the PR - due to Janus Weil type tContainer class(*), allocatable :: x end type integer, parameter :: i = 0 character(7,kind=4) :: chr = 4_"goodbye" type(tContainer) :: cont cont%x = i ! linker error: undefined reference to `__copy_INTEGER_4_.3804' cont = tContainer(i+42) ! Failed here select type (z => cont%x) type is (integer) if (z .ne. 42) stop 8 class default stop 9 end select ! cont = tContainer('hello!') ! ### ICE! ### cont = tContainer(4_'hello!') select type (z => cont%x) type is (character(*,kind=4)) if (z .ne. 4_'hello!') stop 10 class default stop 11 end select cont = tContainer(chr) select type (z => cont%x) type is (character(*,kind=4)) if (z .ne. 4_'goodbye') stop 12 class default stop 13 end select end subroutine bar end program ^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [Patch, fortran] PR49213 - [OOP] gfortran rejects structure constructor expression 2023-06-24 19:50 ` Harald Anlauf @ 2023-06-24 19:50 ` Harald Anlauf 2023-06-27 10:30 ` Paul Richard Thomas 1 sibling, 0 replies; 7+ messages in thread From: Harald Anlauf @ 2023-06-24 19:50 UTC (permalink / raw) To: gcc-patches; +Cc: fortran [-- Attachment #1: Type: text/plain, Size: 3075 bytes --] 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 <pault@gcc.gnu.org> > > 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 [-- Attachment #2: pr49213-kind4.f90 --] [-- Type: text/x-fortran, Size: 2013 bytes --] ! { dg-do run } ! ! Contributed by Neil Carlson <neil.n.carlson@gmail.com> ! program main ! character(2) :: c character(2,kind=4) :: 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(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 = 4_" " call pass_it (T(Sobj)) if (c .ne. 4_"S ") stop 3 call pass_it (T(S2obj)) ! and here if (c .ne. 4_"S2") stop 4 call bar contains subroutine pass_it (foo) type(T), intent(in) :: foo select type (x => foo%x) type is (S) c = 4_"S " if (x%n .ne. 1) stop 5 type is (S2) c = 4_"S2" if ((x%n .ne. 1) .or. (x%m .ne. 2)) stop 6 class default stop 7 end select end subroutine subroutine bar ! Test from comment #29 of the PR - due to Janus Weil type tContainer class(*), allocatable :: x end type integer, parameter :: i = 0 character(7,kind=4) :: chr = 4_"goodbye" type(tContainer) :: cont cont%x = i ! linker error: undefined reference to `__copy_INTEGER_4_.3804' cont = tContainer(i+42) ! Failed here select type (z => cont%x) type is (integer) if (z .ne. 42) stop 8 class default stop 9 end select ! cont = tContainer('hello!') ! ### ICE! ### cont = tContainer(4_'hello!') select type (z => cont%x) type is (character(*,kind=4)) if (z .ne. 4_'hello!') stop 10 class default stop 11 end select cont = tContainer(chr) select type (z => cont%x) type is (character(*,kind=4)) if (z .ne. 4_'goodbye') stop 12 class default stop 13 end select end subroutine bar end program ^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [Patch, fortran] PR49213 - [OOP] gfortran rejects structure constructor expression 2023-06-24 19:50 ` Harald Anlauf 2023-06-24 19:50 ` Harald Anlauf @ 2023-06-27 10:30 ` Paul Richard Thomas 2023-06-27 19:27 ` Harald Anlauf 1 sibling, 1 reply; 7+ messages in thread From: Paul Richard Thomas @ 2023-06-27 10:30 UTC (permalink / raw) To: Harald Anlauf; +Cc: fortran, gcc-patches [-- Attachment #1: Type: text/plain, Size: 4267 bytes --] Hi Harald, Let's try again :-) OK for trunk? Regards Paul Fortran: Enable class expressions in structure constructors [PR49213] 2023-06-27 Paul Thomas <pault@gcc.gnu.org> 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 <anlauf@gmx.de> 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 <pault@gcc.gnu.org> > > > > 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 [-- Attachment #2: pr49213.f90 --] [-- Type: text/x-fortran, Size: 2252 bytes --] ! { dg-do run } ! ! Contributed by Neil Carlson <neil.n.carlson@gmail.com> ! 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(in) :: foo select type (x => foo%x) type is (S) c = "S " if (x%n .ne. 1) stop 5 type is (S2) c = "S2" if ((x%n .ne. 1) .or. (x%m .ne. 2)) stop 6 class default stop 7 end select end subroutine subroutine check_it (t, errno) type(tContainer) :: t integer :: errno select type (x => t%x) type is (integer) if (x .ne. 42) stop errno type is (integer(8)) if (x .ne. 42_8) stop errno type is (real(8)) if (int(x**2) .ne. 2) stop errno type is (character(*, kind=1)) if (x .ne. "end of tests") stop errno type is (character(*, kind=4)) if ((x .ne. 4_"hello!") .and. (x .ne. 4_"goodbye")) stop errno class default stop errno end select end subroutine subroutine bar ! Test from comment #29 extended by Harald Anlauf to check kinds /= default integer(8), parameter :: i = 0_8 integer :: j = 42 character(7,kind=4) :: chr4 = 4_"goodbye" type(tContainer) :: cont cont%x = j call check_it (cont, 8) cont = tContainer(i+42_8) call check_it (cont, 9) cont = tContainer(sqrt (2.0_8)) call check_it (cont, 10) cont = tContainer(4_"hello!") call check_it (cont, 11) cont = tContainer(chr4) call check_it (cont, 12) cont = tContainer("end of tests") call check_it (cont, 13) end subroutine bar end program [-- Attachment #3: pr49213.diff --] [-- Type: text/x-patch, Size: 5560 bytes --] diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc index c960dfeabd9..e418f1f3301 100644 --- a/gcc/fortran/expr.cc +++ b/gcc/fortran/expr.cc @@ -816,9 +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 - && CLASS_DATA (e)->attr.class_pointer)); + && gfc_expr_attr (e).pointer; } diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 82e6ac53aa1..8e018b6e7e8 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -1350,6 +1350,9 @@ resolve_structure_cons (gfc_expr *expr, int init) && CLASS_DATA (comp)->as) rank = CLASS_DATA (comp)->as->rank; + if (comp->ts.type == BT_CLASS && cons->expr->ts.type != BT_CLASS) + gfc_find_vtab (&cons->expr->ts); + if (cons->expr->expr_type != EXPR_NULL && rank != cons->expr->rank && (comp->attr.allocatable || cons->expr->rank)) { @@ -1381,7 +1384,7 @@ resolve_structure_cons (gfc_expr *expr, int init) gfc_basic_typename (comp->ts.type)); t = false; } - else + else if (!UNLIMITED_POLY (comp)) { bool t2 = gfc_convert_type (cons->expr, &comp->ts, 1); if (t) diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc index 18589e17843..b0fd25e92a3 100644 --- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -1915,7 +1915,6 @@ gfc_get_symbol_decl (gfc_symbol * sym) gcc_assert (!sym->value || sym->value->expr_type == EXPR_NULL); } - gfc_finish_var_decl (decl, sym); if (sym->ts.type == BT_CHARACTER) diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 3c209bcde97..b292b5f8995 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -8781,6 +8781,7 @@ alloc_scalar_allocatable_subcomponent (stmtblock_t *block, tree comp, tree size; tree size_in_bytes; tree lhs_cl_size = NULL_TREE; + gfc_se se; if (!comp) return; @@ -8815,16 +8816,30 @@ alloc_scalar_allocatable_subcomponent (stmtblock_t *block, tree comp, } else if (cm->ts.type == BT_CLASS) { - gcc_assert (expr2->ts.type == BT_CLASS || expr2->ts.type == BT_DERIVED); - if (expr2->ts.type == BT_DERIVED) + if (expr2->ts.type != BT_CLASS) { - tmp = gfc_get_symbol_decl (expr2->ts.u.derived); - size = TYPE_SIZE_UNIT (tmp); + if (expr2->ts.type == BT_CHARACTER) + { + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, expr2); + size = build_int_cst (gfc_array_index_type, expr2->ts.kind); + size = fold_build2_loc (input_location, MULT_EXPR, + gfc_array_index_type, + se.string_length, size); + size = fold_convert (size_type_node, size); + } + else + { + if (expr2->ts.type == BT_DERIVED) + tmp = gfc_get_symbol_decl (expr2->ts.u.derived); + else + tmp = gfc_typenode_for_spec (&expr2->ts); + size = TYPE_SIZE_UNIT (tmp); + } } else { gfc_expr *e2vtab; - gfc_se se; e2vtab = gfc_find_and_cut_at_last_class_ref (expr2); gfc_add_vptr_component (e2vtab); gfc_add_size_component (e2vtab); @@ -8975,6 +8990,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, { gfc_init_se (&se, NULL); gfc_conv_expr (&se, expr); + tree size; /* Take care about non-array allocatable components here. The alloc_* routine below is motivated by the alloc_scalar_allocatable_for_ @@ -8990,7 +9006,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, && expr->symtree->n.sym->attr.dummy) se.expr = build_fold_indirect_ref_loc (input_location, se.expr); - if (cm->ts.type == BT_CLASS && expr->ts.type == BT_DERIVED) + if (cm->ts.type == BT_CLASS) { tmp = gfc_class_data_get (dest); tmp = build_fold_indirect_ref_loc (input_location, tmp); @@ -9005,7 +9021,6 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, /* For deferred strings insert a memcpy. */ if (cm->ts.type == BT_CHARACTER && cm->ts.deferred) { - tree size; gcc_assert (se.string_length || expr->ts.u.cl->backend_decl); size = size_of_string_in_bytes (cm->ts.kind, se.string_length ? se.string_length @@ -9013,6 +9028,36 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, tmp = gfc_build_memcpy_call (tmp, se.expr, size); gfc_add_expr_to_block (&block, tmp); } + else if (cm->ts.type == BT_CLASS) + { + /* Fix the expression for memcpy. */ + if (expr->expr_type != EXPR_VARIABLE) + se.expr = gfc_evaluate_now (se.expr, &block); + + if (expr->ts.type == BT_CHARACTER) + { + size = build_int_cst (gfc_array_index_type, expr->ts.kind); + size = fold_build2_loc (input_location, MULT_EXPR, + gfc_array_index_type, + se.string_length, size); + size = fold_convert (size_type_node, size); + } + else + size = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&expr->ts)); + + /* Now copy the expression to the constructor component _data. */ + gfc_add_expr_to_block (&block, + gfc_build_memcpy_call (tmp, se.expr, size)); + + /* Fill the unlimited polymorphic _len field. */ + if (UNLIMITED_POLY (cm) && expr->ts.type == BT_CHARACTER) + { + tmp = gfc_class_len_get (gfc_get_class_from_expr (tmp)); + gfc_add_modify (&block, tmp, + fold_convert (TREE_TYPE (tmp), + se.string_length)); + } + } else gfc_add_modify (&block, tmp, fold_convert (TREE_TYPE (tmp), se.expr)); ^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [Patch, fortran] PR49213 - [OOP] gfortran rejects structure constructor expression 2023-06-27 10:30 ` Paul Richard Thomas @ 2023-06-27 19:27 ` Harald Anlauf 2023-06-27 19:27 ` Harald Anlauf 2023-06-28 9:47 ` Paul Richard Thomas 0 siblings, 2 replies; 7+ messages in thread From: Harald Anlauf @ 2023-06-27 19:27 UTC (permalink / raw) To: Paul Richard Thomas; +Cc: fortran, gcc-patches Hi Paul, this is much better now. I have only a minor comment left: in the calculation of the size of a character string you are using an intermediate gfc_array_index_type, whereas I have learned to use gfc_charlen_type_node now, which seems like the natural type here. OK for trunk, and thanks for your patience! Harald On 6/27/23 12:30, Paul Richard Thomas via Gcc-patches wrote: > Hi Harald, > > Let's try again :-) > > OK for trunk? > > Regards > > Paul > > Fortran: Enable class expressions in structure constructors [PR49213] > > 2023-06-27 Paul Thomas <pault@gcc.gnu.org> > > 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 <anlauf@gmx.de> 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 <pault@gcc.gnu.org> >>> >>> 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 > > > ^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [Patch, fortran] PR49213 - [OOP] gfortran rejects structure constructor expression 2023-06-27 19:27 ` Harald Anlauf @ 2023-06-27 19:27 ` Harald Anlauf 2023-06-28 9:47 ` Paul Richard Thomas 1 sibling, 0 replies; 7+ messages in thread From: Harald Anlauf @ 2023-06-27 19:27 UTC (permalink / raw) To: gcc-patches; +Cc: fortran Hi Paul, this is much better now. I have only a minor comment left: in the calculation of the size of a character string you are using an intermediate gfc_array_index_type, whereas I have learned to use gfc_charlen_type_node now, which seems like the natural type here. OK for trunk, and thanks for your patience! Harald On 6/27/23 12:30, Paul Richard Thomas via Gcc-patches wrote: > Hi Harald, > > Let's try again :-) > > OK for trunk? > > Regards > > Paul > > Fortran: Enable class expressions in structure constructors [PR49213] > > 2023-06-27 Paul Thomas <pault@gcc.gnu.org> > > 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 <anlauf@gmx.de> 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 <pault@gcc.gnu.org> >>> >>> 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 > > > ^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [Patch, fortran] PR49213 - [OOP] gfortran rejects structure constructor expression 2023-06-27 19:27 ` Harald Anlauf 2023-06-27 19:27 ` Harald Anlauf @ 2023-06-28 9:47 ` Paul Richard Thomas 1 sibling, 0 replies; 7+ messages in thread From: Paul Richard Thomas @ 2023-06-28 9:47 UTC (permalink / raw) To: Harald Anlauf; +Cc: fortran, gcc-patches Hi Harald, I'll change to gfc_charlen_type_node. Thanks for your patience in reviewing this patch :-) Cheers Paul On Tue, 27 Jun 2023 at 20:27, Harald Anlauf <anlauf@gmx.de> wrote: > > Hi Paul, > > this is much better now. > > I have only a minor comment left: in the calculation of the > size of a character string you are using an intermediate > gfc_array_index_type, whereas I have learned to use > gfc_charlen_type_node now, which seems like the natural > type here. > > OK for trunk, and thanks for your patience! > > Harald > > > On 6/27/23 12:30, Paul Richard Thomas via Gcc-patches wrote: > > Hi Harald, > > > > Let's try again :-) > > > > OK for trunk? > > > > Regards > > > > Paul > > > > Fortran: Enable class expressions in structure constructors [PR49213] > > > > 2023-06-27 Paul Thomas <pault@gcc.gnu.org> > > > > 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 <anlauf@gmx.de> 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 <pault@gcc.gnu.org> > >>> > >>> 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 ^ permalink raw reply [flat|nested] 7+ messages in thread
end of thread, other threads:[~2023-06-28 9:47 UTC | newest] Thread overview: 7+ messages (download: mbox.gz / follow: Atom feed) -- links below jump to the message on this page -- 2023-06-24 13:18 [Patch, fortran] PR49213 - [OOP] gfortran rejects structure constructor expression Paul Richard Thomas 2023-06-24 19:50 ` Harald Anlauf 2023-06-24 19:50 ` Harald Anlauf 2023-06-27 10:30 ` Paul Richard Thomas 2023-06-27 19:27 ` Harald Anlauf 2023-06-27 19:27 ` Harald Anlauf 2023-06-28 9:47 ` Paul Richard Thomas
This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).