This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[PATCH] PR fortran/91565 -- Extra checks on ORDER
- 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, 27 Aug 2019 15:00:53 -0700
- Subject: [PATCH] PR fortran/91565 -- Extra checks on ORDER
- Reply-to: sgk at troutmask dot apl dot washington dot edu
The attached ptch implements additional checks on the
ORDER dummy argument for the RESHAPE intrinsic function.
Built and regression tested on x86_64-*-freebsd. OK to
commit?
2019-08-27 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/91565
* simplify.c (gfc_simplify_reshape): Add additional checks of the
ORDER dummy argument.
2019-08-27 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/91565
* gfortran.dg/pr91565.f90: New test.
--
Steve
Index: gcc/fortran/simplify.c
===================================================================
--- gcc/fortran/simplify.c (revision 274961)
+++ gcc/fortran/simplify.c (working copy)
@@ -6495,7 +6503,14 @@ gfc_simplify_real (gfc_expr *e, gfc_expr *k)
if (e->expr_type != EXPR_CONSTANT)
return NULL;
+ /* For explicit conversion, turn off -Wconversion and -Wconversion-extra
+ warning. */
+ tmp1 = warn_conversion;
+ tmp2 = warn_conversion_extra;
+ warn_conversion = warn_conversion_extra = 0;
result = gfc_convert_constant (e, BT_REAL, kind);
+ warn_conversion = tmp1;
+ warn_conversion_extra = tmp2;
if (result == &gfc_bad_expr)
return &gfc_bad_expr;
@@ -6668,6 +6683,9 @@ gfc_simplify_reshape (gfc_expr *source, gfc_expr *shap
mpz_init (index);
rank = 0;
+ for (i = 0; i < GFC_MAX_DIMENSIONS; i++)
+ x[i] = 0;
+
for (;;)
{
e = gfc_constructor_lookup_expr (shape_exp->value.constructor, rank);
@@ -6692,9 +6710,29 @@ gfc_simplify_reshape (gfc_expr *source, gfc_expr *shap
}
else
{
- for (i = 0; i < rank; i++)
- x[i] = 0;
+ mpz_t size;
+ int order_size, shape_size;
+ if (order_exp->rank != shape_exp->rank)
+ {
+ gfc_error ("Shapes of ORDER at %L and SHAPE at %L are different",
+ &order_exp->where, &shape_exp->where);
+ return &gfc_bad_expr;
+ }
+
+ gfc_array_size (shape_exp, &size);
+ shape_size = mpz_get_ui (size);
+ mpz_clear (size);
+ gfc_array_size (order_exp, &size);
+ order_size = mpz_get_ui (size);
+ mpz_clear (size);
+ if (order_size != shape_size)
+ {
+ gfc_error ("Sizes of ORDER at %L and SHAPE at %L are different",
+ &order_exp->where, &shape_exp->where);
+ return &gfc_bad_expr;
+ }
+
for (i = 0; i < rank; i++)
{
e = gfc_constructor_lookup_expr (order_exp->value.constructor, i);
@@ -6704,7 +6742,12 @@ gfc_simplify_reshape (gfc_expr *source, gfc_expr *shap
gcc_assert (order[i] >= 1 && order[i] <= rank);
order[i]--;
- gcc_assert (x[order[i]] == 0);
+ if (x[order[i]] != 0)
+ {
+ gfc_error ("ORDER at %L is not a permutation of the size of "
+ "SHAPE at %L", &order_exp->where, &shape_exp->where);
+ return &gfc_bad_expr;
+ }
x[order[i]] = 1;
}
}
Index: gcc/testsuite/gfortran.dg/pr91565.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr91565.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr91565.f90 (working copy)
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! PR fortran/91565
+! Contributed by Gerhard Steinmetz
+program p
+ integer, parameter :: a(2) = [2,2] ! { dg-error "\(1\)" }
+ print *, reshape([1,2,3,4,5,6], [2,3], order=a) ! { dg-error "not a permutation" }
+end
+
+subroutine foo
+ integer, parameter :: a(1) = 1 ! { dg-error "\(1\)" }
+ print *, reshape([1,2,3,4,5,6], [2,3], order=a) ! { dg-error "are different" }
+end
+
+subroutine bar
+ integer, parameter :: a(1,2) = 1 ! { dg-error "\(1\)" }
+ print *, reshape([1,2,3,4,5,6], [2,3], order=a) ! { dg-error "are different" }
+end