OSDN Git Service

2005-09-13 Paul Thomas <pault@gcc.gnu.org>
authorpault <pault@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 14 Sep 2005 05:12:04 +0000 (05:12 +0000)
committerpault <pault@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 14 Sep 2005 05:12:04 +0000 (05:12 +0000)
PR fortran/19358
* trans-array.c (gfc_trans_dummy_array_bias): correct the typo
which uses dim[i].upper for lbound, rather than dim[i].lower.

2005-09-13  Paul Thomas  <pault@gcc.gnu.org>

PR fortran/19358
* gfortran.fortran-torture/assumed_dummy_1.f90: New test.

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

gcc/fortran/ChangeLog
gcc/fortran/trans-array.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/assumed_dummy_1.f90 [new file with mode: 0644]

index 9bde936..eb93719 100644 (file)
@@ -1,3 +1,9 @@
+2005-09-14  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/19358
+       * trans-array.c (gfc_trans_dummy_array_bias): correct the typo
+       which uses dim[i].upper for lbound, rather than dim[i].lower.
+
 2005-09-13  Erik Edelmann  <erik.edelmann@iki.fi>
 
        PR fortran/17740
index a72a19d..c284dca 100644 (file)
@@ -3477,7 +3477,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
       if (!INTEGER_CST_P (lbound))
         {
           gfc_init_se (&se, NULL);
-          gfc_conv_expr_type (&se, sym->as->upper[n],
+          gfc_conv_expr_type (&se, sym->as->lower[n],
                               gfc_array_index_type);
           gfc_add_block_to_block (&block, &se.pre);
           gfc_add_modify_expr (&block, lbound, se.expr);
index e871629..fda2fb3 100644 (file)
@@ -1,3 +1,8 @@
+2005-09-13  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/19358
+       * gfortran.fortran-torture/assumed_dummy_1.f90: New test.
+
 2005-09-13 Josh Conner <jconner@apple.com>
 
        PR c++/23180
diff --git a/gcc/testsuite/gfortran.dg/assumed_dummy_1.f90 b/gcc/testsuite/gfortran.dg/assumed_dummy_1.f90
new file mode 100644 (file)
index 0000000..a160a88
--- /dev/null
@@ -0,0 +1,46 @@
+! { dg do-run}
+! Tests the fix for PRs 19358, 19477, 21211 and 21622.
+!
+! Note that this tests only the valid cases with explicit interfaces.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+module global
+contains
+  SUBROUTINE goo (x, i)
+    REAL, DIMENSION(i:)     :: x
+    integer                 :: i
+    x (3) = 99.0
+  END SUBROUTINE goo
+end module global
+
+SUBROUTINE foo (x, i)
+  REAL, DIMENSION(i:)       :: x
+  integer                   :: i
+  x (4) = 42.0
+END SUBROUTINE foo
+
+program test
+  use global
+  real, dimension(3)        :: y = 0
+  integer                   :: j = 2
+
+interface
+  SUBROUTINE foo (x, i)
+    REAL, DIMENSION(i:)     :: x
+    integer                 :: i
+  END SUBROUTINE foo
+end interface
+  call foo (y, j)
+  call goo (y, j)
+  call roo (y, j)
+  if (any(y.ne.(/21.0, 99.0, 42.0/))) call abort ()
+contains
+  SUBROUTINE roo (x, i)
+    REAL, DIMENSION(i:)     :: x
+    integer                 :: i
+    x (2) = 21.0
+  END SUBROUTINE roo
+end program test
+
+