[gcc r11-9462] Fortran: check arguments of MASKL/MASKR intrinsics before simplification

[Harald Anlauf <anlauf@gcc.gnu.org>]

https://gcc.gnu.org/g:3bd2fd2840789909f6088d1c00d2efe9567293b4

commit r11-9462-g3bd2fd2840789909f6088d1c00d2efe9567293b4
Author: Harald Anlauf <anlauf@gmx.de>
Date:   Mon Dec 20 22:59:53 2021 +0100

    Fortran: check arguments of MASKL/MASKR intrinsics before simplification
    
    gcc/fortran/ChangeLog:
    
            PR fortran/103777
            * simplify.c (gfc_simplify_maskr): Check validity of argument 'I'
            before simplifying.
            (gfc_simplify_maskl): Likewise.
    
    gcc/testsuite/ChangeLog:
    
            PR fortran/103777
            * gfortran.dg/masklr_3.f90: New test.
    
    (cherry picked from commit 49d73c9fb644673323845efebfe6b3106e70af8a)

Diff:
---
 gcc/fortran/simplify.c                 |  6 ++++++
 gcc/testsuite/gfortran.dg/masklr_3.f90 | 14 ++++++++++++++
 2 files changed, 20 insertions(+)

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index fb7b7814603..664fac65a0b 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -4878,6 +4878,9 @@ gfc_simplify_maskr (gfc_expr *i, gfc_expr *kind_arg)
   bool fail = gfc_extract_int (i, &arg);
   gcc_assert (!fail);
 
+  if (!gfc_check_mask (i, kind_arg))
+    return &gfc_bad_expr;
+
   result = gfc_get_constant_expr (BT_INTEGER, kind, &i->where);
 
   /* MASKR(n) = 2^n - 1 */
@@ -4909,6 +4912,9 @@ gfc_simplify_maskl (gfc_expr *i, gfc_expr *kind_arg)
   bool fail = gfc_extract_int (i, &arg);
   gcc_assert (!fail);
 
+  if (!gfc_check_mask (i, kind_arg))
+    return &gfc_bad_expr;
+
   result = gfc_get_constant_expr (BT_INTEGER, kind, &i->where);
 
   /* MASKL(n) = 2^bit_size - 2^(bit_size - n) */
diff --git a/gcc/testsuite/gfortran.dg/masklr_3.f90 b/gcc/testsuite/gfortran.dg/masklr_3.f90
new file mode 100644
index 00000000000..eb689f0f408
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/masklr_3.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! PR fortran/103777 - ICE in gfc_simplify_maskl
+! Contributed by G.Steinmetz
+
+program p
+  print *, maskl([999])       ! { dg-error "must be less than or equal" }
+  print *, maskr([999])       ! { dg-error "must be less than or equal" }
+  print *, maskl([-999])      ! { dg-error "must be nonnegative" }
+  print *, maskr([-999])      ! { dg-error "must be nonnegative" }
+  print *, maskl([32],kind=4)
+  print *, maskl([33],kind=4) ! { dg-error "must be less than or equal" }
+  print *, maskl([64],kind=8)
+  print *, maskl([65],kind=8) ! { dg-error "must be less than or equal" }
+end