Fix ICE in trans_associate_var

2020-03-05  Paul Thomas  <pault@gcc.gnu.org>

	Backport from trunk
	PR fortran/92976
	* match.c (select_type_set_tmp): Variable 'selector' to replace
	select_type_stack->selector. If the selector array spec has
	explicit bounds, make the temporary's bounds deferred.

2020-03-05  Paul Thomas  <pault@gcc.gnu.org>

	Backport from trunk
	PR fortran/92976
	* gfortran.dg/select_type_48.f90 : New test.

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 8fccf0db5cc30128a36c1d167bb2cb7b95d2e5a1..b3ccda4cf466b44ca81f3ce91aadbc5cf02a6bd7 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2020-03-05  Paul Thomas  <pault@gcc.gnu.org>
+
+       Backport from trunk
+       PR fortran/92976
+       * match.c (select_type_set_tmp): Variable 'selector' to replace
+       select_type_stack->selector. If the selector array spec has
+       explicit bounds, make the temporary's bounds deferred.
+
 2020-02-19  Mark Eggleston  <markeggleston@gcc.gnu.org>
 
        Backported from mainline

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index efc0c2d7bc31eb2d440f2276ff7a818e0c0dcf51..088b69f8ec9dae317511b80c0ebff83f1171d1e1 100644 (file)
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -6165,6 +6165,7 @@ select_type_set_tmp (gfc_typespec *ts)
 {
   char name[GFC_MAX_SYMBOL_LEN];
   gfc_symtree *tmp = NULL;
+  gfc_symbol *selector = select_type_stack->selector;
 
   if (!ts)
     {
@@ -6186,22 +6187,27 @@ select_type_set_tmp (gfc_typespec *ts)
       gfc_get_sym_tree (name, gfc_current_ns, &tmp, false);
       gfc_add_type (tmp->n.sym, ts, NULL);
 
-      if (select_type_stack->selector->ts.type == BT_CLASS
-       && select_type_stack->selector->attr.class_ok)
+      if (selector->ts.type == BT_CLASS && selector->attr.class_ok)
        {
-         tmp->n.sym->attr.pointer
-               = CLASS_DATA (select_type_stack->selector)->attr.class_pointer;
+         tmp->n.sym->attr.pointer = CLASS_DATA (selector)->attr.class_pointer;
 
          /* Copy across the array spec to the selector.  */
-         if (CLASS_DATA (select_type_stack->selector)->attr.dimension
-             || CLASS_DATA (select_type_stack->selector)->attr.codimension)
+         if (CLASS_DATA (selector)->attr.dimension
+             || CLASS_DATA (selector)->attr.codimension)
            {
              tmp->n.sym->attr.dimension
-                   = CLASS_DATA (select_type_stack->selector)->attr.dimension;
+                   = CLASS_DATA (selector)->attr.dimension;
              tmp->n.sym->attr.codimension
-                   = CLASS_DATA (select_type_stack->selector)->attr.codimension;
-             tmp->n.sym->as
-           = gfc_copy_array_spec (CLASS_DATA (select_type_stack->selector)->as);
+                   = CLASS_DATA (selector)->attr.codimension;
+             if (CLASS_DATA (selector)->as->type != AS_EXPLICIT)
+               tmp->n.sym->as
+                       = gfc_copy_array_spec (CLASS_DATA (selector)->as);
+             else
+               {
+                 tmp->n.sym->as = gfc_get_array_spec();
+                 tmp->n.sym->as->rank = CLASS_DATA (selector)->as->rank;
+                 tmp->n.sym->as->type = AS_DEFERRED;
+               }
            }
     }
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index eca8fc03beaab52171f5af92a054ce71f007c577..ec8328c01e298611d30ff5478c872e6096fd584f 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2020-03-05  Paul Thomas  <pault@gcc.gnu.org>
+
+       Backport from trunk
+       PR fortran/92976
+       * gfortran.dg/select_type_48.f90 : New test.
+
 2020-03-04  Martin Sebor  <msebor@redhat.com>
 
        PR c++/90938

diff --git a/gcc/testsuite/gfortran.dg/select_type_48.f90 b/gcc/testsuite/gfortran.dg/select_type_48.f90
new file mode 100644 (file)
index 0000000..d9ad01c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_type_48.f90
@@ -0,0 +1,31 @@
+! { dg-do run }
+!
+! Test the fix for PR92976, in which the TYPE IS statement caused an ICE
+! because of the explicit bounds of 'x'.
+!
+! Contributed by Gerhard Steinmetz  <gscfq@t-online.de>
+!
+program p
+   type t
+      integer :: i
+   end type
+   class(t), allocatable :: c(:)
+   allocate (c, source = [t(1111),t(2222),t(3333)])
+   call s(c)
+   if (sum (c%i) .ne. 3333) stop 1
+contains
+   subroutine s(x)
+      class(t) :: x(2)
+      select type (x)
+! ICE as compiler attempted to assign descriptor to an array
+         type is (t)
+            x%i = 0
+! Make sure that bounds are correctly translated.
+            call counter (x)
+      end select
+   end
+   subroutine counter (arg)
+     type(t) :: arg(:)
+     if (size (arg, 1) .ne. 2) stop 2
+   end
+end