summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHarald Anlauf <anlauf@gmx.de>2024-01-27 17:41:43 +0100
committerHarald Anlauf <anlauf@gmx.de>2024-02-09 20:45:07 +0100
commit07b575d5860dbc8791dbb9d10af9f918f34d7ff0 (patch)
tree5df6f8e6e35c14e58550d95242b027bf52d8dade
parent010e4a04c4daaf1b0dacf6aa30fcbdaa73eda33c (diff)
Fortran: fix bounds-checking errors for CLASS array dummies [PR104908]
Commit r11-1235 addressed issues with bounds of unlimited polymorphic array dummies. However, using the descriptor from sym->backend_decl does break the case of CLASS array dummies. The obvious solution is to restrict the fix to the unlimited polymorphic case, thus keeping the original descriptor in the ordinary case. gcc/fortran/ChangeLog: PR fortran/104908 * trans-array.c (gfc_conv_array_ref): Restrict use of transformed descriptor (sym->backend_decl) to the unlimited polymorphic case. gcc/testsuite/ChangeLog: PR fortran/104908 * gfortran.dg/pr104908.f90: New test. (cherry picked from commit ce61de1b8a1bb3a22118e900376f380768f2ba59)
-rw-r--r--gcc/fortran/trans-array.c5
-rw-r--r--gcc/testsuite/gfortran.dg/pr104908.f9032
2 files changed, 36 insertions, 1 deletions
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index abdecc7df7a..44f6ad7c8a0 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -3723,7 +3723,10 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_expr *expr,
}
decl = se->expr;
- if (IS_CLASS_ARRAY (sym) && sym->attr.dummy && ar->as->type != AS_DEFERRED)
+ if (UNLIMITED_POLY(sym)
+ && IS_CLASS_ARRAY (sym)
+ && sym->attr.dummy
+ && ar->as->type != AS_DEFERRED)
decl = sym->backend_decl;
cst_offset = offset = gfc_index_zero_node;
diff --git a/gcc/testsuite/gfortran.dg/pr104908.f90 b/gcc/testsuite/gfortran.dg/pr104908.f90
new file mode 100644
index 00000000000..c3a30b0003c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr104908.f90
@@ -0,0 +1,32 @@
+! { dg-do compile }
+! { dg-additional-options "-fcheck=bounds -fdump-tree-original" }
+!
+! PR fortran/104908 - incorrect out-of-bounds runtime error
+
+program test
+ implicit none
+ type vec
+ integer :: x(3) = [2,4,6]
+ end type vec
+ type(vec) :: w(2)
+ call sub(w)
+contains
+ subroutine sub (v)
+ class(vec), intent(in) :: v(:)
+ integer :: k, q(3)
+ q = [ (v(1)%x(k), k = 1, 3) ] ! <-- was failing here after r11-1235
+ print *, q
+ end
+end
+
+subroutine sub2 (zz)
+ implicit none
+ type vec
+ integer :: x(2,1)
+ end type vec
+ class(vec), intent(in) :: zz(:) ! used to ICE after r11-1235
+ integer :: k
+ k = zz(1)%x(2,1)
+end
+
+! { dg-final { scan-tree-dump-times " above upper bound " 4 "original" } }