CentOS Sources
2018-06-18 6068c75e13da76bf8cf8b3caf58afa24fc3d5919
import devtoolset-7-gcc-7.3.1-5.10.el7
3 files added
14 files modified
2183 ■■■■■ changed files
SOURCES/0005-Allow-comparisons-between-INTEGER-and-REAL.patch 1133 ●●●●● patch | view | raw | blame | history
SOURCES/0006-Allow-blank-format-items-in-format-strings.patch 38 ●●●●● patch | view | raw | blame | history
SOURCES/0007-Allow-more-than-one-character-as-argument-to-ICHAR.patch 40 ●●●●● patch | view | raw | blame | history
SOURCES/0008-Allow-non-integer-substring-indexes.patch 35 ●●●●● patch | view | raw | blame | history
SOURCES/0009-Convert-LOGICAL-to-INTEGER-for-arithmetic-ops-and-vi.patch 71 ●●●● patch | view | raw | blame | history
SOURCES/0010-Allow-mixed-string-length-and-array-specification-in.patch 26 ●●●●● patch | view | raw | blame | history
SOURCES/0011-Allow-character-to-int-conversions-in-DATA-statement.patch 29 ●●●●● patch | view | raw | blame | history
SOURCES/0012-Allow-old-style-initializers-in-derived-types.patch 44 ●●●●● patch | view | raw | blame | history
SOURCES/0013-Allow-per-variable-kind-specification.patch 44 ●●●● patch | view | raw | blame | history
SOURCES/0014-Allow-non-logical-expressions-in-IF-statements.patch 187 ●●●● patch | view | raw | blame | history
SOURCES/0016-Allow-calls-to-intrinsics-with-smaller-types-than-sp.patch 61 ●●●● patch | view | raw | blame | history
SOURCES/0017-Add-the-SEQUENCE-attribute-by-default-if-it-s-not-pr.patch 35 ●●●●● patch | view | raw | blame | history
SOURCES/gcc7-fortran-include.patch 240 ●●●●● patch | view | raw | blame | history
SOURCES/gcc7-fortranlines.patch 36 ●●●●● patch | view | raw | blame | history
SOURCES/gcc7-libstdc++-compat.patch 50 ●●●●● patch | view | raw | blame | history
SOURCES/gcc7-rh1570967.patch 81 ●●●●● patch | view | raw | blame | history
SPECS/gcc.spec 33 ●●●●● patch | view | raw | blame | history
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 <jim.macarthur@codethink.co.uk>
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_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 (b, &a->ts, 2, 1);
+      return;
+      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);
+    }
+  if (a->ts.type == BT_INTEGER && b->ts.type == BT_REAL)
+    {
+      gfc_convert_type_warn (a, &b->ts, 2, 1);
+    }
+
+  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;
 
+  if (gfc_option.allow_std & GFC_STD_EXTRA_LEGACY)
+    promote_types(a, p);
@@ -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.  */
+
   if (a->ts.type != p->ts.type)
+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 ("%<a%d%> 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;
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)
     {
       gfc_error ("%qs and %qs arguments of %qs intrinsic at %L must "
-      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;
+
+      default:
+    gfc_internal_error ("Bad type in gfc_simplify_sign");
+    }
+
   switch (x->ts.type)
     {
       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
SOURCES/0006-Allow-blank-format-items-in-format-strings.patch
@@ -11,8 +11,22 @@
---
        0006-Allow-blank-format-items-in-format-strings.patch
commit 8e205f3940a364318d0cd2197a9897142632b336
Author: Jim MacArthur <jim.macarthur@codethink.co.uk>
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 <francisco.marchena@codethink.co.uk>
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 @@
     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
SOURCES/0007-Allow-more-than-one-character-as-argument-to-ICHAR.patch
@@ -6,13 +6,21 @@
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 <jim.macarthur@codethink.co.uk>
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 <francisco.marchena@codethink.co.uk>
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 @@
       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 @@
     {
       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
SOURCES/0008-Allow-non-integer-substring-indexes.patch
@@ -6,10 +6,18 @@
This feature is enabled by the `-std=extra-legacy` compiler flag.
---
    0008-Allow-non-integer-substring-indexes.patch
commit 9f05bda69f21d7a7c17b58ff0b6392bfd1a06bae
Author: Jim MacArthur <jim.macarthur@codethink.co.uk>
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 <francisco.marchena@codethink.co.uk>
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 @@
       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
SOURCES/0009-Convert-LOGICAL-to-INTEGER-for-arithmetic-ops-and-vi.patch
@@ -9,19 +9,33 @@
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 <jim.macarthur@codethink.co.uk>
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 <francisco.marchena@codethink.co.uk>
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 @@
+    }
+}
+
+/* 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 @@
       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
SOURCES/0010-Allow-mixed-string-length-and-array-specification-in.patch
@@ -8,8 +8,16 @@
        0010-Allow-mixed-string-length-and-array-specification-in.patch
commit 05124ea7df2ee14620d5c24ffe972db3dcab4f4e
Author: Jim MacArthur <jim.macarthur@codethink.co.uk>
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 <francisco.marchena@codethink.co.uk>
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 @@
     }
 
   /* 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
SOURCES/0011-Allow-character-to-int-conversions-in-DATA-statement.patch
@@ -8,8 +8,18 @@
    0011-Allow-character-to-int-conversions-in-DATA-statement.patch
commit 11b148af8967669bcebd91ea6fdae28e9ec8e97c
Author: Jim MacArthur <jim.macarthur@codethink.co.uk>
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 <francisco.marchena@codethink.co.uk>
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 @@
       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
SOURCES/0012-Allow-old-style-initializers-in-derived-types.patch
@@ -10,12 +10,22 @@
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 <jim.macarthur@codethink.co.uk>
Date:   Thu Feb 4 16:00:30 2016 +0000
    Allow old-style initializers in derived types
    
        Drop unnecessary whitespace
    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.
    Test written by: Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
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 @@
       /* 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
SOURCES/0013-Allow-per-variable-kind-specification.patch
@@ -14,8 +14,20 @@
    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 <francisco.marchena@codethink.co.uk>
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 @@
 
   /* 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 @@
     }
 
   /* 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 @@
   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
SOURCES/0014-Allow-non-logical-expressions-in-IF-statements.patch
@@ -8,61 +8,136 @@
    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 ();
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 <setjmp.h>
 #include "match.h"
 #include "parse.h"
+#include "arith.h"
 /* 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 ();
   d->expr1 = top->expr1;
    Allow non-logical expressions in IF statements
    This feature is enabled by the `-std=extra-legacy` compiler flag.
    Signed-off-by: Ben Brewer <ben.brewer@codethink.co.uk>
    Signed-off-by: Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
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 ((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.");
+    }
+
   top->expr1 = NULL;
   top->block = d;
+          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;
 
     case EXEC_WHERE:
@@ -11182,11 +11195,23 @@ start:
       break;
     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;
     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/
+
+          ! 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 <law@redhat.com>
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
+
SOURCES/0016-Allow-calls-to-intrinsics-with-smaller-types-than-sp.patch
@@ -9,10 +9,9 @@
    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 @@
 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 @@
 {
   /* 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 @@
 
 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 @@
 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 @@
 {
   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 @@
 {
   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 @@
     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 @@
     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 @@
 {
   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 @@
     {
       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 @@
   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 @@
     }
     }
 
@@ -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 @@
         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 @@
       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.  */
SOURCES/0017-Add-the-SEQUENCE-attribute-by-default-if-it-s-not-pr.patch
@@ -9,8 +9,18 @@
        0017-Add-the-SEQUENCE-attribute-by-default-if-it-s-not-pr.patch
commit 1635277d719de05fbd37a2887273ce893bf43198
Author: Jim MacArthur <jim.macarthur@codethink.co.uk>
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 <francisco.marchena@codethink.co.uk>
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 @@
       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
SOURCES/gcc7-fortran-include.patch
New file
@@ -0,0 +1,240 @@
commit 858a1903ea946c9947d492209453a8973846b9f7
Author: Jeff Law <law@torsion.usersys.redhat.com>
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
SOURCES/gcc7-fortranlines.patch
New file
@@ -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 # <line> <file> 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]*" }
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");
SOURCES/gcc7-rh1570967.patch
New file
@@ -0,0 +1,81 @@
commit 63256634cd46529bb3e839838f03dc4164feaa4c
Author: foreese <foreese@138bc75d-0d04-0410-961f-82ee72b054a4>
Date:   Thu Aug 10 12:36:44 2017 +0000
    2017-08-10  Fritz Reese <Reese-Fritz@zai.com>
        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
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 @@
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 @@
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 @@
%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 @@
%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 @@
%doc rpm.doc/changelogs/libcc1/ChangeLog*
%changelog
* Tue Jun 12 2018 Marek Polacek <polacek@redhat.com> 7.3.1-5.10
- bump for rebuild
* Tue Jun 05 2018 Jeff Law <polacek@redhat.com> 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 <polacek@redhat.com> 7.3.1-5.8
- bump for rebuild
* Wed May  9 2018 Marek Polacek <polacek@redhat.com> 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 <law@redhat.com> 7.3.1-5.6
- Fix handling of -fdlines-as-comments when -fdec is enabled
  (#1570967)
* Tue Apr 17 2018 Marek Polacek <polacek@redhat.com> 7.3.1-5.5
- fix a goof in 0013-Allow-per-variable-kind-specification.patch
* Thu Mar 29 2018 Jeff Law <law@redhat.com> 7.3.1-5.4
- Add Jakub's patch to generalize default exponent handling to
  instead cover all DEC runtime extensions