From: Tobias Schlüter <tobias.schlueter@physik.uni-muenchen.de>
Date: Mon, 20 Sep 2004 17:22:50 +0000 (+0200)
Subject: re PR fortran/15957 (Error in array assignments; 'shape'-related stuff)
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=da89fba81fb25d870e75ebf454862752a8562f4c;p=gcc.git

re PR fortran/15957 (Error in array assignments; 'shape'-related stuff)

fortran/
PR fortran/15957
* simplify.c (gfc_simplify_reshape): Set shape of return value
correctly.

testsuite/
PR fortran/15957
* gfortran.dg/pr15957.f90: New test.

From-SVN: r87764
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 9053f3652d1..39f739c444a 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2004-09-20  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/15957
+	* simplify.c (gfc_simplify_reshape): Set shape of return value
+	correctly.
+
 2004-09-17  Jeffrey D. Oldham  <oldham@codesourcery.com>
 	    Zack Weinberg  <zack@codesourcery.com>
 
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 61ef50bdbcb..a599f894c6d 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -2822,7 +2822,7 @@ inc:
   e->shape = gfc_get_shape (rank);
 
   for (i = 0; i < rank; i++)
-    mpz_init_set_ui (e->shape[i], shape[order[i]]);
+    mpz_init_set_ui (e->shape[i], shape[i]);
 
   e->ts = head->expr->ts;
   e->rank = rank;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 3414502a11f..fe487a187cf 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2004-09-20  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/15957
+	* gfortran.dg/pr15957.f90: New test.
+
 2004-09-20  Dorit Naishlos  <dorit@il.ibm.com>
 
 	* gcc.dg/vect/vect-74.c: Avoid floating point precision error
diff --git a/gcc/testsuite/gfortran.dg/pr15957.f90 b/gcc/testsuite/gfortran.dg/pr15957.f90
new file mode 100644
index 00000000000..b1439131f89
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr15957.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+! PR 15957
+! we used to return the wrong shape when the order parameter was used
+! in reshape.
+!
+INTEGER, parameter :: i(2,3) = reshape ((/1,2,3,4,5,6/), (/2,3/)), &
+     j(2,4) = reshape ((/1,2,3,4,5,6/), (/2,4/), (/0,0/), (/2,1/))
+
+integer :: k(2,3), m(2,4), n(2,3), o(2,4)
+
+k(1,:) = (/ 1, 3, 5 /)
+k(2,:) = (/ 2, 4, 6 /)
+
+m(1,:) = (/ 1, 2, 3, 4 /)
+m(2,:) = (/ 5, 6, 0, 0 /)
+
+! check that reshape does the right thing while constant folding
+if (any(i /= k)) call abort()
+if (any(j /= m)) call abort()
+
+! check that reshape does the right thing at runtime
+n = reshape ((/1,2,3,4,5,6/), (/2,3/))
+if (any(n /= k)) call abort()
+o = reshape ((/1,2,3,4,5,6/), (/2,4/), (/0,0/), (/2,1/))
+if (any(o /= m)) call abort()
+end 
+