re PR fortran/46007 (wrong code for SHAPE in a scalarized loop)

2010-10-21  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/46007
	* m4/shape.m4 (shape_'rtype_kind`):  Use variable for rank.
	Allocate return array if unallocated.
	* generated/shape_i4.c:  Regenerated.
	* generated/shape_i8.c:  Regenerated.
	* generated/shape_i16.c:  Regenerated.

2010-10-21  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/46007
	* gfortran.dg/shape_5.f90:  New test case.

From-SVN: r165770

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 51877d1454582542629935674df09ba990bf4e84..b4f914e808c186a83afa252aa34c2f159a7508a9 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2010-10-21  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR fortran/46007
+       * gfortran.dg/shape_5.f90:  New test case.
+
 2010-10-21  Janus Weil  <janus@gcc.gnu.org>
 
        PR fortran/46060

diff --git a/gcc/testsuite/gfortran.dg/shape_5.f90 b/gcc/testsuite/gfortran.dg/shape_5.f90
new file mode 100644 (file)
index 0000000..ed128bc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/shape_5.f90
@@ -0,0 +1,8 @@
+! { dg-do run }
+! PR 40067 - this used to segfault on an unallocated return array.
+    integer, dimension(10)             :: int1d
+    integer, dimension(:), pointer     :: int1d_retrieved
+
+    allocate(int1d_retrieved(10))
+    if (any(shape(int1d_retrieved) /= shape(INT1D))) call abort()
+    end

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index c47cac370b5bac13928aa9dfff1553450d47107d..5b06cef1b4ffe1ad8e98aab90ab9a4ab3ee5f2c6 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,12 @@
+2010-10-21  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR fortran/46007
+       * m4/shape.m4 (shape_'rtype_kind`):  Use variable for rank.
+       Allocate return array if unallocated.
+       * generated/shape_i4.c:  Regenerated.
+       * generated/shape_i8.c:  Regenerated.
+       * generated/shape_i16.c:  Regenerated.
+
 2010-10-20  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        PR libgfortran/46079

diff --git a/libgfortran/generated/shape_i16.c b/libgfortran/generated/shape_i16.c
index 9ce28577baa310eb8ec88f301d8cbbe2aeb92475..c2c52005a13a52b4436dd13ec8dd4ca0ee89a05a 100644 (file)
--- a/libgfortran/generated/shape_i16.c
+++ b/libgfortran/generated/shape_i16.c
@@ -41,13 +41,23 @@ shape_16 (gfc_array_i16 * const restrict ret,
   int n;
   index_type stride;
   index_type extent;
+  int rank;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+
+  if (ret->data == NULL)
+    {
+      GFC_DIMENSION_SET(ret->dim[0], 0, rank - 1, 1);
+      ret->offset = 0;
+      ret->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+    }
 
   stride = GFC_DESCRIPTOR_STRIDE(ret,0);
 
   if (GFC_DESCRIPTOR_EXTENT(ret,0) < 1)
     return;
 
-  for (n = 0; n < GFC_DESCRIPTOR_RANK (array); n++)
+  for (n = 0; n < rank; n++)
     {
       extent = GFC_DESCRIPTOR_EXTENT(array,n);
       ret->data[n * stride] = extent > 0 ? extent : 0 ;

diff --git a/libgfortran/generated/shape_i4.c b/libgfortran/generated/shape_i4.c
index 1b23335de5684997af3f54b7be44240a48687af1..0cef3327736b6b364b0050236c6c61dd4b49442a 100644 (file)
--- a/libgfortran/generated/shape_i4.c
+++ b/libgfortran/generated/shape_i4.c
@@ -41,13 +41,23 @@ shape_4 (gfc_array_i4 * const restrict ret,
   int n;
   index_type stride;
   index_type extent;
+  int rank;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+
+  if (ret->data == NULL)
+    {
+      GFC_DIMENSION_SET(ret->dim[0], 0, rank - 1, 1);
+      ret->offset = 0;
+      ret->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
+    }
 
   stride = GFC_DESCRIPTOR_STRIDE(ret,0);
 
   if (GFC_DESCRIPTOR_EXTENT(ret,0) < 1)
     return;
 
-  for (n = 0; n < GFC_DESCRIPTOR_RANK (array); n++)
+  for (n = 0; n < rank; n++)
     {
       extent = GFC_DESCRIPTOR_EXTENT(array,n);
       ret->data[n * stride] = extent > 0 ? extent : 0 ;

diff --git a/libgfortran/generated/shape_i8.c b/libgfortran/generated/shape_i8.c
index efe00a5dd331d3069ce2ba8aa7caa77687468e31..b457ae081c7c54f9cb1b49ff2992d6bdda68d7f2 100644 (file)
--- a/libgfortran/generated/shape_i8.c
+++ b/libgfortran/generated/shape_i8.c
@@ -41,13 +41,23 @@ shape_8 (gfc_array_i8 * const restrict ret,
   int n;
   index_type stride;
   index_type extent;
+  int rank;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+
+  if (ret->data == NULL)
+    {
+      GFC_DIMENSION_SET(ret->dim[0], 0, rank - 1, 1);
+      ret->offset = 0;
+      ret->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
+    }
 
   stride = GFC_DESCRIPTOR_STRIDE(ret,0);
 
   if (GFC_DESCRIPTOR_EXTENT(ret,0) < 1)
     return;
 
-  for (n = 0; n < GFC_DESCRIPTOR_RANK (array); n++)
+  for (n = 0; n < rank; n++)
     {
       extent = GFC_DESCRIPTOR_EXTENT(array,n);
       ret->data[n * stride] = extent > 0 ? extent : 0 ;

diff --git a/libgfortran/m4/shape.m4 b/libgfortran/m4/shape.m4
index eadd3b9b94503186125d3c78fa152468d6662661..a289b0a80769f35990d71c92a256edeecfc306ab 100644 (file)
--- a/libgfortran/m4/shape.m4
+++ b/libgfortran/m4/shape.m4
@@ -42,13 +42,23 @@ shape_'rtype_kind` ('rtype` * const restrict ret,
   int n;
   index_type stride;
   index_type extent;
+  int rank;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+
+  if (ret->data == NULL)
+    {
+      GFC_DIMENSION_SET(ret->dim[0], 0, rank - 1, 1);
+      ret->offset = 0;
+      ret->data = internal_malloc_size (sizeof ('rtype_name`) * rank);
+    }
 
   stride = GFC_DESCRIPTOR_STRIDE(ret,0);
 
   if (GFC_DESCRIPTOR_EXTENT(ret,0) < 1)
     return;
 
-  for (n = 0; n < GFC_DESCRIPTOR_RANK (array); n++)
+  for (n = 0; n < rank; n++)
     {
       extent = GFC_DESCRIPTOR_EXTENT(array,n);
       ret->data[n * stride] = extent > 0 ? extent : 0 ;