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.
This commit is contained in:
parent
2e63128306
commit
49d73c9fb6
2 changed files with 20 additions and 0 deletions
|
@ -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) */
|
||||
|
|
14
gcc/testsuite/gfortran.dg/masklr_3.f90
Normal file
14
gcc/testsuite/gfortran.dg/masklr_3.f90
Normal file
|
@ -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
|
Loading…
Add table
Reference in a new issue