Blob Blame History Raw
From 79bc3c8c15122dd929703f5ca7e468ffd46c3c3e Mon Sep 17 00:00:00 2001
From: Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
Date: Mon, 9 Apr 2018 15:10:02 +0100
Subject: [PATCH 12/16] Support type promotion in calls to intrinsics

Use -fdec-promotion or -fdec to enable this feature.

Merged 2 commits: worked on by Ben Brewer <ben.brewer@codethink.co.uk>,
Francisco Redondo Marchena <francisco.marchena@codethink.co.uk and
Jeff Law <law@redhat.com>

Re-worked by Mark Eggleston <mark.eggleston@codethink.com>
---
 gcc/fortran/check.c                                |  71 +++++-
 gcc/fortran/intrinsic.c                            |   5 +
 gcc/fortran/iresolve.c                             |  91 ++++---
 gcc/fortran/lang.opt                               |   4 +
 gcc/fortran/options.c                              |   1 +
 gcc/fortran/simplify.c                             | 266 ++++++++++++++++-----
 ...ec_intrinsic_int_real_array_const_promotion_1.f |  18 ++
 ...ec_intrinsic_int_real_array_const_promotion_2.f |  18 ++
 ...ec_intrinsic_int_real_array_const_promotion_3.f |  18 ++
 .../dec_intrinsic_int_real_const_promotion_1.f     |  90 +++++++
 .../dec_intrinsic_int_real_const_promotion_2.f     |  90 +++++++
 .../dec_intrinsic_int_real_const_promotion_3.f     |  92 +++++++
 .../dec_intrinsic_int_real_promotion_1.f           | 130 ++++++++++
 .../dec_intrinsic_int_real_promotion_2.f           | 130 ++++++++++
 .../dec_intrinsic_int_real_promotion_3.f           | 130 ++++++++++
 .../dec_intrinsic_int_real_promotion_4.f           | 118 +++++++++
 .../dec_intrinsic_int_real_promotion_5.f           | 118 +++++++++
 .../dec_intrinsic_int_real_promotion_6.f           | 118 +++++++++
 .../dec_intrinsic_int_real_promotion_7.f           | 118 +++++++++
 gcc/testsuite/gfortran.dg/dec_kind_promotion-1.f   |  40 ++++
 gcc/testsuite/gfortran.dg/dec_kind_promotion-2.f   |  40 ++++
 gcc/testsuite/gfortran.dg/dec_kind_promotion-3.f   |  40 ++++
 22 files changed, 1655 insertions(+), 91 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_1.f
 create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_2.f
 create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_3.f
 create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion_1.f
 create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion_2.f
 create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion_3.f
 create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_1.f
 create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_2.f
 create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_3.f
 create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_4.f
 create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_5.f
 create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_6.f
 create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_7.f
 create mode 100644 gcc/testsuite/gfortran.dg/dec_kind_promotion-1.f
 create mode 100644 gcc/testsuite/gfortran.dg/dec_kind_promotion-2.f
 create mode 100644 gcc/testsuite/gfortran.dg/dec_kind_promotion-3.f

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 0ba4d0a031f..89416ba368d 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -947,12 +947,40 @@ gfc_check_allocated (gfc_expr *array)
 }
 
 
+/* 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)
+{
+  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)
+    {
+      i = (a->ts.type != BT_REAL ? a : b);
+      gfc_warning_now (OPT_Wconversion, "Conversion from INTEGER to REAL "
+		       "at %L might lose precision", &i->where);
+    }
+
+  return true;
+}
+
+
 /* Common check function where the first argument must be real or
    integer and the second argument must be the same as the first.  */
 
 bool
 gfc_check_a_p (gfc_expr *a, gfc_expr *p)
 {
+  if (flag_dec_promotion)
+    return check_int_real_promotion (a, p);
+
   if (!int_or_real_check (a, 0))
     return false;
 
@@ -3126,6 +3154,41 @@ check_rest (bt type, int kind, gfc_actual_arglist *arglist)
 }
 
 
+/* Check function where all arguments of an argument list must be real
+   or integer.  */
+
+static bool
+check_rest_int_real (gfc_actual_arglist *arglist)
+{
+  gfc_actual_arglist *arg, *tmp;
+  gfc_expr *x;
+  int m, n;
+
+  if (!min_max_args (arglist))
+    return false;
+
+  for (arg = arglist, n=1; arg; arg = arg->next, n++)
+    {
+      x = arg->expr;
+      if (x->ts.type != BT_INTEGER && x->ts.type != BT_REAL)
+	{
+	  gfc_error ("%<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)
 {
@@ -3150,7 +3213,10 @@ gfc_check_min_max (gfc_actual_arglist *arg)
       return false;
     }
 
-  return check_rest (x->ts.type, x->ts.kind, arg);
+  if (flag_dec_promotion && x->ts.type != BT_CHARACTER)
+    return check_rest_int_real (arg);
+  else
+    return check_rest (x->ts.type, x->ts.kind, arg);
 }
 
 
@@ -4488,6 +4554,9 @@ gfc_check_shift (gfc_expr *i, gfc_expr *shift)
 bool
 gfc_check_sign (gfc_expr *a, gfc_expr *b)
 {
+  if (flag_dec_promotion)
+    return check_int_real_promotion (a, b);
+
   if (!int_or_real_check (a, 0))
     return false;
 
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 6d47ae3105f..a4b23bc244a 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -4329,6 +4329,11 @@ check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym,
       if (ts.kind == 0)
 	ts.kind = actual->expr->ts.kind;
 
+      /* If kind promotion is allowed don't check for kind if it is smaller */
+      if (flag_dec_promotion && ts.type == BT_INTEGER)
+	if (actual->expr->ts.kind < ts.kind)
+	  ts.kind = actual->expr->ts.kind;
+
       if (!gfc_compare_types (&ts, &actual->expr->ts))
 	{
 	  if (error_flag)
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 53338dda0a7..92d50c3deb9 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -893,19 +893,22 @@ gfc_resolve_dble (gfc_expr *f, gfc_expr *a)
 void
 gfc_resolve_dim (gfc_expr *f, gfc_expr *a, gfc_expr *p)
 {
-  f->ts.type = a->ts.type;
   if (p != NULL)
-    f->ts.kind = gfc_kind_max (a,p);
-  else
-    f->ts.kind = a->ts.kind;
-
-  if (p != NULL && a->ts.kind != p->ts.kind)
     {
-      if (a->ts.kind == gfc_kind_max (a,p))
-	gfc_convert_type (p, &a->ts, 2);
+      f->ts.kind = gfc_kind_max (a,p);
+      if (a->ts.type == BT_REAL || p->ts.type == BT_REAL)
+	f->ts.type = BT_REAL;
       else
-	gfc_convert_type (a, &p->ts, 2);
+	f->ts.type = BT_INTEGER;
+
+      if (a->ts.kind != f->ts.kind || a->ts.type != f->ts.type)
+	gfc_convert_type (a, &f->ts, 2);
+
+      if (p->ts.kind != f->ts.kind || p->ts.type != f->ts.type)
+	gfc_convert_type (p, &f->ts, 2);
     }
+  else
+    f->ts = a->ts;
 
   f->value.function.name
     = gfc_get_string ("__dim_%c%d", gfc_type_letter (f->ts.type), f->ts.kind);
@@ -1669,14 +1672,17 @@ gfc_resolve_minmax (const char *name, gfc_expr *f, gfc_actual_arglist *args)
   /* 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);
     }
 
@@ -2169,19 +2175,22 @@ gfc_resolve_minval (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
 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);
@@ -2191,19 +2200,22 @@ gfc_resolve_mod (gfc_expr *f, gfc_expr *a, gfc_expr *p)
 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),
@@ -2578,9 +2590,26 @@ gfc_resolve_shift (gfc_expr *f, gfc_expr *i, gfc_expr *shift ATTRIBUTE_UNUSED)
 
 
 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 --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index fa2851ae837..2a8f5f661a8 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -490,6 +490,10 @@ fdec-old-init
 Fortran Var(flag_dec_old_init)
 Enable support for old style initializers in derived types.
 
+fdec-promotion
+Fortran Var(flag_dec_promotion)
+Add support for type promotion in intrinsic arguments.
+
 fdec-structure
 Fortran Var(flag_dec_structure)
 Enable support for DEC STRUCTURE/RECORD.
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index 7b04a681f7b..7a2583a2076 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -83,6 +83,7 @@ set_dec_flags (int value)
   SET_BITFLAG (flag_dec_old_init, value, value);
   SET_BITFLAG (flag_dec_override_kind, value, value);
   SET_BITFLAG (flag_dec_non_logical_if, value, value);
+  SET_BITFLAG (flag_dec_promotion, value, value);
 }
 
 /* Finalize DEC flags.  */
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 7aff256c6b3..cb5f93e293d 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -2256,39 +2256,79 @@ 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");
@@ -4886,13 +4926,87 @@ min_max_choose (gfc_expr *arg, gfc_expr *extremum, int sign, bool back_val)
 {
   int ret;
 
+  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))
+	{
+	  ret = 1;
+	  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_nan_p (*arp))
+	ret = -1;
+      else
+	{
+	  ret = mpfr_cmp (*arp, *erp) * sign;
+	  if (ret > 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 ret;
+    }
+
   switch (arg->ts.type)
     {
       case BT_INTEGER:
 	ret = mpz_cmp (arg->value.integer,
 		       extremum->value.integer) * sign;
 	if (ret > 0)
-	  mpz_set (extremum->value.integer, arg->value.integer);
+	  {
+	    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:
@@ -5841,7 +5955,9 @@ gfc_simplify_mod (gfc_expr *a, gfc_expr *p)
   gfc_expr *result;
   int kind;
 
-  /* First check p.  */
+  mpfr_t ar;
+  mpfr_t pr;
+
   if (p->expr_type != EXPR_CONSTANT)
     return NULL;
 
@@ -5852,18 +5968,18 @@ gfc_simplify_mod (gfc_expr *a, gfc_expr *p)
 	if (mpz_cmp_ui (p->value.integer, 0) == 0)
 	  {
 	    gfc_error ("Argument %qs of MOD at %L shall not be zero",
-			"P", &p->where);
+	               "P", &p->where);
 	    return &gfc_bad_expr;
 	  }
-	break;
+      break;
       case BT_REAL:
 	if (mpfr_cmp_ui (p->value.real, 0) == 0)
 	  {
 	    gfc_error ("Argument %qs of MOD at %L shall not be zero",
-			"P", &p->where);
+	               "P", &p->where);
 	    return &gfc_bad_expr;
-	  }
-	break;
+	   }
+      break;
       default:
 	gfc_internal_error ("gfc_simplify_mod(): Bad arguments");
     }
@@ -5871,16 +5987,24 @@ gfc_simplify_mod (gfc_expr *a, gfc_expr *p)
   if (a->expr_type != EXPR_CONSTANT)
     return NULL;
 
+  if (a->ts.type != BT_REAL && a->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);
 
-  if (a->ts.type == BT_INTEGER)
-    mpz_tdiv_r (result->value.integer, a->value.integer, p->value.integer);
-  else
+  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);
+      mpfr_fmod (result->value.real, ar, pr, GFC_RND_MODE);
+    }
+  else
+    {
+      result = gfc_get_constant_expr (BT_INTEGER, kind, &a->where);
+      mpz_tdiv_r (result->value.integer, a->value.integer, p->value.integer);
     }
 
   return range_check (result, "MOD");
@@ -5893,7 +6017,9 @@ gfc_simplify_modulo (gfc_expr *a, gfc_expr *p)
   gfc_expr *result;
   int kind;
 
-  /* First check p.  */
+  mpfr_t ar;
+  mpfr_t pr;
+
   if (p->expr_type != EXPR_CONSTANT)
     return NULL;
 
@@ -5904,44 +6030,52 @@ gfc_simplify_modulo (gfc_expr *a, gfc_expr *p)
 	if (mpz_cmp_ui (p->value.integer, 0) == 0)
 	  {
 	    gfc_error ("Argument %qs of MODULO at %L shall not be zero",
-			"P", &p->where);
+	               "P", &p->where);
 	    return &gfc_bad_expr;
 	  }
-	break;
+      break;
       case BT_REAL:
 	if (mpfr_cmp_ui (p->value.real, 0) == 0)
 	  {
 	    gfc_error ("Argument %qs of MODULO at %L shall not be zero",
-			"P", &p->where);
+	               "P", &p->where);
 	    return &gfc_bad_expr;
-	  }
-	break;
+	   }
+      break;
       default:
 	gfc_internal_error ("gfc_simplify_modulo(): Bad arguments");
     }
 
+  if (a->ts.type != BT_REAL && a->ts.type != BT_INTEGER)
+    {
+      gfc_internal_error ("gfc_simplify_modulo(): Bad arguments");
+      return NULL;
+    }
+
   if (a->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);
 
-  if (a->ts.type == BT_INTEGER)
-	mpz_fdiv_r (result->value.integer, a->value.integer, p->value.integer);
-  else
+  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);
+      mpfr_fmod (result->value.real, ar, pr, 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);
+	{
+	  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);
+      mpz_fdiv_r (result->value.integer, a->value.integer, p->value.integer);
     }
 
   return range_check (result, "MODULO");
@@ -7442,27 +7576,41 @@ 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)
+	if (flag_sign_zero && y->ts.type == BT_REAL)
 	  mpfr_copysign (result->value.real, x->value.real, y->value.real,
-			GFC_RND_MODE);
+			 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 --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_1.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_1.f
new file mode 100644
index 00000000000..25763852139
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_1.f
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! { dg-options "-fdec" }
+!
+! Test promotion between integers and reals for mod and modulo where
+! A is a constant array and P is zero.
+!
+! Compilation errors are expected
+!
+! Contributed by Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
+!             and Jeff Law <law@redhat.com>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+      program promotion_int_real_array_const
+          real a(2) = mod([12, 34], 0.0)*4    ! { dg-error "shall not be zero" }
+          a = mod([12.0, 34.0], 0)*4          ! { dg-error "shall not be zero" }
+          real b(2) = modulo([12, 34], 0.0)*4 ! { dg-error "shall not be zero" }
+          b = modulo([12.0, 34.0], 0)*4       ! { dg-error "shall not be zero" }
+      end program
diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_2.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_2.f
new file mode 100644
index 00000000000..b78a46054f4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_2.f
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! { dg-options "-fdec-promotion" }
+!
+! Test promotion between integers and reals for mod and modulo where
+! A is a constant array and P is zero.
+!
+! Compilation errors are expected
+!
+! Contributed by Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
+!             and Jeff Law <law@redhat.com>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+      program promotion_int_real_array_const
+          real a(2) = mod([12, 34], 0.0)*4    ! { dg-error "shall not be zero" }
+          a = mod([12.0, 34.0], 0)*4          ! { dg-error "shall not be zero" }
+          real b(2) = modulo([12, 34], 0.0)*4 ! { dg-error "shall not be zero" }
+          b = modulo([12.0, 34.0], 0)*4       ! { dg-error "shall not be zero" }
+      end program
diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_3.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_3.f
new file mode 100644
index 00000000000..318ab5db97e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_3.f
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! { dg-options "-fdec -fno-dec-promotion" }
+!
+! Test promotion between integers and reals for mod and modulo where
+! A is a constant array and P is zero.
+!
+! Compilation errors are expected
+!
+! Contributed by Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
+!             and Jeff Law <law@redhat.com>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+      program promotion_int_real_array_const
+          real a(2) = mod([12, 34], 0.0)*4    ! { dg-error "'a' and 'p' arguments of 'mod'" }
+          a = mod([12.0, 34.0], 0)*4          ! { dg-error "'a' and 'p' arguments of 'mod'" }
+          real b(2) = modulo([12, 34], 0.0)*4 ! { dg-error "'a' and 'p' arguments of 'modulo'" }
+          b = modulo([12.0, 34.0], 0)*4       ! { dg-error "'a' and 'p' arguments of 'modulo'" }
+      end program
diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion_1.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion_1.f
new file mode 100644
index 00000000000..27eb2582bb2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion_1.f
@@ -0,0 +1,90 @@
+! { dg-do run }
+! { 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.
+!
+! Contributed by Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
+!             and Jeff Law <law@redhat.com>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+      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 --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion_2.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion_2.f
new file mode 100644
index 00000000000..bdd017b7280
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion_2.f
@@ -0,0 +1,90 @@
+! { dg-do run }
+! { dg-options "-fdec-promotion -finit-real=snan" }
+!
+! Test promotion between integers and reals in intrinsic operations.
+! These operations are: mod, modulo, dim, sign, min, max, minloc and
+! maxloc.
+!
+! Contributed by Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
+!             and Jeff Law <law@redhat.com>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+      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 --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion_3.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion_3.f
new file mode 100644
index 00000000000..ce90a5667d6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion_3.f
@@ -0,0 +1,92 @@
+! { dg-do compile }
+! { dg-options "-fdec -fno-dec-promotion -finit-real=snan" }
+!
+! Test that there is no promotion between integers and reals in
+! intrinsic operations.
+!
+! These operations are: mod, modulo, dim, sign, min, max, minloc and
+! maxloc.
+!
+! Contributed by Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
+!             and Jeff Law <law@redhat.com>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+      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) ! { dg-error "'a' and 'p' arguments" }
+        if (abs(m_r - 1.0) > 1.0D-6) STOP 3
+        m_r = MOD(4.0, 3) ! { dg-error "'a' and 'p' arguments" }
+        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) ! { dg-error "'a' and 'p' arguments" }
+        if (abs(md_r - 1.0) > 1.0D-6) STOP 7
+        md_r = MODULO(4.0, 3) ! { dg-error "'a' and 'p' arguments" }
+        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) ! { dg-error "'x' and 'y' arguments" }
+        if (abs(d_r - 1.0) > 1.0D-6) STOP 11
+        d_r = DIM(3, 4.0) ! { dg-error "'x' and 'y' arguments" }
+        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) ! { dg-error "'b' argument" }
+        if (abs(s_r - (-4.0)) > 1.0D-6) STOP 15
+        s_r = SIGN(-4, 3.0) ! { dg-error "'b' argument" }
+        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) ! { dg-error "'a2' argument" }
+        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) ! { dg-error "'a2' argument" }
+        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 --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_1.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_1.f
new file mode 100644
index 00000000000..5c2cd931a4b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_1.f
@@ -0,0 +1,130 @@
+! { dg-do run }
+! { dg-options "-fdec" }
+!
+! Test promotion between integers and reals in intrinsic operations.
+! These operations are: mod, modulo, dim, sign, min, max, minloc and
+! maxloc.
+!
+! Contributed by Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
+!             and Jeff Law <law@redhat.com>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+      PROGRAM promotion_int_real
+        REAL l/0.0/
+        INTEGER a_i/4/
+        INTEGER*4 a2_i/4/
+        INTEGER b_i/3/
+        INTEGER*8 b2_i/3/
+        INTEGER x_i/2/
+        INTEGER y_i/1/
+        REAL a_r/4.0/
+        REAL*4 a2_r/4.0/
+        REAL b_r/3.0/
+        REAL*8 b2_r/3.0/
+        REAL x_r/2.0/
+        REAL y_r/1.0/
+
+        REAL array_nan(4)
+        DATA array_nan(1)/-4.0/
+        DATA array_nan(2)/3.0/
+        DATA array_nan(3)/-2/
+
+        INTEGER m_i/0/
+        REAL m_r/0.0/
+
+        INTEGER md_i/0/
+        REAL md_r/0.0/
+
+        INTEGER d_i/0/
+        REAL d_r/0.0/
+
+        INTEGER s_i/0/
+        REAL s_r/0.0/
+
+        INTEGER mn_i/0/
+        REAL mn_r/0.0/
+
+        INTEGER mx_i/0/
+        REAL mx_r/0.0/
+
+        ! array_nan 4th position value is NAN
+        array_nan(4) = 0/l
+
+        m_i = MOD(a_i, b_i)
+        if (m_i .ne. 1) STOP 1
+        m_i = MOD(a2_i, b2_i)
+        if (m_i .ne. 1) STOP 2
+        m_r = MOD(a_r, b_r)
+        if (abs(m_r - 1.0) > 1.0D-6) STOP 3
+        m_r = MOD(a2_r, b2_r)
+        if (abs(m_r - 1.0) > 1.0D-6) STOP 4
+        m_r = MOD(a_i, b_r)
+        if (abs(m_r - 1.0) > 1.0D-6) STOP 5
+        m_r = MOD(a_r, b_i)
+        if (abs(m_r - 1.0) > 1.0D-6) STOP 6
+
+        md_i = MODULO(a_i, b_i)
+        if (md_i .ne. 1) STOP 7
+        md_i = MODULO(a2_i, b2_i)
+        if (md_i .ne. 1) STOP 8
+        md_r = MODULO(a_r, b_r)
+        if (abs(md_r - 1.0) > 1.0D-6) STOP 9
+        md_r = MODULO(a2_r, b2_r)
+        if (abs(md_r - 1.0) > 1.0D-6) STOP 10
+        md_r = MODULO(a_i, b_r)
+        if (abs(md_r - 1.0) > 1.0D-6) STOP 11
+        md_r = MODULO(a_r, b_i)
+        if (abs(md_r - 1.0) > 1.0D-6) STOP 12
+
+        d_i = DIM(a_i, b_i)
+        if (d_i .ne. 1) STOP 13
+        d_i = DIM(a2_i, b2_i)
+        if (d_i .ne. 1) STOP 14
+        d_r = DIM(a_r, b_r)
+        if (abs(d_r - 1.0) > 1.0D-6) STOP 15
+        d_r = DIM(a2_r, b2_r)
+        if (abs(d_r - 1.0) > 1.0D-6) STOP 16
+        d_r = DIM(a_r, b_i)
+        if (abs(d_r - 1.0) > 1.0D-6) STOP 17
+        d_r = DIM(b_i, a_r)
+        if (abs(d_r) > 1.0D-6) STOP 18
+
+        s_i = SIGN(-a_i, b_i)
+        if (s_i .ne. 4) STOP 19
+        s_i = SIGN(-a2_i, b2_i)
+        if (s_i .ne. 4) STOP 20
+        s_r = SIGN(a_r, -b_r)
+        if (abs(s_r - (-a_r)) > 1.0D-6) STOP 21
+        s_r = SIGN(a2_r, -b2_r)
+        if (abs(s_r - (-a2_r)) > 1.0D-6) STOP 22
+        s_r = SIGN(a_r, -b_i)
+        if (abs(s_r - (-a_r)) > 1.0D-6) STOP 23
+        s_r = SIGN(-a_i, b_r)
+        if (abs(s_r - a_r) > 1.0D-6) STOP 24
+
+        mx_i = MAX(-a_i, -b_i, x_i, y_i)
+        if (mx_i .ne. x_i) STOP 25
+        mx_i = MAX(-a2_i, -b2_i, x_i, y_i)
+        if (mx_i .ne. x_i) STOP 26
+        mx_r = MAX(-a_r, -b_r, x_r, y_r)
+        if (abs(mx_r - x_r) > 1.0D-6) STOP 27
+        mx_r = MAX(-a_r, -b_r, x_r, y_r)
+        if (abs(mx_r - x_r) > 1.0D-6) STOP 28
+        mx_r = MAX(-a_i, -b_r, x_r, y_i)
+        if (abs(mx_r - x_r) > 1.0D-6) STOP 29
+        mx_i = MAXLOC(array_nan, 1)
+        if (mx_i .ne. 2) STOP 30
+
+        mn_i = MIN(-a_i, -b_i, x_i, y_i)
+        if (mn_i .ne. -a_i) STOP 31
+        mn_i = MIN(-a2_i, -b2_i, x_i, y_i)
+        if (mn_i .ne. -a2_i) STOP 32
+        mn_r = MIN(-a_r, -b_r, x_r, y_r)
+        if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 33
+        mn_r = MIN(-a2_r, -b2_r, x_r, y_r)
+        if (abs(mn_r - (-a2_r)) > 1.0D-6) STOP 34
+        mn_r = MIN(-a_i, -b_r, x_r, y_i)
+        if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 35
+        mn_i = MINLOC(array_nan, 1)
+        if (mn_i .ne. 1) STOP 36
+      END PROGRAM
diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_2.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_2.f
new file mode 100644
index 00000000000..d64d468f7d1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_2.f
@@ -0,0 +1,130 @@
+! { dg-do run }
+! { dg-options "-fdec-promotion" }
+!
+! Test promotion between integers and reals in intrinsic operations.
+! These operations are: mod, modulo, dim, sign, min, max, minloc and
+! maxloc.
+!
+! Contributed by Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
+!             and Jeff Law <law@redhat.com>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+      PROGRAM promotion_int_real
+        REAL l/0.0/
+        INTEGER a_i/4/
+        INTEGER*4 a2_i/4/
+        INTEGER b_i/3/
+        INTEGER*8 b2_i/3/
+        INTEGER x_i/2/
+        INTEGER y_i/1/
+        REAL a_r/4.0/
+        REAL*4 a2_r/4.0/
+        REAL b_r/3.0/
+        REAL*8 b2_r/3.0/
+        REAL x_r/2.0/
+        REAL y_r/1.0/
+
+        REAL array_nan(4)
+        DATA array_nan(1)/-4.0/
+        DATA array_nan(2)/3.0/
+        DATA array_nan(3)/-2/
+
+        INTEGER m_i/0/
+        REAL m_r/0.0/
+
+        INTEGER md_i/0/
+        REAL md_r/0.0/
+
+        INTEGER d_i/0/
+        REAL d_r/0.0/
+
+        INTEGER s_i/0/
+        REAL s_r/0.0/
+
+        INTEGER mn_i/0/
+        REAL mn_r/0.0/
+
+        INTEGER mx_i/0/
+        REAL mx_r/0.0/
+
+        ! array_nan 4th position value is NAN
+        array_nan(4) = 0/l
+
+        m_i = MOD(a_i, b_i)
+        if (m_i .ne. 1) STOP 1
+        m_i = MOD(a2_i, b2_i)
+        if (m_i .ne. 1) STOP 2
+        m_r = MOD(a_r, b_r)
+        if (abs(m_r - 1.0) > 1.0D-6) STOP 3
+        m_r = MOD(a2_r, b2_r)
+        if (abs(m_r - 1.0) > 1.0D-6) STOP 4
+        m_r = MOD(a_i, b_r)
+        if (abs(m_r - 1.0) > 1.0D-6) STOP 5
+        m_r = MOD(a_r, b_i)
+        if (abs(m_r - 1.0) > 1.0D-6) STOP 6
+
+        md_i = MODULO(a_i, b_i)
+        if (md_i .ne. 1) STOP 7
+        md_i = MODULO(a2_i, b2_i)
+        if (md_i .ne. 1) STOP 8
+        md_r = MODULO(a_r, b_r)
+        if (abs(md_r - 1.0) > 1.0D-6) STOP 9
+        md_r = MODULO(a2_r, b2_r)
+        if (abs(md_r - 1.0) > 1.0D-6) STOP 10
+        md_r = MODULO(a_i, b_r)
+        if (abs(md_r - 1.0) > 1.0D-6) STOP 11
+        md_r = MODULO(a_r, b_i)
+        if (abs(md_r - 1.0) > 1.0D-6) STOP 12
+
+        d_i = DIM(a_i, b_i)
+        if (d_i .ne. 1) STOP 13
+        d_i = DIM(a2_i, b2_i)
+        if (d_i .ne. 1) STOP 14
+        d_r = DIM(a_r, b_r)
+        if (abs(d_r - 1.0) > 1.0D-6) STOP 15
+        d_r = DIM(a2_r, b2_r)
+        if (abs(d_r - 1.0) > 1.0D-6) STOP 16
+        d_r = DIM(a_r, b_i)
+        if (abs(d_r - 1.0) > 1.0D-6) STOP 17
+        d_r = DIM(b_i, a_r)
+        if (abs(d_r) > 1.0D-6) STOP 18
+
+        s_i = SIGN(-a_i, b_i)
+        if (s_i .ne. 4) STOP 19
+        s_i = SIGN(-a2_i, b2_i)
+        if (s_i .ne. 4) STOP 20
+        s_r = SIGN(a_r, -b_r)
+        if (abs(s_r - (-a_r)) > 1.0D-6) STOP 21
+        s_r = SIGN(a2_r, -b2_r)
+        if (abs(s_r - (-a2_r)) > 1.0D-6) STOP 22
+        s_r = SIGN(a_r, -b_i)
+        if (abs(s_r - (-a_r)) > 1.0D-6) STOP 23
+        s_r = SIGN(-a_i, b_r)
+        if (abs(s_r - a_r) > 1.0D-6) STOP 24
+
+        mx_i = MAX(-a_i, -b_i, x_i, y_i)
+        if (mx_i .ne. x_i) STOP 25
+        mx_i = MAX(-a2_i, -b2_i, x_i, y_i)
+        if (mx_i .ne. x_i) STOP 26
+        mx_r = MAX(-a_r, -b_r, x_r, y_r)
+        if (abs(mx_r - x_r) > 1.0D-6) STOP 27
+        mx_r = MAX(-a_r, -b_r, x_r, y_r)
+        if (abs(mx_r - x_r) > 1.0D-6) STOP 28
+        mx_r = MAX(-a_i, -b_r, x_r, y_i)
+        if (abs(mx_r - x_r) > 1.0D-6) STOP 29
+        mx_i = MAXLOC(array_nan, 1)
+        if (mx_i .ne. 2) STOP 30
+
+        mn_i = MIN(-a_i, -b_i, x_i, y_i)
+        if (mn_i .ne. -a_i) STOP 31
+        mn_i = MIN(-a2_i, -b2_i, x_i, y_i)
+        if (mn_i .ne. -a2_i) STOP 32
+        mn_r = MIN(-a_r, -b_r, x_r, y_r)
+        if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 33
+        mn_r = MIN(-a2_r, -b2_r, x_r, y_r)
+        if (abs(mn_r - (-a2_r)) > 1.0D-6) STOP 34
+        mn_r = MIN(-a_i, -b_r, x_r, y_i)
+        if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 35
+        mn_i = MINLOC(array_nan, 1)
+        if (mn_i .ne. 1) STOP 36
+      END PROGRAM
diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_3.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_3.f
new file mode 100644
index 00000000000..0708b666633
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_3.f
@@ -0,0 +1,130 @@
+! { dg-do compile }
+! { dg-options "-fdec -fno-dec-promotion" }
+!
+! Test promotion between integers and reals in intrinsic operations.
+! These operations are: mod, modulo, dim, sign, min, max, minloc and
+! maxloc.
+!
+! Contributed by Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
+!             and Jeff Law <law@redhat.com>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+      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) ! { dg-error "'a' and 'p' arguments" }
+        if (abs(m_r - 1.0) > 1.0D-6) STOP 5
+        m_r = MOD(a_r, b_i) ! { dg-error "'a' and 'p' arguments" }
+        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) ! { dg-error "'a' and 'p' arguments" }
+        if (abs(md_r - 1.0) > 1.0D-6) STOP 11
+        md_r = MODULO(a_r, b_i) ! { dg-error "'a' and 'p' arguments" }
+        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) ! { dg-error "'x' and 'y' arguments" }
+        if (abs(d_r - 1.0) > 1.0D-6) STOP 17
+        d_r = DIM(b_i, a_r) ! { dg-error "'x' and 'y' arguments" }
+        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) ! { dg-error "'b' argument" }
+        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) ! { dg-error "'b' argument" }
+        if (abs(s_r - (-a2_r)) > 1.0D-6) STOP 22
+        s_r = SIGN(a_r, -b_i) ! { dg-error "'b' argument" }
+        if (abs(s_r - (-a_r)) > 1.0D-6) STOP 23
+        s_r = SIGN(-a_i, b_r) ! { dg-error "'b' argument" }
+        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) ! { dg-error "'a2' argument" }
+        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) ! { dg-error "'a2' argument" }
+        if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 35
+        mn_i = MINLOC(array_nan, 1)
+        if (mn_i .ne. 1) STOP 36
+      END PROGRAM
diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_4.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_4.f
new file mode 100644
index 00000000000..efa4f236410
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_4.f
@@ -0,0 +1,118 @@
+! { 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.
+!
+! Contributed by Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
+!             and Jeff Law <law@redhat.com>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+      PROGRAM promotion_int_real
+        REAL l/0.0/
+        LOGICAL a_l
+        LOGICAL*4 a2_l
+        LOGICAL b_l
+        LOGICAL*8 b2_l
+        LOGICAL x_l
+        LOGICAL y_l
+        CHARACTER a_c
+        CHARACTER*4 a2_c
+        CHARACTER b_c
+        CHARACTER*8 b2_c
+        CHARACTER x_c
+        CHARACTER y_c
+
+        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_l, b_l)                     ! { dg-error "" }
+        if (m_i .ne. 1) STOP 1
+        m_i = MOD(a2_l, b2_l)                   ! { dg-error "" }
+        if (m_i .ne. 1) STOP 2
+        m_r = MOD(a_c, b_c)                     ! { dg-error "" }
+        if (abs(m_r - 1.0) > 1.0D-6) STOP 3
+        m_r = MOD(a2_c, b2_c)                   ! { dg-error "" }
+        if (abs(m_r - 1.0) > 1.0D-6) STOP 4
+        m_r = MOD(a_l, b_c)                     ! { dg-error "" }
+        if (abs(m_r - 1.0) > 1.0D-6) STOP 5
+        m_r = MOD(a_c, b_l)                     ! { dg-error "" }
+        if (abs(m_r - 1.0) > 1.0D-6) STOP 6
+
+        md_i = MODULO(a_l, b_l)                 ! { dg-error "" }
+        if (md_i .ne. 1) STOP 7
+        md_i = MODULO(a2_l, b2_l)               ! { dg-error "" }
+        if (md_i .ne. 1) STOP 8
+        md_r = MODULO(a_c, b_c)                 ! { dg-error "" }
+        if (abs(md_r - 1.0) > 1.0D-6) STOP 9
+        md_r = MODULO(a2_c, b2_c)               ! { dg-error "" }
+        if (abs(md_r - 1.0) > 1.0D-6) STOP 10
+        md_r = MODULO(a_l, b_c)                 ! { dg-error "" }
+        if (abs(md_r - 1.0) > 1.0D-6) STOP 11
+        md_r = MODULO(a_c, b_l)                 ! { dg-error "" }
+        if (abs(md_r - 1.0) > 1.0D-6) STOP 12
+
+        d_i = DIM(a_l, b_l)                     ! { dg-error "" }
+        if (d_i .ne. 1) STOP 13
+        d_i = DIM(a2_l, b2_l)                   ! { dg-error "" }
+        if (d_i .ne. 1) STOP 14
+        d_r = DIM(a_c, b_c)                     ! { dg-error "" }
+        if (abs(d_r - 1.0) > 1.0D-6) STOP 15
+        d_r = DIM(a2_c, b2_c)                   ! { dg-error "" }
+        if (abs(d_r - 1.0) > 1.0D-6) STOP 16
+        d_r = DIM(a_c, b_l)                     ! { dg-error "" }
+        if (abs(d_r - 1.0) > 1.0D-6) STOP 17
+        d_r = DIM(b_l, a_c)                     ! { dg-error "" }
+        if (abs(d_r) > 1.0D-6) STOP 18
+
+        s_i = SIGN(-a_l, b_l)                   ! { dg-error "" }
+        if (s_i .ne. 4) STOP 19
+        s_i = SIGN(-a2_l, b2_l)                 ! { dg-error "" }
+        if (s_i .ne. 4) STOP 20
+        s_r = SIGN(a_c, -b_c)                   ! { dg-error "" }
+        if (abs(s_r - (-a_c)) > 1.0D-6) STOP 21 ! { dg-error "" }
+        s_r = SIGN(a2_c, -b2_c)                 ! { dg-error "" }
+        if (abs(s_r - (-a2_c)) > 1.0D-6) STOP 22 ! { dg-error "" }
+        s_r = SIGN(a_c, -b_l)                   ! { dg-error "" }
+        if (abs(s_r - (-a_c)) > 1.0D-6) STOP 23 ! { dg-error "" }
+        s_r = SIGN(-a_l, b_c)                   ! { dg-error "" }
+        if (abs(s_r - a_c) > 1.0D-6) STOP 24    ! { dg-error "" }
+
+        mx_i = MAX(-a_l, -b_l, x_l, y_l)        ! { dg-error "" }
+        if (mx_i .ne. x_l) STOP 25              ! { dg-error "" }
+        mx_i = MAX(-a2_l, -b2_l, x_l, y_l)      ! { dg-error "" }
+        if (mx_i .ne. x_l) STOP 26              ! { dg-error "" }
+        mx_r = MAX(-a_c, -b_c, x_c, y_c)        ! { dg-error "" }
+        if (abs(mx_r - x_c) > 1.0D-6) STOP 27   ! { dg-error "" }
+        mx_r = MAX(-a_c, -b_c, x_c, y_c)        ! { dg-error "" }
+        if (abs(mx_r - x_c) > 1.0D-6) STOP 28   ! { dg-error "" }
+        mx_r = MAX(-a_l, -b_c, x_c, y_l)        ! { dg-error "" }
+        if (abs(mx_r - x_c) > 1.0D-6) STOP 29   ! { dg-error "" }
+
+        mn_i = MIN(-a_l, -b_l, x_l, y_l)        ! { dg-error "" }
+        if (mn_i .ne. -a_l) STOP 31             ! { dg-error "" }
+        mn_i = MIN(-a2_l, -b2_l, x_l, y_l)      ! { dg-error "" }
+        if (mn_i .ne. -a2_l) STOP 32            ! { dg-error "" }
+        mn_r = MIN(-a_c, -b_c, x_c, y_c)        ! { dg-error "" }
+        if (abs(mn_r - (-a_c)) > 1.0D-6) STOP 33 ! { dg-error "" }
+        mn_r = MIN(-a2_c, -b2_c, x_c, y_c)      ! { dg-error "" }
+        if (abs(mn_r - (-a2_c)) > 1.0D-6) STOP 34 ! { dg-error "" }
+        mn_r = MIN(-a_l, -b_c, x_c, y_l)        ! { dg-error "" }
+        if (abs(mn_r - (-a_c)) > 1.0D-6) STOP 35 ! { dg-error "" }
+      END PROGRAM
diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_5.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_5.f
new file mode 100644
index 00000000000..d023af5086d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_5.f
@@ -0,0 +1,118 @@
+! { dg-do compile }
+! { dg-options "-fdec-promotion" }
+!
+! Test promotion between integers and reals in intrinsic operations.
+! These operations are: mod, modulo, dim, sign, min, max, minloc and
+! maxloc.
+!
+! Contributed by Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
+!             and Jeff Law <law@redhat.com>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+      PROGRAM promotion_int_real
+        REAL l/0.0/
+        LOGICAL a_l
+        LOGICAL*4 a2_l
+        LOGICAL b_l
+        LOGICAL*8 b2_l
+        LOGICAL x_l
+        LOGICAL y_l
+        CHARACTER a_c
+        CHARACTER*4 a2_c
+        CHARACTER b_c
+        CHARACTER*8 b2_c
+        CHARACTER x_c
+        CHARACTER y_c
+
+        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_l, b_l)                     ! { dg-error "" }
+        if (m_i .ne. 1) STOP 1
+        m_i = MOD(a2_l, b2_l)                   ! { dg-error "" }
+        if (m_i .ne. 1) STOP 2
+        m_r = MOD(a_c, b_c)                     ! { dg-error "" }
+        if (abs(m_r - 1.0) > 1.0D-6) STOP 3
+        m_r = MOD(a2_c, b2_c)                   ! { dg-error "" }
+        if (abs(m_r - 1.0) > 1.0D-6) STOP 4
+        m_r = MOD(a_l, b_c)                     ! { dg-error "" }
+        if (abs(m_r - 1.0) > 1.0D-6) STOP 5
+        m_r = MOD(a_c, b_l)                     ! { dg-error "" }
+        if (abs(m_r - 1.0) > 1.0D-6) STOP 6
+
+        md_i = MODULO(a_l, b_l)                 ! { dg-error "" }
+        if (md_i .ne. 1) STOP 7
+        md_i = MODULO(a2_l, b2_l)               ! { dg-error "" }
+        if (md_i .ne. 1) STOP 8
+        md_r = MODULO(a_c, b_c)                 ! { dg-error "" }
+        if (abs(md_r - 1.0) > 1.0D-6) STOP 9
+        md_r = MODULO(a2_c, b2_c)               ! { dg-error "" }
+        if (abs(md_r - 1.0) > 1.0D-6) STOP 10
+        md_r = MODULO(a_l, b_c)                 ! { dg-error "" }
+        if (abs(md_r - 1.0) > 1.0D-6) STOP 11
+        md_r = MODULO(a_c, b_l)                 ! { dg-error "" }
+        if (abs(md_r - 1.0) > 1.0D-6) STOP 12
+
+        d_i = DIM(a_l, b_l)                     ! { dg-error "" }
+        if (d_i .ne. 1) STOP 13
+        d_i = DIM(a2_l, b2_l)                   ! { dg-error "" }
+        if (d_i .ne. 1) STOP 14
+        d_r = DIM(a_c, b_c)                     ! { dg-error "" }
+        if (abs(d_r - 1.0) > 1.0D-6) STOP 15
+        d_r = DIM(a2_c, b2_c)                   ! { dg-error "" }
+        if (abs(d_r - 1.0) > 1.0D-6) STOP 16
+        d_r = DIM(a_c, b_l)                     ! { dg-error "" }
+        if (abs(d_r - 1.0) > 1.0D-6) STOP 17
+        d_r = DIM(b_l, a_c)                     ! { dg-error "" }
+        if (abs(d_r) > 1.0D-6) STOP 18
+
+        s_i = SIGN(-a_l, b_l)                   ! { dg-error "" }
+        if (s_i .ne. 4) STOP 19
+        s_i = SIGN(-a2_l, b2_l)                 ! { dg-error "" }
+        if (s_i .ne. 4) STOP 20
+        s_r = SIGN(a_c, -b_c)                   ! { dg-error "" }
+        if (abs(s_r - (-a_c)) > 1.0D-6) STOP 21 ! { dg-error "" }
+        s_r = SIGN(a2_c, -b2_c)                 ! { dg-error "" }
+        if (abs(s_r - (-a2_c)) > 1.0D-6) STOP 22 ! { dg-error "" }
+        s_r = SIGN(a_c, -b_l)                   ! { dg-error "" }
+        if (abs(s_r - (-a_c)) > 1.0D-6) STOP 23 ! { dg-error "" }
+        s_r = SIGN(-a_l, b_c)                   ! { dg-error "" }
+        if (abs(s_r - a_c) > 1.0D-6) STOP 24    ! { dg-error "" }
+
+        mx_i = MAX(-a_l, -b_l, x_l, y_l)        ! { dg-error "" }
+        if (mx_i .ne. x_l) STOP 25              ! { dg-error "" }
+        mx_i = MAX(-a2_l, -b2_l, x_l, y_l)      ! { dg-error "" }
+        if (mx_i .ne. x_l) STOP 26              ! { dg-error "" }
+        mx_r = MAX(-a_c, -b_c, x_c, y_c)        ! { dg-error "" }
+        if (abs(mx_r - x_c) > 1.0D-6) STOP 27   ! { dg-error "" }
+        mx_r = MAX(-a_c, -b_c, x_c, y_c)        ! { dg-error "" }
+        if (abs(mx_r - x_c) > 1.0D-6) STOP 28   ! { dg-error "" }
+        mx_r = MAX(-a_l, -b_c, x_c, y_l)        ! { dg-error "" }
+        if (abs(mx_r - x_c) > 1.0D-6) STOP 29   ! { dg-error "" }
+
+        mn_i = MIN(-a_l, -b_l, x_l, y_l)        ! { dg-error "" }
+        if (mn_i .ne. -a_l) STOP 31             ! { dg-error "" }
+        mn_i = MIN(-a2_l, -b2_l, x_l, y_l)      ! { dg-error "" }
+        if (mn_i .ne. -a2_l) STOP 32            ! { dg-error "" }
+        mn_r = MIN(-a_c, -b_c, x_c, y_c)        ! { dg-error "" }
+        if (abs(mn_r - (-a_c)) > 1.0D-6) STOP 33 ! { dg-error "" }
+        mn_r = MIN(-a2_c, -b2_c, x_c, y_c)      ! { dg-error "" }
+        if (abs(mn_r - (-a2_c)) > 1.0D-6) STOP 34 ! { dg-error "" }
+        mn_r = MIN(-a_l, -b_c, x_c, y_l)        ! { dg-error "" }
+        if (abs(mn_r - (-a_c)) > 1.0D-6) STOP 35 ! { dg-error "" }
+      END PROGRAM
diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_6.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_6.f
new file mode 100644
index 00000000000..00f8fb88f1b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_6.f
@@ -0,0 +1,118 @@
+! { 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.
+!
+! Contributed by Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
+!             and Jeff Law <law@redhat.com>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+      PROGRAM promotion_int_real
+        REAL l/0.0/
+        INTEGER a_i/4/
+        INTEGER*4 a2_i/4/
+        CHARACTER b_c
+        CHARACTER*8 b2_c
+        INTEGER x_i/2/
+        CHARACTER y_c
+        REAL a_r/4.0/
+        REAL*4 a2_r/4.0/
+        LOGICAL b_l
+        LOGICAL*8 b2_l
+        REAL x_r/2.0/
+        LOGICAL y_l
+
+        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_c)                     ! { dg-error "" }
+        if (m_i .ne. 1) STOP 1
+        m_i = MOD(a2_i, b2_c)                   ! { dg-error "" }
+        if (m_i .ne. 1) STOP 2
+        m_r = MOD(a_r, b_l)                     ! { dg-error "" }
+        if (abs(m_r - 1.0) > 1.0D-6) STOP 3
+        m_r = MOD(a2_r, b2_l)                   ! { dg-error "" }
+        if (abs(m_r - 1.0) > 1.0D-6) STOP 4
+        m_r = MOD(a_i, b_l)                     ! { dg-error "" }
+        if (abs(m_r - 1.0) > 1.0D-6) STOP 5
+        m_r = MOD(a_r, b_c)                     ! { dg-error "" }
+        if (abs(m_r - 1.0) > 1.0D-6) STOP 6
+
+        md_i = MODULO(a_i, b_c)                 ! { dg-error "" }
+        if (md_i .ne. 1) STOP 7
+        md_i = MODULO(a2_i, b2_c)               ! { dg-error "" }
+        if (md_i .ne. 1) STOP 8
+        md_r = MODULO(a_r, b_l)                 ! { dg-error "" }
+        if (abs(md_r - 1.0) > 1.0D-6) STOP 9
+        md_r = MODULO(a2_r, b2_l)               ! { dg-error "" }
+        if (abs(md_r - 1.0) > 1.0D-6) STOP 10
+        md_r = MODULO(a_i, b_l)                 ! { dg-error "" }
+        if (abs(md_r - 1.0) > 1.0D-6) STOP 11
+        md_r = MODULO(a_r, b_c)                 ! { dg-error "" }
+        if (abs(md_r - 1.0) > 1.0D-6) STOP 12
+
+        d_i = DIM(a_i, b_c)                     ! { dg-error "" }
+        if (d_i .ne. 1) STOP 13
+        d_i = DIM(a2_i, b2_c)                   ! { dg-error "" }
+        if (d_i .ne. 1) STOP 14
+        d_r = DIM(a_r, b_l)                     ! { dg-error "" }
+        if (abs(d_r - 1.0) > 1.0D-6) STOP 15
+        d_r = DIM(a2_r, b2_l)                   ! { dg-error "" }
+        if (abs(d_r - 1.0) > 1.0D-6) STOP 16
+        d_r = DIM(a_r, b_c)                     ! { dg-error "" }
+        if (abs(d_r - 1.0) > 1.0D-6) STOP 17
+        d_r = DIM(b_c, a_r)                     ! { dg-error "" }
+        if (abs(d_r) > 1.0D-6) STOP 18
+
+        s_i = SIGN(-a_i, b_c)                   ! { dg-error "" }
+        if (s_i .ne. 4) STOP 19
+        s_i = SIGN(-a2_i, b2_c)                 ! { dg-error "" }
+        if (s_i .ne. 4) STOP 20
+        s_r = SIGN(a_r, -b_l)                   ! { dg-error "" }
+        if (abs(s_r - (-a_r)) > 1.0D-6) STOP 21
+        s_r = SIGN(a2_r, -b2_l)                 ! { dg-error "" }
+        if (abs(s_r - (-a2_r)) > 1.0D-6) STOP 22
+        s_r = SIGN(a_r, -b_c)                   ! { dg-error "" }
+        if (abs(s_r - (-a_r)) > 1.0D-6) STOP 23
+        s_r = SIGN(-a_i, b_l)                   ! { dg-error "" }
+        if (abs(s_r - a_r) > 1.0D-6) STOP 24
+
+        mx_i = MAX(-a_i, -b_c, x_i, y_c)        ! { dg-error "" }
+        if (mx_i .ne. x_i) STOP 25
+        mx_i = MAX(-a2_i, -b2_c, x_i, y_c)      ! { dg-error "" }
+        if (mx_i .ne. x_i) STOP 26
+        mx_r = MAX(-a_r, -b_l, x_r, y_l)        ! { dg-error "" }
+        if (abs(mx_r - x_r) > 1.0D-6) STOP 27
+        mx_r = MAX(-a_r, -b_l, x_r, y_l)        ! { dg-error "" }
+        if (abs(mx_r - x_r) > 1.0D-6) STOP 28
+        mx_r = MAX(-a_i, -b_l, x_r, y_c)        ! { dg-error "" }
+        if (abs(mx_r - x_r) > 1.0D-6) STOP 29
+
+        mn_i = MIN(-a_i, -b_c, x_i, y_c)        ! { dg-error "" }
+        if (mn_i .ne. -a_i) STOP 31
+        mn_i = MIN(-a2_i, -b2_c, x_i, y_c)      ! { dg-error "" }
+        if (mn_i .ne. -a2_i) STOP 32
+        mn_r = MIN(-a_r, -b_l, x_r, y_l)        ! { dg-error "" }
+        if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 33
+        mn_r = MIN(-a2_r, -b2_l, x_r, y_l)      ! { dg-error "" }
+        if (abs(mn_r - (-a2_r)) > 1.0D-6) STOP 34
+        mn_r = MIN(-a_i, -b_l, x_r, y_c)        ! { dg-error "" }
+        if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 35
+      END PROGRAM
diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_7.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_7.f
new file mode 100644
index 00000000000..1d4150d81c0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_7.f
@@ -0,0 +1,118 @@
+! { dg-do compile }
+! { dg-options "-fdec-promotion" }
+!
+! Test promotion between integers and reals in intrinsic operations.
+! These operations are: mod, modulo, dim, sign, min, max, minloc and
+! maxloc.
+!
+! Contributed by Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
+!             and Jeff Law <law@redhat.com>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+      PROGRAM promotion_int_real
+        REAL l/0.0/
+        INTEGER a_i/4/
+        INTEGER*4 a2_i/4/
+        CHARACTER b_c
+        CHARACTER*8 b2_c
+        INTEGER x_i/2/
+        CHARACTER y_c
+        REAL a_r/4.0/
+        REAL*4 a2_r/4.0/
+        LOGICAL b_l
+        LOGICAL*8 b2_l
+        REAL x_r/2.0/
+        LOGICAL y_l
+
+        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_c)                     ! { dg-error "" }
+        if (m_i .ne. 1) STOP 1
+        m_i = MOD(a2_i, b2_c)                   ! { dg-error "" }
+        if (m_i .ne. 1) STOP 2
+        m_r = MOD(a_r, b_l)                     ! { dg-error "" }
+        if (abs(m_r - 1.0) > 1.0D-6) STOP 3
+        m_r = MOD(a2_r, b2_l)                   ! { dg-error "" }
+        if (abs(m_r - 1.0) > 1.0D-6) STOP 4
+        m_r = MOD(a_i, b_l)                     ! { dg-error "" }
+        if (abs(m_r - 1.0) > 1.0D-6) STOP 5
+        m_r = MOD(a_r, b_c)                     ! { dg-error "" }
+        if (abs(m_r - 1.0) > 1.0D-6) STOP 6
+
+        md_i = MODULO(a_i, b_c)                 ! { dg-error "" }
+        if (md_i .ne. 1) STOP 7
+        md_i = MODULO(a2_i, b2_c)               ! { dg-error "" }
+        if (md_i .ne. 1) STOP 8
+        md_r = MODULO(a_r, b_l)                 ! { dg-error "" }
+        if (abs(md_r - 1.0) > 1.0D-6) STOP 9
+        md_r = MODULO(a2_r, b2_l)               ! { dg-error "" }
+        if (abs(md_r - 1.0) > 1.0D-6) STOP 10
+        md_r = MODULO(a_i, b_l)                 ! { dg-error "" }
+        if (abs(md_r - 1.0) > 1.0D-6) STOP 11
+        md_r = MODULO(a_r, b_c)                 ! { dg-error "" }
+        if (abs(md_r - 1.0) > 1.0D-6) STOP 12
+
+        d_i = DIM(a_i, b_c)                     ! { dg-error "" }
+        if (d_i .ne. 1) STOP 13
+        d_i = DIM(a2_i, b2_c)                   ! { dg-error "" }
+        if (d_i .ne. 1) STOP 14
+        d_r = DIM(a_r, b_l)                     ! { dg-error "" }
+        if (abs(d_r - 1.0) > 1.0D-6) STOP 15
+        d_r = DIM(a2_r, b2_l)                   ! { dg-error "" }
+        if (abs(d_r - 1.0) > 1.0D-6) STOP 16
+        d_r = DIM(a_r, b_c)                     ! { dg-error "" }
+        if (abs(d_r - 1.0) > 1.0D-6) STOP 17
+        d_r = DIM(b_c, a_r)                     ! { dg-error "" }
+        if (abs(d_r) > 1.0D-6) STOP 18
+
+        s_i = SIGN(-a_i, b_c)                   ! { dg-error "" }
+        if (s_i .ne. 4) STOP 19
+        s_i = SIGN(-a2_i, b2_c)                 ! { dg-error "" }
+        if (s_i .ne. 4) STOP 20
+        s_r = SIGN(a_r, -b_l)                   ! { dg-error "" }
+        if (abs(s_r - (-a_r)) > 1.0D-6) STOP 21
+        s_r = SIGN(a2_r, -b2_l)                 ! { dg-error "" }
+        if (abs(s_r - (-a2_r)) > 1.0D-6) STOP 22
+        s_r = SIGN(a_r, -b_c)                   ! { dg-error "" }
+        if (abs(s_r - (-a_r)) > 1.0D-6) STOP 23
+        s_r = SIGN(-a_i, b_l)                   ! { dg-error "" }
+        if (abs(s_r - a_r) > 1.0D-6) STOP 24
+
+        mx_i = MAX(-a_i, -b_c, x_i, y_c)        ! { dg-error "" }
+        if (mx_i .ne. x_i) STOP 25
+        mx_i = MAX(-a2_i, -b2_c, x_i, y_c)      ! { dg-error "" }
+        if (mx_i .ne. x_i) STOP 26
+        mx_r = MAX(-a_r, -b_l, x_r, y_l)        ! { dg-error "" }
+        if (abs(mx_r - x_r) > 1.0D-6) STOP 27
+        mx_r = MAX(-a_r, -b_l, x_r, y_l)        ! { dg-error "" }
+        if (abs(mx_r - x_r) > 1.0D-6) STOP 28
+        mx_r = MAX(-a_i, -b_l, x_r, y_c)        ! { dg-error "" }
+        if (abs(mx_r - x_r) > 1.0D-6) STOP 29
+
+        mn_i = MIN(-a_i, -b_c, x_i, y_c)        ! { dg-error "" }
+        if (mn_i .ne. -a_i) STOP 31
+        mn_i = MIN(-a2_i, -b2_c, x_i, y_c)      ! { dg-error "" }
+        if (mn_i .ne. -a2_i) STOP 32
+        mn_r = MIN(-a_r, -b_l, x_r, y_l)        ! { dg-error "" }
+        if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 33
+        mn_r = MIN(-a2_r, -b2_l, x_r, y_l)      ! { dg-error "" }
+        if (abs(mn_r - (-a2_r)) > 1.0D-6) STOP 34
+        mn_r = MIN(-a_i, -b_l, x_r, y_c)        ! { dg-error "" }
+        if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 35
+      END PROGRAM
diff --git a/gcc/testsuite/gfortran.dg/dec_kind_promotion-1.f b/gcc/testsuite/gfortran.dg/dec_kind_promotion-1.f
new file mode 100644
index 00000000000..435bf98350c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_kind_promotion-1.f
@@ -0,0 +1,40 @@
+!{ dg-do run }
+!{ dg-options "-fdec" }
+!
+! integer types of a smaller kind than expected should be
+! accepted by type specific intrinsic functions
+!
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+      program test_small_type_promtion
+        implicit none
+        integer(1) :: a = 1
+        integer :: i
+        if (iiabs(-9_1).ne.9) stop 1
+        if (iabs(-9_1).ne.9) stop 2
+        if (iabs(-9_2).ne.9) stop 3
+        if (jiabs(-9_1).ne.9) stop 4
+        if (jiabs(-9_2).ne.9) stop 5
+        if (iishft(1_1, 2).ne.4) stop 6
+        if (jishft(1_1, 2).ne.4) stop 7
+        if (jishft(1_2, 2).ne.4) stop 8
+        if (kishft(1_1, 2).ne.4) stop 9
+        if (kishft(1_2, 2).ne.4) stop 10
+        if (kishft(1_4, 2).ne.4) stop 11
+        if (imod(17_1, 3).ne.2) stop 12
+        if (jmod(17_1, 3).ne.2) stop 13
+        if (jmod(17_2, 3).ne.2) stop 14
+        if (kmod(17_1, 3).ne.2) stop 15
+        if (kmod(17_2, 3).ne.2) stop 16
+        if (kmod(17_4, 3).ne.2) stop 17
+        if (inot(5_1).ne.-6) stop 18
+        if (jnot(5_1).ne.-6) stop 19
+        if (jnot(5_2).ne.-6) stop 20
+        if (knot(5_1).ne.-6) stop 21
+        if (knot(5_2).ne.-6) stop 22
+        if (knot(5_4).ne.-6) stop 23
+        if (isign(-77_1, 1).ne.77) stop 24
+        if (isign(-77_1, -1).ne.-77) stop 25
+        if (isign(-77_2, 1).ne.77) stop 26
+        if (isign(-77_2, -1).ne.-77) stop 27
+      end program
diff --git a/gcc/testsuite/gfortran.dg/dec_kind_promotion-2.f b/gcc/testsuite/gfortran.dg/dec_kind_promotion-2.f
new file mode 100644
index 00000000000..7b1697ca665
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_kind_promotion-2.f
@@ -0,0 +1,40 @@
+!{ dg-do run }
+!{ dg-options "-fdec-intrinsic-ints -fdec-promotion" }
+!
+! integer types of a smaller kind than expected should be
+! accepted by type specific intrinsic functions
+!
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+      program test_small_type_promtion
+        implicit none
+        integer(1) :: a = 1
+        integer :: i
+        if (iiabs(-9_1).ne.9) stop 1
+        if (iabs(-9_1).ne.9) stop 2
+        if (iabs(-9_2).ne.9) stop 3
+        if (jiabs(-9_1).ne.9) stop 4
+        if (jiabs(-9_2).ne.9) stop 5
+        if (iishft(1_1, 2).ne.4) stop 6
+        if (jishft(1_1, 2).ne.4) stop 7
+        if (jishft(1_2, 2).ne.4) stop 8
+        if (kishft(1_1, 2).ne.4) stop 9
+        if (kishft(1_2, 2).ne.4) stop 10
+        if (kishft(1_4, 2).ne.4) stop 11
+        if (imod(17_1, 3).ne.2) stop 12
+        if (jmod(17_1, 3).ne.2) stop 13
+        if (jmod(17_2, 3).ne.2) stop 14
+        if (kmod(17_1, 3).ne.2) stop 15
+        if (kmod(17_2, 3).ne.2) stop 16
+        if (kmod(17_4, 3).ne.2) stop 17
+        if (inot(5_1).ne.-6) stop 18
+        if (jnot(5_1).ne.-6) stop 19
+        if (jnot(5_2).ne.-6) stop 20
+        if (knot(5_1).ne.-6) stop 21
+        if (knot(5_2).ne.-6) stop 22
+        if (knot(5_4).ne.-6) stop 23
+        if (isign(-77_1, 1).ne.77) stop 24
+        if (isign(-77_1, -1).ne.-77) stop 25
+        if (isign(-77_2, 1).ne.77) stop 26
+        if (isign(-77_2, -1).ne.-77) stop 27
+      end program
diff --git a/gcc/testsuite/gfortran.dg/dec_kind_promotion-3.f b/gcc/testsuite/gfortran.dg/dec_kind_promotion-3.f
new file mode 100644
index 00000000000..b9d550a5a48
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_kind_promotion-3.f
@@ -0,0 +1,40 @@
+!{ dg-do compile }
+!{ dg-options "-fdec -fno-dec-promotion" }
+!
+! integer types of a smaller kind than expected should be
+! accepted by type specific intrinsic functions
+!
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+      program test_small_type_promtion
+        implicit none
+        integer(1) :: a = 1
+        integer :: i
+        if (iiabs(-9_1).ne.9) stop 1
+        if (iabs(-9_1).ne.9) stop 2 ! { dg-error "Type of argument" }
+        if (iabs(-9_2).ne.9) stop 3 ! { dg-error "Type of argument" }
+        if (jiabs(-9_1).ne.9) stop 4
+        if (jiabs(-9_2).ne.9) stop 5
+        if (iishft(1_1, 2).ne.4) stop 6
+        if (jishft(1_1, 2).ne.4) stop 7
+        if (jishft(1_2, 2).ne.4) stop 8
+        if (kishft(1_1, 2).ne.4) stop 9
+        if (kishft(1_2, 2).ne.4) stop 10
+        if (kishft(1_4, 2).ne.4) stop 11
+        if (imod(17_1, 3).ne.2) stop 12
+        if (jmod(17_1, 3).ne.2) stop 13
+        if (jmod(17_2, 3).ne.2) stop 14
+        if (kmod(17_1, 3).ne.2) stop 15
+        if (kmod(17_2, 3).ne.2) stop 16
+        if (kmod(17_4, 3).ne.2) stop 17
+        if (inot(5_1).ne.-6) stop 18
+        if (jnot(5_1).ne.-6) stop 19
+        if (jnot(5_2).ne.-6) stop 20
+        if (knot(5_1).ne.-6) stop 21
+        if (knot(5_2).ne.-6) stop 22
+        if (knot(5_4).ne.-6) stop 23
+        if (isign(-77_1, 1).ne.77) stop 24 ! { dg-error "Type of argument" }
+        if (isign(-77_1, -1).ne.-77) stop 25 ! { dg-error "Type of argument" }
+        if (isign(-77_2, 1).ne.77) stop 26 ! { dg-error "Type of argument" }
+        if (isign(-77_2, -1).ne.-77) stop 27 ! { dg-error "Type of argument" }
+      end program
-- 
2.11.0