public inbox for git-commits@fedoraproject.org
help / color / mirror / Atom feed
* [rpms/gcc] rhel-f41-base: Add RHEL Fortran patchset.
@ 2026-06-29 12:29 Jakub Jelinek
0 siblings, 0 replies; only message in thread
From: Jakub Jelinek @ 2026-06-29 12:29 UTC (permalink / raw)
To: git-commits
A new commit has been pushed.
Repo : rpms/gcc
Branch : rhel-f41-base
Commit : c7b83880f7d31a09d20787b0dced6df9d390924e
Author : Jakub Jelinek <jakub@redhat.com>
Date : 2021-01-31T12:15:51+01:00
Stats : +4467/-0 in 11 file(s)
URL : https://src.fedoraproject.org/rpms/gcc/c/c7b83880f7d31a09d20787b0dced6df9d390924e?branch=rhel-f41-base
Log:
Add RHEL Fortran patchset.
---
diff --git a/gcc.spec b/gcc.spec
index a49fbbe..99687e5 100644
--- a/gcc.spec
+++ b/gcc.spec
@@ -273,6 +273,17 @@ Patch10: gcc11-rh1574936.patch
Patch11: gcc11-d-shared-libphobos.patch
Patch12: gcc11-pr98338-workaround.patch
+Patch100: gcc11-fortran-fdec-duplicates.patch
+Patch101: gcc11-fortran-flogical-as-integer.patch
+Patch102: gcc11-fortran-fdec-ichar.patch
+Patch103: gcc11-fortran-fdec-non-integer-index.patch
+Patch104: gcc11-fortran-fdec-old-init.patch
+Patch105: gcc11-fortran-fdec-override-kind.patch
+Patch106: gcc11-fortran-fdec-non-logical-if.patch
+Patch107: gcc11-fortran-fdec-promotion.patch
+Patch108: gcc11-fortran-fdec-sequence.patch
+Patch109: gcc11-fortran-fdec-add-missing-indexes.patch
+
# On ARM EABI systems, we do want -gnueabi to be part of the
# target triple.
%ifnarch %{arm}
@@ -784,6 +795,19 @@ to NVidia PTX capable devices if available.
%patch11 -p0 -b .d-shared-libphobos~
%patch12 -p0 -b .pr98338-workaround~
+%if %{?rhel} >= 9
+%patch100 -p1 -b .fortran-fdec-duplicates~
+%patch101 -p1 -b .fortran-flogical-as-integer~
+%patch102 -p1 -b .fortran-fdec-ichar~
+%patch103 -p1 -b .fortran-fdec-non-integer-index~
+%patch104 -p1 -b .fortran-fdec-old-init~
+%patch105 -p1 -b .fortran-fdec-override-kind~
+%patch106 -p1 -b .fortran-fdec-non-logical-if~
+%patch107 -p1 -b .fortran-fdec-promotion~
+%patch108 -p1 -b .fortran-fdec-sequence~
+%patch109 -p1 -b .fortran-fdec-add-missing-indexes~
+%endif
+
rm -f libgomp/testsuite/*/*task-detach*
echo 'Red Hat %{version}-%{gcc_release}' > gcc/DEV-PHASE
diff --git a/gcc11-fortran-fdec-add-missing-indexes.patch b/gcc11-fortran-fdec-add-missing-indexes.patch
new file mode 100644
index 0000000..d707b94
--- /dev/null
+++ b/gcc11-fortran-fdec-add-missing-indexes.patch
@@ -0,0 +1,181 @@
+From 7001d522d0273658d9e1fb12ca104d56bfcae34d Mon Sep 17 00:00:00 2001
+From: Mark Eggleston <markeggleston@gcc.gnu.org>
+Date: Fri, 22 Jan 2021 15:06:08 +0000
+Subject: [PATCH 10/10] Fill in missing array dimensions using the lower bound
+
+Use -fdec-add-missing-indexes to enable feature. Also enabled by fdec.
+---
+ gcc/fortran/lang.opt | 8 ++++++++
+ gcc/fortran/options.c | 1 +
+ gcc/fortran/resolve.c | 24 ++++++++++++++++++++++++
+ gcc/testsuite/gfortran.dg/array_6.f90 | 23 +++++++++++++++++++++++
+ gcc/testsuite/gfortran.dg/array_7.f90 | 23 +++++++++++++++++++++++
+ gcc/testsuite/gfortran.dg/array_8.f90 | 23 +++++++++++++++++++++++
+ 6 files changed, 102 insertions(+)
+ create mode 100644 gcc/testsuite/gfortran.dg/array_6.f90
+ create mode 100644 gcc/testsuite/gfortran.dg/array_7.f90
+ create mode 100644 gcc/testsuite/gfortran.dg/array_8.f90
+
+diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
+index 019c798cf09..f27de88ea3f 100644
+--- a/gcc/fortran/lang.opt
++++ b/gcc/fortran/lang.opt
+@@ -281,6 +281,10 @@ Wmissing-include-dirs
+ Fortran
+ ; Documented in C/C++
+
++Wmissing-index
++Fortran Var(warn_missing_index) Warning LangEnabledBy(Fortran,Wall)
++Warn that the lower bound of a missing index will be used.
++
+ Wuse-without-only
+ Fortran Var(warn_use_without_only) Warning
+ Warn about USE statements that have no ONLY qualifier.
+@@ -460,6 +464,10 @@ fdec
+ Fortran Var(flag_dec)
+ Enable all DEC language extensions.
+
++fdec-add-missing-indexes
++Fortran Var(flag_dec_add_missing_indexes)
++Enable the addition of missing indexes using their lower bounds.
++
+ fdec-blank-format-item
+ Fortran Var(flag_dec_blank_format_item)
+ Enable the use of blank format items in format strings.
+diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
+index 050f56fdc25..c3b2822685d 100644
+--- a/gcc/fortran/options.c
++++ b/gcc/fortran/options.c
+@@ -84,6 +84,7 @@ set_dec_flags (int value)
+ SET_BITFLAG (flag_dec_non_logical_if, value, value);
+ SET_BITFLAG (flag_dec_promotion, value, value);
+ SET_BITFLAG (flag_dec_sequence, value, value);
++ SET_BITFLAG (flag_dec_add_missing_indexes, value, value);
+ }
+
+ /* Finalize DEC flags. */
+diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
+index fe7d0cc5944..0efeedab46e 100644
+--- a/gcc/fortran/resolve.c
++++ b/gcc/fortran/resolve.c
+@@ -4806,6 +4806,30 @@ compare_spec_to_ref (gfc_array_ref *ar)
+ if (ar->type == AR_FULL)
+ return true;
+
++ if (flag_dec_add_missing_indexes && as->rank > ar->dimen)
++ {
++ /* Add in the missing dimensions, assuming they are the lower bound
++ of that dimension if not specified. */
++ int j;
++ if (warn_missing_index)
++ {
++ gfc_warning (OPT_Wmissing_index, "Using the lower bound for "
++ "unspecified dimensions in array reference at %L",
++ &ar->where);
++ }
++ /* Other parts of the code iterate ar->start and ar->end from 0 to
++ ar->dimen, so it is safe to assume slots from ar->dimen upwards
++ are unused (i.e. there are no gaps; the specified indexes are
++ contiguous and start at zero. */
++ for(j = ar->dimen; j <= as->rank; j++)
++ {
++ ar->start[j] = gfc_copy_expr (as->lower[j]);
++ ar->end[j] = gfc_copy_expr (as->lower[j]);
++ ar->dimen_type[j] = DIMEN_ELEMENT;
++ }
++ ar->dimen = as->rank;
++ }
++
+ if (as->rank != ar->dimen)
+ {
+ gfc_error ("Rank mismatch in array reference at %L (%d/%d)",
+diff --git a/gcc/testsuite/gfortran.dg/array_6.f90 b/gcc/testsuite/gfortran.dg/array_6.f90
+new file mode 100644
+index 00000000000..5c26e18ab3e
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/array_6.f90
+@@ -0,0 +1,23 @@
++! { dg-do run }
++! { dg-options "-fdec -Wmissing-index" }!
++! Checks that under-specified arrays (referencing arrays with fewer
++! dimensions than the array spec) generates a warning.
++!
++! Contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
++! Updated by Mark Eggleston <mark.eggleston@codethink.co.uk>
++!
++
++program under_specified_array
++ integer chessboard(8,8)
++ integer chessboard3d(8,8,3:5)
++ chessboard(3,1) = 5
++ chessboard(3,2) = 55
++ chessboard3d(4,1,3) = 6
++ chessboard3d(4,1,4) = 66
++ chessboard3d(4,4,3) = 7
++ chessboard3d(4,4,4) = 77
++
++ if (chessboard(3).ne.5) stop 1 ! { dg-warning "Using the lower bound for unspecified dimensions in array reference" }
++ if (chessboard3d(4).ne.6) stop 2 ! { dg-warning "Using the lower bound for unspecified dimensions in array reference" }
++ if (chessboard3d(4,4).ne.7) stop 3 ! { dg-warning "Using the lower bound for unspecified dimensions in array reference" }
++end program
+diff --git a/gcc/testsuite/gfortran.dg/array_7.f90 b/gcc/testsuite/gfortran.dg/array_7.f90
+new file mode 100644
+index 00000000000..5588a5bd02d
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/array_7.f90
+@@ -0,0 +1,23 @@
++! { dg-do run }
++! { dg-options "-fdec-add-missing-indexes -Wmissing-index" }!
++! Checks that under-specified arrays (referencing arrays with fewer
++! dimensions than the array spec) generates a warning.
++!
++! Contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
++! Updated by Mark Eggleston <mark.eggleston@codethink.co.uk>
++!
++
++program under_specified_array
++ integer chessboard(8,8)
++ integer chessboard3d(8,8,3:5)
++ chessboard(3,1) = 5
++ chessboard(3,2) = 55
++ chessboard3d(4,1,3) = 6
++ chessboard3d(4,1,4) = 66
++ chessboard3d(4,4,3) = 7
++ chessboard3d(4,4,4) = 77
++
++ if (chessboard(3).ne.5) stop 1 ! { dg-warning "Using the lower bound for unspecified dimensions in array reference" }
++ if (chessboard3d(4).ne.6) stop 2 ! { dg-warning "Using the lower bound for unspecified dimensions in array reference" }
++ if (chessboard3d(4,4).ne.7) stop 3 ! { dg-warning "Using the lower bound for unspecified dimensions in array reference" }
++end program
+diff --git a/gcc/testsuite/gfortran.dg/array_8.f90 b/gcc/testsuite/gfortran.dg/array_8.f90
+new file mode 100644
+index 00000000000..f0d2ef5e37d
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/array_8.f90
+@@ -0,0 +1,23 @@
++! { dg-do compile }
++! { dg-options "-fdec -fno-dec-add-missing-indexes" }!
++! Checks that under-specified arrays (referencing arrays with fewer
++! dimensions than the array spec) generates a warning.
++!
++! Contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
++! Updated by Mark Eggleston <mark.eggleston@codethink.co.uk>
++!
++
++program under_specified_array
++ integer chessboard(8,8)
++ integer chessboard3d(8,8,3:5)
++ chessboard(3,1) = 5
++ chessboard(3,2) = 55
++ chessboard3d(4,1,3) = 6
++ chessboard3d(4,1,4) = 66
++ chessboard3d(4,4,3) = 7
++ chessboard3d(4,4,4) = 77
++
++ if (chessboard(3).ne.5) stop 1 ! { dg-error "Rank mismatch" }
++ if (chessboard3d(4).ne.6) stop 2 ! { dg-error "Rank mismatch" }
++ if (chessboard3d(4,4).ne.7) stop 3 ! { dg-error "Rank mismatch" }
++end program
+--
+2.27.0
+
diff --git a/gcc11-fortran-fdec-duplicates.patch b/gcc11-fortran-fdec-duplicates.patch
new file mode 100644
index 0000000..b5d1104
--- /dev/null
+++ b/gcc11-fortran-fdec-duplicates.patch
@@ -0,0 +1,215 @@
+From 23b1fcb104c666429451ffaf936f8da5fcd3d43a Mon Sep 17 00:00:00 2001
+From: Mark Eggleston <markeggleston@gcc.gnu.org>
+Date: Fri, 22 Jan 2021 12:29:47 +0000
+Subject: [PATCH 01/10] Allow duplicate declarations.
+
+Enabled by -fdec-duplicates and -fdec.
+
+Some fixes by Jim MacArthur <jim.macarthur@codethink.co.uk>
+Addition of -fdec-duplicates by Mark Eggleston <mark.eggleston@codethink.com>
+---
+ gcc/fortran/lang.opt | 4 ++++
+ gcc/fortran/options.c | 1 +
+ gcc/fortran/symbol.c | 21 +++++++++++++++++--
+ .../gfortran.dg/duplicate_type_4.f90 | 13 ++++++++++++
+ .../gfortran.dg/duplicate_type_5.f90 | 13 ++++++++++++
+ .../gfortran.dg/duplicate_type_6.f90 | 13 ++++++++++++
+ .../gfortran.dg/duplicate_type_7.f90 | 13 ++++++++++++
+ .../gfortran.dg/duplicate_type_8.f90 | 12 +++++++++++
+ .../gfortran.dg/duplicate_type_9.f90 | 12 +++++++++++
+ 9 files changed, 100 insertions(+), 2 deletions(-)
+ create mode 100644 gcc/testsuite/gfortran.dg/duplicate_type_4.f90
+ create mode 100644 gcc/testsuite/gfortran.dg/duplicate_type_5.f90
+ create mode 100644 gcc/testsuite/gfortran.dg/duplicate_type_6.f90
+ create mode 100644 gcc/testsuite/gfortran.dg/duplicate_type_7.f90
+ create mode 100644 gcc/testsuite/gfortran.dg/duplicate_type_8.f90
+ create mode 100644 gcc/testsuite/gfortran.dg/duplicate_type_9.f90
+
+diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
+index 2b1977c523b..52bd522051e 100644
+--- a/gcc/fortran/lang.opt
++++ b/gcc/fortran/lang.opt
+@@ -469,6 +469,10 @@ Fortran Var(flag_dec_char_conversions)
+ Enable the use of character literals in assignments and data statements
+ for non-character variables.
+
++fdec-duplicates
++Fortran Var(flag_dec_duplicates)
++Allow varibles to be duplicated in the type specification matches.
++
+ fdec-include
+ Fortran Var(flag_dec_include)
+ Enable legacy parsing of INCLUDE as statement.
+diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
+index 3a0b98bf1ec..f19ba87f8a0 100644
+--- a/gcc/fortran/options.c
++++ b/gcc/fortran/options.c
+@@ -77,6 +77,7 @@ set_dec_flags (int value)
+ SET_BITFLAG (flag_dec_format_defaults, value, value);
+ SET_BITFLAG (flag_dec_blank_format_item, value, value);
+ SET_BITFLAG (flag_dec_char_conversions, value, value);
++ SET_BITFLAG (flag_dec_duplicates, value, value);
+ }
+
+ /* Finalize DEC flags. */
+diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
+index 3b988d1be22..9843175cc2a 100644
+--- a/gcc/fortran/symbol.c
++++ b/gcc/fortran/symbol.c
+@@ -1995,6 +1995,8 @@ gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where)
+ if (sym->attr.result && type == BT_UNKNOWN && sym->ns->proc_name)
+ type = sym->ns->proc_name->ts.type;
+
++ flavor = sym->attr.flavor;
++
+ if (type != BT_UNKNOWN && !(sym->attr.function && sym->attr.implicit_type)
+ && !(gfc_state_stack->previous && gfc_state_stack->previous->previous
+ && gfc_state_stack->previous->previous->state == COMP_SUBMODULE)
+@@ -2007,6 +2009,23 @@ gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where)
+ else if (sym->attr.function && sym->attr.result)
+ gfc_error ("Symbol %qs at %L already has basic type of %s",
+ sym->ns->proc_name->name, where, gfc_basic_typename (type));
++ else if (flag_dec_duplicates)
++ {
++ /* Ignore temporaries and class/procedure names */
++ if (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS
++ || sym->ts.type == BT_PROCEDURE)
++ return false;
++
++ if (gfc_compare_types (&sym->ts, ts)
++ && (flavor == FL_UNKNOWN || flavor == FL_VARIABLE
++ || flavor == FL_PROCEDURE))
++ {
++ return gfc_notify_std (GFC_STD_LEGACY,
++ "Symbol '%qs' at %L already has "
++ "basic type of %s", sym->name, where,
++ gfc_basic_typename (type));
++ }
++ }
+ else
+ gfc_error ("Symbol %qs at %L already has basic type of %s", sym->name,
+ where, gfc_basic_typename (type));
+@@ -2020,8 +2039,6 @@ gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where)
+ return false;
+ }
+
+- flavor = sym->attr.flavor;
+-
+ if (flavor == FL_PROGRAM || flavor == FL_BLOCK_DATA || flavor == FL_MODULE
+ || flavor == FL_LABEL
+ || (flavor == FL_PROCEDURE && sym->attr.subroutine)
+diff --git a/gcc/testsuite/gfortran.dg/duplicate_type_4.f90 b/gcc/testsuite/gfortran.dg/duplicate_type_4.f90
+new file mode 100644
+index 00000000000..cdd29ea8846
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/duplicate_type_4.f90
+@@ -0,0 +1,13 @@
++! { dg-do compile }
++! { dg-options "-std=f95" }
++
++! PR fortran/30239
++! Check for errors when a symbol gets declared a type twice, even if it
++! is the same.
++
++INTEGER FUNCTION foo ()
++ IMPLICIT NONE
++ INTEGER :: x
++ INTEGER :: x ! { dg-error "basic type of" }
++ x = 42
++END FUNCTION foo
+diff --git a/gcc/testsuite/gfortran.dg/duplicate_type_5.f90 b/gcc/testsuite/gfortran.dg/duplicate_type_5.f90
+new file mode 100644
+index 00000000000..00f931809aa
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/duplicate_type_5.f90
+@@ -0,0 +1,13 @@
++! { dg-do run }
++! { dg-options "-fdec" }
++!
++! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
++!
++
++program test
++ implicit none
++ integer :: x
++ integer :: x
++ x = 42
++ if (x /= 42) stop 1
++end program test
+diff --git a/gcc/testsuite/gfortran.dg/duplicate_type_6.f90 b/gcc/testsuite/gfortran.dg/duplicate_type_6.f90
+new file mode 100644
+index 00000000000..f0df27e323c
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/duplicate_type_6.f90
+@@ -0,0 +1,13 @@
++! { dg-do run }
++! { dg-options "-std=legacy -fdec-duplicates" }
++!
++! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
++!
++
++program test
++ implicit none
++ integer :: x
++ integer :: x
++ x = 42
++ if (x /= 42) stop 1
++end program test
+diff --git a/gcc/testsuite/gfortran.dg/duplicate_type_7.f90 b/gcc/testsuite/gfortran.dg/duplicate_type_7.f90
+new file mode 100644
+index 00000000000..f32472ff586
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/duplicate_type_7.f90
+@@ -0,0 +1,13 @@
++! { dg-do run }
++! { dg-options "-fdec-duplicates" }
++!
++! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
++!
++
++program test
++ implicit none
++ integer :: x
++ integer :: x! { dg-warning "Legacy Extension" }
++ x = 42
++ if (x /= 42) stop 1
++end program test
+diff --git a/gcc/testsuite/gfortran.dg/duplicate_type_8.f90 b/gcc/testsuite/gfortran.dg/duplicate_type_8.f90
+new file mode 100644
+index 00000000000..23c94add179
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/duplicate_type_8.f90
+@@ -0,0 +1,12 @@
++! { dg-do compile }
++! { dg-options "-fdec -fno-dec-duplicates" }
++!
++! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
++!
++
++integer function foo ()
++ implicit none
++ integer :: x
++ integer :: x ! { dg-error "basic type of" }
++ x = 42
++end function foo
+diff --git a/gcc/testsuite/gfortran.dg/duplicate_type_9.f90 b/gcc/testsuite/gfortran.dg/duplicate_type_9.f90
+new file mode 100644
+index 00000000000..d5edee4d8ee
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/duplicate_type_9.f90
+@@ -0,0 +1,12 @@
++! { dg-do compile }
++! { dg-options "-fdec-duplicates -fno-dec-duplicates" }
++!
++! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
++!
++
++integer function foo ()
++ implicit none
++ integer :: x
++ integer :: x ! { dg-error "basic type of" }
++ x = 42
++end function foo
+--
+2.27.0
+
diff --git a/gcc11-fortran-fdec-ichar.patch b/gcc11-fortran-fdec-ichar.patch
new file mode 100644
index 0000000..e7b0522
--- /dev/null
+++ b/gcc11-fortran-fdec-ichar.patch
@@ -0,0 +1,78 @@
+From f883ac209b0feea860354cb4ef7ff06dc8063fab Mon Sep 17 00:00:00 2001
+From: Mark Eggleston <markeggleston@gcc.gnu.org>
+Date: Fri, 22 Jan 2021 12:53:35 +0000
+Subject: [PATCH 03/10] Allow more than one character as argument to ICHAR
+
+Use -fdec to enable.
+---
+ gcc/fortran/check.c | 2 +-
+ gcc/fortran/simplify.c | 4 ++--
+ .../gfortran.dg/dec_ichar_with_string_1.f | 21 +++++++++++++++++++
+ 3 files changed, 24 insertions(+), 3 deletions(-)
+ create mode 100644 gcc/testsuite/gfortran.dg/dec_ichar_with_string_1.f
+
+diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
+index 82db8e4e1b2..623c1cc470e 100644
+--- a/gcc/fortran/check.c
++++ b/gcc/fortran/check.c
+@@ -3157,7 +3157,7 @@ gfc_check_ichar_iachar (gfc_expr *c, gfc_expr *kind)
+ else
+ return true;
+
+- if (i != 1)
++ if (i != 1 && !flag_dec)
+ {
+ 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 23317a2e2d9..9900572424f 100644
+--- a/gcc/fortran/simplify.c
++++ b/gcc/fortran/simplify.c
+@@ -3261,7 +3261,7 @@ gfc_simplify_iachar (gfc_expr *e, gfc_expr *kind)
+ if (e->expr_type != EXPR_CONSTANT)
+ return NULL;
+
+- if (e->value.character.length != 1)
++ if (e->value.character.length != 1 && !flag_dec)
+ {
+ gfc_error ("Argument of IACHAR at %L must be of length one", &e->where);
+ return &gfc_bad_expr;
+@@ -3459,7 +3459,7 @@ gfc_simplify_ichar (gfc_expr *e, gfc_expr *kind)
+ if (e->expr_type != EXPR_CONSTANT)
+ return NULL;
+
+- if (e->value.character.length != 1)
++ if (e->value.character.length != 1 && !flag_dec)
+ {
+ 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_1.f b/gcc/testsuite/gfortran.dg/dec_ichar_with_string_1.f
+new file mode 100644
+index 00000000000..85efccecc0f
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/dec_ichar_with_string_1.f
+@@ -0,0 +1,21 @@
++! { dg-do run }
++! { dg-options "-fdec" }
++!
++! Test ICHAR and IACHAR with more than one character as argument
++!
++! Test case contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
++! Modified by Mark Eggleston <mark.eggleston@codethink.com>
++!
++ 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
+--
+2.27.0
+
diff --git a/gcc11-fortran-fdec-non-integer-index.patch b/gcc11-fortran-fdec-non-integer-index.patch
new file mode 100644
index 0000000..074df3b
--- /dev/null
+++ b/gcc11-fortran-fdec-non-integer-index.patch
@@ -0,0 +1,158 @@
+From 67aef262311d6a746786ee0f59748ccaa7e1e711 Mon Sep 17 00:00:00 2001
+From: Mark Eggleston <markeggleston@gcc.gnu.org>
+Date: Fri, 22 Jan 2021 13:09:54 +0000
+Subject: [PATCH 04/10] Allow non-integer substring indexes
+
+Use -fdec-non-integer-index compiler flag to enable. Also enabled by -fdec.
+---
+ gcc/fortran/lang.opt | 4 ++++
+ gcc/fortran/options.c | 1 +
+ gcc/fortran/resolve.c | 20 +++++++++++++++++++
+ .../dec_not_integer_substring_indexes_1.f | 18 +++++++++++++++++
+ .../dec_not_integer_substring_indexes_2.f | 18 +++++++++++++++++
+ .../dec_not_integer_substring_indexes_3.f | 18 +++++++++++++++++
+ 6 files changed, 79 insertions(+)
+ create mode 100644 gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_1.f
+ create mode 100644 gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_2.f
+ create mode 100644 gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_3.f
+
+diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
+index c4da248f07c..d527c106bd6 100644
+--- a/gcc/fortran/lang.opt
++++ b/gcc/fortran/lang.opt
+@@ -489,6 +489,10 @@ fdec-math
+ Fortran Var(flag_dec_math)
+ Enable legacy math intrinsics for compatibility.
+
++fdec-non-integer-index
++Fortran Var(flag_dec_non_integer_index)
++Enable support for non-integer substring indexes.
++
+ 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 f19ba87f8a0..9a042f64881 100644
+--- a/gcc/fortran/options.c
++++ b/gcc/fortran/options.c
+@@ -78,6 +78,7 @@ set_dec_flags (int value)
+ SET_BITFLAG (flag_dec_blank_format_item, value, value);
+ SET_BITFLAG (flag_dec_char_conversions, value, value);
+ SET_BITFLAG (flag_dec_duplicates, value, value);
++ SET_BITFLAG (flag_dec_non_integer_index, value, value);
+ }
+
+ /* Finalize DEC flags. */
+diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
+index 4b90cb59902..bc0df0fdb99 100644
+--- a/gcc/fortran/resolve.c
++++ b/gcc/fortran/resolve.c
+@@ -5131,6 +5131,16 @@ gfc_resolve_substring (gfc_ref *ref, bool *equal_length)
+ if (!gfc_resolve_expr (ref->u.ss.start))
+ return false;
+
++ /* In legacy mode, allow non-integer string indexes by converting */
++ if (flag_dec_non_integer_index && ref->u.ss.start->ts.type != BT_INTEGER
++ && gfc_numeric_ts (&ref->u.ss.start->ts))
++ {
++ gfc_typespec t;
++ t.type = BT_INTEGER;
++ t.kind = ref->u.ss.start->ts.kind;
++ gfc_convert_type_warn (ref->u.ss.start, &t, 2, 1);
++ }
++
+ if (ref->u.ss.start->ts.type != BT_INTEGER)
+ {
+ gfc_error ("Substring start index at %L must be of type INTEGER",
+@@ -5160,6 +5170,16 @@ gfc_resolve_substring (gfc_ref *ref, bool *equal_length)
+ if (!gfc_resolve_expr (ref->u.ss.end))
+ return false;
+
++ /* Non-integer string index endings, as for start */
++ if (flag_dec_non_integer_index && ref->u.ss.end->ts.type != BT_INTEGER
++ && gfc_numeric_ts (&ref->u.ss.end->ts))
++ {
++ gfc_typespec t;
++ t.type = BT_INTEGER;
++ t.kind = ref->u.ss.end->ts.kind;
++ gfc_convert_type_warn (ref->u.ss.end, &t, 2, 1);
++ }
++
+ 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_1.f b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_1.f
+new file mode 100644
+index 00000000000..0be28abaa4b
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_1.f
+@@ -0,0 +1,18 @@
++! { dg-do run }
++! { dg-options "-fdec" }
++!
++! Test not integer substring indexes
++!
++! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
++!
++ PROGRAM not_integer_substring_indexes
++ CHARACTER*5 st/'Tests'/
++ REAL ir/1.0/
++ REAL ir2/4.0/
++
++ if (st(ir:4).ne.'Test') stop 1
++ if (st(1:ir2).ne.'Test') stop 2
++ if (st(1.0:4).ne.'Test') stop 3
++ if (st(1:4.0).ne.'Test') stop 4
++ if (st(2.5:4).ne.'est') stop 5
++ END
+diff --git a/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_2.f b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_2.f
+new file mode 100644
+index 00000000000..3cf05296d0c
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_2.f
+@@ -0,0 +1,18 @@
++! { dg-do run }
++! { dg-options "-fdec-non-integer-index" }
++!
++! Test not integer substring indexes
++!
++! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
++!
++ PROGRAM not_integer_substring_indexes
++ CHARACTER*5 st/'Tests'/
++ REAL ir/1.0/
++ REAL ir2/4.0/
++
++ if (st(ir:4).ne.'Test') stop 1
++ if (st(1:ir2).ne.'Test') stop 2
++ if (st(1.0:4).ne.'Test') stop 3
++ if (st(1:4.0).ne.'Test') stop 4
++ if (st(2.5:4).ne.'est') stop 5
++ END
+diff --git a/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_3.f b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_3.f
+new file mode 100644
+index 00000000000..703de995897
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_3.f
+@@ -0,0 +1,18 @@
++! { dg-do compile }
++! { dg-options "-fdec -fno-dec-non-integer-index" }
++!
++! Test not integer substring indexes
++!
++! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
++!
++ PROGRAM not_integer_substring_indexes
++ CHARACTER*5 st/'Tests'/
++ REAL ir/1.0/
++ REAL ir2/4.0/
++
++ if (st(ir:4).ne.'Test') stop 1 ! { dg-error "Substring start index" }
++ if (st(1:ir2).ne.'Test') stop 2 ! { dg-error "Substring end index" }
++ if (st(1.0:4).ne.'Test') stop 3 ! { dg-error "Substring start index" }
++ if (st(1:4.0).ne.'Test') stop 4 ! { dg-error "Substring end index" }
++ if (st(2.5:4).ne.'est') stop 5 ! { dg-error "Substring start index" }
++ END
+--
+2.27.0
+
diff --git a/gcc11-fortran-fdec-non-logical-if.patch b/gcc11-fortran-fdec-non-logical-if.patch
new file mode 100644
index 0000000..0133d23
--- /dev/null
+++ b/gcc11-fortran-fdec-non-logical-if.patch
@@ -0,0 +1,378 @@
+From cc87ddb841017bb0976b05091733609ee17d7f05 Mon Sep 17 00:00:00 2001
+From: Mark Eggleston <markeggleston@gcc.gnu.org>
+Date: Fri, 22 Jan 2021 13:15:17 +0000
+Subject: [PATCH 07/10] Allow non-logical expressions in IF statements
+
+Use -fdec-non-logical-if to enable feature. Also enabled using -fdec.
+---
+ gcc/fortran/lang.opt | 4 ++
+ gcc/fortran/options.c | 1 +
+ gcc/fortran/resolve.c | 60 ++++++++++++++++---
+ ...gical_expressions_if_statements_blocks_1.f | 25 ++++++++
+ ...gical_expressions_if_statements_blocks_2.f | 25 ++++++++
+ ...gical_expressions_if_statements_blocks_3.f | 25 ++++++++
+ ...gical_expressions_if_statements_blocks_4.f | 45 ++++++++++++++
+ ...gical_expressions_if_statements_blocks_5.f | 45 ++++++++++++++
+ ...gical_expressions_if_statements_blocks_6.f | 45 ++++++++++++++
+ 9 files changed, 266 insertions(+), 9 deletions(-)
+ create mode 100644 gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_1.f
+ create mode 100644 gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_2.f
+ create mode 100644 gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_3.f
+ create mode 100644 gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_4.f
+ create mode 100644 gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_5.f
+ create mode 100644 gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_6.f
+
+diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
+index 4a269ebb22d..d886c2f33ed 100644
+--- a/gcc/fortran/lang.opt
++++ b/gcc/fortran/lang.opt
+@@ -497,6 +497,10 @@ fdec-override-kind
+ Fortran Var(flag_dec_override_kind)
+ Enable support for per variable kind specification.
+
++fdec-non-logical-if
++Fortran Var(flag_dec_non_logical_if)
++Enable support for non-logical expressions in if statements.
++
+ fdec-old-init
+ Fortran Var(flag_dec_old_init)
+ Enable support for old style initializers in derived types.
+diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
+index edbab483b36..a946c86790a 100644
+--- a/gcc/fortran/options.c
++++ b/gcc/fortran/options.c
+@@ -81,6 +81,7 @@ set_dec_flags (int value)
+ SET_BITFLAG (flag_dec_non_integer_index, value, 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);
+ }
+
+ /* Finalize DEC flags. */
+diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
+index bc0df0fdb99..07dd039f3bf 100644
+--- a/gcc/fortran/resolve.c
++++ b/gcc/fortran/resolve.c
+@@ -10789,10 +10789,31 @@ 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 (flag_dec_non_logical_if && 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;
++ if (warn_conversion_extra)
++ {
++ gfc_warning (OPT_Wconversion_extra, "Non-LOGICAL type in"
++ " IF statement condition %L will be true if"
++ " it evaluates to nonzero",
++ &b->expr1->where);
++ }
++ }
++
++ if ((b->expr1->ts.type != BT_LOGICAL || b->expr1->rank != 0))
++ gfc_error ("IF clause at %L requires a scalar LOGICAL "
++ "expression", &b->expr1->where);
++ }
+ break;
+
+ case EXEC_WHERE:
+@@ -12093,11 +12114,32 @@ 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 (flag_dec_non_logical_if
++ && 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;
++ if (warn_conversion_extra)
++ {
++ gfc_warning (OPT_Wconversion_extra, "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_1.f b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_1.f
+new file mode 100644
+index 00000000000..0101db893ca
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_1.f
+@@ -0,0 +1,25 @@
++! { dg-do run }
++! { dg-options "-fdec -Wconversion-extra" }
++!
++! Allow logical expressions in if statements and blocks
++!
++! Contributed by Francisco Redondo Marchena <francisco.marchema@codethink.co.uk>
++! and Jeff Law <law@redhat.com>
++! Modified by Mark Eggleston <mark.eggleston@codethink.com>
++!
++ 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
+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..876f4e09508
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_2.f
+@@ -0,0 +1,25 @@
++! { dg-do run }
++! { dg-options "-fdec-non-logical-if -Wconversion-extra" }
++!
++! Allow logical expressions in if statements and blocks
++!
++! Contributed by Francisco Redondo Marchena <francisco.marchema@codethink.co.uk>
++! and Jeff Law <law@redhat.com>
++! Modified by Mark Eggleston <mark.eggleston@codethink.com>
++!
++ 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
+diff --git a/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_3.f b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_3.f
+new file mode 100644
+index 00000000000..35cb4c51b8d
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_3.f
+@@ -0,0 +1,25 @@
++! { dg-do compile }
++! { dg-options "-fdec -fno-dec-non-logical-if" }
++!
++! Allow logical expressions in if statements and blocks
++!
++! Contributed by Francisco Redondo Marchena <francisco.marchema@codethink.co.uk>
++! and Jeff Law <law@redhat.com>
++! Modified by Mark Eggleston <mark.eggleston@codethink.com>
++!
++ PROGRAM logical_exp_if_st_bl
++ INTEGER ipos/1/
++ INTEGER ineg/0/
++
++ ! Test non logical variables
++ if (ineg) STOP 1 ! { dg-error "IF clause at" }
++ if (0) STOP 2 ! { dg-error "IF clause at" }
++
++ ! Test non logical expressions in if statements
++ if (MOD(ipos, 1)) STOP 3 ! { dg-error "IF clause at" }
++
++ ! Test non logical expressions in if blocks
++ if (MOD(2 * ipos, 2)) then ! { dg-error "IF clause at" }
++ STOP 4
++ endif
++ END
+diff --git a/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_4.f b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_4.f
+new file mode 100644
+index 00000000000..7b60b60827f
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_4.f
+@@ -0,0 +1,45 @@
++! { dg-do run }
++! { dg-options "-fdec -Wconversion-extra" }
++!
++! Contributed by Francisco Redondo Marchena <francisco.marchema@codethink.co.uk>
++! and Jeff Law <law@redhat.com>
++! Modified by Mark Eggleston <mark.eggleston@codethink.com>
++!
++ function othersub1()
++ integer*4 othersub1
++ othersub1 = 9
++ end
++
++ function othersub2()
++ integer*4 othersub2
++ othersub2 = 0
++ end
++
++ program MAIN
++ integer*4 othersub1
++ integer*4 othersub2
++ integer a /1/
++ integer b /2/
++
++ if (othersub1()) then ! { dg-warning "if it evaluates to nonzero" }
++ write(*,*) "OK"
++ else
++ stop 1
++ end if
++ if (othersub2()) then ! { dg-warning "if it evaluates to nonzero" }
++ stop 2
++ else
++ write(*,*) "OK"
++ end if
++ if (a-b) then ! { dg-warning "if it evaluates to nonzero" }
++ write(*,*) "OK"
++ else
++ stop 3
++ end if
++ if (b-(a+1)) then ! { dg-warning "if it evaluates to nonzero" }
++ stop 3
++ else
++ write(*,*) "OK"
++ end if
++ end
++
+diff --git a/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_5.f b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_5.f
+new file mode 100644
+index 00000000000..80336f48ca1
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_5.f
+@@ -0,0 +1,45 @@
++! { dg-do run }
++! { dg-options "-fdec-non-logical-if -Wconversion-extra" }
++!
++! Contributed by Francisco Redondo Marchena <francisco.marchema@codethink.co.uk>
++! and Jeff Law <law@redhat.com>
++! Modified by Mark Eggleston <mark.eggleston@codethink.com>
++!
++ function othersub1()
++ integer*4 othersub1
++ othersub1 = 9
++ end
++
++ function othersub2()
++ integer*4 othersub2
++ othersub2 = 0
++ end
++
++ program MAIN
++ integer*4 othersub1
++ integer*4 othersub2
++ integer a /1/
++ integer b /2/
++
++ if (othersub1()) then ! { dg-warning "Non-LOGICAL type in IF statement" }
++ write(*,*) "OK"
++ else
++ stop 1
++ end if
++ if (othersub2()) then ! { dg-warning "Non-LOGICAL type in IF statement" }
++ stop 2
++ else
++ write(*,*) "OK"
++ end if
++ if (a-b) then ! { dg-warning "Non-LOGICAL type in IF statement" }
++ write(*,*) "OK"
++ else
++ stop 3
++ end if
++ if (b-(a+1)) then ! { dg-warning "Non-LOGICAL type in IF statement" }
++ stop 3
++ else
++ write(*,*) "OK"
++ end if
++ end
++
+diff --git a/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_6.f b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_6.f
+new file mode 100644
+index 00000000000..e1125ca717a
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_6.f
+@@ -0,0 +1,45 @@
++! { dg-do compile }
++! { dg-options "-fdec -fno-dec-non-logical-if" }
++!
++! Contributed by Francisco Redondo Marchena <francisco.marchema@codethink.co.uk>
++! and Jeff Law <law@redhat.com>
++! Modified by Mark Eggleston <mark.eggleston@codethink.com>
++!
++ function othersub1()
++ integer*4 othersub1
++ othersub1 = 9
++ end
++
++ function othersub2()
++ integer*4 othersub2
++ othersub2 = 0
++ end
++
++ program MAIN
++ integer*4 othersub1
++ integer*4 othersub2
++ integer a /1/
++ integer b /2/
++
++ if (othersub1()) then ! { dg-error "IF clause at" }
++ write(*,*) "OK"
++ else
++ stop 1
++ end if
++ if (othersub2()) then ! { dg-error "IF clause at" }
++ stop 2
++ else
++ write(*,*) "OK"
++ end if
++ if (a-b) then ! { dg-error "IF clause at" }
++ write(*,*) "OK"
++ else
++ stop 3
++ end if
++ if (b-(a+1)) then ! { dg-error "IF clause at" }
++ stop 3
++ else
++ write(*,*) "OK"
++ end if
++ end
++
+--
+2.27.0
+
diff --git a/gcc11-fortran-fdec-old-init.patch b/gcc11-fortran-fdec-old-init.patch
new file mode 100644
index 0000000..8554f2e
--- /dev/null
+++ b/gcc11-fortran-fdec-old-init.patch
@@ -0,0 +1,185 @@
+From 8bcc0f85ed1718c0dd9033ad4a34df181aabaffe Mon Sep 17 00:00:00 2001
+From: Mark Eggleston <markeggleston@gcc.gnu.org>
+Date: Fri, 22 Jan 2021 13:11:06 +0000
+Subject: [PATCH 05/10] Allow old-style initializers in derived types
+
+This allows simple declarations in derived types and structures, such as:
+ LOGICAL*1 NIL /0/
+Only single value expressions are allowed at the moment.
+
+Use -fdec-old-init to enable. Also enabled by -fdec.
+---
+ gcc/fortran/decl.c | 27 +++++++++++++++----
+ gcc/fortran/lang.opt | 4 +++
+ gcc/fortran/options.c | 1 +
+ ...ec_derived_types_initialised_old_style_1.f | 25 +++++++++++++++++
+ ...ec_derived_types_initialised_old_style_2.f | 25 +++++++++++++++++
+ ...ec_derived_types_initialised_old_style_3.f | 26 ++++++++++++++++++
+ 6 files changed, 103 insertions(+), 5 deletions(-)
+ create mode 100644 gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_1.f
+ create mode 100644 gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_2.f
+ create mode 100644 gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_3.f
+
+diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
+index 723915822f3..5c8c1b7981b 100644
+--- a/gcc/fortran/decl.c
++++ b/gcc/fortran/decl.c
+@@ -2827,12 +2827,29 @@ variable_decl (int elem)
+ but not components of derived types. */
+ else if (gfc_current_state () == COMP_DERIVED)
+ {
+- gfc_error ("Invalid old style initialization for derived type "
+- "component at %C");
+- m = MATCH_ERROR;
+- goto cleanup;
++ if (flag_dec_old_init)
++ {
++ /* Attempt to match an old-style initializer which is a simple
++ integer or character expression; this will not work with
++ multiple values. */
++ m = gfc_match_init_expr (&initializer);
++ if (m == MATCH_ERROR)
++ goto cleanup;
++ else if (m == MATCH_YES)
++ {
++ m = gfc_match ("/");
++ if (m != MATCH_YES)
++ goto cleanup;
++ }
++ }
++ else
++ {
++ gfc_error ("Invalid old style initialization for derived type "
++ "component at %C");
++ m = MATCH_ERROR;
++ goto cleanup;
++ }
+ }
+-
+ /* 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/fortran/lang.opt b/gcc/fortran/lang.opt
+index d527c106bd6..25cc948699b 100644
+--- a/gcc/fortran/lang.opt
++++ b/gcc/fortran/lang.opt
+@@ -493,6 +493,10 @@ fdec-non-integer-index
+ Fortran Var(flag_dec_non_integer_index)
+ Enable support for non-integer substring indexes.
+
++fdec-old-init
++Fortran Var(flag_dec_old_init)
++Enable support for old style initializers in derived types.
++
+ 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 9a042f64881..d6bd36c3a8a 100644
+--- a/gcc/fortran/options.c
++++ b/gcc/fortran/options.c
+@@ -79,6 +79,7 @@ set_dec_flags (int value)
+ SET_BITFLAG (flag_dec_char_conversions, value, value);
+ SET_BITFLAG (flag_dec_duplicates, value, value);
+ SET_BITFLAG (flag_dec_non_integer_index, value, value);
++ SET_BITFLAG (flag_dec_old_init, value, value);
+ }
+
+ /* Finalize DEC flags. */
+diff --git a/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_1.f b/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_1.f
+new file mode 100644
+index 00000000000..eac4f9bfcf1
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_1.f
+@@ -0,0 +1,25 @@
++! { dg-do run }
++! { dg-options "-fdec" }
++!
++! Test old style initializers in derived types
++!
++! Contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
++! Modified by Mark Eggleston <mark.eggleston@codethink.com>
++!
++ PROGRAM spec_in_var
++ TYPE STRUCT1
++ INTEGER*4 ID /8/
++ INTEGER*4 TYPE /5/
++ INTEGER*8 DEFVAL /0/
++ CHARACTER*(5) NAME /'tests'/
++ LOGICAL*1 NIL /0/
++ END TYPE STRUCT1
++
++ TYPE (STRUCT1) SINST
++
++ IF(SINST%ID.NE.8) STOP 1
++ IF(SINST%TYPE.NE.5) STOP 2
++ IF(SINST%DEFVAL.NE.0) STOP 3
++ IF(SINST%NAME.NE.'tests') STOP 4
++ IF(SINST%NIL) STOP 5
++ END
+diff --git a/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_2.f b/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_2.f
+new file mode 100644
+index 00000000000..d904c8b2974
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_2.f
+@@ -0,0 +1,25 @@
++! { dg-do run }
++! { dg-options "-std=legacy -fdec-old-init" }
++!
++! Test old style initializers in derived types
++!
++! Contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
++! Modified by Mark Eggleston <mark.eggleston@codethink.com>
++!
++ PROGRAM spec_in_var
++ TYPE STRUCT1
++ INTEGER*4 ID /8/
++ INTEGER*4 TYPE /5/
++ INTEGER*8 DEFVAL /0/
++ CHARACTER*(5) NAME /'tests'/
++ LOGICAL*1 NIL /0/
++ END TYPE STRUCT1
++
++ TYPE (STRUCT1) SINST
++
++ IF(SINST%ID.NE.8) STOP 1
++ IF(SINST%TYPE.NE.5) STOP 2
++ IF(SINST%DEFVAL.NE.0) STOP 3
++ IF(SINST%NAME.NE.'tests') STOP 4
++ IF(SINST%NIL) STOP 5
++ END
+diff --git a/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_3.f b/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_3.f
+new file mode 100644
+index 00000000000..58c2b4b66cf
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_3.f
+@@ -0,0 +1,26 @@
++! { dg-do compile }
++! { dg-options "-std=legacy -fdec -fno-dec-old-init" }
++!
++! Test old style initializers in derived types
++!
++! Contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
++! Modified by Mark Eggleston <mark.eggleston@codethink.com>
++!
++
++ PROGRAM spec_in_var
++ TYPE STRUCT1
++ INTEGER*4 ID /8/ ! { dg-error "Invalid old style initialization" }
++ INTEGER*4 TYPE /5/ ! { dg-error "Invalid old style initialization" }
++ INTEGER*8 DEFVAL /0/ ! { dg-error "Invalid old style initialization" }
++ CHARACTER*(5) NAME /'tests'/ ! { dg-error "Invalid old style initialization" }
++ LOGICAL*1 NIL /0/ ! { dg-error "Invalid old style initialization" }
++ END TYPE STRUCT1
++
++ TYPE (STRUCT1) SINST
++
++ IF(SINST%ID.NE.8) STOP 1 ! { dg-error "'id' at \\(1\\) is not a member" }
++ IF(SINST%TYPE.NE.5) STOP 2 ! { dg-error "'type' at \\(1\\) is not a member" }
++ IF(SINST%DEFVAL.NE.0) STOP 3 ! { dg-error "'defval' at \\(1\\) is not a member" }
++ IF(SINST%NAME.NE.'tests') STOP 4 ! { dg-error "'name' at \\(1\\) is not a member" }
++ IF(SINST%NIL) STOP 5 ! { dg-error "'nil' at \\(1\\) is not a member" }
++ END
+--
+2.27.0
+
diff --git a/gcc11-fortran-fdec-override-kind.patch b/gcc11-fortran-fdec-override-kind.patch
new file mode 100644
index 0000000..e1c7b83
--- /dev/null
+++ b/gcc11-fortran-fdec-override-kind.patch
@@ -0,0 +1,588 @@
+From 786869fd62813e80da9b6545a295d53c36275c19 Mon Sep 17 00:00:00 2001
+From: Mark Eggleston <markeggleston@gcc.gnu.org>
+Date: Fri, 22 Jan 2021 13:12:14 +0000
+Subject: [PATCH 06/10] Allow string length and kind to be specified on a per
+ variable basis.
+
+This allows kind/length to be mixed with array specification in
+declarations.
+
+e.g.
+
+ INTEGER*4 x*2, y*8
+ CHARACTER names*20(10)
+ REAL v(100)*8, vv*4(50)
+
+The per-variable size overrides the kind or length specified for the type.
+
+Use -fdec-override-kind to enable. Also enabled by -fdec.
+
+Note: this feature is a merger of two previously separate features.
+
+Now accepts named constants as kind parameters:
+
+ INTEGER A
+ PARAMETER (A=2)
+ INTEGER B*(A)
+
+Contributed by Mark Eggleston <mark.eggleston@codethink.com>
+
+Now rejects invalid kind parameters and prints error messages:
+
+ INTEGER X*3
+
+caused an internal compiler error.
+
+Contributed by Mark Eggleston <mark.eggleston@codethink.com>
+---
+ gcc/fortran/decl.c | 156 ++++++++++++++----
+ gcc/fortran/lang.opt | 4 +
+ gcc/fortran/options.c | 1 +
+ .../dec_mixed_char_array_declaration_1.f | 13 ++
+ .../dec_mixed_char_array_declaration_2.f | 13 ++
+ .../dec_mixed_char_array_declaration_3.f | 13 ++
+ .../gfortran.dg/dec_spec_in_variable_1.f | 31 ++++
+ .../gfortran.dg/dec_spec_in_variable_2.f | 31 ++++
+ .../gfortran.dg/dec_spec_in_variable_3.f | 31 ++++
+ .../gfortran.dg/dec_spec_in_variable_4.f | 14 ++
+ .../gfortran.dg/dec_spec_in_variable_5.f | 19 +++
+ .../gfortran.dg/dec_spec_in_variable_6.f | 19 +++
+ .../gfortran.dg/dec_spec_in_variable_7.f | 15 ++
+ .../gfortran.dg/dec_spec_in_variable_8.f | 14 ++
+ 14 files changed, 340 insertions(+), 34 deletions(-)
+ create mode 100644 gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration_1.f
+ create mode 100644 gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration_2.f
+ create mode 100644 gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration_3.f
+ create mode 100644 gcc/testsuite/gfortran.dg/dec_spec_in_variable_1.f
+ create mode 100644 gcc/testsuite/gfortran.dg/dec_spec_in_variable_2.f
+ create mode 100644 gcc/testsuite/gfortran.dg/dec_spec_in_variable_3.f
+ create mode 100644 gcc/testsuite/gfortran.dg/dec_spec_in_variable_4.f
+ create mode 100644 gcc/testsuite/gfortran.dg/dec_spec_in_variable_5.f
+ create mode 100644 gcc/testsuite/gfortran.dg/dec_spec_in_variable_6.f
+ create mode 100644 gcc/testsuite/gfortran.dg/dec_spec_in_variable_7.f
+ create mode 100644 gcc/testsuite/gfortran.dg/dec_spec_in_variable_8.f
+
+diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
+index 5c8c1b7981b..f7dc9d8263d 100644
+--- a/gcc/fortran/decl.c
++++ b/gcc/fortran/decl.c
+@@ -1213,6 +1213,54 @@ syntax:
+ return MATCH_ERROR;
+ }
+
++/* This matches the nonstandard kind given after a variable name, like:
++ INTEGER x*2, y*4
++ The per-variable kind will override any kind given in the type
++ declaration.
++*/
++
++static match
++match_per_symbol_kind (int *length)
++{
++ match m;
++ gfc_expr *expr = NULL;
++
++ m = gfc_match_char ('*');
++ if (m != MATCH_YES)
++ return m;
++
++ m = gfc_match_small_literal_int (length, NULL);
++ if (m == MATCH_YES || m == MATCH_ERROR)
++ return m;
++
++ if (gfc_match_char ('(') == MATCH_NO)
++ return MATCH_ERROR;
++
++ m = gfc_match_expr (&expr);
++ if (m == MATCH_YES)
++ {
++ m = MATCH_ERROR; // Assume error
++ if (gfc_expr_check_typed (expr, gfc_current_ns, false))
++ {
++ if ((expr->expr_type == EXPR_CONSTANT)
++ && (expr->ts.type == BT_INTEGER))
++ {
++ *length = mpz_get_si(expr->value.integer);
++ m = MATCH_YES;
++ }
++ }
++
++ if (m == MATCH_YES)
++ {
++ if (gfc_match_char (')') == MATCH_NO)
++ m = MATCH_ERROR;
++ }
++ }
++
++ if (expr != NULL)
++ gfc_free_expr (expr);
++ return m;
++}
+
+ /* Special subroutine for finding a symbol. Check if the name is found
+ in the current name space. If not, and we're compiling a function or
+@@ -2443,6 +2491,35 @@ check_function_name (char *name)
+ }
+
+
++static match
++match_character_length_clause (gfc_charlen **cl, bool *cl_deferred, int elem)
++{
++ gfc_expr* char_len;
++ char_len = NULL;
++
++ match m = match_char_length (&char_len, cl_deferred, false);
++ if (m == MATCH_YES)
++ {
++ *cl = gfc_new_charlen (gfc_current_ns, NULL);
++ (*cl)->length = char_len;
++ }
++ else if (m == MATCH_NO)
++ {
++ if (elem > 1
++ && (current_ts.u.cl->length == NULL
++ || current_ts.u.cl->length->expr_type != EXPR_CONSTANT))
++ {
++ *cl = gfc_new_charlen (gfc_current_ns, NULL);
++ (*cl)->length = gfc_copy_expr (current_ts.u.cl->length);
++ }
++ else
++ *cl = current_ts.u.cl;
++
++ *cl_deferred = current_ts.deferred;
++ }
++ return m;
++}
++
+ /* Match a variable name with an optional initializer. When this
+ subroutine is called, a variable is expected to be parsed next.
+ Depending on what is happening at the moment, updates either the
+@@ -2453,7 +2530,7 @@ variable_decl (int elem)
+ {
+ char name[GFC_MAX_SYMBOL_LEN + 1];
+ static unsigned int fill_id = 0;
+- gfc_expr *initializer, *char_len;
++ gfc_expr *initializer;
+ gfc_array_spec *as;
+ gfc_array_spec *cp_as; /* Extra copy for Cray Pointees. */
+ gfc_charlen *cl;
+@@ -2462,11 +2539,15 @@ variable_decl (int elem)
+ match m;
+ bool t;
+ gfc_symbol *sym;
++ match cl_match;
++ match kind_match;
++ int overridden_kind;
+ char c;
+
+ initializer = NULL;
+ as = NULL;
+ cp_as = NULL;
++ kind_match = MATCH_NO;
+
+ /* 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
+@@ -2519,6 +2600,28 @@ variable_decl (int elem)
+
+ var_locus = gfc_current_locus;
+
++
++ cl = NULL;
++ cl_deferred = false;
++ cl_match = MATCH_NO;
++
++ /* Check for a character length clause before an array clause */
++ if (flag_dec_override_kind)
++ {
++ if (current_ts.type == BT_CHARACTER)
++ {
++ cl_match = match_character_length_clause (&cl, &cl_deferred, elem);
++ if (cl_match == MATCH_ERROR)
++ goto cleanup;
++ }
++ else
++ {
++ kind_match = match_per_symbol_kind (&overridden_kind);
++ if (kind_match == MATCH_ERROR)
++ goto cleanup;
++ }
++ }
++
+ /* Now we could see the optional array spec. or character length. */
+ m = gfc_match_array_spec (&as, true, true);
+ if (m == MATCH_ERROR)
+@@ -2667,40 +2770,12 @@ variable_decl (int elem)
+ }
+ }
+
+- char_len = NULL;
+- cl = NULL;
+- cl_deferred = false;
+-
+- if (current_ts.type == BT_CHARACTER)
++ /* Second chance for a character length clause */
++ if (cl_match == MATCH_NO && current_ts.type == BT_CHARACTER)
+ {
+- switch (match_char_length (&char_len, &cl_deferred, false))
+- {
+- case MATCH_YES:
+- cl = gfc_new_charlen (gfc_current_ns, NULL);
+-
+- cl->length = char_len;
+- break;
+-
+- /* Non-constant lengths need to be copied after the first
+- element. Also copy assumed lengths. */
+- case MATCH_NO:
+- if (elem > 1
+- && (current_ts.u.cl->length == NULL
+- || current_ts.u.cl->length->expr_type != EXPR_CONSTANT))
+- {
+- cl = gfc_new_charlen (gfc_current_ns, NULL);
+- cl->length = gfc_copy_expr (current_ts.u.cl->length);
+- }
+- else
+- cl = current_ts.u.cl;
+-
+- cl_deferred = current_ts.deferred;
+-
+- break;
+-
+- case MATCH_ERROR:
+- goto cleanup;
+- }
++ m = match_character_length_clause (&cl, &cl_deferred, elem);
++ if (m == MATCH_ERROR)
++ goto cleanup;
+ }
+
+ /* The dummy arguments and result of the abreviated form of MODULE
+@@ -2802,6 +2877,19 @@ variable_decl (int elem)
+ goto cleanup;
+ }
+
++ if (kind_match == MATCH_YES)
++ {
++ gfc_find_symbol (name, gfc_current_ns, 1, &sym);
++ /* sym *must* be found at this point */
++ sym->ts.kind = overridden_kind;
++ if (gfc_validate_kind (sym->ts.type, sym->ts.kind, true) < 0)
++ {
++ gfc_error ("Kind %d not supported for type %s at %C",
++ sym->ts.kind, gfc_basic_typename (sym->ts.type));
++ return MATCH_ERROR;
++ }
++ }
++
+ if (!check_function_name (name))
+ {
+ m = MATCH_ERROR;
+diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
+index 25cc948699b..4a269ebb22d 100644
+--- a/gcc/fortran/lang.opt
++++ b/gcc/fortran/lang.opt
+@@ -493,6 +493,10 @@ fdec-non-integer-index
+ Fortran Var(flag_dec_non_integer_index)
+ Enable support for non-integer substring indexes.
+
++fdec-override-kind
++Fortran Var(flag_dec_override_kind)
++Enable support for per variable kind specification.
++
+ fdec-old-init
+ Fortran Var(flag_dec_old_init)
+ Enable support for old style initializers in derived types.
+diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
+index d6bd36c3a8a..edbab483b36 100644
+--- a/gcc/fortran/options.c
++++ b/gcc/fortran/options.c
+@@ -80,6 +80,7 @@ set_dec_flags (int value)
+ SET_BITFLAG (flag_dec_duplicates, value, value);
+ SET_BITFLAG (flag_dec_non_integer_index, value, value);
+ SET_BITFLAG (flag_dec_old_init, value, value);
++ SET_BITFLAG (flag_dec_override_kind, value, value);
+ }
+
+ /* Finalize DEC flags. */
+diff --git a/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration_1.f b/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration_1.f
+new file mode 100644
+index 00000000000..706ea4112a4
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration_1.f
+@@ -0,0 +1,13 @@
++! { dg-do run }
++! { dg-options "-fdec" }
++!
++! Test character declaration with mixed string length and array specification
++!
++! Contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
++! Modified by Mark Eggleston <mark.eggleston@codethink.com>
++!
++ PROGRAM character_declaration
++ CHARACTER ASPEC_SLENGTH*2 (5) /'01','02','03','04','05'/
++ CHARACTER SLENGTH_ASPEC(5)*2 /'01','02','03','04','05'/
++ if (ASPEC_SLENGTH(3).NE.SLENGTH_ASPEC(3)) STOP 1
++ END
+diff --git a/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration_2.f b/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration_2.f
+new file mode 100644
+index 00000000000..26d2acf01de
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration_2.f
+@@ -0,0 +1,13 @@
++! { dg-do run }
++! { dg-options "-fdec-override-kind" }
++!
++! Test character declaration with mixed string length and array specification
++!
++! Contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
++! Modified by Mark Eggleston <mark.eggleston@codethink.com>
++!
++ PROGRAM character_declaration
++ CHARACTER ASPEC_SLENGTH*2 (5) /'01','02','03','04','05'/
++ CHARACTER SLENGTH_ASPEC(5)*2 /'01','02','03','04','05'/
++ if (ASPEC_SLENGTH(3).NE.SLENGTH_ASPEC(3)) STOP 1
++ END
+diff --git a/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration_3.f b/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration_3.f
+new file mode 100644
+index 00000000000..76e4f0bdb93
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration_3.f
+@@ -0,0 +1,13 @@
++! { dg-do compile }
++! { dg-options "-fdec-override-kind -fno-dec-override-kind" }
++!
++! Test character declaration with mixed string length and array specification
++!
++! Contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
++! Modified by Mark Eggleston <mark.eggleston@codethink.com>
++!
++ PROGRAM character_declaration
++ CHARACTER ASPEC_SLENGTH*2 (5) /'01','02','03','04','05'/ ! { dg-error "Syntax error" }
++ CHARACTER SLENGTH_ASPEC(5)*2 /'01','02','03','04','05'/
++ if (ASPEC_SLENGTH(3).NE.SLENGTH_ASPEC(3)) STOP 1 ! { dg-error " Operands of comparison operator" }
++ END
+diff --git a/gcc/testsuite/gfortran.dg/dec_spec_in_variable_1.f b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_1.f
+new file mode 100644
+index 00000000000..edd0f5874b7
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_1.f
+@@ -0,0 +1,31 @@
++! { dg-do run }
++! { dg-options "-fdec" }
++!
++! Test kind specification in variable not in type
++!
++! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
++!
++ program spec_in_var
++ integer*8 ai*1, bi*4, ci
++ real*4 ar*4, br*8, cr
++
++ ai = 1
++ ar = 1.0
++ bi = 2
++ br = 2.0
++ ci = 3
++ cr = 3.0
++
++ if (ai .ne. 1) stop 1
++ if (abs(ar - 1.0) > 1.0D-6) stop 2
++ if (bi .ne. 2) stop 3
++ if (abs(br - 2.0) > 1.0D-6) stop 4
++ if (ci .ne. 3) stop 5
++ if (abs(cr - 3.0) > 1.0D-6) stop 6
++ if (kind(ai) .ne. 1) stop 7
++ if (kind(ar) .ne. 4) stop 8
++ if (kind(bi) .ne. 4) stop 9
++ if (kind(br) .ne. 8) stop 10
++ if (kind(ci) .ne. 8) stop 11
++ if (kind(cr) .ne. 4) stop 12
++ end
+diff --git a/gcc/testsuite/gfortran.dg/dec_spec_in_variable_2.f b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_2.f
+new file mode 100644
+index 00000000000..bfaba584dbb
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_2.f
+@@ -0,0 +1,31 @@
++! { dg-do run }
++! { dg-options "-fdec-override-kind" }
++!
++! Test kind specification in variable not in type
++!
++! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
++!
++ program spec_in_var
++ integer*8 ai*1, bi*4, ci
++ real*4 ar*4, br*8, cr
++
++ ai = 1
++ ar = 1.0
++ bi = 2
++ br = 2.0
++ ci = 3
++ cr = 3.0
++
++ if (ai .ne. 1) stop 1
++ if (abs(ar - 1.0) > 1.0D-6) stop 2
++ if (bi .ne. 2) stop 3
++ if (abs(br - 2.0) > 1.0D-6) stop 4
++ if (ci .ne. 3) stop 5
++ if (abs(cr - 3.0) > 1.0D-6) stop 6
++ if (kind(ai) .ne. 1) stop 7
++ if (kind(ar) .ne. 4) stop 8
++ if (kind(bi) .ne. 4) stop 9
++ if (kind(br) .ne. 8) stop 10
++ if (kind(ci) .ne. 8) stop 11
++ if (kind(cr) .ne. 4) stop 12
++ end
+diff --git a/gcc/testsuite/gfortran.dg/dec_spec_in_variable_3.f b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_3.f
+new file mode 100644
+index 00000000000..5ff434e7466
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_3.f
+@@ -0,0 +1,31 @@
++! { dg-do compile }
++! { dg-options "-fdec -fno-dec-override-kind" }
++!
++! Test kind specification in variable not in type
++!
++! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
++!
++ program spec_in_var
++ integer*8 ai*1, bi*4, ci ! { dg-error "Syntax error" }
++ real*4 ar*4, br*8, cr ! { dg-error "Syntax error" }
++
++ ai = 1
++ ar = 1.0
++ bi = 2
++ br = 2.0
++ ci = 3
++ cr = 3.0
++
++ if (ai .ne. 1) stop 1
++ if (abs(ar - 1.0) > 1.0D-6) stop 2
++ if (bi .ne. 2) stop 3
++ if (abs(br - 2.0) > 1.0D-6) stop 4
++ if (ci .ne. 3) stop 5
++ if (abs(cr - 3.0) > 1.0D-6) stop 6
++ if (kind(ai) .ne. 1) stop 7
++ if (kind(ar) .ne. 4) stop 8
++ if (kind(bi) .ne. 4) stop 9
++ if (kind(br) .ne. 8) stop 10
++ if (kind(ci) .ne. 8) stop 11
++ if (kind(cr) .ne. 4) stop 12
++ end
+diff --git a/gcc/testsuite/gfortran.dg/dec_spec_in_variable_4.f b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_4.f
+new file mode 100644
+index 00000000000..c01980e8b9d
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_4.f
+@@ -0,0 +1,14 @@
++! { dg-do compile }
++!
++! Test kind specification in variable not in type. The per variable
++! kind specification is not enabled so these should fail
++!
++! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
++!
++ program spec_in_var
++ integer a
++ parameter(a=2)
++ integer b*(a) ! { dg-error "Syntax error" }
++ real c*(8) ! { dg-error "Syntax error" }
++ logical d*1_1 ! { dg-error "Syntax error" }
++ end
+diff --git a/gcc/testsuite/gfortran.dg/dec_spec_in_variable_5.f b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_5.f
+new file mode 100644
+index 00000000000..e2f39da3f4f
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_5.f
+@@ -0,0 +1,19 @@
++! { dg-do run }
++! { dg-options "-fdec-override-kind" }
++!
++! Test kind specification in variable not in type
++!
++! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
++!
++ program spec_in_var
++ integer a
++ parameter(a=2)
++ integer b*(a)
++ real c*(8)
++ logical d*(1_1)
++ character e*(a)
++ if (kind(b).ne.2) stop 1
++ if (kind(c).ne.8) stop 2
++ if (kind(d).ne.1) stop 3
++ if (len(e).ne.2) stop 4
++ end
+diff --git a/gcc/testsuite/gfortran.dg/dec_spec_in_variable_6.f b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_6.f
+new file mode 100644
+index 00000000000..569747874e3
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_6.f
+@@ -0,0 +1,19 @@
++! { dg-do run }
++! { dg-options "-fdec" }
++!
++! Test kind specification in variable not in type
++!
++! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
++!
++ program spec_in_var
++ integer a
++ parameter(a=2)
++ integer b*(a)
++ real c*(8)
++ logical d*(1_1)
++ character e*(a)
++ if (kind(b).ne.2) stop 1
++ if (kind(c).ne.8) stop 2
++ if (kind(d).ne.1) stop 3
++ if (len(e).ne.2) stop 4
++ end
+diff --git a/gcc/testsuite/gfortran.dg/dec_spec_in_variable_7.f b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_7.f
+new file mode 100644
+index 00000000000..b975bfd15c5
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_7.f
+@@ -0,0 +1,15 @@
++! { dg-do compile }
++! { dg-options "-fdec -fno-dec-override-kind" }
++!
++! Test kind specification in variable not in type as the per variable
++! kind specification is not enables these should fail
++!
++! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
++!
++ program spec_in_var
++ integer a
++ parameter(a=2)
++ integer b*(a) ! { dg-error "Syntax error" }
++ real c*(8) ! { dg-error "Syntax error" }
++ logical d*1_1 ! { dg-error "Syntax error" }
++ end
+diff --git a/gcc/testsuite/gfortran.dg/dec_spec_in_variable_8.f b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_8.f
+new file mode 100644
+index 00000000000..85732e0bd85
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_8.f
+@@ -0,0 +1,14 @@
++! { dg-do compile }
++! { dg-options "-fdec" }
++!
++! Check that invalid kind values are rejected.
++!
++! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
++!
++ program spec_in_var
++ integer a
++ parameter(a=3)
++ integer b*(a) ! { dg-error "Kind 3 not supported" }
++ real c*(78) ! { dg-error "Kind 78 not supported" }
++ logical d*(*) ! { dg-error "Invalid character" }
++ end
+--
+2.27.0
+
diff --git a/gcc11-fortran-fdec-promotion.patch b/gcc11-fortran-fdec-promotion.patch
new file mode 100644
index 0000000..8643405
--- /dev/null
+++ b/gcc11-fortran-fdec-promotion.patch
@@ -0,0 +1,2093 @@
+From 7a27318818e359a277f2fa5f7dc3932d0fb950f5 Mon Sep 17 00:00:00 2001
+From: Mark Eggleston <markeggleston@gcc.gnu.org>
+Date: Fri, 22 Jan 2021 14:58:07 +0000
+Subject: [PATCH 08/10] 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 | 240 ++++++++++++++----
+ ...trinsic_int_real_array_const_promotion_1.f | 18 ++
+ ...trinsic_int_real_array_const_promotion_2.f | 18 ++
+ ...trinsic_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 +++++++++
+ .../gfortran.dg/dec_kind_promotion-1.f | 40 +++
+ .../gfortran.dg/dec_kind_promotion-2.f | 40 +++
+ .../gfortran.dg/dec_kind_promotion-3.f | 39 +++
+ 22 files changed, 1639 insertions(+), 80 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 623c1cc470e..e20a834a860 100644
+--- a/gcc/fortran/check.c
++++ b/gcc/fortran/check.c
+@@ -1396,12 +1396,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;
+
+@@ -3724,6 +3752,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)
+ {
+@@ -3748,7 +3811,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);
+ }
+
+
+@@ -5121,6 +5187,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 e68eff8bdbb..81b3a24c2be 100644
+--- a/gcc/fortran/intrinsic.c
++++ b/gcc/fortran/intrinsic.c
+@@ -4467,6 +4467,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 e17fe45f080..b9cdaff2499 100644
+--- a/gcc/fortran/iresolve.c
++++ b/gcc/fortran/iresolve.c
+@@ -817,19 +817,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);
+@@ -1606,14 +1609,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);
+ }
+
+@@ -2106,19 +2112,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);
+@@ -2128,19 +2137,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),
+@@ -2515,9 +2527,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 d886c2f33ed..4ca2f93f2df 100644
+--- a/gcc/fortran/lang.opt
++++ b/gcc/fortran/lang.opt
+@@ -505,6 +505,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 a946c86790a..15079c7e95a 100644
+--- a/gcc/fortran/options.c
++++ b/gcc/fortran/options.c
+@@ -82,6 +82,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 9900572424f..3419e06fec2 100644
+--- a/gcc/fortran/simplify.c
++++ b/gcc/fortran/simplify.c
+@@ -2333,39 +2333,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");
+@@ -4953,6 +4993,76 @@ 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:
+@@ -5912,7 +6022,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;
+
+@@ -5942,16 +6054,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");
+@@ -5964,7 +6084,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;
+
+@@ -5991,28 +6113,36 @@ gfc_simplify_modulo (gfc_expr *a, gfc_expr *p)
+ 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");
+@@ -7578,27 +7708,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..db8dff6c55d
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/dec_kind_promotion-3.f
+@@ -0,0 +1,39 @@
++!{ 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
++ 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 mismatch in argument" }
++ if (iabs(-9_2).ne.9) stop 3 ! { dg-error "type mismatch in 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 mismatch in argument" }
++ if (isign(-77_1, -1).ne.-77) stop 25 ! { dg-error "type mismatch in argument" }
++ if (isign(-77_2, 1).ne.77) stop 26 ! { dg-error "type mismatch in argument" }
++ if (isign(-77_2, -1).ne.-77) stop 27 ! { dg-error "type mismatch in argument" }
++ end program
+--
+2.27.0
+
diff --git a/gcc11-fortran-fdec-sequence.patch b/gcc11-fortran-fdec-sequence.patch
new file mode 100644
index 0000000..cef8b09
--- /dev/null
+++ b/gcc11-fortran-fdec-sequence.patch
@@ -0,0 +1,262 @@
+From bb76446db10c21860a4e19569ce3e350d8a2b59f Mon Sep 17 00:00:00 2001
+From: Mark Eggleston <markeggleston@gcc.gnu.org>
+Date: Fri, 22 Jan 2021 15:00:44 +0000
+Subject: [PATCH 09/10] Add the SEQUENCE attribute by default if it's not
+ present.
+
+Use -fdec-sequence to enable this feature. Also enabled by -fdec.
+---
+ gcc/fortran/lang.opt | 4 ++
+ gcc/fortran/options.c | 1 +
+ gcc/fortran/resolve.c | 13 ++++-
+ ...dd_SEQUENCE_to_COMMON_block_by_default_1.f | 57 +++++++++++++++++++
+ ...dd_SEQUENCE_to_COMMON_block_by_default_2.f | 57 +++++++++++++++++++
+ ...dd_SEQUENCE_to_COMMON_block_by_default_3.f | 57 +++++++++++++++++++
+ 6 files changed, 186 insertions(+), 3 deletions(-)
+ create mode 100644 gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_1.f
+ create mode 100644 gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_2.f
+ create mode 100644 gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_3.f
+
+diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
+index 4ca2f93f2df..019c798cf09 100644
+--- a/gcc/fortran/lang.opt
++++ b/gcc/fortran/lang.opt
+@@ -509,6 +509,10 @@ fdec-promotion
+ Fortran Var(flag_dec_promotion)
+ Add support for type promotion in intrinsic arguments
+
++fdec-sequence
++Fortran Var(flag_dec_sequence)
++Add the SEQUENCE attribute by default if it's not present
++
+ 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 15079c7e95a..050f56fdc25 100644
+--- a/gcc/fortran/options.c
++++ b/gcc/fortran/options.c
+@@ -83,6 +83,7 @@ set_dec_flags (int 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);
++ SET_BITFLAG (flag_dec_sequence, value, value);
+ }
+
+ /* Finalize DEC flags. */
+diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
+index 07dd039f3bf..fe7d0cc5944 100644
+--- a/gcc/fortran/resolve.c
++++ b/gcc/fortran/resolve.c
+@@ -978,9 +978,16 @@ resolve_common_vars (gfc_common_head *common_block, bool named_common)
+
+ if (!(csym->ts.u.derived->attr.sequence
+ || csym->ts.u.derived->attr.is_bind_c))
+- gfc_error_now ("Derived type variable %qs in COMMON at %L "
+- "has neither the SEQUENCE nor the BIND(C) "
+- "attribute", csym->name, &csym->declared_at);
++ {
++ if (flag_dec_sequence)
++ /* Assume sequence. */
++ csym->ts.u.derived->attr.sequence = 1;
++ else
++ gfc_error_now ("Derived type variable '%s' in COMMON at %L "
++ "has neither the SEQUENCE nor the BIND(C) "
++ "attribute", csym->name, &csym->declared_at);
++ }
++
+ 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_1.f b/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_1.f
+new file mode 100644
+index 00000000000..fe7b39625eb
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_1.f
+@@ -0,0 +1,57 @@
++! { dg-do run }
++! { dg-options "-fdec" }
++!
++! Test add default SEQUENCE attribute derived types appearing in
++! COMMON blocks and EQUIVALENCE statements.
++!
++! Contributed by Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
++! Modified by Mark Eggleston <mark.eggleston@codethink.com>
++!
++ MODULE SEQ
++ TYPE STRUCT1
++ INTEGER*4 ID
++ INTEGER*4 TYPE
++ INTEGER*8 DEFVAL
++ CHARACTER*(4) NAME
++ LOGICAL*1 NIL
++ END TYPE STRUCT1
++ END MODULE
++
++ SUBROUTINE A
++ USE SEQ
++ TYPE (STRUCT1) S
++ COMMON /BLOCK1/ S
++ IF (S%ID.NE.5) STOP 1
++ IF (S%TYPE.NE.1000) STOP 2
++ IF (S%DEFVAL.NE.-99) STOP 3
++ IF (S%NAME.NE."JANE") STOP 4
++ IF (S%NIL.NEQV..FALSE.) STOP 5
++ END SUBROUTINE
++
++ PROGRAM sequence_att_common
++ USE SEQ
++ IMPLICIT NONE
++ TYPE (STRUCT1) S1
++ TYPE (STRUCT1) S2
++ TYPE (STRUCT1) S3
++
++ EQUIVALENCE (S1,S2)
++ COMMON /BLOCK1/ S3
++
++ S1%ID = 5
++ S1%TYPE = 1000
++ S1%DEFVAL = -99
++ S1%NAME = "JANE"
++ S1%NIL = .FALSE.
++
++ IF (S2%ID.NE.5) STOP 1
++ IF (S2%TYPE.NE.1000) STOP 2
++ IF (S2%DEFVAL.NE.-99) STOP 3
++ IF (S2%NAME.NE."JANE") STOP 4
++ IF (S2%NIL.NEQV..FALSE.) STOP 5
++
++ S3 = S1
++
++ CALL A
++
++ END
+diff --git a/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_2.f b/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_2.f
+new file mode 100644
+index 00000000000..83512f0f3a2
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_2.f
+@@ -0,0 +1,57 @@
++! { dg-do run }
++! { dg-options "-fdec-sequence" }
++!
++! Test add default SEQUENCE attribute derived types appearing in
++! COMMON blocks and EQUIVALENCE statements.
++!
++! Contributed by Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
++! Modified by Mark Eggleston <mark.eggleston@codethink.com>
++!
++ MODULE SEQ
++ TYPE STRUCT1
++ INTEGER*4 ID
++ INTEGER*4 TYPE
++ INTEGER*8 DEFVAL
++ CHARACTER*(4) NAME
++ LOGICAL*1 NIL
++ END TYPE STRUCT1
++ END MODULE
++
++ SUBROUTINE A
++ USE SEQ
++ TYPE (STRUCT1) S
++ COMMON /BLOCK1/ S
++ IF (S%ID.NE.5) STOP 1
++ IF (S%TYPE.NE.1000) STOP 2
++ IF (S%DEFVAL.NE.-99) STOP 3
++ IF (S%NAME.NE."JANE") STOP 4
++ IF (S%NIL.NEQV..FALSE.) STOP 5
++ END SUBROUTINE
++
++ PROGRAM sequence_att_common
++ USE SEQ
++ IMPLICIT NONE
++ TYPE (STRUCT1) S1
++ TYPE (STRUCT1) S2
++ TYPE (STRUCT1) S3
++
++ EQUIVALENCE (S1,S2)
++ COMMON /BLOCK1/ S3
++
++ S1%ID = 5
++ S1%TYPE = 1000
++ S1%DEFVAL = -99
++ S1%NAME = "JANE"
++ S1%NIL = .FALSE.
++
++ IF (S2%ID.NE.5) STOP 1
++ IF (S2%TYPE.NE.1000) STOP 2
++ IF (S2%DEFVAL.NE.-99) STOP 3
++ IF (S2%NAME.NE."JANE") STOP 4
++ IF (S2%NIL.NEQV..FALSE.) STOP 5
++
++ S3 = S1
++
++ CALL A
++
++ END
+diff --git a/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_3.f b/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_3.f
+new file mode 100644
+index 00000000000..26cd59f9090
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_3.f
+@@ -0,0 +1,57 @@
++! { dg-do compile }
++! { dg-options "-fdec -fno-dec-sequence" }
++!
++! Test add default SEQUENCE attribute derived types appearing in
++! COMMON blocks and EQUIVALENCE statements.
++!
++! Contributed by Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
++! Modified by Mark Eggleston <mark.eggleston@codethink.com>
++!
++ MODULE SEQ
++ TYPE STRUCT1
++ INTEGER*4 ID
++ INTEGER*4 TYPE
++ INTEGER*8 DEFVAL
++ CHARACTER*(4) NAME
++ LOGICAL*1 NIL
++ END TYPE STRUCT1
++ END MODULE
++
++ SUBROUTINE A
++ USE SEQ
++ TYPE (STRUCT1) S ! { dg-error "Derived type variable" }
++ COMMON /BLOCK1/ S
++ IF (S%ID.NE.5) STOP 1
++ IF (S%TYPE.NE.1000) STOP 2
++ IF (S%DEFVAL.NE.-99) STOP 3
++ IF (S%NAME.NE."JANE") STOP 4
++ IF (S%NIL.NEQV..FALSE.) STOP 5
++ END SUBROUTINE
++
++ PROGRAM sequence_att_common
++ USE SEQ
++ IMPLICIT NONE
++ TYPE (STRUCT1) S1
++ TYPE (STRUCT1) S2
++ TYPE (STRUCT1) S3 ! { dg-error "Derived type variable" }
++
++ EQUIVALENCE (S1,S2) ! { dg-error "Derived type variable" }
++ COMMON /BLOCK1/ S3
++
++ S1%ID = 5
++ S1%TYPE = 1000
++ S1%DEFVAL = -99
++ S1%NAME = "JANE"
++ S1%NIL = .FALSE.
++
++ IF (S2%ID.NE.5) STOP 1
++ IF (S2%TYPE.NE.1000) STOP 2
++ IF (S2%DEFVAL.NE.-99) STOP 3
++ IF (S2%NAME.NE."JANE") STOP 4
++ IF (S2%NIL.NEQV..FALSE.) STOP 5
++
++ S3 = S1
++
++ CALL A
++
++ END
+--
+2.27.0
+
diff --git a/gcc11-fortran-flogical-as-integer.patch b/gcc11-fortran-flogical-as-integer.patch
new file mode 100644
index 0000000..41cbf60
--- /dev/null
+++ b/gcc11-fortran-flogical-as-integer.patch
@@ -0,0 +1,305 @@
+From 9b45f3063dfd2b893e7963a4828c1b0afecdc68a Mon Sep 17 00:00:00 2001
+From: Mark Eggleston <markeggleston@gcc.gnu.org>
+Date: Fri, 22 Jan 2021 12:41:46 +0000
+Subject: [PATCH 02/10] 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 -flogical-as-integer flag.
+
+Note: using this feature will disable bitwise logical operations enabled by
+-fdec.
+---
+ gcc/fortran/lang.opt | 4 ++
+ gcc/fortran/resolve.c | 55 ++++++++++++++++++-
+ .../logical_to_integer_and_vice_versa_1.f | 31 +++++++++++
+ .../logical_to_integer_and_vice_versa_2.f | 31 +++++++++++
+ .../logical_to_integer_and_vice_versa_3.f | 33 +++++++++++
+ .../logical_to_integer_and_vice_versa_4.f | 33 +++++++++++
+ 6 files changed, 186 insertions(+), 1 deletion(-)
+ create mode 100644 gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_1.f
+ create mode 100644 gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_2.f
+ create mode 100644 gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_3.f
+ create mode 100644 gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_4.f
+
+diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
+index 52bd522051e..c4da248f07c 100644
+--- a/gcc/fortran/lang.opt
++++ b/gcc/fortran/lang.opt
+@@ -497,6 +497,10 @@ fdec-static
+ Fortran Var(flag_dec_static)
+ Enable DEC-style STATIC and AUTOMATIC attributes.
+
++flogical-as-integer
++Fortran Var(flag_logical_as_integer)
++Convert from integer to logical or logical to integer for arithmetic operations.
++
+ fdefault-double-8
+ Fortran Var(flag_default_double)
+ Set the default double precision kind to an 8 byte wide type.
+diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
+index c075d0fa0c4..4b90cb59902 100644
+--- a/gcc/fortran/resolve.c
++++ b/gcc/fortran/resolve.c
+@@ -3915,7 +3915,6 @@ lookup_uop_fuzzy (const char *op, gfc_symtree *uop)
+ return gfc_closest_fuzzy_match (op, candidates);
+ }
+
+-
+ /* Callback finding an impure function as an operand to an .and. or
+ .or. expression. Remember the last function warned about to
+ avoid double warnings when recursing. */
+@@ -3975,6 +3974,22 @@ convert_hollerith_to_character (gfc_expr *e)
+ }
+ }
+
++/* 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)
++ {
++ /* Convert to LOGICAL */
++ gfc_typespec t;
++ t.type = BT_LOGICAL;
++ t.kind = 1;
++ gfc_convert_type_warn (e, &t, 2, 1);
++ }
++}
++
+ /* Convert to numeric and issue a warning for the conversion. */
+
+ static void
+@@ -3987,6 +4002,22 @@ convert_to_numeric (gfc_expr *a, gfc_expr *b)
+ gfc_convert_type_warn (a, &t, 2, 1);
+ }
+
++/* 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)
++ {
++ /* Convert to INTEGER */
++ gfc_typespec t;
++ t.type = BT_INTEGER;
++ t.kind = 1;
++ gfc_convert_type_warn (e, &t, 2, 1);
++ }
++}
++
+ /* Resolve an operator expression node. This can involve replacing the
+ operation with a user defined function call. */
+
+@@ -4072,6 +4103,12 @@ resolve_operator (gfc_expr *e)
+ case INTRINSIC_TIMES:
+ case INTRINSIC_DIVIDE:
+ case INTRINSIC_POWER:
++ if (flag_logical_as_integer)
++ {
++ convert_logical_to_integer (op1);
++ convert_logical_to_integer (op2);
++ }
++
+ if (gfc_numeric_ts (&op1->ts) && gfc_numeric_ts (&op2->ts))
+ {
+ gfc_type_convert_binary (e, 1);
+@@ -4108,6 +4145,13 @@ resolve_operator (gfc_expr *e)
+ case INTRINSIC_OR:
+ case INTRINSIC_EQV:
+ case INTRINSIC_NEQV:
++
++ if (flag_logical_as_integer)
++ {
++ convert_integer_to_logical (op1);
++ convert_integer_to_logical (op2);
++ }
++
+ if (op1->ts.type == BT_LOGICAL && op2->ts.type == BT_LOGICAL)
+ {
+ e->ts.type = BT_LOGICAL;
+@@ -4158,6 +4202,9 @@ resolve_operator (gfc_expr *e)
+ goto simplify_op;
+ }
+
++ if (flag_logical_as_integer)
++ convert_integer_to_logical (op1);
++
+ if (op1->ts.type == BT_LOGICAL)
+ {
+ e->ts.type = BT_LOGICAL;
+@@ -4198,6 +4245,12 @@ resolve_operator (gfc_expr *e)
+ convert_hollerith_to_character (op2);
+ }
+
++ if (flag_logical_as_integer)
++ {
++ convert_logical_to_integer (op1);
++ convert_logical_to_integer (op2);
++ }
++
+ if (op1->ts.type == BT_CHARACTER && op2->ts.type == BT_CHARACTER
+ && op1->ts.kind == op2->ts.kind)
+ {
+diff --git a/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_1.f b/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_1.f
+new file mode 100644
+index 00000000000..938a91d9e9a
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_1.f
+@@ -0,0 +1,31 @@
++! { dg-do run }
++! { dg-options "-std=legacy -flogical-as-integer" }
++!
++! Test conversion between logical and integer for logical operators
++!
++! Test case contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
++! Modified for -flogical-as-integer by Mark Eggleston
++! <mark.eggleston@codethink.com>
++!
++ PROGRAM logical_integer_conversion
++ LOGICAL lpos /.true./
++ INTEGER ineg/0/
++ INTEGER ires
++ LOGICAL lres
++
++ ! Test Logicals converted to Integers
++ if ((lpos.AND.ineg).EQ.1) STOP 3
++ if ((ineg.AND.lpos).NE.0) STOP 4
++ ires = (.true..AND.0)
++ if (ires.NE.0) STOP 5
++ ires = (1.AND..false.)
++ if (ires.EQ.1) STOP 6
++
++ ! Test Integers converted to Logicals
++ if (lpos.EQ.ineg) STOP 7
++ if (ineg.EQ.lpos) STOP 8
++ lres = (.true..EQ.0)
++ if (lres) STOP 9
++ lres = (1.EQ..false.)
++ if (lres) STOP 10
++ END
+diff --git a/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_2.f b/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_2.f
+new file mode 100644
+index 00000000000..9f146202ba5
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_2.f
+@@ -0,0 +1,31 @@
++! { dg-do compile }
++! { dg-options "-std=legacy -flogical-as-integer -fno-logical-as-integer" }
++!
++! Based on logical_to_integer_and_vice_versa_1.f but with option disabled
++! to test for error messages.
++!
++! Test case contributed by by Mark Eggleston <mark.eggleston@codethink.com>
++!
++!
++ 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 ! { dg-error "Operands of logical operator" }
++ if ((ineg.AND.lpos).NE.0) STOP 4 ! { dg-error "Operands of logical operator" }
++ ires = (.true..AND.0) ! { dg-error "Operands of logical operator" }
++ if (ires.NE.0) STOP 5
++ ires = (1.AND..false.) ! { dg-error "Operands of logical operator" }
++ if (ires.EQ.1) STOP 6
++
++ ! Test Integers converted to Logicals
++ if (lpos.EQ.ineg) STOP 7 ! { dg-error "Operands of comparison operator" }
++ if (ineg.EQ.lpos) STOP 8 ! { dg-error "Operands of comparison operator" }
++ lres = (.true..EQ.0) ! { dg-error "Operands of comparison operator" }
++ if (lres) STOP 9
++ lres = (1.EQ..false.) ! { dg-error "Operands of comparison operator" }
++ if (lres) STOP 10
++ END
+diff --git a/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_3.f b/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_3.f
+new file mode 100644
+index 00000000000..446873eb2dc
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_3.f
+@@ -0,0 +1,33 @@
++! { dg-do compile }
++! { dg-options "-std=legacy -flogical-as-integer" }
++!
++! Test conversion between logical and integer for logical operators
++!
++ program test
++ logical f /.false./
++ logical t /.true./
++ real x
++
++ x = 7.7
++ x = x + t*3.0
++ if (abs(x - 10.7).gt.0.00001) stop 1
++ x = x + .false.*5.0
++ if (abs(x - 10.7).gt.0.00001) stop 2
++ x = x - .true.*5.0
++ if (abs(x - 5.7).gt.0.00001) stop 3
++ x = x + t
++ if (abs(x - 6.7).gt.0.00001) stop 4
++ x = x + f
++ if (abs(x - 6.7).gt.0.00001) stop 5
++ x = x - t
++ if (abs(x - 5.7).gt.0.00001) stop 6
++ x = x - f
++ if (abs(x - 5.7).gt.0.00001) stop 7
++ x = x**.true.
++ if (abs(x - 5.7).gt.0.00001) stop 8
++ x = x**.false.
++ if (abs(x - 1.0).gt.0.00001) stop 9
++ x = x/t
++ if (abs(x - 1.0).gt.0.00001) stop 10
++ if ((x/.false.).le.huge(x)) stop 11
++ end
+diff --git a/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_4.f b/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_4.f
+new file mode 100644
+index 00000000000..4301a4988d8
+--- /dev/null
++++ b/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_4.f
+@@ -0,0 +1,33 @@
++! { dg-do compile }
++! { dg-options "-std=legacy -flogical-as-integer -fno-logical-as-integer" }
++!
++! Test conversion between logical and integer for logical operators
++!
++ program test
++ logical f /.false./
++ logical t /.true./
++ real x
++
++ x = 7.7
++ x = x + t*3.0 ! { dg-error "Operands of binary numeric" }
++ if (abs(x - 10.7).gt.0.00001) stop 1
++ x = x + .false.*5.0 ! { dg-error "Operands of binary numeric" }
++ if (abs(x - 10.7).gt.0.00001) stop 2
++ x = x - .true.*5.0 ! { dg-error "Operands of binary numeric" }
++ if (abs(x - 5.7).gt.0.00001) stop 3
++ x = x + t ! { dg-error "Operands of binary numeric" }
++ if (abs(x - 6.7).gt.0.00001) stop 4
++ x = x + f ! { dg-error "Operands of binary numeric" }
++ if (abs(x - 6.7).gt.0.00001) stop 5
++ x = x - t ! { dg-error "Operands of binary numeric" }
++ if (abs(x - 5.7).gt.0.00001) stop 6
++ x = x - f ! { dg-error "Operands of binary numeric" }
++ if (abs(x - 5.7).gt.0.00001) stop 7
++ x = x**.true. ! { dg-error "Operands of binary numeric" }
++ if (abs(x - 5.7).gt.0.00001) stop 8
++ x = x**.false. ! { dg-error "Operands of binary numeric" }
++ if (abs(x - 1.0).gt.0.00001) stop 9
++ x = x/t ! { dg-error "Operands of binary numeric" }
++ if (abs(x - 1.0).gt.0.00001) stop 10
++ if ((x/.false.).le.huge(x)) stop 11 ! { dg-error "Operands of binary numeric" }
++ end
+--
+2.27.0
+
^ permalink raw reply related [flat|nested] only message in thread
only message in thread, other threads:[~2026-06-29 12:29 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2026-06-29 12:29 [rpms/gcc] rhel-f41-base: Add RHEL Fortran patchset Jakub Jelinek
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox