public inbox for git-commits@fedoraproject.org
help / color / mirror / Atom feed
From: Jakub Jelinek <jakub@redhat.com>
To: git-commits@fedoraproject.org
Subject: [rpms/gcc] rhel-f41-base: Fix up RHEL/ELN Fortran patches.
Date: Mon, 29 Jun 2026 12:29:51 GMT [thread overview]
Message-ID: <178273619187.1.2951293320009148846.rpms-gcc-91b35405493f@fedoraproject.org> (raw)
A new commit has been pushed.
Repo : rpms/gcc
Branch : rhel-f41-base
Commit : 91b35405493f90d5d176b3e237e2f3e1c3ff4746
Author : Jakub Jelinek <jakub@redhat.com>
Date : 2022-07-04T15:37:15+02:00
Stats : +9/-2966 in 7 file(s)
URL : https://src.fedoraproject.org/rpms/gcc/c/91b35405493f90d5d176b3e237e2f3e1c3ff4746?branch=rhel-f41-base
Log:
Fix up RHEL/ELN Fortran patches.
---
diff --git a/gcc12-fortran-fdec-add-missing-indexes.patch b/gcc12-fortran-fdec-add-missing-indexes.patch
deleted file mode 100644
index 529868f..0000000
--- a/gcc12-fortran-fdec-add-missing-indexes.patch
+++ /dev/null
@@ -1,181 +0,0 @@
-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.cc | 1 +
- gcc/fortran/resolve.cc | 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.cc b/gcc/fortran/options.cc
-index 050f56fdc25..c3b2822685d 100644
---- a/gcc/fortran/options.cc
-+++ b/gcc/fortran/options.cc
-@@ -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.cc b/gcc/fortran/resolve.cc
-index fe7d0cc5944..0efeedab46e 100644
---- a/gcc/fortran/resolve.cc
-+++ b/gcc/fortran/resolve.cc
-@@ -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/gcc12-fortran-fdec-ichar.patch b/gcc12-fortran-fdec-ichar.patch
deleted file mode 100644
index 900b054..0000000
--- a/gcc12-fortran-fdec-ichar.patch
+++ /dev/null
@@ -1,78 +0,0 @@
-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.cc | 2 +-
- gcc/fortran/simplify.cc | 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.cc b/gcc/fortran/check.cc
-index 82db8e4e1b2..623c1cc470e 100644
---- a/gcc/fortran/check.cc
-+++ b/gcc/fortran/check.cc
-@@ -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.cc b/gcc/fortran/simplify.cc
-index 23317a2e2d9..9900572424f 100644
---- a/gcc/fortran/simplify.cc
-+++ b/gcc/fortran/simplify.cc
-@@ -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/gcc12-fortran-fdec-non-integer-index.patch b/gcc12-fortran-fdec-non-integer-index.patch
deleted file mode 100644
index 2c168fe..0000000
--- a/gcc12-fortran-fdec-non-integer-index.patch
+++ /dev/null
@@ -1,158 +0,0 @@
-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.cc | 1 +
- gcc/fortran/resolve.cc | 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.cc b/gcc/fortran/options.cc
-index f19ba87f8a0..9a042f64881 100644
---- a/gcc/fortran/options.cc
-+++ b/gcc/fortran/options.cc
-@@ -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.cc b/gcc/fortran/resolve.cc
-index 4b90cb59902..bc0df0fdb99 100644
---- a/gcc/fortran/resolve.cc
-+++ b/gcc/fortran/resolve.cc
-@@ -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/gcc12-fortran-fdec-old-init.patch b/gcc12-fortran-fdec-old-init.patch
deleted file mode 100644
index d5661c8..0000000
--- a/gcc12-fortran-fdec-old-init.patch
+++ /dev/null
@@ -1,185 +0,0 @@
-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.cc | 27 +++++++++++++++----
- gcc/fortran/lang.opt | 4 +++
- gcc/fortran/options.cc | 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.cc b/gcc/fortran/decl.cc
-index 723915822f3..5c8c1b7981b 100644
---- a/gcc/fortran/decl.cc
-+++ b/gcc/fortran/decl.cc
-@@ -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.cc b/gcc/fortran/options.cc
-index 9a042f64881..d6bd36c3a8a 100644
---- a/gcc/fortran/options.cc
-+++ b/gcc/fortran/options.cc
-@@ -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/gcc12-fortran-fdec-override-kind.patch b/gcc12-fortran-fdec-override-kind.patch
index 4df6ead..370fa56 100644
--- a/gcc12-fortran-fdec-override-kind.patch
+++ b/gcc12-fortran-fdec-override-kind.patch
@@ -281,25 +281,25 @@ 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.
+@@ -502,6 +502,10 @@ fdec-math
+ Fortran Var(flag_dec_math)
+ Enable legacy math intrinsics for compatibility.
+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.
+ fdec-structure
+ Fortran Var(flag_dec_structure)
+ Enable support for DEC STRUCTURE/RECORD.
diff --git a/gcc/fortran/options.cc b/gcc/fortran/options.cc
index d6bd36c3a8a..edbab483b36 100644
--- a/gcc/fortran/options.cc
+++ b/gcc/fortran/options.cc
-@@ -80,6 +80,7 @@ set_dec_flags (int value)
+@@ -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);
- SET_BITFLAG (flag_dec_old_init, value, value);
+ SET_BITFLAG (flag_dec_override_kind, value, value);
}
diff --git a/gcc12-fortran-fdec-promotion.patch b/gcc12-fortran-fdec-promotion.patch
deleted file mode 100644
index 870d62a..0000000
--- a/gcc12-fortran-fdec-promotion.patch
+++ /dev/null
@@ -1,2093 +0,0 @@
-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.cc | 71 +++++-
- gcc/fortran/intrinsic.cc | 5 +
- gcc/fortran/iresolve.cc | 91 ++++---
- gcc/fortran/lang.opt | 4 +
- gcc/fortran/options.cc | 1 +
- gcc/fortran/simplify.cc | 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.cc b/gcc/fortran/check.cc
-index 623c1cc470e..e20a834a860 100644
---- a/gcc/fortran/check.cc
-+++ b/gcc/fortran/check.cc
-@@ -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.cc b/gcc/fortran/intrinsic.cc
-index e68eff8bdbb..81b3a24c2be 100644
---- a/gcc/fortran/intrinsic.cc
-+++ b/gcc/fortran/intrinsic.cc
-@@ -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.cc b/gcc/fortran/iresolve.cc
-index e17fe45f080..b9cdaff2499 100644
---- a/gcc/fortran/iresolve.cc
-+++ b/gcc/fortran/iresolve.cc
-@@ -834,19 +834,22 @@ gfc_resolve_dble (gfc_expr *f, gfc_expr
- void
- gfc_resolve_dim (gfc_expr *f, gfc_expr *a, gfc_expr *p)
- {
-- f->ts.type = a->ts.type;
- if (p != NULL)
-- f->ts.kind = gfc_kind_max (a,p);
-- else
-- f->ts.kind = a->ts.kind;
--
-- if (p != NULL && a->ts.kind != p->ts.kind)
- {
-- if (a->ts.kind == gfc_kind_max (a,p))
-- gfc_convert_type (p, &a->ts, 2);
-+ f->ts.kind = gfc_kind_max (a,p);
-+ if (a->ts.type == BT_REAL || p->ts.type == BT_REAL)
-+ f->ts.type = BT_REAL;
- else
-- gfc_convert_type (a, &p->ts, 2);
-+ f->ts.type = BT_INTEGER;
-+
-+ if (a->ts.kind != f->ts.kind || a->ts.type != f->ts.type)
-+ gfc_convert_type (a, &f->ts, 2);
-+
-+ if (p->ts.kind != f->ts.kind || p->ts.type != f->ts.type)
-+ gfc_convert_type (p, &f->ts, 2);
- }
-+ else
-+ f->ts = a->ts;
-
- f->value.function.name
- = gfc_get_string ("__dim_%c%d", gfc_type_letter (f->ts.type),
-@@ -1622,14 +1625,17 @@ gfc_resolve_minmax (const char *name, gf
- /* Find the largest type kind. */
- for (a = args->next; a; a = a->next)
- {
-+ if (a->expr-> ts.type == BT_REAL)
-+ f->ts.type = BT_REAL;
-+
- if (a->expr->ts.kind > f->ts.kind)
- f->ts.kind = a->expr->ts.kind;
- }
-
-- /* Convert all parameters to the required kind. */
-+ /* Convert all parameters to the required type and/or kind. */
- for (a = args; a; a = a->next)
- {
-- if (a->expr->ts.kind != f->ts.kind)
-+ if (a->expr->ts.type != f->ts.type || a->expr->ts.kind != f->ts.kind)
- gfc_convert_type (a->expr, &f->ts, 2);
- }
-
-@@ -2130,19 +2136,22 @@ gfc_resolve_minval (gfc_expr *f, gfc_exp
- void
- gfc_resolve_mod (gfc_expr *f, gfc_expr *a, gfc_expr *p)
- {
-- f->ts.type = a->ts.type;
- if (p != NULL)
-- f->ts.kind = gfc_kind_max (a,p);
-- else
-- f->ts.kind = a->ts.kind;
--
-- if (p != NULL && a->ts.kind != p->ts.kind)
- {
-- if (a->ts.kind == gfc_kind_max (a,p))
-- gfc_convert_type (p, &a->ts, 2);
-+ f->ts.kind = gfc_kind_max (a,p);
-+ if (a->ts.type == BT_REAL || p->ts.type == BT_REAL)
-+ f->ts.type = BT_REAL;
- else
-- gfc_convert_type (a, &p->ts, 2);
-+ f->ts.type = BT_INTEGER;
-+
-+ if (a->ts.kind != f->ts.kind || a->ts.type != f->ts.type)
-+ gfc_convert_type (a, &f->ts, 2);
-+
-+ if (p->ts.kind != f->ts.kind || p->ts.type != f->ts.type)
-+ gfc_convert_type (p, &f->ts, 2);
- }
-+ else
-+ f->ts = a->ts;
-
- f->value.function.name
- = gfc_get_string ("__mod_%c%d", gfc_type_letter (f->ts.type),
-@@ -2153,19 +2162,22 @@ gfc_resolve_mod (gfc_expr *f, gfc_expr *
- void
- gfc_resolve_modulo (gfc_expr *f, gfc_expr *a, gfc_expr *p)
- {
-- f->ts.type = a->ts.type;
- if (p != NULL)
-- f->ts.kind = gfc_kind_max (a,p);
-- else
-- f->ts.kind = a->ts.kind;
--
-- if (p != NULL && a->ts.kind != p->ts.kind)
- {
-- if (a->ts.kind == gfc_kind_max (a,p))
-- gfc_convert_type (p, &a->ts, 2);
-+ f->ts.kind = gfc_kind_max (a,p);
-+ if (a->ts.type == BT_REAL || p->ts.type == BT_REAL)
-+ f->ts.type = BT_REAL;
- else
-- gfc_convert_type (a, &p->ts, 2);
-+ f->ts.type = BT_INTEGER;
-+
-+ if (a->ts.kind != f->ts.kind || a->ts.type != f->ts.type)
-+ gfc_convert_type (a, &f->ts, 2);
-+
-+ if (p->ts.kind != f->ts.kind || p->ts.type != f->ts.type)
-+ gfc_convert_type (p, &f->ts, 2);
- }
-+ else
-+ f->ts = a->ts;
-
- f->value.function.name
- = gfc_get_string ("__modulo_%c%d", gfc_type_letter (f->ts.type),
-@@ -2543,9 +2555,26 @@ gfc_resolve_shift (gfc_expr *f, gfc_expr
-
-
- void
--gfc_resolve_sign (gfc_expr *f, gfc_expr *a, gfc_expr *b ATTRIBUTE_UNUSED)
-+gfc_resolve_sign (gfc_expr *f, gfc_expr *a, gfc_expr *b)
- {
-- f->ts = a->ts;
-+ if (b != NULL)
-+ {
-+ f->ts.kind = gfc_kind_max (a, b);
-+ if (a->ts.type == BT_REAL || b->ts.type == BT_REAL)
-+ f->ts.type = BT_REAL;
-+ else
-+ f->ts.type = BT_INTEGER;
-+
-+ if (a->ts.kind != f->ts.kind || a->ts.type != f->ts.type)
-+ gfc_convert_type (a, &f->ts, 2);
-+
-+ if (b->ts.kind != f->ts.kind || b->ts.type != f->ts.type)
-+ gfc_convert_type (b, &f->ts, 2);
-+ }
-+ else
-+ {
-+ f->ts = a->ts;
-+ }
- f->value.function.name
- = gfc_get_string ("__sign_%c%d", gfc_type_letter (a->ts.type),
- gfc_type_abi_kind (&a->ts));
-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.cc b/gcc/fortran/options.cc
-index a946c86790a..15079c7e95a 100644
---- a/gcc/fortran/options.cc
-+++ b/gcc/fortran/options.cc
-@@ -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.cc b/gcc/fortran/simplify.cc
-index 9900572424f..3419e06fec2 100644
---- a/gcc/fortran/simplify.cc
-+++ b/gcc/fortran/simplify.cc
-@@ -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/gcc12-fortran-fdec-sequence.patch b/gcc12-fortran-fdec-sequence.patch
deleted file mode 100644
index d79348e..0000000
--- a/gcc12-fortran-fdec-sequence.patch
+++ /dev/null
@@ -1,262 +0,0 @@
-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.cc | 1 +
- gcc/fortran/resolve.cc | 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.cc b/gcc/fortran/options.cc
-index 15079c7e95a..050f56fdc25 100644
---- a/gcc/fortran/options.cc
-+++ b/gcc/fortran/options.cc
-@@ -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.cc b/gcc/fortran/resolve.cc
-index 07dd039f3bf..fe7d0cc5944 100644
---- a/gcc/fortran/resolve.cc
-+++ b/gcc/fortran/resolve.cc
-@@ -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
-
reply other threads:[~2026-06-29 12:29 UTC|newest]
Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=178273619187.1.2951293320009148846.rpms-gcc-91b35405493f@fedoraproject.org \
--to=jakub@redhat.com \
--cc=git-commits@fedoraproject.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox