This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[PATCH] PR fortran/66380 -- Remove assert() to allow error condition
- From: Steve Kargl <sgk at troutmask dot apl dot washington dot edu>
- To: fortran at gcc dot gnu dot org, gcc-patches at gcc dot gnu dot org
- Date: Tue, 2 Jun 2015 10:36:45 -0700
- Subject: [PATCH] PR fortran/66380 -- Remove assert() to allow error condition
- Authentication-results: sourceware.org; auth=none
The attached patch returns an assert() and returns NULL
during the simplification of a bad RESHAPE call. This
allows gfortran to correctly issue and error message.
Regression tested on trunk. OK to commit.
2015-05-27 Steven G. Kargl <kargl@gcc.gnu.org>
* simplify.c (gfc_simplify_reshape): Convert assert into returning
NULL, which triggers an error condition.
2015-05-27 Steven G. Kargl <kargl@gcc.gnu.org>
* gfortran.dg/reshape_7.f90: New test.
--
Steve
Index: fortran/simplify.c
===================================================================
--- fortran/simplify.c (revision 223986)
+++ fortran/simplify.c (working copy)
@@ -5188,8 +5188,11 @@ gfc_simplify_reshape (gfc_expr *source,
e = gfc_constructor_lookup_expr (source->value.constructor, j);
else
{
- gcc_assert (npad > 0);
-
+ if (npad <= 0)
+ {
+ mpz_clear (index);
+ return NULL;
+ }
j = j - nsource;
j = j % npad;
e = gfc_constructor_lookup_expr (pad->value.constructor, j);
Index: testsuite/gfortran.dg/reshape_7.f90
===================================================================
--- testsuite/gfortran.dg/reshape_7.f90 (revision 0)
+++ testsuite/gfortran.dg/reshape_7.f90 (working copy)
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! PR fortran/66380
+!
+subroutine p0
+ integer, parameter :: sh(2) = [2, 3]
+ integer, parameter :: &
+ & a(2,2) = reshape([1, 2, 3, 4], sh) ! { dg-error "Different shape" }
+ if (a(1,1) /= 0) call abort
+end subroutine p0
+
+
+subroutine p1
+ integer, parameter :: sh(2) = [2, 1]
+ integer, parameter :: &
+ & a(2,2) = reshape([1, 2, 3, 4], sh) ! { dg-error "Different shape" }
+ if (a(1,1) /= 0) call abort
+end subroutine p1