summaryrefslogtreecommitdiff
path: root/gcc/fortran/simplify.c
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran/simplify.c')
-rw-r--r--gcc/fortran/simplify.c86
1 files changed, 84 insertions, 2 deletions
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index d18bc081088..60d85934b72 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -5460,12 +5460,13 @@ gfc_simplify_selected_real_kind (gfc_expr *p, gfc_expr *q, gfc_expr *rdx)
if (gfc_real_kinds[i].range >= range)
found_range = 1;
- if (gfc_real_kinds[i].radix >= radix)
+ if (radix == 0 || gfc_real_kinds[i].radix == radix)
found_radix = 1;
if (gfc_real_kinds[i].precision >= precision
&& gfc_real_kinds[i].range >= range
- && gfc_real_kinds[i].radix >= radix && gfc_real_kinds[i].kind < kind)
+ && (radix == 0 || gfc_real_kinds[i].radix == radix)
+ && gfc_real_kinds[i].kind < kind)
kind = gfc_real_kinds[i].kind;
}
@@ -5488,6 +5489,87 @@ gfc_simplify_selected_real_kind (gfc_expr *p, gfc_expr *q, gfc_expr *rdx)
gfc_expr *
+gfc_simplify_ieee_selected_real_kind (gfc_expr *expr)
+{
+ gfc_actual_arglist *arg = expr->value.function.actual;
+ gfc_expr *p = arg->expr, *r = arg->next->expr,
+ *rad = arg->next->next->expr;
+ int precision, range, radix, res;
+ int found_precision, found_range, found_radix, i;
+
+ if (p)
+ {
+ if (p->expr_type != EXPR_CONSTANT
+ || gfc_extract_int (p, &precision) != NULL)
+ return NULL;
+ }
+ else
+ precision = 0;
+
+ if (r)
+ {
+ if (r->expr_type != EXPR_CONSTANT
+ || gfc_extract_int (r, &range) != NULL)
+ return NULL;
+ }
+ else
+ range = 0;
+
+ if (rad)
+ {
+ if (rad->expr_type != EXPR_CONSTANT
+ || gfc_extract_int (rad, &radix) != NULL)
+ return NULL;
+ }
+ else
+ radix = 0;
+
+ res = INT_MAX;
+ found_precision = 0;
+ found_range = 0;
+ found_radix = 0;
+
+ for (i = 0; gfc_real_kinds[i].kind != 0; i++)
+ {
+ /* We only support the target's float and double types. */
+ if (!gfc_real_kinds[i].c_float && !gfc_real_kinds[i].c_double)
+ continue;
+
+ if (gfc_real_kinds[i].precision >= precision)
+ found_precision = 1;
+
+ if (gfc_real_kinds[i].range >= range)
+ found_range = 1;
+
+ if (radix == 0 || gfc_real_kinds[i].radix == radix)
+ found_radix = 1;
+
+ if (gfc_real_kinds[i].precision >= precision
+ && gfc_real_kinds[i].range >= range
+ && (radix == 0 || gfc_real_kinds[i].radix == radix)
+ && gfc_real_kinds[i].kind < res)
+ res = gfc_real_kinds[i].kind;
+ }
+
+ if (res == INT_MAX)
+ {
+ if (found_radix && found_range && !found_precision)
+ res = -1;
+ else if (found_radix && found_precision && !found_range)
+ res = -2;
+ else if (found_radix && !found_precision && !found_range)
+ res = -3;
+ else if (found_radix)
+ res = -4;
+ else
+ res = -5;
+ }
+
+ return gfc_get_int_expr (gfc_default_integer_kind, &expr->where, res);
+}
+
+
+gfc_expr *
gfc_simplify_set_exponent (gfc_expr *x, gfc_expr *i)
{
gfc_expr *result;