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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a87c48a3ff863fdb4df55a6bd86434fd29f1aa98..b0bd14f1839d6deac3f464ee9756239167fa709d 100644 (file)
--- 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 c845befb5d01b91e8086d93b4b2dab7939551c59..d8b4381251e9f38165ba785603ee22087facae43 100644 (file)
--- 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 b15a4b2595263210af19a1612f71ae321cab25c8..697b7354e1bd3ded76384d37bed52340fa11890a 100644 (file)
--- 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 e899f5653f4c5da037a38643b68cb08df9557a7d..a14db69e416d8775232df4091c3774155d3420a4 100644 (file)
--- 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 (file)
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