re PR fortran/84141 (Internal error: type_name(): Bad type)

2018-02-10  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/84141
	PR fortran/84155
	* trans-array.c (gfc_array_init_size): Revert the change made
	in revision 257356 setting the dtype.
	* trans-types.c (gfc_get_dtype): Do not use the cached dtype.
	Call gfc_get_dtype_rank_type every time.

	PR fortran/56691
	* trans-array.c (gfc_conv_expr_descriptor): If the source array
	is a descriptor type, use its offset, removing the condition
	that is be a class expression.

2018-02-10  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/56691
	* gfortran.dg/type_to_class_4.f03: New test.

From-SVN: r257550

5 files changed, 59 insertions, 8 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a87c48a..b0bd14f 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,17 @@
+2018-02-10  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/84141
+	PR fortran/84155
+	* trans-array.c (gfc_array_init_size): Revert the change made
+	in revision 257356 setting the dtype.
+	* trans-types.c (gfc_get_dtype): Do not use the cached dtype.
+	Call gfc_get_dtype_rank_type every time.
+
+	PR fortran/56691
+	* trans-array.c (gfc_conv_expr_descriptor): If the source array
+	is a descriptor type, use its offset, removing the condition
+	that is be a class expression.
+
 2018-02-07  Steven G. Kargl  <kargl@gcc.gnu.org>
 
 	PR fortran/82994
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index c845bef..d8b4381 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -5354,8 +5354,8 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
     }
   else
     {
-      tmp = gfc_get_dtype_rank_type (rank, gfc_get_element_type (type));
-      gfc_add_modify (pblock, gfc_conv_descriptor_dtype (descriptor), tmp);
+      tmp = gfc_conv_descriptor_dtype (descriptor);
+      gfc_add_modify (pblock, tmp, gfc_get_dtype (type));
     }
 
   or_expr = logical_false_node;
@@ -7529,9 +7529,9 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
 	      : base;
 	  gfc_conv_descriptor_offset_set (&loop.pre, parm, tmp);
 	}
-      else if (IS_CLASS_ARRAY (expr) && !se->data_not_needed
-	       && (!rank_remap || se->use_offset)
-	       && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)))
+      else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc))
+	       && !se->data_not_needed
+	       && (!rank_remap || se->use_offset))
 	{
 	  gfc_conv_descriptor_offset_set (&loop.pre, parm,
 					 gfc_conv_descriptor_offset_get (desc));
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index b15a4b2..697b735 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -1593,9 +1593,6 @@ gfc_get_dtype (tree type)
 
   gcc_assert (GFC_DESCRIPTOR_TYPE_P (type) || GFC_ARRAY_TYPE_P (type));
 
-  if (GFC_TYPE_ARRAY_DTYPE (type))
-    return GFC_TYPE_ARRAY_DTYPE (type);
-
   rank = GFC_TYPE_ARRAY_RANK (type);
   etype = gfc_get_element_type (type);
   dtype = gfc_get_dtype_rank_type (rank, etype);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index e899f56..a14db69 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2018-02-10  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/56691
+	* gfortran.dg/type_to_class_4.f03: New test.
+
 2018-02-10  Alan Modra  <amodra@gmail.com>
 
 	PR target/84300
diff --git a/gcc/testsuite/gfortran.dg/type_to_class_4.f03 b/gcc/testsuite/gfortran.dg/type_to_class_4.f03
new file mode 100644
index 0000000..196e448
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/type_to_class_4.f03
@@ -0,0 +1,35 @@
+! { dg-do run }
+!
+! Test the fix for PR56691 comment #7 (and comment #0).
+!
+! Reduced from the original of Marco Restelli  <mrestelli@gmail.com>
+! by Janus Weil  <janus@gcc.gnu.org>
+!
+module m2
+  implicit none
+  type :: t_stv
+    real :: f1
+  end type
+contains
+  subroutine lcb(y)
+    class(t_stv), intent(in) :: y(:)
+    integer :: k
+    do k=1,size(y)
+      if (int(y(k)%f1) .ne. k) call abort
+    enddo
+  end subroutine
+end module
+
+program test
+ use m2
+ implicit none
+
+ type(t_stv), allocatable :: work(:)
+
+  allocate(work(4))
+  work(:)%f1 = (/ 1.,2.,3.,4./)
+
+  call lcb(work)
+  call lcb(work(:4)) ! Indexing used to be offset by 1.
+
+end program