diff options
| -rw-r--r-- | gcc/fortran/expr.cc | 1 | ||||
| -rw-r--r-- | gcc/fortran/primary.cc | 13 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/actual_array_subref.f90 | 103 |
3 files changed, 113 insertions, 4 deletions
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc index 07e9bac..92a9ebd 100644 --- a/gcc/fortran/expr.cc +++ b/gcc/fortran/expr.cc @@ -1194,6 +1194,7 @@ is_subref_array (gfc_expr * e) what follows cannot be a subreference array, unless there is a substring reference. */ if (!seen_array && ref->type == REF_COMPONENT + && ref->next == NULL && ref->u.c.component->ts.type != BT_CHARACTER && ref->u.c.component->ts.type != BT_CLASS && !gfc_bt_struct (ref->u.c.component->ts.type)) diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc index 161d4c2..72ecc7c 100644 --- a/gcc/fortran/primary.cc +++ b/gcc/fortran/primary.cc @@ -2893,6 +2893,7 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts) gfc_symbol *sym; gfc_component *comp; bool has_inquiry_part; + bool has_substring_ref = false; if (expr->expr_type != EXPR_VARIABLE && expr->expr_type != EXPR_FUNCTION @@ -2955,7 +2956,12 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts) has_inquiry_part = false; for (ref = expr->ref; ref; ref = ref->next) - if (ref->type == REF_INQUIRY) + if (ref->type == REF_SUBSTRING) + { + has_substring_ref = true; + optional = false; + } + else if (ref->type == REF_INQUIRY) { has_inquiry_part = true; optional = false; @@ -3003,9 +3009,8 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts) *ts = comp->ts; /* Don't set the string length if a substring reference follows. */ - if (ts->type == BT_CHARACTER - && ref->next && ref->next->type == REF_SUBSTRING) - ts->u.cl = NULL; + if (ts->type == BT_CHARACTER && has_substring_ref) + ts->u.cl = NULL; } if (comp->ts.type == BT_CLASS) diff --git a/gcc/testsuite/gfortran.dg/actual_array_subref.f90 b/gcc/testsuite/gfortran.dg/actual_array_subref.f90 new file mode 100644 index 0000000..932d7ab --- /dev/null +++ b/gcc/testsuite/gfortran.dg/actual_array_subref.f90 @@ -0,0 +1,103 @@ +! { dg-do run } +! { dg-additional-options "-O2 -fcheck=bounds" } +! +! PR fortran/119986 +! +! Check passing of inquiry references of complex arrays and substring +! references of character arrays when these are components of derived types. +! +! Extended version of report by Neil Carlson. + +program main + implicit none + integer :: j + + complex, parameter :: z0(*) = [(cmplx(j,-j),j=1,4)] + type :: cx + real :: re + real :: im + end type cx + type(cx), parameter :: c0(*) = [(cx (j,-j),j=1,4)] + + type :: my_type + complex :: z(4) = z0 + type(cx) :: c(4) = c0 + end type my_type + type(my_type) :: x + + character(*), parameter :: s0(*) = ["abcd","efgh","ijkl","mnop"] + character(*), parameter :: expect(*) = s0(:)(2:3) + character(len(s0)) :: s1(4) = s0 + + type :: str1 + character(len(s0)) :: s(4) = s0 + end type str1 + type(str1) :: string1 + + type :: str2 + character(:), allocatable :: s(:) + end type str2 + type(str2) :: string2 + + integer :: stopcode = 0 + + if (len(expect) /= 2) stop 1 + if (expect(4) /= "no") stop 2 + if (any(c0 %re /= [ 1, 2, 3, 4])) stop 3 + if (any(c0 %im /= [-1,-2,-3,-4])) stop 4 + + stopcode = 10 + call fubar ( x%z %re, x%z %im) + call fubar ( x%c %re, x%c %im) + + stopcode = 20 + call fubar ((x%z %re), (x%z %im)) + call fubar ((x%c %re), (x%c %im)) + + stopcode = 30 + call fubar ([x%z %re], [x%z %im]) + call fubar ([x%c %re], [x%c %im]) + + stopcode = 50 + call chk ( s0(:)(2:3) ) + call chk ((s0(:)(2:3))) + call chk ([s0(:)(2:3)]) + + stopcode = 60 + call chk ( s1(:)(2:3) ) + call chk ((s1(:)(2:3))) + call chk ([s1(:)(2:3)]) + + stopcode = 70 + call chk ( string1%s(:)(2:3) ) + call chk ((string1%s(:)(2:3))) + call chk ([string1%s(:)(2:3)]) + + string2% s = s0 + if (len(string2%s) /= 4) stop 99 + stopcode = 80 + call chk ( string2%s(:)(2:3) ) + call chk ((string2%s(:)(2:3))) + call chk ([string2%s(:)(2:3)]) + deallocate (string2% s) + +contains + + subroutine fubar(u, v) + real, intent(in) :: u(:), v(:) + if (any (u /= z0%re)) stop stopcode + 1 + if (any (v /= z0%im)) stop stopcode + 2 + if (any (u /= c0%re)) stop stopcode + 3 + if (any (v /= c0%im)) stop stopcode + 4 + stopcode = stopcode + 4 + end subroutine + + subroutine chk (s) + character(*), intent(in) :: s(:) + if (size(s) /= 4) stop stopcode + 1 + if (len (s) /= 2) stop stopcode + 2 + if (any (s /= expect)) stop stopcode + 3 + stopcode = stopcode + 3 + end subroutine chk + +end program |