diff options
| author | Harald Anlauf <anlauf@gmx.de> | 2022-12-10 22:05:15 +0100 |
|---|---|---|
| committer | Harald Anlauf <anlauf@gmx.de> | 2022-12-10 22:05:15 +0100 |
| commit | ae4438537fbc2ed04f3b0fb32d4e02b0ed6977a1 (patch) | |
| tree | 3354cf55ca8d797df65f0ad8ca1d0316d3b72e8a | |
| parent | 7676235f690e624b7ed41a22b22ce8ccfac1492f (diff) | |
| download | gcc-ae4438537fbc2ed04f3b0fb32d4e02b0ed6977a1.zip gcc-ae4438537fbc2ed04f3b0fb32d4e02b0ed6977a1.tar.gz gcc-ae4438537fbc2ed04f3b0fb32d4e02b0ed6977a1.tar.bz2 | |
Fortran: reject bad SIZE argument while simplifying ISHFTC [PR106911]
gcc/fortran/ChangeLog:
PR fortran/106911
* simplify.cc (gfc_simplify_ishftc): If the SIZE argument is known
to be outside the allowed range, terminate simplification.
gcc/testsuite/ChangeLog:
PR fortran/106911
* gfortran.dg/pr106911.f90: New test.
| -rw-r--r-- | gcc/fortran/simplify.cc | 3 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/pr106911.f90 | 18 |
2 files changed, 21 insertions, 0 deletions
diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc index aff9a1b..3d3aaba 100644 --- a/gcc/fortran/simplify.cc +++ b/gcc/fortran/simplify.cc @@ -3955,6 +3955,9 @@ gfc_simplify_ishftc (gfc_expr *e, gfc_expr *s, gfc_expr *sz) return NULL; gfc_extract_int (sz, &ssize); + + if (ssize > isize || ssize <= 0) + return &gfc_bad_expr; } else ssize = isize; diff --git a/gcc/testsuite/gfortran.dg/pr106911.f90 b/gcc/testsuite/gfortran.dg/pr106911.f90 new file mode 100644 index 0000000..f3fe7f6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr106911.f90 @@ -0,0 +1,18 @@ +! { dg-do compile } +! PR fortran/106911 - ICE in gfc_convert_mpz_to_signed +! Contributed by G.Steinmetz + +program p + implicit none + integer, parameter :: a = 10 + integer, parameter :: b = 20 + integer, parameter :: c = ishftc(1_1, a, b) ! { dg-error "must be less than or equal" } + integer, parameter :: d = ishftc(1_1, a, 0) ! { dg-error "must be positive" } + interface + subroutine s + import :: a, b + integer, parameter :: e = ishftc(1_1, a, b) ! { dg-error "must be less than or equal" } + integer, parameter :: f = ishftc(1_1, a, 0) ! { dg-error "must be positive" } + end + end interface +end |