From: Paul Thomas <pault@gcc.gnu.org>
Date: Sun, 20 May 2018 09:59:54 +0000 (+0000)
Subject: re PR fortran/82923 (Automatic allocation of deferred length character using function... 
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=7c71e79664fbc04c3eb1d8b0307b33e502488664;p=gcc.git

re PR fortran/82923 (Automatic allocation of deferred length character using function result)

2018-05-19  Paul Thomas  <pault@gcc.gnu.org>

	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  <pault@gcc.gnu.org>

	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
---

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  <pault@gcc.gnu.org>
+
+	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  <pault@gcc.gnu.org>
 
 	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  <pault@gcc.gnu.org>
+
+	PR fortran/82923
+	* gfortran.dg/select_type_42.f90: New test.
+
 2018-05-19  Paul Thomas  <pault@gcc.gnu.org>
 
 	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  <damian@sourceryinstitute.org>
+!
+  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