diff --git a/SOURCES/0005-Allow-comparisons-between-INTEGER-and-REAL.patch b/SOURCES/0005-Allow-comparisons-between-INTEGER-and-REAL.patch index 19adee1..29c1162 100644 --- a/SOURCES/0005-Allow-comparisons-between-INTEGER-and-REAL.patch +++ b/SOURCES/0005-Allow-comparisons-between-INTEGER-and-REAL.patch @@ -1,48 +1,1117 @@ -From ab5aa6f7c04e7193c5387bc74db2605c4dc07f01 Mon Sep 17 00:00:00 2001 -From: Jim MacArthur -Date: Thu, 4 Feb 2016 16:46:46 +0000 -Subject: [PATCH 05/23] Allow comparisons between INTEGER and REAL - -This feature is enabled with the `-std=extra-legacy` compiler flag. ---- - 0005-Allow-comparisons-between-INTEGER-and-REAL.patch - -diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c -index 4f2d216..fd0d280 100644 ---- a/gcc/fortran/check.c -+++ b/gcc/fortran/check.c -@@ -901,6 +901,24 @@ gfc_check_allocated (gfc_expr *array) +diff -Nrup a/gcc/fortran/check.c b/gcc/fortran/check.c +--- a/gcc/fortran/check.c 2018-06-05 11:49:50.228072283 -0600 ++++ b/gcc/fortran/check.c 2018-06-05 11:50:45.287707664 -0600 +@@ -901,12 +901,40 @@ gfc_check_allocated (gfc_expr *array) } -+/* Attempt to promote types of A and B so that they are -+ equivalent, if possible. */ -+void -+promote_types (gfc_expr *a, gfc_expr *b) ++/* Check function where both arguments must be real or integer ++ and warn if they are different types. */ ++ ++bool ++check_int_real_promotion (gfc_expr *a, gfc_expr *b) +{ -+ if (a->ts.type == b->ts.type) -+ return; -+ if (a->ts.type == BT_REAL && b->ts.type == BT_INTEGER) -+ { -+ gfc_convert_type_warn (b, &a->ts, 2, 1); -+ return; -+ } -+ if (a->ts.type == BT_INTEGER && b->ts.type == BT_REAL) ++ gfc_expr *i; ++ ++ if (!int_or_real_check (a, 0)) ++ return false; ++ ++ if (!int_or_real_check (b, 1)) ++ return false; ++ ++ if (a->ts.type != b->ts.type) + { -+ gfc_convert_type_warn (a, &b->ts, 2, 1); ++ i = (a->ts.type != BT_REAL ? a : b); ++ gfc_warning_now (OPT_Wconversion, "Conversion from INTEGER to REAL " ++ "at %L might lose precision", &i->where); + } ++ ++ return true; +} + ++ /* Common check function where the first argument must be real or integer and the second argument must be the same as the first. */ -@@ -910,6 +928,9 @@ gfc_check_a_p (gfc_expr *a, gfc_expr *p) + bool + gfc_check_a_p (gfc_expr *a, gfc_expr *p) + { ++ if (flag_dec) ++ return check_int_real_promotion (a, p); ++ + if (!int_or_real_check (a, 0)) + return false; + +@@ -3035,6 +3063,41 @@ check_rest (bt type, int kind, gfc_actua + } + + ++/* Check function where all arguments of an argument list must be real ++ or integer. */ ++ ++static bool ++check_rest_int_real (gfc_actual_arglist *arglist) ++{ ++ gfc_actual_arglist *arg, *tmp; ++ gfc_expr *x; ++ int m, n; ++ ++ if (!min_max_args (arglist)) ++ return false; ++ ++ for (arg = arglist, n=1; arg; arg = arg->next, n++) ++ { ++ x = arg->expr; ++ if (x->ts.type != BT_INTEGER && x->ts.type != BT_REAL) ++ { ++ gfc_error ("% argument of %qs intrinsic at %L must be " ++ "INTEGER or REAL", n, gfc_current_intrinsic, &x->where); ++ return false; ++ } ++ ++ for (tmp = arglist, m=1; tmp != arg; tmp = tmp->next, m++) ++ if (!gfc_check_conformance (tmp->expr, x, ++ "arguments 'a%d' and 'a%d' for " ++ "intrinsic '%s'", m, n, ++ gfc_current_intrinsic)) ++ return false; ++ } ++ ++ return true; ++} ++ ++ + bool + gfc_check_min_max (gfc_actual_arglist *arg) + { +@@ -3059,7 +3122,10 @@ gfc_check_min_max (gfc_actual_arglist *a + return false; + } + +- return check_rest (x->ts.type, x->ts.kind, arg); ++ if (flag_dec && x->ts.type != BT_CHARACTER) ++ return check_rest_int_real (arg); ++ else ++ return check_rest (x->ts.type, x->ts.kind, arg); + } + + +@@ -4293,6 +4359,9 @@ gfc_check_shift (gfc_expr *i, gfc_expr * + bool + gfc_check_sign (gfc_expr *a, gfc_expr *b) + { ++ if (flag_dec) ++ return check_int_real_promotion (a, b); ++ if (!int_or_real_check (a, 0)) return false; -+ if (gfc_option.allow_std & GFC_STD_EXTRA_LEGACY) -+ promote_types(a, p); +diff -Nrup a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c +--- a/gcc/fortran/iresolve.c 2017-03-08 10:35:49.000000000 -0700 ++++ b/gcc/fortran/iresolve.c 2018-06-05 11:50:45.287707664 -0600 +@@ -892,19 +892,22 @@ gfc_resolve_dble (gfc_expr *f, gfc_expr + void + gfc_resolve_dim (gfc_expr *f, gfc_expr *a, gfc_expr *p) + { +- f->ts.type = a->ts.type; + if (p != NULL) +- f->ts.kind = gfc_kind_max (a,p); +- else +- f->ts.kind = a->ts.kind; +- +- if (p != NULL && a->ts.kind != p->ts.kind) + { +- if (a->ts.kind == gfc_kind_max (a,p)) +- gfc_convert_type (p, &a->ts, 2); ++ f->ts.kind = gfc_kind_max (a,p); ++ if (a->ts.type == BT_REAL || p->ts.type == BT_REAL) ++ f->ts.type = BT_REAL; + else +- gfc_convert_type (a, &p->ts, 2); ++ f->ts.type = BT_INTEGER; ++ ++ if (a->ts.kind != f->ts.kind || a->ts.type != f->ts.type) ++ gfc_convert_type (a, &f->ts, 2); ++ ++ if (p->ts.kind != f->ts.kind || p->ts.type != f->ts.type) ++ gfc_convert_type (p, &f->ts, 2); + } ++ else ++ f->ts = a->ts; + + f->value.function.name + = gfc_get_string ("__dim_%c%d", gfc_type_letter (f->ts.type), f->ts.kind); +@@ -1669,14 +1672,17 @@ gfc_resolve_minmax (const char *name, gf + /* Find the largest type kind. */ + for (a = args->next; a; a = a->next) + { ++ if (a->expr-> ts.type == BT_REAL) ++ f->ts.type = BT_REAL; ++ + if (a->expr->ts.kind > f->ts.kind) + f->ts.kind = a->expr->ts.kind; + } + +- /* Convert all parameters to the required kind. */ ++ /* Convert all parameters to the required type and/or kind. */ + for (a = args; a; a = a->next) + { +- if (a->expr->ts.kind != f->ts.kind) ++ if (a->expr->ts.type != f->ts.type || a->expr->ts.kind != f->ts.kind) + gfc_convert_type (a->expr, &f->ts, 2); + } + +@@ -1958,19 +1964,22 @@ gfc_resolve_minval (gfc_expr *f, gfc_exp + void + gfc_resolve_mod (gfc_expr *f, gfc_expr *a, gfc_expr *p) + { +- f->ts.type = a->ts.type; + if (p != NULL) +- f->ts.kind = gfc_kind_max (a,p); +- else +- f->ts.kind = a->ts.kind; +- +- if (p != NULL && a->ts.kind != p->ts.kind) + { +- if (a->ts.kind == gfc_kind_max (a,p)) +- gfc_convert_type (p, &a->ts, 2); ++ f->ts.kind = gfc_kind_max (a,p); ++ if (a->ts.type == BT_REAL || p->ts.type == BT_REAL) ++ f->ts.type = BT_REAL; + else +- gfc_convert_type (a, &p->ts, 2); ++ f->ts.type = BT_INTEGER; ++ ++ if (a->ts.kind != f->ts.kind || a->ts.type != f->ts.type) ++ gfc_convert_type (a, &f->ts, 2); ++ ++ if (p->ts.kind != f->ts.kind || p->ts.type != f->ts.type) ++ gfc_convert_type (p, &f->ts, 2); + } ++ else ++ f->ts = a->ts; + + f->value.function.name + = gfc_get_string ("__mod_%c%d", gfc_type_letter (f->ts.type), f->ts.kind); +@@ -1980,19 +1989,22 @@ gfc_resolve_mod (gfc_expr *f, gfc_expr * + void + gfc_resolve_modulo (gfc_expr *f, gfc_expr *a, gfc_expr *p) + { +- f->ts.type = a->ts.type; + if (p != NULL) +- f->ts.kind = gfc_kind_max (a,p); +- else +- f->ts.kind = a->ts.kind; +- +- if (p != NULL && a->ts.kind != p->ts.kind) + { +- if (a->ts.kind == gfc_kind_max (a,p)) +- gfc_convert_type (p, &a->ts, 2); ++ f->ts.kind = gfc_kind_max (a,p); ++ if (a->ts.type == BT_REAL || p->ts.type == BT_REAL) ++ f->ts.type = BT_REAL; + else +- gfc_convert_type (a, &p->ts, 2); ++ f->ts.type = BT_INTEGER; ++ ++ if (a->ts.kind != f->ts.kind || a->ts.type != f->ts.type) ++ gfc_convert_type (a, &f->ts, 2); ++ ++ if (p->ts.kind != f->ts.kind || p->ts.type != f->ts.type) ++ gfc_convert_type (p, &f->ts, 2); + } ++ else ++ f->ts = a->ts; + + f->value.function.name + = gfc_get_string ("__modulo_%c%d", gfc_type_letter (f->ts.type), +@@ -2364,9 +2376,26 @@ gfc_resolve_shift (gfc_expr *f, gfc_expr + + + void +-gfc_resolve_sign (gfc_expr *f, gfc_expr *a, gfc_expr *b ATTRIBUTE_UNUSED) ++gfc_resolve_sign (gfc_expr *f, gfc_expr *a, gfc_expr *b) + { +- f->ts = a->ts; ++ if (b != NULL) ++ { ++ f->ts.kind = gfc_kind_max (a, b); ++ if (a->ts.type == BT_REAL || b->ts.type == BT_REAL) ++ f->ts.type = BT_REAL; ++ else ++ f->ts.type = BT_INTEGER; ++ ++ if (a->ts.kind != f->ts.kind || a->ts.type != f->ts.type) ++ gfc_convert_type (a, &f->ts, 2); ++ ++ if (b->ts.kind != f->ts.kind || b->ts.type != f->ts.type) ++ gfc_convert_type (b, &f->ts, 2); ++ } ++ else ++ { ++ f->ts = a->ts; ++ } + f->value.function.name + = gfc_get_string ("__sign_%c%d", gfc_type_letter (a->ts.type), a->ts.kind); + } +diff -Nrup a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c +--- a/gcc/fortran/simplify.c 2018-06-05 11:49:50.231072264 -0600 ++++ b/gcc/fortran/simplify.c 2018-06-05 11:51:17.284495772 -0600 +@@ -2088,39 +2088,78 @@ gfc_simplify_digits (gfc_expr *x) + } + + ++/* Simplify function which sets the floating-point value of ar from ++ the value of a independently if a is integer of real. */ ++ ++static void ++simplify_int_real_promotion (const gfc_expr *a, const gfc_expr *b, mpfr_t *ar) ++{ ++ if (a->ts.type == BT_REAL) ++ { ++ mpfr_init2 (*ar, (a->ts.kind * 8)); ++ mpfr_set (*ar, a->value.real, GFC_RND_MODE); ++ } ++ else ++ { ++ mpfr_init2 (*ar, (b->ts.kind * 8)); ++ mpfr_set_z (*ar, a->value.integer, GFC_RND_MODE); ++ } ++} ++ ++ ++/* Simplify function which promotes a and b arguments from integer to real if required in ++ ar and br floating-point values. This function returns true if a or b are reals and false ++ otherwise. */ ++ ++static bool ++simplify_int_real_promotion2 (const gfc_expr *a, const gfc_expr *b, mpfr_t *ar, mpfr_t *br) ++{ ++ if (a->ts.type != BT_REAL && b->ts.type != BT_REAL) ++ return false; ++ ++ simplify_int_real_promotion (a, b, ar); ++ simplify_int_real_promotion (b, a, br); ++ ++ return true; ++} ++ ++ + gfc_expr * + gfc_simplify_dim (gfc_expr *x, gfc_expr *y) + { + gfc_expr *result; + int kind; + ++ mpfr_t xr; ++ mpfr_t yr; ++ + if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT) + return NULL; + +- kind = x->ts.kind > y->ts.kind ? x->ts.kind : y->ts.kind; +- result = gfc_get_constant_expr (x->ts.type, kind, &x->where); +- +- switch (x->ts.type) ++ if ((x->ts.type != BT_REAL && x->ts.type != BT_INTEGER) ++ || (y->ts.type != BT_REAL && y->ts.type != BT_INTEGER)) + { +- case BT_INTEGER: +- if (mpz_cmp (x->value.integer, y->value.integer) > 0) +- mpz_sub (result->value.integer, x->value.integer, y->value.integer); +- else +- mpz_set_ui (result->value.integer, 0); +- +- break; +- +- case BT_REAL: +- if (mpfr_cmp (x->value.real, y->value.real) > 0) +- mpfr_sub (result->value.real, x->value.real, y->value.real, +- GFC_RND_MODE); +- else +- mpfr_set_ui (result->value.real, 0, GFC_RND_MODE); ++ gfc_internal_error ("gfc_simplify_dim(): Bad arguments"); ++ return NULL; ++ } + +- break; ++ kind = x->ts.kind > y->ts.kind ? x->ts.kind : y->ts.kind; + +- default: +- gfc_internal_error ("gfc_simplify_dim(): Bad type"); ++ if (simplify_int_real_promotion2 (x, y, &xr, &yr)) ++ { ++ result = gfc_get_constant_expr (BT_REAL, kind, &x->where); ++ if (mpfr_cmp (xr, yr) > 0) ++ mpfr_sub (result->value.real, xr, yr, GFC_RND_MODE); ++ else ++ mpfr_set_ui (result->value.real, 0, GFC_RND_MODE); ++ } ++ else ++ { ++ result = gfc_get_constant_expr (BT_INTEGER, kind, &x->where); ++ if (mpz_cmp (x->value.integer, y->value.integer) > 0) ++ mpz_sub (result->value.integer, x->value.integer, y->value.integer); ++ else ++ mpz_set_ui (result->value.integer, 0); + } + + return range_check (result, "DIM"); +@@ -4427,12 +4466,82 @@ gfc_simplify_merge_bits (gfc_expr *i, gf + static void + min_max_choose (gfc_expr *arg, gfc_expr *extremum, int sign) + { ++ mpfr_t *arp; ++ mpfr_t *erp; ++ mpfr_t ar; ++ mpfr_t er; ++ ++ if (arg->ts.type != extremum->ts.type) ++ { ++ if (arg->ts.type == BT_REAL) ++ { ++ arp = &arg->value.real; ++ } ++ else ++ { ++ mpfr_init2 (ar, (arg->ts.kind * 8)); ++ mpfr_set_z (ar, arg->value.integer, GFC_RND_MODE); ++ arp = &ar; ++ } ++ ++ if (extremum->ts.type == BT_REAL) ++ { ++ erp = &extremum->value.real; ++ } ++ else ++ { ++ mpfr_init2 (er, (extremum->ts.kind * 8)); ++ mpfr_set_z (er, extremum->value.integer, GFC_RND_MODE); ++ erp = &er; ++ } ++ ++ if (mpfr_nan_p (*erp)) ++ { ++ extremum->ts.type = arg->ts.type; ++ extremum->ts.kind = arg->ts.kind; ++ if (arg->ts.type == BT_INTEGER) ++ { ++ mpz_init2 (extremum->value.integer, (arg->ts.kind * 8)); ++ mpz_set (extremum->value.integer, arg->value.integer); ++ } ++ else ++ { ++ mpfr_init2 (extremum->value.real, (arg->ts.kind * 8)); ++ mpfr_set (extremum->value.real, *arp, GFC_RND_MODE); ++ } ++ } ++ else ++ { ++ if ((mpfr_cmp (*arp, *erp) * sign) > 0) ++ { ++ extremum->ts.type = arg->ts.type; ++ extremum->ts.kind = arg->ts.kind; ++ if (arg->ts.type == BT_INTEGER) ++ { ++ mpz_init2 (extremum->value.integer, (arg->ts.kind * 8)); ++ mpz_set (extremum->value.integer, arg->value.integer); ++ } ++ else ++ { ++ mpfr_init2 (extremum->value.real, (arg->ts.kind * 8)); ++ mpfr_set (extremum->value.real, *arp, GFC_RND_MODE); ++ } ++ } ++ } ++ ++ return; ++ } ++ + switch (arg->ts.type) + { + case BT_INTEGER: +- if (mpz_cmp (arg->value.integer, +- extremum->value.integer) * sign > 0) +- mpz_set (extremum->value.integer, arg->value.integer); ++ if ((mpz_cmp (arg->value.integer, ++ extremum->value.integer) * sign) > 0) ++ { ++ if (arg->ts.kind > extremum->ts.kind) ++ extremum->ts.kind = arg->ts.kind; ++ mpz_set (extremum->value.integer, arg->value.integer); ++ } + break; + + case BT_REAL: +@@ -4641,41 +4750,48 @@ gfc_simplify_mod (gfc_expr *a, gfc_expr + gfc_expr *result; + int kind; + ++ mpfr_t ar; ++ mpfr_t pr; ++ + if (a->expr_type != EXPR_CONSTANT || p->expr_type != EXPR_CONSTANT) + return NULL; + ++ if ((a->ts.type != BT_REAL && a->ts.type != BT_INTEGER) ++ || (p->ts.type != BT_REAL && p->ts.type != BT_INTEGER)) ++ { ++ gfc_internal_error ("gfc_simplify_mod(): Bad arguments"); ++ return NULL; ++ } ++ + kind = a->ts.kind > p->ts.kind ? a->ts.kind : p->ts.kind; +- result = gfc_get_constant_expr (a->ts.type, kind, &a->where); + +- switch (a->ts.type) ++ if (simplify_int_real_promotion2 (a, p, &ar, &pr)) + { +- case BT_INTEGER: +- if (mpz_cmp_ui (p->value.integer, 0) == 0) +- { +- /* Result is processor-dependent. */ +- gfc_error ("Second argument MOD at %L is zero", &a->where); +- gfc_free_expr (result); +- return &gfc_bad_expr; +- } +- mpz_tdiv_r (result->value.integer, a->value.integer, p->value.integer); +- break; ++ result = gfc_get_constant_expr (BT_REAL, kind, &a->where); + +- case BT_REAL: +- if (mpfr_cmp_ui (p->value.real, 0) == 0) +- { +- /* Result is processor-dependent. */ +- gfc_error ("Second argument of MOD at %L is zero", &p->where); +- gfc_free_expr (result); +- return &gfc_bad_expr; +- } ++ if (mpfr_cmp_ui (pr, 0) == 0) ++ { ++ /* Result is processor-dependent. */ ++ gfc_error ("Second argument of MOD at %L is zero", &p->where); ++ gfc_free_expr (result); ++ return &gfc_bad_expr; ++ } + +- gfc_set_model_kind (kind); +- mpfr_fmod (result->value.real, a->value.real, p->value.real, +- GFC_RND_MODE); +- break; ++ gfc_set_model_kind (kind); ++ mpfr_fmod (result->value.real, ar, pr, GFC_RND_MODE); ++ } ++ else ++ { ++ result = gfc_get_constant_expr (BT_INTEGER, kind, &a->where); + +- default: +- gfc_internal_error ("gfc_simplify_mod(): Bad arguments"); ++ if (mpz_cmp_ui (p->value.integer, 0) == 0) ++ { ++ /* Result is processor-dependent. */ ++ gfc_error ("Second argument MOD at %L is zero", &p->where); ++ gfc_free_expr (result); ++ return &gfc_bad_expr; ++ } ++ mpz_tdiv_r (result->value.integer, a->value.integer, p->value.integer); + } + + return range_check (result, "MOD"); +@@ -4688,52 +4804,55 @@ gfc_simplify_modulo (gfc_expr *a, gfc_ex + gfc_expr *result; + int kind; + ++ mpfr_t ar; ++ mpfr_t pr; ++ + if (a->expr_type != EXPR_CONSTANT || p->expr_type != EXPR_CONSTANT) + return NULL; + +- kind = a->ts.kind > p->ts.kind ? a->ts.kind : p->ts.kind; +- result = gfc_get_constant_expr (a->ts.type, kind, &a->where); +- +- switch (a->ts.type) ++ if ((a->ts.type != BT_REAL && a->ts.type != BT_INTEGER) ++ || (p->ts.type != BT_REAL && p->ts.type != BT_INTEGER)) + { +- case BT_INTEGER: +- if (mpz_cmp_ui (p->value.integer, 0) == 0) +- { +- /* Result is processor-dependent. This processor just opts +- to not handle it at all. */ +- gfc_error ("Second argument of MODULO at %L is zero", &a->where); +- gfc_free_expr (result); +- return &gfc_bad_expr; +- } +- mpz_fdiv_r (result->value.integer, a->value.integer, p->value.integer); ++ gfc_internal_error ("gfc_simplify_modulo(): Bad arguments"); ++ return NULL; ++ } + +- break; ++ kind = a->ts.kind > p->ts.kind ? a->ts.kind : p->ts.kind; + +- case BT_REAL: +- if (mpfr_cmp_ui (p->value.real, 0) == 0) +- { +- /* Result is processor-dependent. */ +- gfc_error ("Second argument of MODULO at %L is zero", &p->where); +- gfc_free_expr (result); +- return &gfc_bad_expr; +- } ++ if (simplify_int_real_promotion2 (a, p, &ar, &pr)) ++ { ++ result = gfc_get_constant_expr (BT_REAL, kind, &a->where); + +- gfc_set_model_kind (kind); +- mpfr_fmod (result->value.real, a->value.real, p->value.real, +- GFC_RND_MODE); +- if (mpfr_cmp_ui (result->value.real, 0) != 0) +- { +- if (mpfr_signbit (a->value.real) != mpfr_signbit (p->value.real)) +- mpfr_add (result->value.real, result->value.real, p->value.real, +- GFC_RND_MODE); +- } +- else +- mpfr_copysign (result->value.real, result->value.real, +- p->value.real, GFC_RND_MODE); +- break; ++ if (mpfr_cmp_ui (pr, 0) == 0) ++ { ++ /* Result is processor-dependent. */ ++ gfc_error ("Second argument of MODULO at %L is zero", &p->where); ++ gfc_free_expr (result); ++ return &gfc_bad_expr; ++ } ++ gfc_set_model_kind (kind); ++ mpfr_fmod (result->value.real, ar, pr, GFC_RND_MODE); ++ if (mpfr_cmp_ui (result->value.real, 0) != 0) ++ { ++ if (mpfr_signbit (ar) != mpfr_signbit (pr)) ++ mpfr_add (result->value.real, result->value.real, pr, GFC_RND_MODE); ++ } ++ else ++ mpfr_copysign (result->value.real, result->value.real, pr, GFC_RND_MODE); ++ } ++ else ++ { ++ result = gfc_get_constant_expr (BT_INTEGER, kind, &a->where); + +- default: +- gfc_internal_error ("gfc_simplify_modulo(): Bad arguments"); ++ if (mpz_cmp_ui (p->value.integer, 0) == 0) ++ { ++ /* Result is processor-dependent. This processor just opts ++ to not handle it at all. */ ++ gfc_error ("Second argument of MODULO at %L is zero", &a->where); ++ gfc_free_expr (result); ++ return &gfc_bad_expr; ++ } ++ mpz_fdiv_r (result->value.integer, a->value.integer, p->value.integer); + } + + return range_check (result, "MODULO"); +@@ -6133,27 +6252,40 @@ gfc_expr * + gfc_simplify_sign (gfc_expr *x, gfc_expr *y) + { + gfc_expr *result; ++ bool neg; + + if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT) + return NULL; + + result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where); + ++ switch (y->ts.type) ++ { ++ case BT_INTEGER: ++ neg = (mpz_sgn (y->value.integer) < 0); ++ break; ++ ++ case BT_REAL: ++ neg = (mpfr_sgn (y->value.real) < 0); ++ break; + - if (a->ts.type != p->ts.type) ++ default: ++ gfc_internal_error ("Bad type in gfc_simplify_sign"); ++ } ++ + switch (x->ts.type) { - gfc_error ("%qs and %qs arguments of %qs intrinsic at %L must " + case BT_INTEGER: + mpz_abs (result->value.integer, x->value.integer); +- if (mpz_sgn (y->value.integer) < 0) ++ if (neg) + mpz_neg (result->value.integer, result->value.integer); + break; + + case BT_REAL: +- if (flag_sign_zero) +- mpfr_copysign (result->value.real, x->value.real, y->value.real, +- GFC_RND_MODE); ++ if (flag_sign_zero && y->ts.type == BT_REAL) ++ mpfr_copysign (result->value.real, x->value.real, y->value.real, GFC_RND_MODE); + else +- mpfr_setsign (result->value.real, x->value.real, +- mpfr_sgn (y->value.real) < 0 ? 1 : 0, GFC_RND_MODE); ++ mpfr_setsign (result->value.real, x->value.real, neg, GFC_RND_MODE); + break; + + default: +diff -Nrup a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion.f +--- a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion.f 1969-12-31 17:00:00.000000000 -0700 ++++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion.f 2018-06-05 11:50:45.288707657 -0600 +@@ -0,0 +1,86 @@ ++! { dg-do compile } ++! { dg-options "-fdec -finit-real=snan" } ++! ++! Test promotion between integers and reals in intrinsic operations. ++! These operations are: mod, modulo, dim, sign, min, max, minloc and ++! maxloc. ++! ++ PROGRAM promotion_int_real_const ++ ! array_nan 4th position value is NAN ++ REAL array_nan(4) ++ DATA array_nan(1)/-4.0/ ++ DATA array_nan(2)/3.0/ ++ DATA array_nan(3)/-2/ ++ ++ INTEGER m_i/0/ ++ REAL m_r/0.0/ ++ ++ INTEGER md_i/0/ ++ REAL md_r/0.0/ ++ ++ INTEGER d_i/0/ ++ REAL d_r/0.0/ ++ ++ INTEGER s_i/0/ ++ REAL s_r/0.0/ ++ ++ INTEGER mn_i/0/ ++ REAL mn_r/0.0/ ++ ++ INTEGER mx_i/0/ ++ REAL mx_r/0.0/ ++ ++ m_i = MOD(4, 3) ++ if (m_i .ne. 1) STOP 1 ++ m_r = MOD(4.0, 3.0) ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 2 ++ m_r = MOD(4, 3.0) ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 3 ++ m_r = MOD(4.0, 3) ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 4 ++ ++ md_i = MODULO(4, 3) ++ if (md_i .ne. 1) STOP 5 ++ md_r = MODULO(4.0, 3.0) ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 6 ++ md_r = MODULO(4, 3.0) ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 7 ++ md_r = MODULO(4.0, 3) ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 8 ++ ++ d_i = DIM(4, 3) ++ if (d_i .ne. 1) STOP 9 ++ d_r = DIM(4.0, 3.0) ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 10 ++ d_r = DIM(4.0, 3) ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 11 ++ d_r = DIM(3, 4.0) ++ if (abs(d_r) > 1.0D-6) STOP 12 ++ ++ s_i = SIGN(-4, 3) ++ if (s_i .ne. 4) STOP 13 ++ s_r = SIGN(4.0, -3.0) ++ if (abs(s_r - (-4.0)) > 1.0D-6) STOP 14 ++ s_r = SIGN(4.0, -3) ++ if (abs(s_r - (-4.0)) > 1.0D-6) STOP 15 ++ s_r = SIGN(-4, 3.0) ++ if (abs(s_r - 4.0) > 1.0D-6) STOP 16 ++ ++ mx_i = MAX(-4, -3, 2, 1) ++ if (mx_i .ne. 2) STOP 17 ++ mx_r = MAX(-4.0, -3.0, 2.0, 1.0) ++ if (abs(mx_r - 2.0) > 1.0D-6) STOP 18 ++ mx_r = MAX(-4, -3.0, 2.0, 1) ++ if (abs(mx_r - 2.0) > 1.0D-6) STOP 19 ++ mx_i = MAXLOC(array_nan, 1) ++ if (mx_i .ne. 2) STOP 20 ++ ++ mn_i = MIN(-4, -3, 2, 1) ++ if (mn_i .ne. -4) STOP 21 ++ mn_r = MIN(-4.0, -3.0, 2.0, 1.0) ++ if (abs(mn_r - (-4.0)) > 1.0D-6) STOP 22 ++ mn_r = MIN(-4, -3.0, 2.0, 1) ++ if (abs(mn_r - (-4.0)) > 1.0D-6) STOP 23 ++ mn_i = MINLOC(array_nan, 1) ++ if (mn_i .ne. 1) STOP 24 ++ END PROGRAM +diff -Nrup a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion-2.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion-2.f +--- a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion-2.f 1969-12-31 17:00:00.000000000 -0700 ++++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion-2.f 2018-06-05 11:50:45.288707657 -0600 +@@ -0,0 +1,114 @@ ++! { dg-do compile } ++! { dg-options "-fdec" } ++! ++! Test promotion between integers and reals in intrinsic operations. ++! These operations are: mod, modulo, dim, sign, min, max, minloc and ++! maxloc. ++! ++ PROGRAM promotion_int_real ++ REAL l/0.0/ ++ LOGICAL a_i ++ LOGICAL*4 a2_i ++ LOGICAL b_i ++ LOGICAL*8 b2_i ++ LOGICAL x_i ++ LOGICAL y_i ++ CHARACTER a_r ++ CHARACTER*4 a2_r ++ CHARACTER b_r ++ CHARACTER*8 b2_r ++ CHARACTER x_r ++ CHARACTER y_r ++ ++ INTEGER m_i/0/ ++ REAL m_r/0.0/ ++ ++ INTEGER md_i/0/ ++ REAL md_r/0.0/ ++ ++ INTEGER d_i/0/ ++ REAL d_r/0.0/ ++ ++ INTEGER s_i/0/ ++ REAL s_r/0.0/ ++ ++ INTEGER mn_i/0/ ++ REAL mn_r/0.0/ ++ ++ INTEGER mx_i/0/ ++ REAL mx_r/0.0/ ++ ++ m_i = MOD(a_i, b_i) ! { dg-error "" } ++ if (m_i .ne. 1) STOP 1 ++ m_i = MOD(a2_i, b2_i) ! { dg-error "" } ++ if (m_i .ne. 1) STOP 2 ++ m_r = MOD(a_r, b_r) ! { dg-error "" } ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 3 ++ m_r = MOD(a2_r, b2_r) ! { dg-error "" } ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 4 ++ m_r = MOD(a_i, b_r) ! { dg-error "" } ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 5 ++ m_r = MOD(a_r, b_i) ! { dg-error "" } ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 6 ++ ++ md_i = MODULO(a_i, b_i) ! { dg-error "" } ++ if (md_i .ne. 1) STOP 7 ++ md_i = MODULO(a2_i, b2_i) ! { dg-error "" } ++ if (md_i .ne. 1) STOP 8 ++ md_r = MODULO(a_r, b_r) ! { dg-error "" } ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 9 ++ md_r = MODULO(a2_r, b2_r) ! { dg-error "" } ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 10 ++ md_r = MODULO(a_i, b_r) ! { dg-error "" } ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 11 ++ md_r = MODULO(a_r, b_i) ! { dg-error "" } ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 12 ++ ++ d_i = DIM(a_i, b_i) ! { dg-error "" } ++ if (d_i .ne. 1) STOP 13 ++ d_i = DIM(a2_i, b2_i) ! { dg-error "" } ++ if (d_i .ne. 1) STOP 14 ++ d_r = DIM(a_r, b_r) ! { dg-error "" } ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 15 ++ d_r = DIM(a2_r, b2_r) ! { dg-error "" } ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 16 ++ d_r = DIM(a_r, b_i) ! { dg-error "" } ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 17 ++ d_r = DIM(b_i, a_r) ! { dg-error "" } ++ if (abs(d_r) > 1.0D-6) STOP 18 ++ ++ s_i = SIGN(-a_i, b_i) ! { dg-error "" } ++ if (s_i .ne. 4) STOP 19 ++ s_i = SIGN(-a2_i, b2_i) ! { dg-error "" } ++ if (s_i .ne. 4) STOP 20 ++ s_r = SIGN(a_r, -b_r) ! { dg-error "" } ++ if (abs(s_r - (-a_r)) > 1.0D-6) STOP 21 ! { dg-error "" } ++ s_r = SIGN(a2_r, -b2_r) ! { dg-error "" } ++ if (abs(s_r - (-a2_r)) > 1.0D-6) STOP 22 ! { dg-error "" } ++ s_r = SIGN(a_r, -b_i) ! { dg-error "" } ++ if (abs(s_r - (-a_r)) > 1.0D-6) STOP 23 ! { dg-error "" } ++ s_r = SIGN(-a_i, b_r) ! { dg-error "" } ++ if (abs(s_r - a_r) > 1.0D-6) STOP 24 ! { dg-error "" } ++ ++ mx_i = MAX(-a_i, -b_i, x_i, y_i) ! { dg-error "" } ++ if (mx_i .ne. x_i) STOP 25 ! { dg-error "" } ++ mx_i = MAX(-a2_i, -b2_i, x_i, y_i) ! { dg-error "" } ++ if (mx_i .ne. x_i) STOP 26 ! { dg-error "" } ++ mx_r = MAX(-a_r, -b_r, x_r, y_r) ! { dg-error "" } ++ if (abs(mx_r - x_r) > 1.0D-6) STOP 27 ! { dg-error "" } ++ mx_r = MAX(-a_r, -b_r, x_r, y_r) ! { dg-error "" } ++ if (abs(mx_r - x_r) > 1.0D-6) STOP 28 ! { dg-error "" } ++ mx_r = MAX(-a_i, -b_r, x_r, y_i) ! { dg-error "" } ++ if (abs(mx_r - x_r) > 1.0D-6) STOP 29 ! { dg-error "" } ++ ++ mn_i = MIN(-a_i, -b_i, x_i, y_i) ! { dg-error "" } ++ if (mn_i .ne. -a_i) STOP 31 ! { dg-error "" } ++ mn_i = MIN(-a2_i, -b2_i, x_i, y_i) ! { dg-error "" } ++ if (mn_i .ne. -a2_i) STOP 32 ! { dg-error "" } ++ mn_r = MIN(-a_r, -b_r, x_r, y_r) ! { dg-error "" } ++ if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 33 ! { dg-error "" } ++ mn_r = MIN(-a2_r, -b2_r, x_r, y_r) ! { dg-error "" } ++ if (abs(mn_r - (-a2_r)) > 1.0D-6) STOP 34 ! { dg-error "" } ++ mn_r = MIN(-a_i, -b_r, x_r, y_i) ! { dg-error "" } ++ if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 35 ! { dg-error "" } ++ END PROGRAM +diff -Nrup a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion-3.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion-3.f +--- a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion-3.f 1969-12-31 17:00:00.000000000 -0700 ++++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion-3.f 2018-06-05 11:50:45.288707657 -0600 +@@ -0,0 +1,114 @@ ++! { dg-do compile } ++! { dg-options "-fdec" } ++! ++! Test promotion between integers and reals in intrinsic operations. ++! These operations are: mod, modulo, dim, sign, min, max, minloc and ++! maxloc. ++! ++ PROGRAM promotion_int_real ++ REAL l/0.0/ ++ INTEGER a_i/4/ ++ INTEGER*4 a2_i/4/ ++ CHARACTER b_i ++ CHARACTER*8 b2_i ++ INTEGER x_i/2/ ++ CHARACTER y_i ++ REAL a_r/4.0/ ++ REAL*4 a2_r/4.0/ ++ LOGICAL b_r ++ LOGICAL*8 b2_r ++ REAL x_r/2.0/ ++ LOGICAL y_r ++ ++ INTEGER m_i/0/ ++ REAL m_r/0.0/ ++ ++ INTEGER md_i/0/ ++ REAL md_r/0.0/ ++ ++ INTEGER d_i/0/ ++ REAL d_r/0.0/ ++ ++ INTEGER s_i/0/ ++ REAL s_r/0.0/ ++ ++ INTEGER mn_i/0/ ++ REAL mn_r/0.0/ ++ ++ INTEGER mx_i/0/ ++ REAL mx_r/0.0/ ++ ++ m_i = MOD(a_i, b_i) ! { dg-error "" } ++ if (m_i .ne. 1) STOP 1 ++ m_i = MOD(a2_i, b2_i) ! { dg-error "" } ++ if (m_i .ne. 1) STOP 2 ++ m_r = MOD(a_r, b_r) ! { dg-error "" } ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 3 ++ m_r = MOD(a2_r, b2_r) ! { dg-error "" } ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 4 ++ m_r = MOD(a_i, b_r) ! { dg-error "" } ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 5 ++ m_r = MOD(a_r, b_i) ! { dg-error "" } ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 6 ++ ++ md_i = MODULO(a_i, b_i) ! { dg-error "" } ++ if (md_i .ne. 1) STOP 7 ++ md_i = MODULO(a2_i, b2_i) ! { dg-error "" } ++ if (md_i .ne. 1) STOP 8 ++ md_r = MODULO(a_r, b_r) ! { dg-error "" } ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 9 ++ md_r = MODULO(a2_r, b2_r) ! { dg-error "" } ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 10 ++ md_r = MODULO(a_i, b_r) ! { dg-error "" } ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 11 ++ md_r = MODULO(a_r, b_i) ! { dg-error "" } ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 12 ++ ++ d_i = DIM(a_i, b_i) ! { dg-error "" } ++ if (d_i .ne. 1) STOP 13 ++ d_i = DIM(a2_i, b2_i) ! { dg-error "" } ++ if (d_i .ne. 1) STOP 14 ++ d_r = DIM(a_r, b_r) ! { dg-error "" } ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 15 ++ d_r = DIM(a2_r, b2_r) ! { dg-error "" } ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 16 ++ d_r = DIM(a_r, b_i) ! { dg-error "" } ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 17 ++ d_r = DIM(b_i, a_r) ! { dg-error "" } ++ if (abs(d_r) > 1.0D-6) STOP 18 ++ ++ s_i = SIGN(-a_i, b_i) ! { dg-error "" } ++ if (s_i .ne. 4) STOP 19 ++ s_i = SIGN(-a2_i, b2_i) ! { dg-error "" } ++ if (s_i .ne. 4) STOP 20 ++ s_r = SIGN(a_r, -b_r) ! { dg-error "" } ++ if (abs(s_r - (-a_r)) > 1.0D-6) STOP 21 ++ s_r = SIGN(a2_r, -b2_r) ! { dg-error "" } ++ if (abs(s_r - (-a2_r)) > 1.0D-6) STOP 22 ++ s_r = SIGN(a_r, -b_i) ! { dg-error "" } ++ if (abs(s_r - (-a_r)) > 1.0D-6) STOP 23 ++ s_r = SIGN(-a_i, b_r) ! { dg-error "" } ++ if (abs(s_r - a_r) > 1.0D-6) STOP 24 ++ ++ mx_i = MAX(-a_i, -b_i, x_i, y_i) ! { dg-error "" } ++ if (mx_i .ne. x_i) STOP 25 ++ mx_i = MAX(-a2_i, -b2_i, x_i, y_i) ! { dg-error "" } ++ if (mx_i .ne. x_i) STOP 26 ++ mx_r = MAX(-a_r, -b_r, x_r, y_r) ! { dg-error "" } ++ if (abs(mx_r - x_r) > 1.0D-6) STOP 27 ++ mx_r = MAX(-a_r, -b_r, x_r, y_r) ! { dg-error "" } ++ if (abs(mx_r - x_r) > 1.0D-6) STOP 28 ++ mx_r = MAX(-a_i, -b_r, x_r, y_i) ! { dg-error "" } ++ if (abs(mx_r - x_r) > 1.0D-6) STOP 29 ++ ++ mn_i = MIN(-a_i, -b_i, x_i, y_i) ! { dg-error "" } ++ if (mn_i .ne. -a_i) STOP 31 ++ mn_i = MIN(-a2_i, -b2_i, x_i, y_i) ! { dg-error "" } ++ if (mn_i .ne. -a2_i) STOP 32 ++ mn_r = MIN(-a_r, -b_r, x_r, y_r) ! { dg-error "" } ++ if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 33 ++ mn_r = MIN(-a2_r, -b2_r, x_r, y_r) ! { dg-error "" } ++ if (abs(mn_r - (-a2_r)) > 1.0D-6) STOP 34 ++ mn_r = MIN(-a_i, -b_r, x_r, y_i) ! { dg-error "" } ++ if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 35 ++ END PROGRAM +diff -Nrup a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion.f +--- a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion.f 1969-12-31 17:00:00.000000000 -0700 ++++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion.f 2018-06-05 11:50:45.288707657 -0600 +@@ -0,0 +1,126 @@ ++! { dg-do compile } ++! { dg-options "-fdec" } ++! ++! Test promotion between integers and reals in intrinsic operations. ++! These operations are: mod, modulo, dim, sign, min, max, minloc and ++! maxloc. ++! ++ PROGRAM promotion_int_real ++ REAL l/0.0/ ++ INTEGER a_i/4/ ++ INTEGER*4 a2_i/4/ ++ INTEGER b_i/3/ ++ INTEGER*8 b2_i/3/ ++ INTEGER x_i/2/ ++ INTEGER y_i/1/ ++ REAL a_r/4.0/ ++ REAL*4 a2_r/4.0/ ++ REAL b_r/3.0/ ++ REAL*8 b2_r/3.0/ ++ REAL x_r/2.0/ ++ REAL y_r/1.0/ ++ ++ REAL array_nan(4) ++ DATA array_nan(1)/-4.0/ ++ DATA array_nan(2)/3.0/ ++ DATA array_nan(3)/-2/ ++ ++ INTEGER m_i/0/ ++ REAL m_r/0.0/ ++ ++ INTEGER md_i/0/ ++ REAL md_r/0.0/ ++ ++ INTEGER d_i/0/ ++ REAL d_r/0.0/ ++ ++ INTEGER s_i/0/ ++ REAL s_r/0.0/ ++ ++ INTEGER mn_i/0/ ++ REAL mn_r/0.0/ ++ ++ INTEGER mx_i/0/ ++ REAL mx_r/0.0/ ++ ++ ! array_nan 4th position value is NAN ++ array_nan(4) = 0/l ++ ++ m_i = MOD(a_i, b_i) ++ if (m_i .ne. 1) STOP 1 ++ m_i = MOD(a2_i, b2_i) ++ if (m_i .ne. 1) STOP 2 ++ m_r = MOD(a_r, b_r) ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 3 ++ m_r = MOD(a2_r, b2_r) ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 4 ++ m_r = MOD(a_i, b_r) ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 5 ++ m_r = MOD(a_r, b_i) ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 6 ++ ++ md_i = MODULO(a_i, b_i) ++ if (md_i .ne. 1) STOP 7 ++ md_i = MODULO(a2_i, b2_i) ++ if (md_i .ne. 1) STOP 8 ++ md_r = MODULO(a_r, b_r) ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 9 ++ md_r = MODULO(a2_r, b2_r) ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 10 ++ md_r = MODULO(a_i, b_r) ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 11 ++ md_r = MODULO(a_r, b_i) ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 12 ++ ++ d_i = DIM(a_i, b_i) ++ if (d_i .ne. 1) STOP 13 ++ d_i = DIM(a2_i, b2_i) ++ if (d_i .ne. 1) STOP 14 ++ d_r = DIM(a_r, b_r) ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 15 ++ d_r = DIM(a2_r, b2_r) ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 16 ++ d_r = DIM(a_r, b_i) ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 17 ++ d_r = DIM(b_i, a_r) ++ if (abs(d_r) > 1.0D-6) STOP 18 ++ ++ s_i = SIGN(-a_i, b_i) ++ if (s_i .ne. 4) STOP 19 ++ s_i = SIGN(-a2_i, b2_i) ++ if (s_i .ne. 4) STOP 20 ++ s_r = SIGN(a_r, -b_r) ++ if (abs(s_r - (-a_r)) > 1.0D-6) STOP 21 ++ s_r = SIGN(a2_r, -b2_r) ++ if (abs(s_r - (-a2_r)) > 1.0D-6) STOP 22 ++ s_r = SIGN(a_r, -b_i) ++ if (abs(s_r - (-a_r)) > 1.0D-6) STOP 23 ++ s_r = SIGN(-a_i, b_r) ++ if (abs(s_r - a_r) > 1.0D-6) STOP 24 ++ ++ mx_i = MAX(-a_i, -b_i, x_i, y_i) ++ if (mx_i .ne. x_i) STOP 25 ++ mx_i = MAX(-a2_i, -b2_i, x_i, y_i) ++ if (mx_i .ne. x_i) STOP 26 ++ mx_r = MAX(-a_r, -b_r, x_r, y_r) ++ if (abs(mx_r - x_r) > 1.0D-6) STOP 27 ++ mx_r = MAX(-a_r, -b_r, x_r, y_r) ++ if (abs(mx_r - x_r) > 1.0D-6) STOP 28 ++ mx_r = MAX(-a_i, -b_r, x_r, y_i) ++ if (abs(mx_r - x_r) > 1.0D-6) STOP 29 ++ mx_i = MAXLOC(array_nan, 1) ++ if (mx_i .ne. 2) STOP 30 ++ ++ mn_i = MIN(-a_i, -b_i, x_i, y_i) ++ if (mn_i .ne. -a_i) STOP 31 ++ mn_i = MIN(-a2_i, -b2_i, x_i, y_i) ++ if (mn_i .ne. -a2_i) STOP 32 ++ mn_r = MIN(-a_r, -b_r, x_r, y_r) ++ if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 33 ++ mn_r = MIN(-a2_r, -b2_r, x_r, y_r) ++ if (abs(mn_r - (-a2_r)) > 1.0D-6) STOP 34 ++ mn_r = MIN(-a_i, -b_r, x_r, y_i) ++ if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 35 ++ mn_i = MINLOC(array_nan, 1) ++ if (mn_i .ne. 1) STOP 36 ++ END PROGRAM diff --git a/SOURCES/0006-Allow-blank-format-items-in-format-strings.patch b/SOURCES/0006-Allow-blank-format-items-in-format-strings.patch index af7b0f4..8f855c5 100644 --- a/SOURCES/0006-Allow-blank-format-items-in-format-strings.patch +++ b/SOURCES/0006-Allow-blank-format-items-in-format-strings.patch @@ -11,8 +11,22 @@ This feature is enabled by the `-std=extra-legacy` compiler flag. --- 0006-Allow-blank-format-items-in-format-strings.patch +commit 8e205f3940a364318d0cd2197a9897142632b336 +Author: Jim MacArthur +Date: Thu Feb 4 16:59:41 2016 +0000 + + Allow blank format items in format strings + + This has to be written in a slightly verbose manner because GCC 7 + defaults to building with -Werror=implicit-fallthrough which prevents + us from just falling through to the default: case. + + This feature is enabled by the `-std=extra-legacy` compiler flag. + + Test written by: Francisco Redondo Marchena + diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c -index b2fa741..aa3443f 100644 +index 0bec4ee39b2..d93dcfadd61 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -752,6 +752,16 @@ format_item_1: @@ -32,3 +46,25 @@ index b2fa741..aa3443f 100644 default: error = unexpected_element; goto syntax; +diff --git a/gcc/testsuite/gfortran.dg/dec_format_empty_item.f b/gcc/testsuite/gfortran.dg/dec_format_empty_item.f +new file mode 100644 +index 00000000000..e817001e38a +--- /dev/null ++++ b/gcc/testsuite/gfortran.dg/dec_format_empty_item.f +@@ -0,0 +1,16 @@ ++! { dg-do compile } ++! { dg-options "-std=extra-legacy" } ++! ++! Test blank/empty format items in format string ++! ++ PROGRAM blank_format_items ++ INTEGER A/0/ ++ ++ OPEN(1, status="scratch") ++ WRITE(1, 10) 100 ++ REWIND(1) ++ READ(1, 10) A ++ IF (a.NE.100) STOP 1 ++ PRINT 10, A ++10 FORMAT( I5,) ++ END diff --git a/SOURCES/0007-Allow-more-than-one-character-as-argument-to-ICHAR.patch b/SOURCES/0007-Allow-more-than-one-character-as-argument-to-ICHAR.patch index f9b8312..f77dd34 100644 --- a/SOURCES/0007-Allow-more-than-one-character-as-argument-to-ICHAR.patch +++ b/SOURCES/0007-Allow-more-than-one-character-as-argument-to-ICHAR.patch @@ -6,13 +6,21 @@ Subject: [PATCH 07/23] Allow more than one character as argument to ICHAR This feature is enabled by the `-std=extra-legacy` compiler flag. --- - 0007-Allow-more-than-one-character-as-argument-to-ICHAR.patch +commit 44861a8907c8d849193287231a464d34fcce522d +Author: Jim MacArthur +Date: Mon Oct 5 13:45:15 2015 +0100 + + Allow more than one character as argument to ICHAR + + This feature is enabled by the `-std=extra-legacy` compiler flag. + + Test written by: Francisco Redondo Marchena diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c -index fd0d280..b84022b 100644 +index 4f2d21610b9..38a90519c81 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c -@@ -2493,7 +2493,7 @@ gfc_check_ichar_iachar (gfc_expr *c, gfc_expr *kind) +@@ -2472,7 +2472,7 @@ gfc_check_ichar_iachar (gfc_expr *c, gfc_expr *kind) else return true; @@ -22,7 +30,7 @@ index fd0d280..b84022b 100644 gfc_error ("Argument of %s at %L must be of length one", gfc_current_intrinsic, &c->where); diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c -index d64f2f3..fce03df 100644 +index 80c96371ad9..6e05bb444ed 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -2774,7 +2774,7 @@ gfc_simplify_iachar (gfc_expr *e, gfc_expr *kind) @@ -43,3 +51,27 @@ index d64f2f3..fce03df 100644 { gfc_error ("Argument of ICHAR at %L must be of length one", &e->where); return &gfc_bad_expr; +diff --git a/gcc/testsuite/gfortran.dg/dec_ichar_with_string.f b/gcc/testsuite/gfortran.dg/dec_ichar_with_string.f +new file mode 100644 +index 00000000000..c97746d4a4e +--- /dev/null ++++ b/gcc/testsuite/gfortran.dg/dec_ichar_with_string.f +@@ -0,0 +1,18 @@ ++! { dg-do compile } ++! { dg-options "-std=extra-legacy" } ++! ++! Test ICHAR and IACHAR with more than one character as argument ++! ++ PROGRAM ichar_more_than_one_character ++ CHARACTER*4 st/'Test'/ ++ INTEGER i ++ ++ i = ICHAR(st) ++ if (i.NE.84) STOP 1 ++ i = IACHAR(st) ++ if (i.NE.84) STOP 2 ++ i = ICHAR('Test') ++ if (i.NE.84) STOP 3 ++ i = IACHAR('Test') ++ if (i.NE.84) STOP 4 ++ END diff --git a/SOURCES/0008-Allow-non-integer-substring-indexes.patch b/SOURCES/0008-Allow-non-integer-substring-indexes.patch index 107e01f..c27f19b 100644 --- a/SOURCES/0008-Allow-non-integer-substring-indexes.patch +++ b/SOURCES/0008-Allow-non-integer-substring-indexes.patch @@ -6,10 +6,18 @@ Subject: [PATCH 08/23] Allow non-integer substring indexes This feature is enabled by the `-std=extra-legacy` compiler flag. --- - 0008-Allow-non-integer-substring-indexes.patch +commit 9f05bda69f21d7a7c17b58ff0b6392bfd1a06bae +Author: Jim MacArthur +Date: Mon Oct 5 14:05:03 2015 +0100 + + Allow non-integer substring indexes + + This feature is enabled by the `-std=extra-legacy` compiler flag. + + Test written by: Francisco Redondo Marchena diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c -index 84a4827..667cc50 100644 +index 84a4827a1b7..667cc5073e3 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -4680,6 +4680,17 @@ resolve_substring (gfc_ref *ref) @@ -48,3 +56,26 @@ index 84a4827..667cc50 100644 if (ref->u.ss.end->ts.type != BT_INTEGER) { gfc_error ("Substring end index at %L must be of type INTEGER", +diff --git a/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes.f b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes.f +new file mode 100644 +index 00000000000..8f5c8eb3c0e +--- /dev/null ++++ b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes.f +@@ -0,0 +1,17 @@ ++! { dg-do compile } ++! { dg-options "-std=extra-legacy" } ++! ++! Test not integer substring indexes ++! ++ PROGRAM not_integer_substring_indexes ++ CHARACTER*5 st/'Tests'/ ++ CHARACTER*4 st2 ++ REAL ir/1.0/ ++ REAL ir2/4.0/ ++ ++ st2 = st(ir:4) ++ st2 = st(1:ir2) ++ st2 = st(1.0:4) ++ st2 = st(1:4.0) ++ st2 = st(1.5:4) ++ END diff --git a/SOURCES/0009-Convert-LOGICAL-to-INTEGER-for-arithmetic-ops-and-vi.patch b/SOURCES/0009-Convert-LOGICAL-to-INTEGER-for-arithmetic-ops-and-vi.patch index 87e44ec..e7e88a5 100644 --- a/SOURCES/0009-Convert-LOGICAL-to-INTEGER-for-arithmetic-ops-and-vi.patch +++ b/SOURCES/0009-Convert-LOGICAL-to-INTEGER-for-arithmetic-ops-and-vi.patch @@ -9,19 +9,33 @@ operations, and converting INTEGER types to LOGICAL for use in boolean operations. This feature is enabled with the `-std=extra-legacy` compiler flag. ---- - 0009-Convert-LOGICAL-to-INTEGER-for-arithmetic-ops-and-vi.patch - Fixup +commit f40dbd54915de8155aad94bfa19c22f11b8a8eae +Author: Jim MacArthur +Date: Wed Oct 7 16:31:18 2015 -0400 + + Convert LOGICAL to INTEGER for arithmetic ops, and vice versa + + We allow converting LOGICAL types to INTEGER when doing arithmetic + operations, and converting INTEGER types to LOGICAL for use in + boolean operations. + + This feature is enabled with the `-std=extra-legacy` compiler flag. + + Test written by: Francisco Redondo Marchena diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c -index 667cc50..33b441a 100644 +index 667cc5073e3..33b441aa1bc 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c -@@ -3627,6 +3627,22 @@ is_character_based (bt type) - for the conversion. */ +@@ -3623,6 +3623,22 @@ is_character_based (bt type) + return type == BT_CHARACTER || type == BT_HOLLERITH; + } - static void ++/* If E is a logical, convert it to an integer and issue a warning ++ for the conversion. */ ++ ++static void +convert_integer_to_logical (gfc_expr *e) +{ + if (e->ts.type == BT_INTEGER) @@ -34,13 +48,9 @@ index 667cc50..33b441a 100644 + } +} + -+/* If E is a logical, convert it to an integer and issue a warning -+ for the conversion. */ -+ -+static void - convert_logical_to_integer (gfc_expr *e) - { - if (e->ts.type == BT_LOGICAL) + /* If E is a logical, convert it to an integer and issue a warning + for the conversion. */ + @@ -3733,6 +3749,12 @@ resolve_operator (gfc_expr *e) case INTRINSIC_OR: case INTRINSIC_EQV: @@ -66,3 +76,36 @@ index 667cc50..33b441a 100644 if (op1->ts.type == BT_LOGICAL) { e->ts.type = BT_LOGICAL; +diff --git a/gcc/testsuite/gfortran.dg/dec_logical_to_integer_and_vice_versa.f b/gcc/testsuite/gfortran.dg/dec_logical_to_integer_and_vice_versa.f +new file mode 100644 +index 00000000000..7b9ec0d0cd2 +--- /dev/null ++++ b/gcc/testsuite/gfortran.dg/dec_logical_to_integer_and_vice_versa.f +@@ -0,0 +1,27 @@ ++! { dg-do compile } ++! { dg-options "-std=extra-legacy" } ++! ++! Test convertion between logical and integer for logical operators ++! ++ PROGRAM logical_integer_conversion ++ LOGICAL lpos /.true./ ++ INTEGER ineg/0/ ++ INTEGER ires ++ LOGICAL lres ++ ++ ! Test Logicals converted to Integers ++ if ((lpos.AND.ineg).EQ.1) STOP 3 ++ if ((ineg.AND.lpos).NE.0) STOP 4 ++ ires = (.true..AND.0) ++ if (ires.NE.0) STOP 5 ++ ires = (1.AND..false.) ++ if (ires.EQ.1) STOP 6 ++ ++ ! Test Integers converted to Logicals ++ if (lpos.EQ.ineg) STOP 7 ++ if (ineg.EQ.lpos) STOP 8 ++ lres = (.true..EQ.0) ++ if (lres) STOP 9 ++ lres = (1.EQ..false.) ++ if (lres) STOP 10 ++ END diff --git a/SOURCES/0010-Allow-mixed-string-length-and-array-specification-in.patch b/SOURCES/0010-Allow-mixed-string-length-and-array-specification-in.patch index 42b40f9..95154c3 100644 --- a/SOURCES/0010-Allow-mixed-string-length-and-array-specification-in.patch +++ b/SOURCES/0010-Allow-mixed-string-length-and-array-specification-in.patch @@ -8,8 +8,16 @@ Subject: [PATCH 10/23] Allow mixed string length and array specification in 0010-Allow-mixed-string-length-and-array-specification-in.patch +commit 05124ea7df2ee14620d5c24ffe972db3dcab4f4e +Author: Jim MacArthur +Date: Wed Oct 7 17:04:06 2015 -0400 + + Allow mixed string length and array specification in character declarations. + + Test written by: Francisco Redondo Marchena + diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c -index 6d3d28a..c90f9de 100644 +index 6d3d28af127..c90f9de5a78 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -2145,6 +2145,35 @@ check_function_name (char *name) @@ -132,3 +140,19 @@ index 6d3d28a..c90f9de 100644 } /* The dummy arguments and result of the abreviated form of MODULE +diff --git a/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration.f b/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration.f +new file mode 100644 +index 00000000000..69b110edb25 +--- /dev/null ++++ b/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration.f +@@ -0,0 +1,10 @@ ++! { dg-do compile } ++! { dg-options "-std=extra-legacy" } ++! ++! Test character declaration with mixed string length and array specification ++! ++ PROGRAM character_declaration ++ CHARACTER ASPEC_SLENGTH*2 (5) /'01','02','03','04','05'/ ++ CHARACTER SLENGTH_ASPEC(5)*2 /'01','02','03','04','05'/ ++ if (ASPEC_SLENGTH(3).NE.SLENGTH_ASPEC(3)) STOP 1 ++ END diff --git a/SOURCES/0011-Allow-character-to-int-conversions-in-DATA-statement.patch b/SOURCES/0011-Allow-character-to-int-conversions-in-DATA-statement.patch index f92b065..1130a94 100644 --- a/SOURCES/0011-Allow-character-to-int-conversions-in-DATA-statement.patch +++ b/SOURCES/0011-Allow-character-to-int-conversions-in-DATA-statement.patch @@ -8,8 +8,18 @@ This feature is enabled by the `-std=extra-legacy` compiler flag. 0011-Allow-character-to-int-conversions-in-DATA-statement.patch +commit 11b148af8967669bcebd91ea6fdae28e9ec8e97c +Author: Jim MacArthur +Date: Wed Oct 7 18:23:31 2015 -0400 + + Allow character-to-int conversions in DATA statements + + This feature is enabled by the `-std=extra-legacy` compiler flag. + + Test written by: Francisco Redondo Marchena + diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c -index f347c75..9982b8d 100644 +index f347c753702..9982b8d0e85 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -3294,6 +3294,10 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform, @@ -23,3 +33,20 @@ index f347c75..9982b8d 100644 if (lvalue->ts.type == BT_LOGICAL && rvalue->ts.type == BT_LOGICAL) return true; +diff --git a/gcc/testsuite/gfortran.dg/dec_char_to_int_conversion_in_data.f b/gcc/testsuite/gfortran.dg/dec_char_to_int_conversion_in_data.f +new file mode 100644 +index 00000000000..e0e4f735243 +--- /dev/null ++++ b/gcc/testsuite/gfortran.dg/dec_char_to_int_conversion_in_data.f +@@ -0,0 +1,11 @@ ++! { dg-do compile } ++! { dg-options "-std=extra-legacy" } ++! ++! Test character to int conversion in DATA types ++! ++ PROGRAM char_int_data_type ++ INTEGER*1 ai(2) ++ ++ DATA ai/'1',1/ ++ if(ai(1).NE.49) STOP 1 ++ END diff --git a/SOURCES/0012-Allow-old-style-initializers-in-derived-types.patch b/SOURCES/0012-Allow-old-style-initializers-in-derived-types.patch index 5af68a2..a91db5b 100644 --- a/SOURCES/0012-Allow-old-style-initializers-in-derived-types.patch +++ b/SOURCES/0012-Allow-old-style-initializers-in-derived-types.patch @@ -10,12 +10,22 @@ Only single value expressions are allowed at the moment. This feature is enabled by the `-std=extra-legacy` compiler flag. --- - 0012-Allow-old-style-initializers-in-derived-types.patch +commit a9ee9b2c45580d0e52670cec4d3d68095dabc178 +Author: Jim MacArthur +Date: Thu Feb 4 16:00:30 2016 +0000 + + Allow old-style initializers in derived types + + This allows simple declarations in derived types and structures, such as: + LOGICAL*1 NIL /0/ + Only single value expressions are allowed at the moment. + + This feature is enabled by the `-std=extra-legacy` compiler flag. - Drop unnecessary whitespace + Test written by: Francisco Redondo Marchena diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c -index c90f9de..3ad9c2c 100644 +index c90f9de5a78..3ad9c2c8b40 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -2437,12 +2437,30 @@ variable_decl (int elem) @@ -54,3 +64,31 @@ index c90f9de..3ad9c2c 100644 /* For structure components, read the initializer as a special expression and let the rest of this function apply the initializer as usual. */ +diff --git a/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style.f b/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style.f +new file mode 100644 +index 00000000000..eac7de987e8 +--- /dev/null ++++ b/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style.f +@@ -0,0 +1,22 @@ ++! { dg-do compile } ++! { dg-options "-std=extra-legacy" } ++! ++! Test old style initializers in derived types ++! ++ PROGRAM spec_in_var ++ TYPE STRUCT1 ++ INTEGER*4 ID /8/ ++ INTEGER*4 TYPE /5/ ++ INTEGER*8 DEFVAL /0/ ++ CHARACTER*(5) NAME /'tests'/ ++ LOGICAL*1 NIL /0/ ++ END TYPE STRUCT1 ++ ++ TYPE (STRUCT1) SINST ++ ++ if(SINST%ID.NE.8) STOP 1 ++ if(SINST%TYPE.NE.5) STOP 2 ++ if(SINST%DEFVAL.NE.0) STOP 3 ++ if(SINST%NAME.NE.'tests') STOP 4 ++ if(SINST%NIL) STOP 5 ++ END diff --git a/SOURCES/0013-Allow-per-variable-kind-specification.patch b/SOURCES/0013-Allow-per-variable-kind-specification.patch index db21ee3..2dd665b 100644 --- a/SOURCES/0013-Allow-per-variable-kind-specification.patch +++ b/SOURCES/0013-Allow-per-variable-kind-specification.patch @@ -14,8 +14,20 @@ This feature is enabled by the `-std=extra-legacy` compiler flag. 0013-Allow-per-variable-kind-specification.patch + Allow per-variable kind specification. + + INTEGER*4 x*2, y*8 + + The per-variable sizes override the kind specified in the type. + At the moment, you can follow this with an array specification, so + INTEGER x*2(10) is OK, but not the other way round. + + This feature is enabled by the `-std=extra-legacy` compiler flag. + + Test written by: Francisco Redondo Marchena + diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c -index 3ad9c2c..832904a 100644 +index 3ad9c2c8b40..faa08d9c4bb 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -1019,6 +1019,24 @@ syntax: @@ -57,9 +69,13 @@ index 3ad9c2c..832904a 100644 /* When we get here, we've just matched a list of attributes and maybe a type and a double colon. The next thing we expect to see -@@ -2216,9 +2237,18 @@ variable_decl (int elem) - if ((gfc_option.allow_std & GFC_STD_EXTRA_LEGACY) - && current_ts.type == BT_CHARACTER) +@@ -2213,12 +2234,20 @@ variable_decl (int elem) + cl_match = MATCH_NO; + + /* Check for a character length clause before an array clause */ +- if ((gfc_option.allow_std & GFC_STD_EXTRA_LEGACY) +- && current_ts.type == BT_CHARACTER) ++ if (gfc_option.allow_std & GFC_STD_EXTRA_LEGACY) { - cl_match = match_character_length_clause (&cl, &cl_deferred, elem); - if (cl_match == MATCH_ERROR) @@ -79,7 +95,7 @@ index 3ad9c2c..832904a 100644 } /* Now we could see the optional array spec. or character length. */ -@@ -2412,6 +2442,13 @@ variable_decl (int elem) +@@ -2412,6 +2441,13 @@ variable_decl (int elem) goto cleanup; } @@ -93,3 +109,21 @@ index 3ad9c2c..832904a 100644 if (!check_function_name (name)) { m = MATCH_ERROR; +diff --git a/gcc/testsuite/gfortran.dg/dec_spec_in_variable.f b/gcc/testsuite/gfortran.dg/dec_spec_in_variable.f +new file mode 100644 +index 00000000000..0341a176aca +--- /dev/null ++++ b/gcc/testsuite/gfortran.dg/dec_spec_in_variable.f +@@ -0,0 +1,12 @@ ++! { dg-do compile } ++! { dg-options "-std=extra-legacy" } ++! ++! Test kind specification in variable not in type ++! ++ PROGRAM spec_in_var ++ INTEGER ai*1/1/ ++ REAL ar*4/1.0/ ++ ++ if(ai.NE.1) STOP 1 ++ if(abs(ar - 1.0) > 1.0D-6) STOP 2 ++ END diff --git a/SOURCES/0014-Allow-non-logical-expressions-in-IF-statements.patch b/SOURCES/0014-Allow-non-logical-expressions-in-IF-statements.patch index 5c88881..04fda43 100644 --- a/SOURCES/0014-Allow-non-logical-expressions-in-IF-statements.patch +++ b/SOURCES/0014-Allow-non-logical-expressions-in-IF-statements.patch @@ -8,61 +8,136 @@ This feature is enabled by the `-std=extra-legacy` compiler flag. 0014-Allow-non-logical-expressions-in-IF-statements.patch -diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c -index 682f7b0..c63b834 100644 ---- a/gcc/fortran/match.c -+++ b/gcc/fortran/match.c -@@ -25,6 +25,7 @@ along with GCC; see the file COPYING3. If not see - #include "gfortran.h" - #include "match.h" - #include "parse.h" -+#include "arith.h" - - int gfc_matching_ptr_assignment = 0; - int gfc_matching_procptr_assignment = 0; -@@ -1666,7 +1667,17 @@ got_match: - *p->next = new_st; - p->next->loc = gfc_current_locus; - -- p->expr1 = expr; -+ if ((gfc_option.allow_std & GFC_STD_EXTRA_LEGACY) -+ && expr->ts.type != BT_LOGICAL) -+ { -+ p->expr1 = gfc_ne (expr, gfc_get_int_expr (1, &gfc_current_locus, 0), INTRINSIC_NE); -+ gfc_warning_now (0, "The type of condition in this IF statement isn't LOGICAL; it will be true if it evaluates to nonzero."); -+ } -+ else -+ { -+ p->expr1 = expr; -+ } -+ p->op = EXEC_IF; - - gfc_clear_new_st (); + Allow non-logical expressions in IF statements + + This feature is enabled by the `-std=extra-legacy` compiler flag. + + Signed-off-by: Ben Brewer + Signed-off-by: Francisco Redondo Marchena + +diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c +index 33b441aa1bc..f979915e856 100644 +--- a/gcc/fortran/resolve.c ++++ b/gcc/fortran/resolve.c +@@ -9919,10 +9919,23 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) + switch (b->op) + { + case EXEC_IF: +- if (t && b->expr1 != NULL +- && (b->expr1->ts.type != BT_LOGICAL || b->expr1->rank != 0)) +- gfc_error ("IF clause at %L requires a scalar LOGICAL expression", +- &b->expr1->where); ++ if (t && b->expr1 != NULL) ++ { ++ if (gfc_option.allow_std & GFC_STD_EXTRA_LEGACY && b->expr1->ts.type != BT_LOGICAL) ++ { ++ gfc_expr* cast; ++ cast = gfc_ne (b->expr1, gfc_get_int_expr (1, &gfc_current_locus, 0), INTRINSIC_NE); ++ if (cast == NULL) ++ gfc_internal_error ("gfc_resolve_blocks(): Failed to cast to LOGICAL in IF"); ++ b->expr1 = cast; ++ gfc_warning (0, "Non-LOGICAL type in IF statement condition %L" ++ " will be true if it evaluates to nonzero", &b->expr1->where); ++ } ++ ++ if ((b->expr1->ts.type != BT_LOGICAL || b->expr1->rank != 0)) ++ gfc_error ("IF clause at %L requires a scalar LOGICAL expression", ++ &b->expr1->where); ++ } + break; -diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c -index 3aedb1d..e926ba6 100644 ---- a/gcc/fortran/parse.c -+++ b/gcc/fortran/parse.c -@@ -26,6 +26,7 @@ along with GCC; see the file COPYING3. If not see - #include - #include "match.h" - #include "parse.h" -+#include "arith.h" + case EXEC_WHERE: +@@ -11182,11 +11195,23 @@ start: + break; - /* Current statement label. Zero means no statement label. Because new_st - can get wiped during statement matching, we have to keep it separate. */ -@@ -4036,6 +4037,14 @@ parse_if_block (void) - d = add_statement (); + case EXEC_IF: +- if (t && code->expr1 != NULL +- && (code->expr1->ts.type != BT_LOGICAL +- || code->expr1->rank != 0)) +- gfc_error ("IF clause at %L requires a scalar LOGICAL expression", +- &code->expr1->where); ++ if (t && code->expr1 != NULL) ++ { ++ if (gfc_option.allow_std & GFC_STD_EXTRA_LEGACY && code->expr1->ts.type != BT_LOGICAL) ++ { ++ gfc_expr* cast; ++ cast = gfc_ne (code->expr1, gfc_get_int_expr (1, &gfc_current_locus, 0), INTRINSIC_NE); ++ if (cast == NULL) ++ gfc_internal_error ("gfc_resolve_code(): Failed to cast to LOGICAL in IF"); ++ code->expr1 = cast; ++ gfc_warning (0, "Non-LOGICAL type in IF statement condition %L" ++ " will be true if it evaluates to nonzero", &code->expr1->where); ++ } ++ ++ if ((code->expr1->ts.type != BT_LOGICAL || code->expr1->rank != 0)) ++ gfc_error ("IF clause at %L requires a scalar LOGICAL expression", ++ &code->expr1->where); ++ } + break; - d->expr1 = top->expr1; + case EXEC_CALL: +diff --git a/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks.f b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks.f +new file mode 100644 +index 00000000000..ad23fcfc9af +--- /dev/null ++++ b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks.f +@@ -0,0 +1,21 @@ ++! { dg-do compile } ++! { dg-options "-std=extra-legacy" } ++! ++! Allow logical expressions in if statements and blocks ++! ++ PROGRAM logical_exp_if_st_bl ++ INTEGER ipos/1/ ++ INTEGER ineg/0/ + -+ if ((gfc_option.allow_std & GFC_STD_EXTRA_LEGACY) -+ && top->expr1->ts.type != BT_LOGICAL) -+ { -+ d->expr1 = gfc_ne (top->expr1, gfc_get_int_expr (1, &gfc_current_locus, 0), INTRINSIC_NE); -+ gfc_warning_now (0, "The type of condition in this IF statement isn't LOGICAL; it will be true if it evaluates to nonzero."); -+ } ++ ! Test non logical variables ++ if (ineg) STOP 1 ! { dg-warning "if it evaluates to nonzero" } ++ if (0) STOP 2 ! { dg-warning "if it evaluates to nonzero" } ++ ++ ! Test non logical expressions in if statements ++ if (MOD(ipos, 1)) STOP 3 ! { dg-warning "if it evaluates to nonzero" } ++ ++ ! Test non logical expressions in if blocks ++ if (MOD(2 * ipos, 2)) then ! { dg-warning "if it evaluates to nonzero" } ++ STOP 4 ++ endif ++ END +commit cf72338b9468fad669b60600bcce7918a8d4591e +Author: Jeff Law +Date: Tue Jun 5 15:45:41 2018 -0600 + + Additional test for + + 0014-Allow-non-logical-expressions-in-IF-statements.patch + "Allow non-logical expressions in IF statements" + +diff --git a/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks-2.f b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks-2.f +new file mode 100644 +index 00000000000..7da6aaceec7 +--- /dev/null ++++ b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks-2.f +@@ -0,0 +1,23 @@ ++! { dg-do compile } ++! { dg-options "-std=extra-legacy" } ++ ++ function othersub1() ++ integer*4 othersub1 ++ othersub1 = 1 ++ end ++ function othersub2() ++ integer*4 othersub2 ++ othersub2 = 2 ++ end ++ program MAIN ++ integer*4 othersub1 ++ integer*4 othersub2 ++c the if (integer) works here ++ if (othersub2()) then ! { dg-warning "" } ++ write (*,*), 'othersub2 is true' ++c but fails in the "else if" ++ else if (othersub1()) then ! { dg-warning "" } ++ write (*,*), 'othersub2 is false, othersub1 is true' ++ endif ++ end + - top->expr1 = NULL; - top->block = d; - diff --git a/SOURCES/0016-Allow-calls-to-intrinsics-with-smaller-types-than-sp.patch b/SOURCES/0016-Allow-calls-to-intrinsics-with-smaller-types-than-sp.patch index dc1282b..c87dda4 100644 --- a/SOURCES/0016-Allow-calls-to-intrinsics-with-smaller-types-than-sp.patch +++ b/SOURCES/0016-Allow-calls-to-intrinsics-with-smaller-types-than-sp.patch @@ -9,10 +9,9 @@ This feature is enabled by the `-std=extra-legacy` compiler flag. 0016-Allow-calls-to-intrinsics-with-smaller-types-than-sp.patch -diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h -index a32de3e..e222003 100644 ---- a/gcc/fortran/gfortran.h -+++ b/gcc/fortran/gfortran.h +diff -Nrup a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h +--- a/gcc/fortran/gfortran.h 2018-06-05 11:59:14.269337049 -0600 ++++ b/gcc/fortran/gfortran.h 2018-06-05 11:59:52.830081690 -0600 @@ -646,6 +646,8 @@ enum gfc_reverse GFC_INHIBIT_REVERSE }; @@ -31,11 +30,10 @@ index a32de3e..e222003 100644 bool gfc_check_operator_interface (gfc_symbol*, gfc_intrinsic_op, locus); bool gfc_has_vector_subscript (gfc_expr*); gfc_intrinsic_op gfc_equivalent_op (gfc_intrinsic_op); -diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c -index 162f777..fc73e31 100644 ---- a/gcc/fortran/interface.c -+++ b/gcc/fortran/interface.c -@@ -682,7 +682,7 @@ gfc_compare_derived_types (gfc_symbol *derived1, gfc_symbol *derived2) +diff -Nrup a/gcc/fortran/interface.c b/gcc/fortran/interface.c +--- a/gcc/fortran/interface.c 2018-03-03 06:51:39.000000000 -0700 ++++ b/gcc/fortran/interface.c 2018-06-05 12:01:11.218559539 -0600 +@@ -682,7 +682,7 @@ gfc_compare_derived_types (gfc_symbol *d /* Compare two typespecs, recursively if necessary. */ bool @@ -44,7 +42,7 @@ index 162f777..fc73e31 100644 { /* See if one of the typespecs is a BT_VOID, which is what is being used to allow the funcs like c_f_pointer to accept any pointer type. -@@ -721,12 +721,23 @@ gfc_compare_types (gfc_typespec *ts1, gfc_typespec *ts2) +@@ -721,12 +721,23 @@ gfc_compare_types (gfc_typespec *ts1, gf return compare_union_types (ts1->u.derived, ts2->u.derived); if (ts1->type != BT_DERIVED && ts1->type != BT_CLASS) @@ -69,7 +67,7 @@ index 162f777..fc73e31 100644 static bool compare_type (gfc_symbol *s1, gfc_symbol *s2) -@@ -743,7 +754,9 @@ compare_type (gfc_symbol *s1, gfc_symbol *s2) +@@ -743,7 +754,9 @@ compare_type (gfc_symbol *s1, gfc_symbol return gfc_compare_types (&s1->ts, &s2->ts) || s2->ts.type == BT_ASSUMED; } @@ -80,7 +78,7 @@ index 162f777..fc73e31 100644 static bool compare_rank (gfc_symbol *s1, gfc_symbol *s2) { -@@ -2150,7 +2163,7 @@ argument_rank_mismatch (const char *name, locus *where, +@@ -2150,7 +2163,7 @@ argument_rank_mismatch (const char *name static bool compare_parameter (gfc_symbol *formal, gfc_expr *actual, @@ -89,7 +87,7 @@ index 162f777..fc73e31 100644 { gfc_ref *ref; bool rank_check, is_pointer; -@@ -2242,7 +2255,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, +@@ -2242,7 +2255,7 @@ compare_parameter (gfc_symbol *formal, g && actual->ts.type != BT_HOLLERITH && formal->ts.type != BT_ASSUMED && !(formal->attr.ext_attr & (1 << EXT_ATTR_NO_ARG_CHECK)) @@ -108,7 +106,7 @@ index 162f777..fc73e31 100644 { gfc_actual_arglist **new_arg, *a, *actual; gfc_formal_arglist *f; -@@ -2918,7 +2932,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, +@@ -2918,7 +2932,7 @@ compare_actual_formal (gfc_actual_arglis } if (!compare_parameter (f->sym, a->expr, ranks_must_agree, @@ -117,7 +115,7 @@ index 162f777..fc73e31 100644 return false; /* TS 29113, 6.3p2. */ -@@ -3666,7 +3680,8 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where) +@@ -3666,7 +3680,8 @@ gfc_procedure_use (gfc_symbol *sym, gfc_ /* For a statement function, check that types and type parameters of actual arguments and dummy arguments match. */ if (!compare_actual_formal (ap, dummy_args, 0, sym->attr.elemental, @@ -127,17 +125,16 @@ index 162f777..fc73e31 100644 return false; if (!check_intents (dummy_args, *ap)) -@@ -3715,7 +3730,8 @@ gfc_ppc_use (gfc_component *comp, gfc_actual_arglist **ap, locus *where) +@@ -3715,7 +3730,7 @@ gfc_ppc_use (gfc_component *comp, gfc_ac } if (!compare_actual_formal (ap, comp->ts.interface->formal, 0, - comp->attr.elemental, false, where)) -+ comp->attr.elemental, false, where, -+ MATCH_EXACT)) ++ comp->attr.elemental, false, where, MATCH_EXACT)) return; check_intents (comp->ts.interface->formal, *ap); -@@ -3729,7 +3745,7 @@ gfc_ppc_use (gfc_component *comp, gfc_actual_arglist **ap, locus *where) +@@ -3729,7 +3744,7 @@ gfc_ppc_use (gfc_component *comp, gfc_ac GENERIC resolution. */ bool @@ -146,7 +143,7 @@ index 162f777..fc73e31 100644 { gfc_formal_arglist *dummy_args; bool r; -@@ -3740,7 +3756,7 @@ gfc_arglist_matches_symbol (gfc_actual_arglist** args, gfc_symbol* sym) +@@ -3740,7 +3755,7 @@ gfc_arglist_matches_symbol (gfc_actual_a dummy_args = gfc_sym_get_dummy_args (sym); r = !sym->attr.elemental; @@ -155,7 +152,7 @@ index 162f777..fc73e31 100644 { check_intents (dummy_args, *args); if (warn_aliasing) -@@ -3766,7 +3782,8 @@ gfc_search_interface (gfc_interface *intr, int sub_flag, +@@ -3766,7 +3781,8 @@ gfc_search_interface (gfc_interface *int locus null_expr_loc; gfc_actual_arglist *a; bool has_null_arg = false; @@ -165,7 +162,7 @@ index 162f777..fc73e31 100644 for (a = *ap; a; a = a->next) if (a->expr && a->expr->expr_type == EXPR_NULL && a->expr->ts.type == BT_UNKNOWN) -@@ -3776,38 +3793,43 @@ gfc_search_interface (gfc_interface *intr, int sub_flag, +@@ -3776,38 +3792,43 @@ gfc_search_interface (gfc_interface *int break; } @@ -236,7 +233,7 @@ index 162f777..fc73e31 100644 } } -@@ -3942,7 +3964,7 @@ matching_typebound_op (gfc_expr** tb_base, +@@ -3942,7 +3963,7 @@ matching_typebound_op (gfc_expr** tb_bas /* Check if this arglist matches the formal. */ argcopy = gfc_copy_actual_arglist (args); @@ -245,11 +242,10 @@ index 162f777..fc73e31 100644 gfc_free_actual_arglist (argcopy); /* Return if we found a match. */ -diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c -index 371f5b8..846492a 100644 ---- a/gcc/fortran/intrinsic.c -+++ b/gcc/fortran/intrinsic.c -@@ -4229,6 +4229,16 @@ check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym, +diff -Nrup a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c +--- a/gcc/fortran/intrinsic.c 2018-06-05 11:59:14.278336990 -0600 ++++ b/gcc/fortran/intrinsic.c 2018-06-05 11:59:52.831081683 -0600 +@@ -4229,6 +4229,16 @@ check_arglist (gfc_actual_arglist **ap, if (ts.kind == 0) ts.kind = actual->expr->ts.kind; @@ -266,11 +262,10 @@ index 371f5b8..846492a 100644 if (!gfc_compare_types (&ts, &actual->expr->ts)) { if (error_flag) -diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c -index 33b441a..f82c298 100644 ---- a/gcc/fortran/resolve.c -+++ b/gcc/fortran/resolve.c -@@ -6055,7 +6055,7 @@ resolve_typebound_generic_call (gfc_expr* e, const char **name) +diff -Nrup a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c +--- a/gcc/fortran/resolve.c 2018-06-05 11:59:14.291336904 -0600 ++++ b/gcc/fortran/resolve.c 2018-06-05 11:59:52.833081670 -0600 +@@ -6055,7 +6055,7 @@ resolve_typebound_generic_call (gfc_expr && gfc_sym_get_dummy_args (target) == NULL); /* Check if this arglist matches the formal. */ diff --git a/SOURCES/0017-Add-the-SEQUENCE-attribute-by-default-if-it-s-not-pr.patch b/SOURCES/0017-Add-the-SEQUENCE-attribute-by-default-if-it-s-not-pr.patch index a6746b8..13ab77f 100644 --- a/SOURCES/0017-Add-the-SEQUENCE-attribute-by-default-if-it-s-not-pr.patch +++ b/SOURCES/0017-Add-the-SEQUENCE-attribute-by-default-if-it-s-not-pr.patch @@ -9,8 +9,18 @@ This feature is enabled by the `-std=extra-legacy` compiler flag. 0017-Add-the-SEQUENCE-attribute-by-default-if-it-s-not-pr.patch +commit 1635277d719de05fbd37a2887273ce893bf43198 +Author: Jim MacArthur +Date: Wed Nov 18 15:08:56 2015 +0000 + + Add the SEQUENCE attribute by default if it's not present. + + This feature is enabled by the `-std=extra-legacy` compiler flag. + + Test written by: Francisco Redondo Marchena + diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c -index f82c298..a831f70 100644 +index 2e60984b3bd..022b9230ec9 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -963,9 +963,16 @@ resolve_common_vars (gfc_common_head *common_block, bool named_common) @@ -33,3 +43,26 @@ index f82c298..a831f70 100644 if (csym->ts.u.derived->attr.alloc_comp) gfc_error_now ("Derived type variable %qs in COMMON at %L " "has an ultimate component that is " +diff --git a/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default.f b/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default.f +new file mode 100644 +index 00000000000..c0851c8bc77 +--- /dev/null ++++ b/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default.f +@@ -0,0 +1,17 @@ ++! { dg-do compile } ++! { dg-options "-std=extra-legacy" } ++! ++! Test add default SEQUENCE attribute to COMMON blocks ++! ++ PROGRAM sequence_att_common ++ TYPE STRUCT1 ++ INTEGER*4 ID ++ INTEGER*4 TYPE ++ INTEGER*8 DEFVAL ++ CHARACTER*(4) NAME ++ LOGICAL*1 NIL ++ END TYPE STRUCT1 ++ ++ TYPE (STRUCT1) SINST ++ COMMON /BLOCK1/ SINST ++ END diff --git a/SOURCES/gcc7-fortran-include.patch b/SOURCES/gcc7-fortran-include.patch new file mode 100644 index 0000000..5914f9e --- /dev/null +++ b/SOURCES/gcc7-fortran-include.patch @@ -0,0 +1,240 @@ +commit 858a1903ea946c9947d492209453a8973846b9f7 +Author: Jeff Law +Date: Tue May 29 13:56:59 2018 -0400 + + Fix bloomberg INCLUDE issue + +diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c +index 55d6daf..9c9a208 100644 +--- a/gcc/fortran/scanner.c ++++ b/gcc/fortran/scanner.c +@@ -2129,6 +2129,38 @@ preprocessor_line (gfc_char_t *c) + current_file->line++; + } + ++/* Add LINE with length LEN and truncation status TRUNC to ++ FILE_CHANGES. */ ++static void ++add_line (gfc_char_t *line, int len, int trunc) ++{ ++ gfc_linebuf *b; ++ ++ b = XCNEWVAR (gfc_linebuf, gfc_linebuf_header_size ++ + (len + 1) * sizeof (gfc_char_t)); ++ ++ ++ b->location = linemap_line_start (line_table, current_file->line++, len); ++ /* ??? We add the location for the maximum column possible here, ++ because otherwise if the next call creates a new line-map, it ++ will not reserve space for any offset. */ ++ if (len > 0) ++ linemap_position_for_column (line_table, len); ++ ++ b->file = current_file; ++ b->truncated = trunc; ++ wide_strcpy (b->line, line); ++ ++ if (line_head == NULL) ++ line_head = b; ++ else ++ line_tail->next = b; ++ ++ line_tail = b; ++ ++ while (file_changes_cur < file_changes_count) ++ file_changes[file_changes_cur++].lb = b; ++} + + static bool load_file (const char *, const char *, bool); + +@@ -2139,7 +2171,7 @@ static bool load_file (const char *, const char *, bool); + processed or true if we matched an include. */ + + static bool +-include_line (gfc_char_t *line) ++include_line (FILE *input, gfc_char_t *line, int *len, int *trunc) + { + gfc_char_t quote, *c, *begin, *stop; + char *filename; +@@ -2173,6 +2205,33 @@ include_line (gfc_char_t *line) + while (*c == ' ' || *c == '\t') + c++; + ++ /* If we have reached EOL, read ahead to find the quote. We eat ++ any whitespace. We use getchar behind the back of load_line and ++ put it back if we do not find what we are looking for. */ ++ int new_line_len = 0; ++ int new_trunc = 0; ++ gfc_char_t *new_line = NULL; ++ if (*c == '\0') ++ { ++ unsigned char x; ++ ++ do ++ x = getc (input); ++ while (x == ' ' || x == '\t' || x == '\r' || x == '\n'); ++ ++ /* Always put the character back. */ ++ ungetc (x, input); ++ ++ /* If we did not fine the quote, put the character back and ++ return that no INCLUDE has processed. */ ++ if (x != '"' && x != '\'') ++ return false; ++ ++ /* Read the next line and continue processing. */ ++ new_trunc = load_line (input, &new_line, &new_line_len, NULL); ++ c = new_line; ++ } ++ + /* Find filename between quotes. */ + + quote = *c++; +@@ -2184,16 +2243,45 @@ include_line (gfc_char_t *line) + while (*c != quote && *c != '\0') + c++; + ++ /* Reached EOL without finding ending quote. */ + if (*c == '\0') +- return false; ++ { ++ /* If we loaded another line, then we want to add the ++ original line and return the current line. ++ ++ We do not try to support multi-line filenames for ++ INCLUDE statements. */ ++ if (new_line) ++ { ++ add_line (line, *len, *trunc); ++ *line = *new_line; ++ *len = new_line_len; ++ *trunc = new_trunc; ++ } ++ return false; ++ } + + stop = c++; + ++ /* Consume trailing whitespace on this line. */ + while (*c == ' ' || *c == '\t') + c++; + ++ /* If we encounter real characters before reaching EOL, then ++ we do not consider this an include line. */ + if (*c != '\0' && *c != '!') +- return false; ++ { ++ /* If we loaded another line, then we want to add the ++ original line and return the current line. */ ++ if (new_line) ++ { ++ add_line (line, *len, *trunc); ++ *line = *new_line; ++ *len = new_line_len; ++ *trunc = new_trunc; ++ } ++ return false; ++ } + + /* We have an include line at this point. */ + +@@ -2215,7 +2303,6 @@ static bool + load_file (const char *realfilename, const char *displayedname, bool initial) + { + gfc_char_t *line; +- gfc_linebuf *b; + gfc_file *f; + FILE *input; + int len, line_len; +@@ -2370,39 +2457,13 @@ load_file (const char *realfilename, const char *displayedname, bool initial) + but the first line that's not a preprocessor line. */ + first_line = false; + +- if (include_line (line)) ++ if (include_line (input, line, &len, &trunc)) + { + current_file->line++; + continue; + } + +- /* Add line. */ +- +- b = XCNEWVAR (gfc_linebuf, gfc_linebuf_header_size +- + (len + 1) * sizeof (gfc_char_t)); +- +- +- b->location +- = linemap_line_start (line_table, current_file->line++, len); +- /* ??? We add the location for the maximum column possible here, +- because otherwise if the next call creates a new line-map, it +- will not reserve space for any offset. */ +- if (len > 0) +- linemap_position_for_column (line_table, len); +- +- b->file = current_file; +- b->truncated = trunc; +- wide_strcpy (b->line, line); +- +- if (line_head == NULL) +- line_head = b; +- else +- line_tail->next = b; +- +- line_tail = b; +- +- while (file_changes_cur < file_changes_count) +- file_changes[file_changes_cur++].lb = b; ++ add_line (line, len, trunc); + } + + /* Release the line buffer allocated in load_line. */ +diff --git a/gcc/testsuite/gfortran.dg/include_10.f90 b/gcc/testsuite/gfortran.dg/include_10.f90 +new file mode 100644 +index 0000000..5a9bb5b +--- /dev/null ++++ b/gcc/testsuite/gfortran.dg/include_10.f90 +@@ -0,0 +1,11 @@ ++! { dg-do compile } ++! ++! Ensure that we handle the pathname on a separate line than ++! the include directivbe ++! ++ ++subroutine one() ++ include ++ "include_4.inc" ++ integer(i4) :: i ++end subroutine one +diff --git a/gcc/testsuite/gfortran.dg/include_11.f90 b/gcc/testsuite/gfortran.dg/include_11.f90 +new file mode 100644 +index 0000000..44b23e03 +--- /dev/null ++++ b/gcc/testsuite/gfortran.dg/include_11.f90 +@@ -0,0 +1,10 @@ ++! { dg-do compile } ++! ++! Ensure that we can make an assignment to a variable named ++! include. ++! ++ ++subroutine one() ++ integer :: include ++ include = 5 ++end subroutine one +diff --git a/gcc/testsuite/gfortran.dg/include_12.f90 b/gcc/testsuite/gfortran.dg/include_12.f90 +new file mode 100644 +index 0000000..8679b20 +--- /dev/null ++++ b/gcc/testsuite/gfortran.dg/include_12.f90 +@@ -0,0 +1,11 @@ ++! { dg-do compile } ++! ++! Ensure we can make an assignment to a variable named include using ++! a line continuation ++! ++ ++subroutine one() ++ integer :: include ++ include & ++ = 5 ++end subroutine one diff --git a/SOURCES/gcc7-fortranlines.patch b/SOURCES/gcc7-fortranlines.patch new file mode 100644 index 0000000..87600da --- /dev/null +++ b/SOURCES/gcc7-fortranlines.patch @@ -0,0 +1,36 @@ +diff -Nrup a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c +--- a/gcc/fortran/scanner.c 2017-03-08 12:35:48.000000000 -0500 ++++ b/gcc/fortran/scanner.c 2018-05-03 19:01:52.000000000 -0400 +@@ -2097,6 +2097,10 @@ preprocessor_line (gfc_char_t *c) + in the linemap. Alternative could be using GC or updating linemap to + point to the new name, but there is no API for that currently. */ + current_file->filename = xstrdup (filename); ++ ++ /* We need to tell the linemap API that the filename changed. Just ++ changing current_file is insufficient. */ ++ linemap_add (line_table, LC_RENAME, false, current_file->filename, line); + } + + /* Set new line number. */ +diff -Nrup a/gcc/testsuite/gfortran.dg/linefile.f90 b/gcc/testsuite/gfortran.dg/linefile.f90 +--- a/gcc/testsuite/gfortran.dg/linefile.f90 1969-12-31 19:00:00.000000000 -0500 ++++ b/gcc/testsuite/gfortran.dg/linefile.f90 2018-05-07 13:34:22.000000000 -0400 +@@ -0,0 +1,18 @@ ++! { dg-do compile } ++! { dg-options "-Wall" } ++ ++! This will verify that the # directive later does not ++! mess up the diagnostic on this line ++SUBROUTINE s(dummy) ! { dg-warning "Unused" } ++ INTEGER, INTENT(in) :: dummy ++END SUBROUTINE ++ ++# 12345 "foo-f" ++SUBROUTINE s2(dummy) ++ INTEGER, INTENT(in) :: dummy ++END SUBROUTINE ++! We want to check that the # directive changes the filename in the ++! diagnostic. Nothing else really matters here. dg-regexp allows us ++! to see the entire diagnostic. We just have to make sure to consume ++! the entire message. ++! { dg-regexp "foo-f\[^\n]*" } diff --git a/SOURCES/gcc7-libstdc++-compat.patch b/SOURCES/gcc7-libstdc++-compat.patch index f432f5b..34ef397 100644 --- a/SOURCES/gcc7-libstdc++-compat.patch +++ b/SOURCES/gcc7-libstdc++-compat.patch @@ -5910,7 +5910,7 @@ + $(LTCXXCOMPILE) -std=gnu++1z -c $< --- libstdc++-v3/src/nonshared11/random48.cc.jj 2017-05-31 12:11:25.234560624 +0200 +++ libstdc++-v3/src/nonshared11/random48.cc 2017-05-31 15:25:50.424872511 +0200 -@@ -0,0 +1,72 @@ +@@ -0,0 +1,95 @@ +// Copyright (C) 2013-2017 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free @@ -5959,6 +5959,29 @@ +asm (".hidden _ZNSt23mersenne_twister_engineImLm32ELm624ELm397ELm31ELm2567483615ELm11ELm4294967295ELm7ELm2636928640ELm15ELm4022730752ELm18ELm1812433253EEC1Em"); +asm (".hidden _ZNSt23mersenne_twister_engineImLm32ELm624ELm397ELm31ELm2567483615ELm11ELm4294967295ELm7ELm2636928640ELm15ELm4022730752ELm18ELm1812433253EEC2Em"); +asm (".hidden _ZNSt23mersenne_twister_engineImLm32ELm624ELm397ELm31ELm2567483615ELm11ELm4294967295ELm7ELm2636928640ELm15ELm4022730752ELm18ELm1812433253EEclEv"); ++#elif defined(__s390__) ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE10shift_sizeE"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE10state_sizeE"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE11_M_gen_randEv"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE11tempering_bE"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE11tempering_cE"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE11tempering_dE"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE11tempering_lE"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE11tempering_sE"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE11tempering_tE"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE11tempering_uE"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE12default_seedE"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE25initialization_multiplierE"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE3maxEv"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE3minEv"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE4seedEj"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE7discardEy"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE8xor_maskE"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE9mask_bitsE"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE9word_sizeE"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EEC1Ej"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EEC2Ej"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EEclEv"); +#else +asm (".hidden _ZNSt23mersenne_twister_engineIjLj32ELj624ELj397ELj31ELj2567483615ELj11ELj4294967295ELj7ELj2636928640ELj15ELj4022730752ELj18ELj1812433253EE10shift_sizeE"); +asm (".hidden _ZNSt23mersenne_twister_engineIjLj32ELj624ELj397ELj31ELj2567483615ELj11ELj4294967295ELj7ELj2636928640ELj15ELj4022730752ELj18ELj1812433253EE10state_sizeE"); @@ -8202,7 +8225,7 @@ +#endif --- libstdc++-v3/src/nonshared11/random.cc.jj 2017-05-31 12:11:25.236560600 +0200 +++ libstdc++-v3/src/nonshared11/random.cc 2017-05-31 15:25:50.425872499 +0200 -@@ -0,0 +1,71 @@ +@@ -0,0 +1,94 @@ +// Copyright (C) 2013-2017 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free @@ -8250,6 +8273,29 @@ +asm (".hidden _ZNSt23mersenne_twister_engineImLm32ELm624ELm397ELm31ELm2567483615ELm11ELm4294967295ELm7ELm2636928640ELm15ELm4022730752ELm18ELm1812433253EEC1Em"); +asm (".hidden _ZNSt23mersenne_twister_engineImLm32ELm624ELm397ELm31ELm2567483615ELm11ELm4294967295ELm7ELm2636928640ELm15ELm4022730752ELm18ELm1812433253EEC2Em"); +asm (".hidden _ZNSt23mersenne_twister_engineImLm32ELm624ELm397ELm31ELm2567483615ELm11ELm4294967295ELm7ELm2636928640ELm15ELm4022730752ELm18ELm1812433253EEclEv"); ++#elif defined(__s390__) ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE10shift_sizeE"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE10state_sizeE"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE11_M_gen_randEv"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE11tempering_bE"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE11tempering_cE"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE11tempering_dE"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE11tempering_lE"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE11tempering_sE"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE11tempering_tE"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE11tempering_uE"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE12default_seedE"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE25initialization_multiplierE"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE3maxEv"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE3minEv"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE4seedEj"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE7discardEy"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE8xor_maskE"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE9mask_bitsE"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EE9word_sizeE"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EEC1Ej"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EEC2Ej"); ++asm (".hidden _ZNSt23mersenne_twister_engineIjLm32ELm624ELm397ELm31ELj2567483615ELm11ELj4294967295ELm7ELj2636928640ELm15ELj4022730752ELm18ELj1812433253EEclEv"); +#else +asm (".hidden _ZNSt23mersenne_twister_engineIjLj32ELj624ELj397ELj31ELj2567483615ELj11ELj4294967295ELj7ELj2636928640ELj15ELj4022730752ELj18ELj1812433253EE10shift_sizeE"); +asm (".hidden _ZNSt23mersenne_twister_engineIjLj32ELj624ELj397ELj31ELj2567483615ELj11ELj4294967295ELj7ELj2636928640ELj15ELj4022730752ELj18ELj1812433253EE10state_sizeE"); diff --git a/SOURCES/gcc7-rh1570967.patch b/SOURCES/gcc7-rh1570967.patch new file mode 100644 index 0000000..43bab56 --- /dev/null +++ b/SOURCES/gcc7-rh1570967.patch @@ -0,0 +1,81 @@ +commit 63256634cd46529bb3e839838f03dc4164feaa4c +Author: foreese +Date: Thu Aug 10 12:36:44 2017 +0000 + + 2017-08-10 Fritz Reese + + gcc/fortran/ChangeLog: + + * options.c (set_dec_flags, gfc_post_options): Only set flag_d_lines + with -fdec when not set by user. + + gcc/testsuite/ChangeLog: + + gfortran.dg/ + * dec_d_lines_1.f, dec_d_lines_2.f: New. + + + + git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@251024 138bc75d-0d04-0410-961f-82ee72b054a4 + +diff --git gcc/fortran/options.c gcc/fortran/options.c +index 283c8354e06..cd254e93229 100644 +--- gcc/fortran/options.c ++++ gcc/fortran/options.c +@@ -57,9 +57,6 @@ set_dec_flags (int value) + | GFC_STD_GNU | GFC_STD_LEGACY; + gfc_option.warn_std &= ~(GFC_STD_LEGACY | GFC_STD_F95_DEL); + +- /* Set -fd-lines-as-comments by default. */ +- if (value && gfc_current_form != FORM_FREE && gfc_option.flag_d_lines == -1) +- gfc_option.flag_d_lines = 0; + + /* Set other DEC compatibility extensions. */ + flag_dollar_ok |= value; +@@ -339,8 +336,15 @@ gfc_post_options (const char **pfilename) + diagnostic_classify_diagnostic (global_dc, OPT_Wline_truncation, + DK_ERROR, UNKNOWN_LOCATION); + } +- else if (warn_line_truncation == -1) +- warn_line_truncation = 0; ++ else ++ { ++ /* With -fdec, set -fd-lines-as-comments by default in fixed form. */ ++ if (flag_dec && gfc_option.flag_d_lines == -1) ++ gfc_option.flag_d_lines = 0; ++ ++ if (warn_line_truncation == -1) ++ warn_line_truncation = 0; ++ } + + /* If -pedantic, warn about the use of GNU extensions. */ + if (pedantic && (gfc_option.allow_std & GFC_STD_GNU) != 0) +diff --git gcc/testsuite/gfortran.dg/dec_d_lines_1.f gcc/testsuite/gfortran.dg/dec_d_lines_1.f +new file mode 100644 +index 00000000000..2cc7a01daff +--- /dev/null ++++ gcc/testsuite/gfortran.dg/dec_d_lines_1.f +@@ -0,0 +1,9 @@ ++! { dg-do compile } ++! { dg-options "-ffixed-form -fd-lines-as-code -fdec" } ++! ++! Ensure -fd-lines-as-code is not overridden by -fdec. ++! ++ i = 0 ++d end ++ subroutine s ++D end +diff --git gcc/testsuite/gfortran.dg/dec_d_lines_2.f gcc/testsuite/gfortran.dg/dec_d_lines_2.f +new file mode 100644 +index 00000000000..31eaf5f2328 +--- /dev/null ++++ gcc/testsuite/gfortran.dg/dec_d_lines_2.f +@@ -0,0 +1,8 @@ ++! { dg-do compile } ++! { dg-options "-ffixed-form -fdec" } ++! ++! Ensure -fd-lines-as-comments is enabled by default with -fdec. ++! ++d This is a comment. ++D This line, too. ++ end diff --git a/SPECS/gcc.spec b/SPECS/gcc.spec index 3352c2a..ea230bf 100644 --- a/SPECS/gcc.spec +++ b/SPECS/gcc.spec @@ -95,7 +95,7 @@ Summary: GCC version 7 Name: %{?scl_prefix}gcc Version: %{gcc_version} -Release: %{gcc_release}.4%{?dist} +Release: %{gcc_release}.10%{?dist} # libgcc, libgfortran, libgomp, libstdc++ and crtstuff have # GCC Runtime Exception. License: GPLv3+ and GPLv3+ with exceptions and GPLv2+ with exceptions and LGPLv2+ and BSD @@ -258,6 +258,7 @@ Patch11: gcc7-Wno-format-security.patch Patch13: gcc7-rh1512529-aarch64.patch Patch14: gcc7-pr84524.patch Patch15: gcc7-pr84128.patch +Patch16: gcc7-rh1570967.patch Patch1000: gcc7-libstdc++-compat.patch Patch1001: gcc7-alt-compat-test.patch @@ -291,6 +292,10 @@ Patch3018: 0018-Fill-in-missing-array-dimensions-using-the-lower-bou.patch Patch3019: 0019-Add-tests-for-AUTOMATIC-keyword.patch Patch3020: 0020-Add-test-for-STRUCTURE-and-RECORD.patch Patch3022: 0022-Default-values-for-certain-field-descriptors-in-form.patch +Patch3023: gcc7-fortranlines.patch +Patch3024: gcc7-fortran-include.patch + + %if 0%{?rhel} >= 7 %global nonsharedver 48 @@ -683,6 +688,7 @@ This package contains the Memory Protection Extensions static runtime libraries. %patch13 -p0 -b .rh1512529-aarch64~ %patch14 -p0 -b .pr84524~ %patch15 -p0 -b .pr84128~ +%patch16 -p0 -b .rh1570967~ %if 0%{?rhel} <= 7 %patch1000 -p0 -b .libstdc++-compat~ @@ -738,6 +744,8 @@ cd .. %patch3019 -p1 -b .fortran19~ %patch3020 -p1 -b .fortran20~ %patch3022 -p1 -b .fortran22~ +%patch3023 -p1 -b .fortran23~ +%patch3024 -p1 -b .fortran24~ %endif echo 'Red Hat %{version}-%{gcc_release}' > gcc/DEV-PHASE @@ -2893,6 +2901,29 @@ fi %doc rpm.doc/changelogs/libcc1/ChangeLog* %changelog +* Tue Jun 12 2018 Marek Polacek 7.3.1-5.10 +- bump for rebuild + +* Tue Jun 05 2018 Jeff Law 7.3.1-5.9 +- Fix INCLUDE handling when pathname is on a separate line +- Integrate updates to patches #0005 and #0014. Add testcases for +- various legacy fortran extensions (#1586289) + + +* Sat May 19 2018 Marek Polacek 7.3.1-5.8 +- bump for rebuild + +* Wed May 9 2018 Marek Polacek 7.3.1-5.7 +- fix 0014-Allow-non-logical-expressions-in-IF-statements.patch: also allow + non logical expressions in ELSE-IF statements + +* Mon Apr 23 2018 Jeff Law 7.3.1-5.6 +- Fix handling of -fdlines-as-comments when -fdec is enabled + (#1570967) + +* Tue Apr 17 2018 Marek Polacek 7.3.1-5.5 +- fix a goof in 0013-Allow-per-variable-kind-specification.patch + * Thu Mar 29 2018 Jeff Law 7.3.1-5.4 - Add Jakub's patch to generalize default exponent handling to instead cover all DEC runtime extensions