PR fortran/19269

	* simplify.c (gfc_simplify_transpose): Set the result's typespec from
	the source, not the first element of the return value.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@103982 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e88f468..dbfc43f 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2005-09-06  Richard Sandiford  <richard@codesourcery.com>
+
+       PR fortran/19269
+       * simplify.c (gfc_simplify_transpose): Set the result's typespec from
+       the source, not the first element of the return value.
+
 2005-09-04  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
 
        PR fortran/23661

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 72d03ea..44dfe1a 100644 (file)
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -2858,7 +2858,7 @@ inc:
   for (i = 0; i < rank; i++)
     mpz_init_set_ui (e->shape[i], shape[i]);
 
-  e->ts = head->expr->ts;
+  e->ts = source->ts;
   e->rank = rank;
 
   return e;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 74e070b..f173375 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2005-09-06  Richard Sandiford  <richard@codesourcery.com>
+
+       PR fortran/19269
+       * gfortran.fortran-torture/execute/pr19269-1.f90: New test.
+
 2005-09-06  Jakub Jelinek  <jakub@redhat.com>
 
        PR c/23075

diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/pr19269-1.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/pr19269-1.f90
new file mode 100644 (file)
index 0000000..03224c3
--- /dev/null
+++ b/gcc/testsuite/gfortran.fortran-torture/execute/pr19269-1.f90
@@ -0,0 +1,16 @@
+program main
+  call test (reshape ((/ 'a', 'b', 'c', 'd' /), (/ 2, 2 /)))
+contains
+  subroutine test (a)
+    character (len = *), dimension (:, :) :: a
+
+    if (size (a, 1) .ne. 2) call abort
+    if (size (a, 2) .ne. 2) call abort
+    if (len (a) .ne. 1) call abort
+
+    if (a (1, 1) .ne. 'a') call abort
+    if (a (2, 1) .ne. 'b') call abort
+    if (a (1, 2) .ne. 'c') call abort
+    if (a (2, 2) .ne. 'd') call abort
+  end subroutine test
+end program main