From 7c71e79664fbc04c3eb1d8b0307b33e502488664 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sun, 20 May 2018 09:59:54 +0000 Subject: [PATCH] re PR fortran/82923 (Automatic allocation of deferred length character using function result) 2018-05-19 Paul Thomas PR fortran/82923 PR fortran/66694 PR fortran/82617 * trans-array.c (gfc_alloc_allocatable_for_assignment): Set the charlen backend_decl of the rhs expr to ss->info->string_length so that the value in the current scope is used. 2018-05-19 Paul Thomas PR fortran/82923 * gfortran.dg/allocate_assumed_charlen_4.f90: New test. Note that the patch fixes PR66694 & PR82617, although the testcases are not explicitly included. From-SVN: r260413 --- gcc/fortran/ChangeLog | 6 +++++ gcc/fortran/match.c | 27 +++++++++++++++----- gcc/testsuite/ChangeLog | 5 ++++ gcc/testsuite/gfortran.dg/select_type_42.f90 | 26 +++++++++++++++++++ 4 files changed, 58 insertions(+), 6 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/select_type_42.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ef3d2aa3768..a52932c103f 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2018-05-20 Paul Thomas + + PR fortran/82275 + * match.c (gfc_match_type_spec): Go through the array ref and + decrement 'rank' for every dimension that is an element. + 2018-05-19 Paul Thomas PR fortran/82923 diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 8f3a027c209..0931edd84aa 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -2118,7 +2118,7 @@ gfc_match_type_spec (gfc_typespec *ts) or list item in a type-list of an OpenMP reduction clause. Need to differentiate REAL([KIND]=scalar-int-initialization-expr) from REAL(A,[KIND]) and REAL(KIND,A). Logically, when this code was - written the use of LOGICAL as a type-spec or intrinsic subprogram + written the use of LOGICAL as a type-spec or intrinsic subprogram was overlooked. */ m = gfc_match (" %n", name); @@ -5935,6 +5935,7 @@ copy_ts_from_selector_to_associate (gfc_expr *associate, gfc_expr *selector) { gfc_ref *ref; gfc_symbol *assoc_sym; + int rank = 0; assoc_sym = associate->symtree->n.sym; @@ -5971,14 +5972,28 @@ copy_ts_from_selector_to_associate (gfc_expr *associate, gfc_expr *selector) selector->rank = ref->u.ar.dimen; else selector->rank = 0; + + rank = selector->rank; } - if (selector->rank) + if (rank) { - assoc_sym->attr.dimension = 1; - assoc_sym->as = gfc_get_array_spec (); - assoc_sym->as->rank = selector->rank; - assoc_sym->as->type = AS_DEFERRED; + for (int i = 0; i < ref->u.ar.dimen + ref->u.ar.codimen; i++) + if (ref->u.ar.dimen_type[i] == DIMEN_ELEMENT + || (ref->u.ar.dimen_type[i] == DIMEN_UNKNOWN + && ref->u.ar.end[i] == NULL + && ref->u.ar.stride[i] == NULL)) + rank--; + + if (rank) + { + assoc_sym->attr.dimension = 1; + assoc_sym->as = gfc_get_array_spec (); + assoc_sym->as->rank = rank; + assoc_sym->as->type = AS_DEFERRED; + } + else + assoc_sym->as = NULL; } else assoc_sym->as = NULL; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 1b4e16db013..372661152cc 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2018-05-20 Paul Thomas + + PR fortran/82923 + * gfortran.dg/select_type_42.f90: New test. + 2018-05-19 Paul Thomas PR fortran/82923 diff --git a/gcc/testsuite/gfortran.dg/select_type_42.f90 b/gcc/testsuite/gfortran.dg/select_type_42.f90 new file mode 100644 index 00000000000..ff73e6c7858 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/select_type_42.f90 @@ -0,0 +1,26 @@ +! { dg-do run } +! +! Tests the fix for PR82275. +! Associating a name with a reduced-dimension section of a +! multidimensional array precluded subsequent use of the name +! with the appropriately reduced dimensionality and instead +! required use of the (invalid) full set of original dimensions. +! +! Contributed by Damian Rouson +! + type component + integer :: i + end type + type container + class(component), allocatable :: component_array(:,:) + end type + type(container) bag + type(component) section_copy + allocate(bag%component_array, source = reshape ([component(10), component (100)], [1,2])) + select type(associate_name=>bag%component_array(1,:)) + type is (component) + section_copy = associate_name(2) ! gfortran rejected valid +! section_copy = associate_name(1,1)! gfortran accepted invalid + end select + if (section_copy%i .ne. 100) stop 1 +end -- 2.30.2