aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/simplify.c
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran/simplify.c')
-rw-r--r--gcc/fortran/simplify.c72
1 files changed, 38 insertions, 34 deletions
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 2f96e90..eb3e8c3 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -1,6 +1,6 @@
/* Simplify intrinsic functions at compile-time.
- Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
- 2010, 2011 Free Software Foundation, Inc.
+ Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+ 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
Contributed by Andy Vaught & Katherine Holcomb
This file is part of GCC.
@@ -82,7 +82,7 @@ range_check (gfc_expr *result, const char *name)
{
case ARITH_OK:
return result;
-
+
case ARITH_OVERFLOW:
gfc_error ("Result of %s overflows its kind at %L", name,
&result->where);
@@ -380,7 +380,7 @@ compute_dot_product (gfc_expr *matrix_a, int stride_a, int offset_a,
}
-/* Build a result expression for transformational intrinsics,
+/* Build a result expression for transformational intrinsics,
depending on DIM. */
static gfc_expr *
@@ -491,7 +491,7 @@ simplify_transformation_to_scalar (gfc_expr *result, gfc_expr *array, gfc_expr *
REAL, PARAMETER :: array(n, m) = ...
REAL, PARAMETER :: s(n) = PROD(array, DIM=1)
- where OP == gfc_multiply(). The result might be post processed using post_op. */
+ where OP == gfc_multiply(). The result might be post processed using post_op. */
static gfc_expr *
simplify_transformation_to_array (gfc_expr *result, gfc_expr *array, gfc_expr *dim,
@@ -1314,7 +1314,7 @@ gfc_simplify_bessel_n2 (gfc_expr *order1, gfc_expr *order2, gfc_expr *x,
mpfr_clear (last1);
return result;
}
-
+
/* Get second recursion anchor. */
mpfr_init (last2);
@@ -1335,7 +1335,7 @@ gfc_simplify_bessel_n2 (gfc_expr *order1, gfc_expr *order2, gfc_expr *x,
}
if (jn)
gfc_constructor_insert_expr (&result->value.constructor, e, &x->where, -2);
- else
+ else
gfc_constructor_append_expr (&result->value.constructor, e, &x->where);
if (n1 + 1 == n2)
@@ -1349,7 +1349,7 @@ gfc_simplify_bessel_n2 (gfc_expr *order1, gfc_expr *order2, gfc_expr *x,
mpfr_init (x2rev);
mpfr_ui_div (x2rev, 2, x->value.real, GFC_RND_MODE);
-
+
for (i = 2; i <= n2-n1; i++)
{
e = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
@@ -1743,7 +1743,7 @@ gfc_simplify_cosh (gfc_expr *x)
case BT_COMPLEX:
mpc_cosh (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
break;
-
+
default:
gcc_unreachable ();
}
@@ -2251,6 +2251,10 @@ gfc_simplify_extends_type_of (gfc_expr *a, gfc_expr *mold)
return gfc_get_logical_expr (gfc_default_logical_kind, &a->where,
gfc_type_is_extension_of (mold->ts.u.derived,
a->ts.u.derived));
+
+ if (UNLIMITED_POLY (a) || UNLIMITED_POLY (mold))
+ return NULL;
+
/* Return .false. if the dynamic type can never be the same. */
if ((a->ts.type == BT_CLASS && mold->ts.type == BT_CLASS
&& !gfc_type_is_extension_of
@@ -2676,7 +2680,7 @@ gfc_simplify_index (gfc_expr *x, gfc_expr *y, gfc_expr *b, gfc_expr *kind)
int back, len, lensub;
int i, j, k, count, index = 0, start;
- if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT
+ if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT
|| ( b != NULL && b->expr_type != EXPR_CONSTANT))
return NULL;
@@ -2685,7 +2689,7 @@ gfc_simplify_index (gfc_expr *x, gfc_expr *y, gfc_expr *b, gfc_expr *kind)
else
back = 0;
- k = get_kind (BT_INTEGER, kind, "INDEX", gfc_default_integer_kind);
+ k = get_kind (BT_INTEGER, kind, "INDEX", gfc_default_integer_kind);
if (k == -1)
return &gfc_bad_expr;
@@ -3229,7 +3233,7 @@ simplify_bound_dim (gfc_expr *array, gfc_expr *kind, int d, int upper,
int k;
k = get_kind (BT_INTEGER, kind, upper ? "UBOUND" : "LBOUND",
- gfc_default_integer_kind);
+ gfc_default_integer_kind);
if (k == -1)
return &gfc_bad_expr;
@@ -3558,7 +3562,7 @@ simplify_cobound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind, int upper)
e->expr_type = EXPR_ARRAY;
e->ts.type = BT_INTEGER;
k = get_kind (BT_INTEGER, kind, upper ? "UCOBOUND" : "LCOBOUND",
- gfc_default_integer_kind);
+ gfc_default_integer_kind);
if (k == -1)
{
gfc_free_expr (e);
@@ -3912,7 +3916,7 @@ gfc_simplify_maskr (gfc_expr *i, gfc_expr *kind_arg)
if (i->expr_type != EXPR_CONSTANT)
return NULL;
-
+
kind = get_kind (BT_INTEGER, kind_arg, "MASKR", gfc_default_integer_kind);
if (kind == -1)
return &gfc_bad_expr;
@@ -3944,7 +3948,7 @@ gfc_simplify_maskl (gfc_expr *i, gfc_expr *kind_arg)
if (i->expr_type != EXPR_CONSTANT)
return NULL;
-
+
kind = get_kind (BT_INTEGER, kind_arg, "MASKL", gfc_default_integer_kind);
if (kind == -1)
return &gfc_bad_expr;
@@ -4066,7 +4070,7 @@ min_max_choose (gfc_expr *arg, gfc_expr *extremum, int sign)
#undef LENGTH
#undef STRING
break;
-
+
default:
gfc_internal_error ("simplify_min_max(): Bad type in arglist");
}
@@ -4119,14 +4123,14 @@ simplify_min_max (gfc_expr *expr, int sign)
return NULL;
/* Convert to the correct type and kind. */
- if (expr->ts.type != BT_UNKNOWN)
+ if (expr->ts.type != BT_UNKNOWN)
return gfc_convert_constant (expr->value.function.actual->expr,
expr->ts.type, expr->ts.kind);
- if (specific->ts.type != BT_UNKNOWN)
+ if (specific->ts.type != BT_UNKNOWN)
return gfc_convert_constant (expr->value.function.actual->expr,
- specific->ts.type, specific->ts.kind);
-
+ specific->ts.type, specific->ts.kind);
+
return gfc_copy_expr (expr->value.function.actual->expr);
}
@@ -4176,14 +4180,14 @@ simplify_minval_maxval (gfc_expr *expr, int sign)
return NULL;
/* Convert to the correct type and kind. */
- if (expr->ts.type != BT_UNKNOWN)
+ if (expr->ts.type != BT_UNKNOWN)
return gfc_convert_constant (extremum->expr,
expr->ts.type, expr->ts.kind);
- if (specific->ts.type != BT_UNKNOWN)
+ if (specific->ts.type != BT_UNKNOWN)
return gfc_convert_constant (extremum->expr,
- specific->ts.type, specific->ts.kind);
-
+ specific->ts.type, specific->ts.kind);
+
return gfc_copy_expr (extremum->expr);
}
@@ -4261,7 +4265,7 @@ gfc_simplify_mod (gfc_expr *a, gfc_expr *p)
}
gfc_set_model_kind (kind);
- mpfr_fmod (result->value.real, a->value.real, p->value.real,
+ mpfr_fmod (result->value.real, a->value.real, p->value.real,
GFC_RND_MODE);
break;
@@ -4310,7 +4314,7 @@ gfc_simplify_modulo (gfc_expr *a, gfc_expr *p)
}
gfc_set_model_kind (kind);
- mpfr_fmod (result->value.real, a->value.real, p->value.real,
+ mpfr_fmod (result->value.real, a->value.real, p->value.real,
GFC_RND_MODE);
if (mpfr_cmp_ui (result->value.real, 0) != 0)
{
@@ -4319,7 +4323,7 @@ gfc_simplify_modulo (gfc_expr *a, gfc_expr *p)
GFC_RND_MODE);
}
else
- mpfr_copysign (result->value.real, result->value.real,
+ mpfr_copysign (result->value.real, result->value.real,
p->value.real, GFC_RND_MODE);
break;
@@ -4621,7 +4625,7 @@ gfc_simplify_pack (gfc_expr *array, gfc_expr *mask, gfc_expr *vector)
}
else if (mask->expr_type == EXPR_ARRAY)
{
- /* Copy only those elements of ARRAY to RESULT whose
+ /* Copy only those elements of ARRAY to RESULT whose
MASK equals .TRUE.. */
mask_ctor = gfc_constructor_first (mask->value.constructor);
while (mask_ctor)
@@ -4921,8 +4925,8 @@ gfc_simplify_repeat (gfc_expr *e, gfc_expr *n)
if (e->expr_type != EXPR_CONSTANT)
return NULL;
- if (len ||
- (e->ts.u.cl->length &&
+ if (len ||
+ (e->ts.u.cl->length &&
mpz_sgn (e->ts.u.cl->length->value.integer)) != 0)
{
const char *res = gfc_extract_int (n, &ncop);
@@ -5740,7 +5744,7 @@ gfc_simplify_spacing (gfc_expr *x)
}
/* In the Fortran 95 standard, the result is b**(e - p) where b, e, and p
- are the radix, exponent of x, and precision. This excludes the
+ are the radix, exponent of x, and precision. This excludes the
possibility of subnormal numbers. Fortran 2003 states the result is
b**max(e - p, emin - 1). */
@@ -6025,11 +6029,11 @@ gfc_simplify_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size)
: mold;
/* Set result character length, if needed. Note that this needs to be
- set even for array expressions, in order to pass this information into
+ set even for array expressions, in order to pass this information into
gfc_target_interpret_expr. */
if (result->ts.type == BT_CHARACTER && gfc_is_constant_expr (mold_element))
result->value.character.length = mold_element->value.character.length;
-
+
/* Set the number of elements in the result, and determine its size. */
if (mold->expr_type == EXPR_ARRAY || mold->rank || size)
@@ -6087,7 +6091,7 @@ gfc_simplify_transpose (gfc_expr *matrix)
{
gfc_expr *e = gfc_constructor_lookup_expr (matrix->value.constructor,
col * matrix_rows + row);
- gfc_constructor_insert_expr (&result->value.constructor,
+ gfc_constructor_insert_expr (&result->value.constructor,
gfc_copy_expr (e), &matrix->where,
row * matrix_cols + col);
}
generated by cgit v1.1 at 2025-05-29 20:13:29 +0000