Commit 14df5747 by Scott Robert Ladd

Added pedantic_min_int to gfc_integer_info Added ARITH_ASYMMETRIC to arith...

Added pedantic_min_int to gfc_integer_info
Added ARITH_ASYMMETRIC to arith
Added support for an "asymmetric integer" warning when compiling with pedantic
Set minimum integer values to reflect realities of two's complement signed integers

From-SVN: r89785
parent 7ec02c04
......@@ -27,6 +27,7 @@ Software Foundation, 59 Temple Place - Suite 330, Boston, MA
#include "config.h"
#include "system.h"
#include "flags.h"
#include "gfortran.h"
#include "arith.h"
......@@ -157,6 +158,9 @@ gfc_arith_error (arith code)
case ARITH_INCOMMENSURATE:
p = "Array operands are incommensurate";
break;
case ARITH_ASYMMETRIC:
p = "Integer outside symmetric range implied by Standard Fortran";
break;
default:
gfc_internal_error ("gfc_arith_error(): Bad error code");
}
......@@ -194,11 +198,20 @@ gfc_arith_init_1 (void)
/* These are the numbers that are actually representable by the
target. For bases other than two, this needs to be changed. */
if (int_info->radix != 2)
gfc_internal_error ("Fix min_int, max_int calculation");
gfc_internal_error ("Fix min_int, max_int calculation");
/* See PRs 13490 and 17912, related to integer ranges.
The pedantic_min_int exists for range checking when a program
is compiled with -pedantic, and reflects the belief that
Standard Fortran requires integers to be symmetrical, i.e.
every negative integer must have a representable positive
absolute value, and vice versa. */
mpz_init (int_info->pedantic_min_int);
mpz_neg (int_info->pedantic_min_int, int_info->huge);
mpz_init (int_info->min_int);
mpz_neg (int_info->min_int, int_info->huge);
/* No -1 here, because the representation is symmetric. */
mpz_sub_ui(int_info->min_int, int_info->pedantic_min_int, 1);
mpz_init (int_info->max_int);
mpz_add (int_info->max_int, int_info->huge, int_info->huge);
......@@ -317,7 +330,8 @@ gfc_arith_done_1 (void)
/* Given an integer and a kind, make sure that the integer lies within
the range of the kind. Returns ARITH_OK or ARITH_OVERFLOW. */
the range of the kind. Returns ARITH_OK, ARITH_ASYMMETRIC or
ARITH_OVERFLOW. */
static arith
gfc_check_integer_range (mpz_t p, int kind)
......@@ -328,6 +342,12 @@ gfc_check_integer_range (mpz_t p, int kind)
i = gfc_validate_kind (BT_INTEGER, kind, false);
result = ARITH_OK;
if (pedantic)
{
if (mpz_cmp (p, gfc_integer_kinds[i].pedantic_min_int) < 0)
result = ARITH_ASYMMETRIC;
}
if (mpz_cmp (p, gfc_integer_kinds[i].min_int) < 0
|| mpz_cmp (p, gfc_integer_kinds[i].max_int) > 0)
result = ARITH_OVERFLOW;
......@@ -529,7 +549,7 @@ gfc_range_check (gfc_expr * e)
default:
gfc_internal_error ("gfc_range_check(): Bad type");
}
return rc;
}
......@@ -582,6 +602,12 @@ gfc_arith_uminus (gfc_expr * op1, gfc_expr ** resultp)
rc = ARITH_OK;
*resultp = result;
}
else if (rc == ARITH_ASYMMETRIC)
{
gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where);
rc = ARITH_OK;
*resultp = result;
}
else if (rc != ARITH_OK)
gfc_free_expr (result);
else
......@@ -631,6 +657,12 @@ gfc_arith_plus (gfc_expr * op1, gfc_expr * op2, gfc_expr ** resultp)
rc = ARITH_OK;
*resultp = result;
}
else if (rc == ARITH_ASYMMETRIC)
{
gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where);
rc = ARITH_OK;
*resultp = result;
}
else if (rc != ARITH_OK)
gfc_free_expr (result);
else
......@@ -680,6 +712,12 @@ gfc_arith_minus (gfc_expr * op1, gfc_expr * op2, gfc_expr ** resultp)
rc = ARITH_OK;
*resultp = result;
}
else if (rc == ARITH_ASYMMETRIC)
{
gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where);
rc = ARITH_OK;
*resultp = result;
}
else if (rc != ARITH_OK)
gfc_free_expr (result);
else
......@@ -743,6 +781,12 @@ gfc_arith_times (gfc_expr * op1, gfc_expr * op2, gfc_expr ** resultp)
rc = ARITH_OK;
*resultp = result;
}
else if (rc == ARITH_ASYMMETRIC)
{
gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where);
rc = ARITH_OK;
*resultp = result;
}
else if (rc != ARITH_OK)
gfc_free_expr (result);
else
......@@ -839,6 +883,12 @@ gfc_arith_divide (gfc_expr * op1, gfc_expr * op2, gfc_expr ** resultp)
rc = ARITH_OK;
*resultp = result;
}
else if (rc == ARITH_ASYMMETRIC)
{
gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where);
rc = ARITH_OK;
*resultp = result;
}
else if (rc != ARITH_OK)
gfc_free_expr (result);
else
......@@ -1029,11 +1079,17 @@ gfc_arith_power (gfc_expr * op1, gfc_expr * op2, gfc_expr ** resultp)
rc = ARITH_OK;
*resultp = result;
}
else if (rc == ARITH_ASYMMETRIC)
{
gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where);
rc = ARITH_OK;
*resultp = result;
}
else if (rc != ARITH_OK)
gfc_free_expr (result);
else
*resultp = result;
return rc;
}
......@@ -1932,9 +1988,16 @@ gfc_int2int (gfc_expr * src, int kind)
if ((rc = gfc_check_integer_range (result->value.integer, kind))
!= ARITH_OK)
{
arith_error (rc, &src->ts, &result->ts, &src->where);
gfc_free_expr (result);
return NULL;
if (rc == ARITH_ASYMMETRIC)
{
gfc_warning ("%s at %L", gfc_arith_error (rc), &src->where);
}
else
{
arith_error (rc, &src->ts, &result->ts, &src->where);
gfc_free_expr (result);
return NULL;
}
}
return result;
......
......@@ -185,7 +185,7 @@ extern mstring intrinsic_operators[];
/* Arithmetic results. */
typedef enum
{ ARITH_OK = 1, ARITH_OVERFLOW, ARITH_UNDERFLOW, ARITH_NAN,
ARITH_DIV0, ARITH_0TO0, ARITH_INCOMMENSURATE
ARITH_DIV0, ARITH_0TO0, ARITH_INCOMMENSURATE, ARITH_ASYMMETRIC
}
arith;
......@@ -1100,7 +1100,7 @@ gfc_expr;
typedef struct
{
/* Values really representable by the target. */
mpz_t huge, min_int, max_int;
mpz_t huge, pedantic_min_int, min_int, max_int;
int kind, radix, digits, bit_size, range;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment