Fortran: Fix SHAPE for zero-size arrays
PR fortran/115150
gcc/fortran/ChangeLog:
* trans-intrinsic.cc (gfc_conv_intrinsic_bound): Fix SHAPE
for zero-size arrays
gcc/testsuite/ChangeLog:
* gfortran.dg/shape_12.f90: New test.
gcc/fortran/trans-intrinsic.cc | 4 ++-
gcc/testsuite/gfortran.dg/shape_12.f90 | 51 ++++++++++++++++++++++++++++++++++
2 files changed, 54 insertions(+), 1 deletion(-)
@@ -3090,7 +3090,9 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, enum gfc_isym_id op)
lbound, gfc_index_one_node);
}
else if (op == GFC_ISYM_SHAPE)
- se->expr = size;
+ se->expr = fold_build2_loc (input_location, MAX_EXPR,
+ gfc_array_index_type, size,
+ gfc_index_zero_node);
else
gcc_unreachable ();
new file mode 100644
@@ -0,0 +1,51 @@
+! { dg-do run }
+!
+! PR fortran/115150
+!
+! Check that SHAPE handles zero-sized arrays correctly
+!
+implicit none
+call one
+call two
+
+contains
+
+subroutine one
+ real,allocatable :: A(:),B(:,:)
+ allocate(a(3:0), b(5:1, 2:5))
+
+ if (any (shape(a) /= [0])) stop 1
+ if (any (shape(b) /= [0, 4])) stop 2
+ if (size(a) /= 0) stop 3
+ if (size(b) /= 0) stop 4
+ if (any (lbound(a) /= [1])) stop 5
+ if (any (lbound(b) /= [1, 2])) stop 6
+ if (any (ubound(a) /= [0])) stop 5
+ if (any (ubound(b) /= [0,5])) stop 6
+end
+
+subroutine two
+integer :: x1(10), x2(10,10)
+call f(x1, x2, -3)
+end
+
+subroutine f(y1, y2, n)
+ integer, value :: n
+ integer :: y1(1:n)
+ integer :: y2(1:n,4,2:*)
+ call g(y1, y2)
+end
+
+subroutine g(z1, z2)
+ integer :: z1(..), z2(..)
+
+ if (any (shape(z1) /= [0])) stop 1
+ if (any (shape(z2) /= [0, 4, -1])) stop 2
+ if (size(z1) /= 0) stop 3
+ if (size(z2) /= 0) stop 4
+ if (any (lbound(z1) /= [1])) stop 5
+ if (any (lbound(z2) /= [1, 1, 1])) stop 6
+ if (any (ubound(z1) /= [0])) stop 5
+ if (any (ubound(z2) /= [0, 4, -1])) stop 6
+end
+end