Catch division by zero errors in array sizes.

2019-12-30  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/92961
	* gfortran.h (gfc_seen_div0): Add declaration.
	* arith.h (gfc_seen_div0): Add definition.
	(eval_intrinsic): For integer division by zero, set gfc_seen_div0.
	* decl.c (variable_decl):  If resolution resp. simplification
	fails for array spec and a division of zero error has been
	seen, return MATCH_ERROR.

2019-12-30  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/92961
	* gfortran.dg/arith_divide_2.f90: New test.

From-SVN: r279762
This commit is contained in:
Thomas Koenig 2019-12-30 10:34:11 +00:00
parent c3182576ea
commit 6725111873
6 changed files with 59 additions and 4 deletions

View File

@ -1,3 +1,13 @@
2019-12-30 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/92961
* gfortran.h (gfc_seen_div0): Add declaration.
* arith.h (gfc_seen_div0): Add definition.
(eval_intrinsic): For integer division by zero, set gfc_seen_div0.
* decl.c (variable_decl): If resolution resp. simplification
fails for array spec and a division of zero error has been
seen, return MATCH_ERROR.
2019-12-21 Harald Anlauf <anlauf@gmx.de>
PR fortran/92990

View File

@ -32,6 +32,8 @@ along with GCC; see the file COPYING3. If not see
#include "target-memory.h"
#include "constructor.h"
bool gfc_seen_div0;
/* MPFR does not have a direct replacement for mpz_set_f() from GMP.
It's easily implemented with a few calls though. */
@ -1620,6 +1622,10 @@ eval_intrinsic (gfc_intrinsic_op op,
gfc_error (gfc_arith_error (rc), &op1->where);
if (rc == ARITH_OVERFLOW)
goto done;
if (rc == ARITH_DIV0 && op2->ts.type == BT_INTEGER)
gfc_seen_div0 = true;
return NULL;
}

View File

@ -2535,6 +2535,8 @@ variable_decl (int elem)
goto cleanup;
}
gfc_seen_div0 = false;
/* F2018:C830 (R816) An explicit-shape-spec whose bounds are not
constant expressions shall appear only in a subprogram, derived
type definition, BLOCK construct, or interface body. */
@ -2551,7 +2553,12 @@ variable_decl (int elem)
for (int i = 0; i < as->rank; i++)
{
e = gfc_copy_expr (as->lower[i]);
gfc_resolve_expr (e);
if (!gfc_resolve_expr (e) && gfc_seen_div0)
{
m = MATCH_ERROR;
goto cleanup;
}
gfc_simplify_expr (e, 0);
if (e && (e->expr_type != EXPR_CONSTANT))
{
@ -2561,7 +2568,12 @@ variable_decl (int elem)
gfc_free_expr (e);
e = gfc_copy_expr (as->upper[i]);
gfc_resolve_expr (e);
if (!gfc_resolve_expr (e) && gfc_seen_div0)
{
m = MATCH_ERROR;
goto cleanup;
}
gfc_simplify_expr (e, 0);
if (e && (e->expr_type != EXPR_CONSTANT))
{
@ -2587,7 +2599,12 @@ variable_decl (int elem)
if (e->expr_type != EXPR_CONSTANT)
{
n = gfc_copy_expr (e);
gfc_simplify_expr (n, 1);
if (!gfc_simplify_expr (n, 1) && gfc_seen_div0)
{
m = MATCH_ERROR;
goto cleanup;
}
if (n->expr_type == EXPR_CONSTANT)
gfc_replace_expr (e, n);
else
@ -2597,7 +2614,12 @@ variable_decl (int elem)
if (e->expr_type != EXPR_CONSTANT)
{
n = gfc_copy_expr (e);
gfc_simplify_expr (n, 1);
if (!gfc_simplify_expr (n, 1) && gfc_seen_div0)
{
m = MATCH_ERROR;
goto cleanup;
}
if (n->expr_type == EXPR_CONSTANT)
gfc_replace_expr (e, n);
else
@ -2934,6 +2956,7 @@ variable_decl (int elem)
cleanup:
/* Free stuff up and return. */
gfc_seen_div0 = false;
gfc_free_expr (initializer);
gfc_free_array_spec (as);

View File

@ -2995,6 +2995,8 @@ void gfc_arith_done_1 (void);
arith gfc_check_integer_range (mpz_t p, int kind);
bool gfc_check_character_range (gfc_char_t, int);
extern bool gfc_seen_div0;
/* trans-types.c */
bool gfc_check_any_c_kind (gfc_typespec *);
int gfc_validate_kind (bt, int, bool);

View File

@ -1,3 +1,8 @@
2019-12-30 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/92961
* gfortran.dg/arith_divide_2.f90: New test.
2019-12-30 Jakub Jelinek <jakub@redhat.com>
PR c++/92745

View File

@ -0,0 +1,9 @@
! { dg-do compile }
! PR 92961 - this used to ICE. Original test case by Gerhard Steinmetz.
program p
integer :: a((0)/0) ! { dg-error "Division by zero" }
integer :: b(0/(0)) ! { dg-error "Division by zero" }
integer :: c((0)/(0)) ! { dg-error "Division by zero" }
integer :: d(0/0) ! { dg-error "Division by zero" }
integer :: x = ubound(a,1) ! { dg-error "must be an array" }
end