https://gcc.gnu.org/g:f425e358695319d5e7f784abd673ce74e8bd8591
commit f425e358695319d5e7f784abd673ce74e8bd8591 Author: Mikael Morin <[email protected]> Date: Mon Sep 28 09:59:55 2026 +0200 fortran: Ignore attributes of class containers's _data component [PR127637] The majority of the attributes returned by gfc_variable_attr are taken from the last component reference if there is one at least; otherwise from the root symbol. This misses some attributes if the last component reference is the implicit _data reference of a class container, as those only store the allocatable, dimension, codimension and pointer attributes. The rest of attributes remain in the original entity. This change adds a tracking of the current type through the reference chain walk, and a check on each component ref to avoid overwriting the current set of attributes if the current type is a class container, and the component its _data field. The optional variable, tracking the optional attribute value, was cleared on the first component ref. Move that under the new check for the same reason. PR fortran/127637 gcc/fortran/ChangeLog: * primary.cc (gfc_variable_attr): Track the current type through the data reference walk. Don't overwrite the attribute set and the the optional variable if the current type is a class container and the component its _data field. gcc/testsuite/ChangeLog: * gfortran.dg/optional_class_2.f90: New test. Diff: --- gcc/fortran/primary.cc | 12 ++++++++-- gcc/testsuite/gfortran.dg/optional_class_2.f90 | 32 ++++++++++++++++++++++++++ 2 files changed, 42 insertions(+), 2 deletions(-) diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc index 07c2ddb131b0..918ad54c51f8 100644 --- a/gcc/fortran/primary.cc +++ b/gcc/fortran/primary.cc @@ -3030,6 +3030,7 @@ gfc_variable_attr (gfc_expr *expr) gfc_ref *ref; gfc_symbol *sym; gfc_component *comp; + gfc_typespec *current_ts; bool has_inquiry_part; bool has_substring_ref = false; @@ -3040,6 +3041,7 @@ gfc_variable_attr (gfc_expr *expr) sym = expr->symtree->n.sym; attr = sym->attr; + current_ts = &sym->ts; optional = attr.optional; if (sym->ts.type == BT_CLASS && sym->attr.class_ok && sym->ts.u.derived) @@ -3124,9 +3126,15 @@ gfc_variable_attr (gfc_expr *expr) break; case REF_COMPONENT: - optional = false; comp = ref->u.c.component; - attr = comp->attr; + if (!(current_ts->type == BT_CLASS + && current_ts->u.derived->attr.is_class + && strcmp (comp->name, "_data") == 0)) + { + optional = false; + attr = comp->attr; + } + current_ts = &sym->ts; if (comp->ts.type == BT_CLASS) { diff --git a/gcc/testsuite/gfortran.dg/optional_class_2.f90 b/gcc/testsuite/gfortran.dg/optional_class_2.f90 new file mode 100644 index 000000000000..73ff0ee109ac --- /dev/null +++ b/gcc/testsuite/gfortran.dg/optional_class_2.f90 @@ -0,0 +1,32 @@ +! { dg-do run } +! +! PR fortran/127637 +! Check that the scalarization of the assignment picks the loop upper bound from +! the non-optional array. + +program prog + implicit none + integer, parameter :: n = 5 + type :: t + integer :: c + end type + type(t), allocatable :: x(:) + integer :: i + call sub() +contains + elemental function f(v, a) result(r) + integer, intent(in) :: v + type(t), optional, intent(in) :: a + integer :: r + r = v + 42 + if (present(a)) r = a%c + end function + subroutine sub(o) + class(t), optional, intent(in) :: o(:) + integer, allocatable :: y(:) + allocate(y(n)) + y = 0 + y(:) = f(y, o) + if (any(y /= 42)) error stop 1 + end +end program
