import gcc-toolset-10-gcc-10.2.1-8.2.el8

This commit is contained in:
CentOS Sources 2021-05-18 02:46:31 -04:00 committed by Andrew Lukoshko
parent c2df8d99d8
commit ebf9ed518d
23 changed files with 407 additions and 3194 deletions

View File

@ -1,5 +1,5 @@
7f4348418dc3efefd357b32a2b5c8010211ab284 SOURCES/doxygen-1.8.0.src.tar.gz
19a2803c35999e08af82cdbfc7e7502ad2fe7b59 SOURCES/gcc-10.2.1-20200804.tar.xz
08872639b847a6d34583cb46508d58f1abf0220d SOURCES/gcc-10.2.1-20201112.tar.xz
c5a2b201bf05229647e73203c0bf2d9679d4d21f SOURCES/isl-0.16.1.tar.bz2
5ef03ca7aee134fe7dfecb6c9d048799f0810278 SOURCES/mpc-0.8.1.tar.gz
6ec33952e824e837fef0e829c93d39d6a507082f SOURCES/newlib-cygwin-50e2a63b04bdd018484605fbb954fd1bd5147fa0.tar.xz

2
.gitignore vendored
View File

@ -1,5 +1,5 @@
SOURCES/doxygen-1.8.0.src.tar.gz
SOURCES/gcc-10.2.1-20200804.tar.xz
SOURCES/gcc-10.2.1-20201112.tar.xz
SOURCES/isl-0.16.1.tar.bz2
SOURCES/mpc-0.8.1.tar.gz
SOURCES/newlib-cygwin-50e2a63b04bdd018484605fbb954fd1bd5147fa0.tar.xz

View File

@ -1,7 +1,7 @@
From dd2c3c5e8e8370d6e08a87b7122b8fbe4ddf7dde Mon Sep 17 00:00:00 2001
From: Mark Doffman <mark.doffman@codethink.co.uk>
Date: Tue, 23 Jun 2015 22:59:08 +0000
Subject: [PATCH 02/16] Allow duplicate declarations.
From 1926e1725a6cfba844e72dd3aed83b9aa3eb09dd Mon Sep 17 00:00:00 2001
From: Mark Eggleston <markeggleston@gcc.gnu.org>
Date: Mon, 3 Feb 2020 08:32:04 +0000
Subject: [PATCH 01/10] Allow duplicate declarations.
Enabled by -fdec-duplicates and -fdec.
@ -10,14 +10,14 @@ Addition of -fdec-duplicates by Mark Eggleston <mark.eggleston@codethink.com>
---
gcc/fortran/lang.opt | 4 ++++
gcc/fortran/options.c | 1 +
gcc/fortran/symbol.c | 23 ++++++++++++++++++++---
gcc/fortran/symbol.c | 21 +++++++++++++++++++--
gcc/testsuite/gfortran.dg/duplicate_type_4.f90 | 13 +++++++++++++
gcc/testsuite/gfortran.dg/duplicate_type_5.f90 | 13 +++++++++++++
gcc/testsuite/gfortran.dg/duplicate_type_6.f90 | 13 +++++++++++++
gcc/testsuite/gfortran.dg/duplicate_type_7.f90 | 13 +++++++++++++
gcc/testsuite/gfortran.dg/duplicate_type_8.f90 | 12 ++++++++++++
gcc/testsuite/gfortran.dg/duplicate_type_9.f90 | 12 ++++++++++++
9 files changed, 101 insertions(+), 3 deletions(-)
9 files changed, 100 insertions(+), 2 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/duplicate_type_4.f90
create mode 100644 gcc/testsuite/gfortran.dg/duplicate_type_5.f90
create mode 100644 gcc/testsuite/gfortran.dg/duplicate_type_6.f90
@ -26,12 +26,12 @@ Addition of -fdec-duplicates by Mark Eggleston <mark.eggleston@codethink.com>
create mode 100644 gcc/testsuite/gfortran.dg/duplicate_type_9.f90
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 26e82601b62..491d81ccaa5 100644
index da4b1aa879a..6275dc3deff 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -440,6 +440,10 @@ fdec
Fortran Var(flag_dec)
Enable all DEC language extensions.
@@ -465,6 +465,10 @@ Fortran Var(flag_dec_char_conversions)
Enable the use of character literals in assignments and data statements
for non-character variables.
+fdec-duplicates
+Fortran Var(flag_dec_duplicates)
@ -41,19 +41,19 @@ index 26e82601b62..491d81ccaa5 100644
Fortran Var(flag_dec_include)
Enable legacy parsing of INCLUDE as statement.
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index 4f91486e977..f93db8b6d7c 100644
index 4cc8a908417..75181ca6442 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -75,6 +75,7 @@ set_dec_flags (int value)
SET_BITFLAG (flag_dec_math, value, value);
SET_BITFLAG (flag_dec_include, value, value);
@@ -77,6 +77,7 @@ set_dec_flags (int value)
SET_BITFLAG (flag_dec_format_defaults, value, value);
SET_BITFLAG (flag_dec_blank_format_item, value, value);
SET_BITFLAG (flag_dec_char_conversions, value, value);
+ SET_BITFLAG (flag_dec_duplicates, value, value);
}
/* Finalize DEC flags. */
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index ec753229a98..4247b5b60c8 100644
index 96e4cee3040..92f2ce21cca 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -1995,6 +1995,8 @@ gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where)
@ -65,10 +65,10 @@ index ec753229a98..4247b5b60c8 100644
if (type != BT_UNKNOWN && !(sym->attr.function && sym->attr.implicit_type)
&& !(gfc_state_stack->previous && gfc_state_stack->previous->previous
&& gfc_state_stack->previous->previous->state == COMP_SUBMODULE)
@@ -2004,9 +2006,26 @@ gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where)
gfc_error ("Symbol %qs at %L conflicts with symbol from module %qs, "
"use-associated at %L", sym->name, where, sym->module,
&sym->declared_at);
@@ -2007,6 +2009,23 @@ gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where)
else if (sym->attr.function && sym->attr.result)
gfc_error ("Symbol %qs at %L already has basic type of %s",
sym->ns->proc_name->name, where, gfc_basic_typename (type));
+ else if (flag_dec_duplicates)
+ {
+ /* Ignore temporaries and class/procedure names */
@ -88,12 +88,8 @@ index ec753229a98..4247b5b60c8 100644
+ }
else
gfc_error ("Symbol %qs at %L already has basic type of %s", sym->name,
- where, gfc_basic_typename (type));
+ where, gfc_basic_typename (type));
return false;
}
@@ -2017,8 +2036,6 @@ gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where)
where, gfc_basic_typename (type));
@@ -2020,8 +2039,6 @@ gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where)
return false;
}

View File

@ -1,873 +0,0 @@
From f3e3034684c7ac44a14c70d6a248d8acee303176 Mon Sep 17 00:00:00 2001
From: law <law@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Thu, 10 May 2018 11:48:34 +0100
Subject: [PATCH 01/16] Default widths for i, f and g format specifiers in
format strings.
Enabled using -fdec.
The behaviour is modelled on the Oracle Fortran compiler. At the time
of writing, the details were available at this URL:
https://docs.oracle.com/cd/E19957-01/805-4939/6j4m0vnc3/index.html#z4000743746d
Addition by Mark Eggleston <mark.eggleston@codethink.com>:
Use -fdec-format-defaults to enable this feature. Also enabled using -fdec.
---
gcc/fortran/io.c | 31 +++++++++++--
gcc/fortran/lang.opt | 4 ++
gcc/fortran/options.c | 1 +
.../gfortran.dg/fmt_f_default_field_width_1.f90 | 43 ++++++++++++++++++
.../gfortran.dg/fmt_f_default_field_width_2.f90 | 46 +++++++++++++++++++
.../gfortran.dg/fmt_f_default_field_width_3.f90 | 28 ++++++++++++
.../gfortran.dg/fmt_g_default_field_width_1.f90 | 48 ++++++++++++++++++++
.../gfortran.dg/fmt_g_default_field_width_2.f90 | 52 ++++++++++++++++++++++
.../gfortran.dg/fmt_g_default_field_width_3.f90 | 31 +++++++++++++
.../gfortran.dg/fmt_i_default_field_width_1.f90 | 38 ++++++++++++++++
.../gfortran.dg/fmt_i_default_field_width_2.f90 | 42 +++++++++++++++++
.../gfortran.dg/fmt_i_default_field_width_3.f90 | 35 +++++++++++++++
libgfortran/io/format.c | 35 +++++++++++++++
libgfortran/io/io.h | 50 +++++++++++++++++++++
libgfortran/io/read.c | 6 +++
libgfortran/io/write.c | 22 +++++----
libgfortran/io/write_float.def | 37 ++++++++++++---
17 files changed, 531 insertions(+), 18 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/fmt_f_default_field_width_1.f90
create mode 100644 gcc/testsuite/gfortran.dg/fmt_f_default_field_width_2.f90
create mode 100644 gcc/testsuite/gfortran.dg/fmt_f_default_field_width_3.f90
create mode 100644 gcc/testsuite/gfortran.dg/fmt_g_default_field_width_1.f90
create mode 100644 gcc/testsuite/gfortran.dg/fmt_g_default_field_width_2.f90
create mode 100644 gcc/testsuite/gfortran.dg/fmt_g_default_field_width_3.f90
create mode 100644 gcc/testsuite/gfortran.dg/fmt_i_default_field_width_1.f90
create mode 100644 gcc/testsuite/gfortran.dg/fmt_i_default_field_width_2.f90
create mode 100644 gcc/testsuite/gfortran.dg/fmt_i_default_field_width_3.f90
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index 9828897852a..57117579627 100644
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -903,6 +903,13 @@ data_desc:
if (u != FMT_POSINT)
{
+ if (flag_dec_format_defaults)
+ {
+ /* Assume a default width based on the variable size. */
+ saved_token = u;
+ break;
+ }
+
format_locus.nextc += format_string_pos;
gfc_error ("Positive width required in format "
"specifier %s at %L", token_to_string (t),
@@ -1027,6 +1034,13 @@ data_desc:
goto fail;
if (t != FMT_ZERO && t != FMT_POSINT)
{
+ if (flag_dec_format_defaults)
+ {
+ /* Assume the default width is expected here and continue lexing. */
+ value = 0; /* It doesn't matter what we set the value to here. */
+ saved_token = t;
+ break;
+ }
error = nonneg_required;
goto syntax;
}
@@ -1096,8 +1110,17 @@ data_desc:
goto fail;
if (t != FMT_ZERO && t != FMT_POSINT)
{
- error = nonneg_required;
- goto syntax;
+ if (flag_dec_format_defaults)
+ {
+ /* Assume the default width is expected here and continue lexing. */
+ value = 0; /* It doesn't matter what we set the value to here. */
+ saved_token = t;
+ }
+ else
+ {
+ error = nonneg_required;
+ goto syntax;
+ }
}
else if (is_input && t == FMT_ZERO)
{
@@ -4368,8 +4391,8 @@ get_io_list:
}
/* See if we want to use defaults for missing exponents in real transfers
- and other DEC runtime extensions. */
- if (flag_dec)
+ and other DEC runtime extensions. */
+ if (flag_dec_format_defaults)
dt->dec_ext = 1;
/* A full IO statement has been matched. Check the constraints. spec_end is
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 9151d02c491..26e82601b62 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -444,6 +444,10 @@ fdec-include
Fortran Var(flag_dec_include)
Enable legacy parsing of INCLUDE as statement.
+fdec-format-defaults
+Fortran Var(flag_dec_format_defaults)
+Enable default widths for i, f and g format specifiers.
+
fdec-intrinsic-ints
Fortran Var(flag_dec_intrinsic_ints)
Enable kind-specific variants of integer intrinsic functions.
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index 02970d59066..4f91486e977 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -74,6 +74,7 @@ set_dec_flags (int value)
SET_BITFLAG (flag_dec_static, value, value);
SET_BITFLAG (flag_dec_math, value, value);
SET_BITFLAG (flag_dec_include, value, value);
+ SET_BITFLAG (flag_dec_format_defaults, value, value);
}
/* Finalize DEC flags. */
diff --git a/gcc/testsuite/gfortran.dg/fmt_f_default_field_width_1.f90 b/gcc/testsuite/gfortran.dg/fmt_f_default_field_width_1.f90
new file mode 100644
index 00000000000..49c77155761
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_f_default_field_width_1.f90
@@ -0,0 +1,43 @@
+! { dg-do run }
+! { dg-options -fdec }
+!
+! Test case for the default field widths enabled by the -fdec-format-defaults flag.
+!
+! This feature is not part of any Fortran standard, but it is supported by the
+! Oracle Fortran compiler and others.
+!
+! libgfortran uses printf() internally to implement FORMAT. If you print float
+! values to a higher precision than the type can actually store, the results
+! are implementation dependent: some platforms print zeros, others print random
+! numbers. Don't depend on this behaviour in tests because they will not be
+! portable.
+
+ character(50) :: buffer
+
+ real*4 :: real_4
+ real*8 :: real_8
+ real*16 :: real_16
+ integer :: len
+
+ real_4 = 4.18
+ write(buffer, '(A, F, A)') ':',real_4,':'
+ print *,buffer
+ if (buffer.ne.": 4.1799998:") stop 1
+
+ real_4 = 0.00000018
+ write(buffer, '(A, F, A)') ':',real_4,':'
+ print *,buffer
+ if (buffer.ne.": 0.0000002:") stop 2
+
+ real_8 = 4.18
+ write(buffer, '(A, F, A)') ':',real_8,':'
+ print *,buffer
+ len = len_trim(buffer)
+ if (len /= 27) stop 3
+
+ real_16 = 4.18
+ write(buffer, '(A, F, A)') ':',real_16,':'
+ print *,buffer
+ len = len_trim(buffer)
+ if (len /= 44) stop 4
+end
diff --git a/gcc/testsuite/gfortran.dg/fmt_f_default_field_width_2.f90 b/gcc/testsuite/gfortran.dg/fmt_f_default_field_width_2.f90
new file mode 100644
index 00000000000..1c2ec0413a7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_f_default_field_width_2.f90
@@ -0,0 +1,46 @@
+! { dg-do run }
+! { dg-options -fdec-format-defaults }
+!
+! Test case for the default field widths enabled by the -fdec-format-defaults flag.
+!
+! This feature is not part of any Fortran standard, but it is supported by the
+! Oracle Fortran compiler and others.
+!
+! libgfortran uses printf() internally to implement FORMAT. If you print float
+! values to a higher precision than the type can actually store, the results
+! are implementation dependent: some platforms print zeros, others print random
+! numbers. Don't depend on this behaviour in tests because they will not be
+! portable.
+!
+! Test case added by Mark Eggleston <mark.eggleston@codethink.com> to check
+! use of -fdec-format-defaults
+!
+ character(50) :: buffer
+
+ real*4 :: real_4
+ real*8 :: real_8
+ real*16 :: real_16
+ integer :: len
+
+ real_4 = 4.18
+ write(buffer, '(A, F, A)') ':',real_4,':'
+ print *,buffer
+ if (buffer.ne.": 4.1799998:") stop 1
+
+ real_4 = 0.00000018
+ write(buffer, '(A, F, A)') ':',real_4,':'
+ print *,buffer
+ if (buffer.ne.": 0.0000002:") stop 2
+
+ real_8 = 4.18
+ write(buffer, '(A, F, A)') ':',real_8,':'
+ print *,buffer
+ len = len_trim(buffer)
+ if (len /= 27) stop 3
+
+ real_16 = 4.18
+ write(buffer, '(A, F, A)') ':',real_16,':'
+ print *,buffer
+ len = len_trim(buffer)
+ if (len /= 44) stop 4
+end
diff --git a/gcc/testsuite/gfortran.dg/fmt_f_default_field_width_3.f90 b/gcc/testsuite/gfortran.dg/fmt_f_default_field_width_3.f90
new file mode 100644
index 00000000000..e513063189b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_f_default_field_width_3.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+! { dg-options "-fdec -fno-dec-format-defaults" }
+!
+! Test case for the default field widths not enabled.
+!
+! Test case added by Mark Eggleston <mark.eggleston@codethink.com> to check
+! use of -fno-dec-format-defaults
+!
+
+ character(50) :: buffer
+
+ real*4 :: real_4
+ real*8 :: real_8
+ real*16 :: real_16
+ integer :: len
+
+ real_4 = 4.18
+ write(buffer, '(A, F, A)') ':',real_4,':' ! { dg-error "Nonnegative width required" }
+
+ real_4 = 0.00000018
+ write(buffer, '(A, F, A)') ':',real_4,':' ! { dg-error "Nonnegative width required" }
+
+ real_8 = 4.18
+ write(buffer, '(A, F, A)') ':',real_8,':' ! { dg-error "Nonnegative width required" }
+
+ real_16 = 4.18
+ write(buffer, '(A, F, A)') ':',real_16,':' ! { dg-error "Nonnegative width required" }
+end
diff --git a/gcc/testsuite/gfortran.dg/fmt_g_default_field_width_1.f90 b/gcc/testsuite/gfortran.dg/fmt_g_default_field_width_1.f90
new file mode 100644
index 00000000000..6e2ad141d4a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_g_default_field_width_1.f90
@@ -0,0 +1,48 @@
+! { dg-do run }
+! { dg-options -fdec }
+!
+! Test case for the default field widths enabled by the -fdec-format-defaults flag.
+!
+! This feature is not part of any Fortran standard, but it is supported by the
+! Oracle Fortran compiler and others.
+!
+! libgfortran uses printf() internally to implement FORMAT. If you print float
+! values to a higher precision than the type can actually store, the results
+! are implementation dependent: some platforms print zeros, others print random
+! numbers. Don't depend on this behaviour in tests because they will not be
+! portable.
+
+ character(50) :: buffer
+
+ real*4 :: real_4
+ real*8 :: real_8
+ real*16 :: real_16
+ integer :: len
+
+ real_4 = 4.18
+ write(buffer, '(A, G, A)') ':',real_4,':'
+ print *,buffer
+ if (buffer.ne.": 4.180000 :") stop 1
+
+ real_4 = 0.00000018
+ write(buffer, '(A, G, A)') ':',real_4,':'
+ print *,buffer
+ if (buffer.ne.": 0.1800000E-06:") stop 2
+
+ real_4 = 18000000.4
+ write(buffer, '(A, G, A)') ':',real_4,':'
+ print *,buffer
+ if (buffer.ne.": 0.1800000E+08:") stop 3
+
+ real_8 = 4.18
+ write(buffer, '(A, G, A)') ':',real_8,':'
+ print *,buffer
+ len = len_trim(buffer)
+ if (len /= 27) stop 4
+
+ real_16 = 4.18
+ write(buffer, '(A, G, A)') ':',real_16,':'
+ print *,buffer
+ len = len_trim(buffer)
+ if (len /= 44) stop 5
+end
diff --git a/gcc/testsuite/gfortran.dg/fmt_g_default_field_width_2.f90 b/gcc/testsuite/gfortran.dg/fmt_g_default_field_width_2.f90
new file mode 100644
index 00000000000..7b218af8610
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_g_default_field_width_2.f90
@@ -0,0 +1,52 @@
+! { dg-do run }
+! { dg-options -fdec-format-defaults }
+!
+! Test case for the default field widths enabled by the -fdec-format-defaults flag.
+!
+! This feature is not part of any Fortran standard, but it is supported by the
+! Oracle Fortran compiler and others.
+!
+! libgfortran uses printf() internally to implement FORMAT. If you print float
+! values to a higher precision than the type can actually store, the results
+! are implementation dependent: some platforms print zeros, others print random
+! numbers. Don't depend on this behaviour in tests because they will not be
+! portable.
+!
+! Test case added by Mark Eggleston <mark.eggleston@codethink.com> to check
+! use of -fdec-format-defaults
+!
+
+ character(50) :: buffer
+
+ real*4 :: real_4
+ real*8 :: real_8
+ real*16 :: real_16
+ integer :: len
+
+ real_4 = 4.18
+ write(buffer, '(A, G, A)') ':',real_4,':'
+ print *,buffer
+ if (buffer.ne.": 4.180000 :") stop 1
+
+ real_4 = 0.00000018
+ write(buffer, '(A, G, A)') ':',real_4,':'
+ print *,buffer
+ if (buffer.ne.": 0.1800000E-06:") stop 2
+
+ real_4 = 18000000.4
+ write(buffer, '(A, G, A)') ':',real_4,':'
+ print *,buffer
+ if (buffer.ne.": 0.1800000E+08:") stop 3
+
+ real_8 = 4.18
+ write(buffer, '(A, G, A)') ':',real_8,':'
+ print *,buffer
+ len = len_trim(buffer)
+ if (len /= 27) stop 4
+
+ real_16 = 4.18
+ write(buffer, '(A, G, A)') ':',real_16,':'
+ print *,buffer
+ len = len_trim(buffer)
+ if (len /= 44) stop 5
+end
diff --git a/gcc/testsuite/gfortran.dg/fmt_g_default_field_width_3.f90 b/gcc/testsuite/gfortran.dg/fmt_g_default_field_width_3.f90
new file mode 100644
index 00000000000..e255c2f94a0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_g_default_field_width_3.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! { dg-options "-fdec -fno-dec-format-defaults" }
+!
+! Test case for the default field widths not enabled.
+!
+! Test case added by Mark Eggleston <mark.eggleston@codethink.com> to check
+! use of -fno-dec-format-defaults
+!
+
+ character(50) :: buffer
+
+ real*4 :: real_4
+ real*8 :: real_8
+ real*16 :: real_16
+ integer :: len
+
+ real_4 = 4.18
+ write(buffer, '(A, G, A)') ':',real_4,':' ! { dg-error "Positive width required" }
+
+ real_4 = 0.00000018
+ write(buffer, '(A, G, A)') ':',real_4,':' ! { dg-error "Positive width required" }
+
+ real_4 = 18000000.4
+ write(buffer, '(A, G, A)') ':',real_4,':' ! { dg-error "Positive width required" }
+
+ real_8 = 4.18
+ write(buffer, '(A, G, A)') ':',real_8,':' ! { dg-error "Positive width required" }
+
+ real_16 = 4.18
+ write(buffer, '(A, G, A)') ':',real_16,':' ! { dg-error "Positive width required" }
+end
diff --git a/gcc/testsuite/gfortran.dg/fmt_i_default_field_width_1.f90 b/gcc/testsuite/gfortran.dg/fmt_i_default_field_width_1.f90
new file mode 100644
index 00000000000..0d32d240394
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_i_default_field_width_1.f90
@@ -0,0 +1,38 @@
+! { dg-do run }
+! { dg-options -fdec }
+!
+! Test case for the default field widths enabled by the -fdec-format-defaults flag.
+!
+! This feature is not part of any Fortran standard, but it is supported by the
+! Oracle Fortran compiler and others.
+
+ character(50) :: buffer
+ character(1) :: colon
+
+ integer*2 :: integer_2
+ integer*4 :: integer_4
+ integer*8 :: integer_8
+
+ write(buffer, '(A, I, A)') ':',12340,':'
+ print *,buffer
+ if (buffer.ne.": 12340:") stop 1
+
+ read(buffer, '(A1, I, A1)') colon, integer_4, colon
+ if (integer_4.ne.12340) stop 2
+
+ integer_2 = -99
+ write(buffer, '(A, I, A)') ':',integer_2,':'
+ print *,buffer
+ if (buffer.ne.": -99:") stop 3
+
+ integer_8 = -11112222
+ write(buffer, '(A, I, A)') ':',integer_8,':'
+ print *,buffer
+ if (buffer.ne.": -11112222:") stop 4
+
+! If the width is 7 and there are 7 leading zeroes, the result should be zero.
+ integer_2 = 789
+ buffer = '0000000789'
+ read(buffer, '(I)') integer_2
+ if (integer_2.ne.0) stop 5
+end
diff --git a/gcc/testsuite/gfortran.dg/fmt_i_default_field_width_2.f90 b/gcc/testsuite/gfortran.dg/fmt_i_default_field_width_2.f90
new file mode 100644
index 00000000000..6cee3f86809
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_i_default_field_width_2.f90
@@ -0,0 +1,42 @@
+! { dg-do run }
+! { dg-options -fdec-format-defaults }
+!
+! Test case for the default field widths enabled by the -fdec-format-defaults flag.
+!
+! This feature is not part of any Fortran standard, but it is supported by the
+! Oracle Fortran compiler and others.
+!
+! Test case added by Mark Eggleston <mark.eggleston@codethink.com> to check
+! use of -fdec-format-defaults
+!
+
+ character(50) :: buffer
+ character(1) :: colon
+
+ integer*2 :: integer_2
+ integer*4 :: integer_4
+ integer*8 :: integer_8
+
+ write(buffer, '(A, I, A)') ':',12340,':'
+ print *,buffer
+ if (buffer.ne.": 12340:") stop 1
+
+ read(buffer, '(A1, I, A1)') colon, integer_4, colon
+ if (integer_4.ne.12340) stop 2
+
+ integer_2 = -99
+ write(buffer, '(A, I, A)') ':',integer_2,':'
+ print *,buffer
+ if (buffer.ne.": -99:") stop 3
+
+ integer_8 = -11112222
+ write(buffer, '(A, I, A)') ':',integer_8,':'
+ print *,buffer
+ if (buffer.ne.": -11112222:") stop 4
+
+! If the width is 7 and there are 7 leading zeroes, the result should be zero.
+ integer_2 = 789
+ buffer = '0000000789'
+ read(buffer, '(I)') integer_2
+ if (integer_2.ne.0) stop 5
+end
diff --git a/gcc/testsuite/gfortran.dg/fmt_i_default_field_width_3.f90 b/gcc/testsuite/gfortran.dg/fmt_i_default_field_width_3.f90
new file mode 100644
index 00000000000..3a6684b3c4d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_i_default_field_width_3.f90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+! { dg-options "-fdec -fno-dec-format-defaults" }
+!
+! Test case for the default field widths enabled by the -fdec-format-defaults flag.
+!
+! This feature is not part of any Fortran standard, but it is supported by the
+! Oracle Fortran compiler and others.
+!
+! Test case added by Mark Eggleston <mark.eggleston@codethink.com> to check
+! use of -fdec-format-defaults
+!
+
+ character(50) :: buffer
+ character(1) :: colon
+
+ integer*2 :: integer_2
+ integer*4 :: integer_4
+ integer*8 :: integer_8
+
+ write(buffer, '(A, I, A)') ':',12340,':' ! { dg-error "Nonnegative width required" }
+
+ read(buffer, '(A1, I, A1)') colon, integer_4, colon ! { dg-error "Nonnegative width required" }
+ if (integer_4.ne.12340) stop 2
+
+ integer_2 = -99
+ write(buffer, '(A, I, A)') ':',integer_2,':' ! { dg-error "Nonnegative width required" }
+
+ integer_8 = -11112222
+ write(buffer, '(A, I, A)') ':',integer_8,':' ! { dg-error "Nonnegative width required" }
+
+! If the width is 7 and there are 7 leading zeroes, the result should be zero.
+ integer_2 = 789
+ buffer = '0000000789'
+ read(buffer, '(I)') integer_2 ! { dg-error "Nonnegative width required" }
+end
diff --git a/libgfortran/io/format.c b/libgfortran/io/format.c
index 688764785da..e798d9bda87 100644
--- a/libgfortran/io/format.c
+++ b/libgfortran/io/format.c
@@ -956,12 +956,33 @@ parse_format_list (st_parameter_dt *dtp, bool *seen_dd)
*seen_dd = true;
if (u != FMT_POSINT && u != FMT_ZERO)
{
+ if (dtp->common.flags & IOPARM_DT_DEC_EXT)
+ {
+ tail->u.real.w = DEFAULT_WIDTH;
+ tail->u.real.d = 0;
+ tail->u.real.e = -1;
+ fmt->saved_token = u;
+ break;
+ }
fmt->error = nonneg_required;
goto finished;
}
}
+ else if (u == FMT_ZERO)
+ {
+ fmt->error = posint_required;
+ goto finished;
+ }
else if (u != FMT_POSINT)
{
+ if (dtp->common.flags & IOPARM_DT_DEC_EXT)
+ {
+ tail->u.real.w = DEFAULT_WIDTH;
+ tail->u.real.d = 0;
+ tail->u.real.e = -1;
+ fmt->saved_token = u;
+ break;
+ }
fmt->error = posint_required;
goto finished;
}
@@ -1100,6 +1121,13 @@ parse_format_list (st_parameter_dt *dtp, bool *seen_dd)
{
if (t != FMT_POSINT)
{
+ if (dtp->common.flags & IOPARM_DT_DEC_EXT)
+ {
+ tail->u.integer.w = DEFAULT_WIDTH;
+ tail->u.integer.m = -1;
+ fmt->saved_token = t;
+ break;
+ }
fmt->error = posint_required;
goto finished;
}
@@ -1108,6 +1136,13 @@ parse_format_list (st_parameter_dt *dtp, bool *seen_dd)
{
if (t != FMT_ZERO && t != FMT_POSINT)
{
+ if (dtp->common.flags & IOPARM_DT_DEC_EXT)
+ {
+ tail->u.integer.w = DEFAULT_WIDTH;
+ tail->u.integer.m = -1;
+ fmt->saved_token = t;
+ break;
+ }
fmt->error = nonneg_required;
goto finished;
}
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index 5caaea280f0..f5e63797ba1 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -1011,6 +1011,56 @@ memset4 (gfc_char4_t *p, gfc_char4_t c, int k)
*p++ = c;
}
+/* Used in width fields to indicate that the default should be used */
+#define DEFAULT_WIDTH -1
+
+/* Defaults for certain format field descriptors. These are decided based on
+ * the type of the value being formatted.
+ *
+ * The behaviour here is modelled on the Oracle Fortran compiler. At the time
+ * of writing, the details were available at this URL:
+ *
+ * https://docs.oracle.com/cd/E19957-01/805-4939/6j4m0vnc3/index.html#z4000743746d
+ */
+
+static inline int
+default_width_for_integer (int kind)
+{
+ switch (kind)
+ {
+ case 1:
+ case 2: return 7;
+ case 4: return 12;
+ case 8: return 23;
+ case 16: return 44;
+ default: return 0;
+ }
+}
+
+static inline int
+default_width_for_float (int kind)
+{
+ switch (kind)
+ {
+ case 4: return 15;
+ case 8: return 25;
+ case 16: return 42;
+ default: return 0;
+ }
+}
+
+static inline int
+default_precision_for_float (int kind)
+{
+ switch (kind)
+ {
+ case 4: return 7;
+ case 8: return 16;
+ case 16: return 33;
+ default: return 0;
+ }
+}
+
#endif
extern void
diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c
index 52ffb4639ac..be9f6cb6f76 100644
--- a/libgfortran/io/read.c
+++ b/libgfortran/io/read.c
@@ -635,6 +635,12 @@ read_decimal (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
w = f->u.w;
+ /* This is a legacy extension, and the frontend will only allow such cases
+ * through when -fdec-format-defaults is passed.
+ */
+ if (w == DEFAULT_WIDTH)
+ w = default_width_for_integer (length);
+
p = read_block_form (dtp, &w);
if (p == NULL)
diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index c8811e200e0..4ef35561fdd 100644
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -685,9 +685,8 @@ write_l (st_parameter_dt *dtp, const fnode *f, char *source, int len)
p[wlen - 1] = (n) ? 'T' : 'F';
}
-
static void
-write_boz (st_parameter_dt *dtp, const fnode *f, const char *q, int n)
+write_boz (st_parameter_dt *dtp, const fnode *f, const char *q, int n, int len)
{
int w, m, digits, nzero, nblank;
char *p;
@@ -720,6 +719,9 @@ write_boz (st_parameter_dt *dtp, const fnode *f, const char *q, int n)
/* Select a width if none was specified. The idea here is to always
print something. */
+ if (w == DEFAULT_WIDTH)
+ w = default_width_for_integer (len);
+
if (w == 0)
w = ((digits < m) ? m : digits);
@@ -846,6 +848,8 @@ write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source,
/* Select a width if none was specified. The idea here is to always
print something. */
+ if (w == DEFAULT_WIDTH)
+ w = default_width_for_integer (len);
if (w == 0)
w = ((digits < m) ? m : digits) + nsign;
@@ -1206,13 +1210,13 @@ write_b (st_parameter_dt *dtp, const fnode *f, const char *source, int len)
if (len > (int) sizeof (GFC_UINTEGER_LARGEST))
{
p = btoa_big (source, itoa_buf, len, &n);
- write_boz (dtp, f, p, n);
+ write_boz (dtp, f, p, n, len);
}
else
{
n = extract_uint (source, len);
p = btoa (n, itoa_buf, sizeof (itoa_buf));
- write_boz (dtp, f, p, n);
+ write_boz (dtp, f, p, n, len);
}
}
@@ -1227,13 +1231,13 @@ write_o (st_parameter_dt *dtp, const fnode *f, const char *source, int len)
if (len > (int) sizeof (GFC_UINTEGER_LARGEST))
{
p = otoa_big (source, itoa_buf, len, &n);
- write_boz (dtp, f, p, n);
+ write_boz (dtp, f, p, n, len);
}
else
{
n = extract_uint (source, len);
p = otoa (n, itoa_buf, sizeof (itoa_buf));
- write_boz (dtp, f, p, n);
+ write_boz (dtp, f, p, n, len);
}
}
@@ -1247,13 +1251,13 @@ write_z (st_parameter_dt *dtp, const fnode *f, const char *source, int len)
if (len > (int) sizeof (GFC_UINTEGER_LARGEST))
{
p = ztoa_big (source, itoa_buf, len, &n);
- write_boz (dtp, f, p, n);
+ write_boz (dtp, f, p, n, len);
}
else
{
n = extract_uint (source, len);
p = gfc_xtoa (n, itoa_buf, sizeof (itoa_buf));
- write_boz (dtp, f, p, n);
+ write_boz (dtp, f, p, n, len);
}
}
@@ -1491,7 +1495,7 @@ size_from_kind (st_parameter_dt *dtp, const fnode *f, int kind)
{
int size;
- if (f->format == FMT_F && f->u.real.w == 0)
+ if ((f->format == FMT_F && f->u.real.w == 0) || f->u.real.w == DEFAULT_WIDTH)
{
switch (kind)
{
diff --git a/libgfortran/io/write_float.def b/libgfortran/io/write_float.def
index c63db4e77ef..daa16679f53 100644
--- a/libgfortran/io/write_float.def
+++ b/libgfortran/io/write_float.def
@@ -113,7 +113,8 @@ determine_precision (st_parameter_dt * dtp, const fnode * f, int len)
static void
build_float_string (st_parameter_dt *dtp, const fnode *f, char *buffer,
size_t size, int nprinted, int precision, int sign_bit,
- bool zero_flag, int npad, char *result, size_t *len)
+ bool zero_flag, int npad, int default_width, char *result,
+ size_t *len)
{
char *put;
char *digits;
@@ -132,8 +133,17 @@ build_float_string (st_parameter_dt *dtp, const fnode *f, char *buffer,
sign_t sign;
ft = f->format;
- w = f->u.real.w;
- d = f->u.real.d;
+ if (f->u.real.w == DEFAULT_WIDTH)
+ /* This codepath can only be reached with -fdec-format-defaults. */
+ {
+ w = default_width;
+ d = precision;
+ }
+ else
+ {
+ w = f->u.real.w;
+ d = f->u.real.d;
+ }
p = dtp->u.p.scale_factor;
*len = 0;
@@ -960,6 +970,11 @@ determine_en_precision (st_parameter_dt *dtp, const fnode *f,
int save_scale_factor;\
volatile GFC_REAL_ ## x temp;\
save_scale_factor = dtp->u.p.scale_factor;\
+ if (w == DEFAULT_WIDTH)\
+ {\
+ w = default_width;\
+ d = precision;\
+ }\
switch (dtp->u.p.current_unit->round_status)\
{\
case ROUND_ZERO:\
@@ -1035,7 +1050,8 @@ determine_en_precision (st_parameter_dt *dtp, const fnode *f,
nprinted = FDTOA(y,precision,m);\
}\
build_float_string (dtp, &newf, buffer, size, nprinted, precision,\
- sign_bit, zero_flag, npad, result, res_len);\
+ sign_bit, zero_flag, npad, default_width,\
+ result, res_len);\
dtp->u.p.scale_factor = save_scale_factor;\
}\
else\
@@ -1045,7 +1061,8 @@ determine_en_precision (st_parameter_dt *dtp, const fnode *f,
else\
nprinted = DTOA(y,precision,m);\
build_float_string (dtp, f, buffer, size, nprinted, precision,\
- sign_bit, zero_flag, npad, result, res_len);\
+ sign_bit, zero_flag, npad, default_width,\
+ result, res_len);\
}\
}\
@@ -1059,6 +1076,16 @@ get_float_string (st_parameter_dt *dtp, const fnode *f, const char *source,
{
int sign_bit, nprinted;
bool zero_flag;
+ int default_width = 0;
+
+ if (f->u.real.w == DEFAULT_WIDTH)
+ /* This codepath can only be reached with -fdec-format-defaults. The default
+ * values are based on those used in the Oracle Fortran compiler.
+ */
+ {
+ default_width = default_width_for_float (kind);
+ precision = default_precision_for_float (kind);
+ }
switch (kind)
{
--
2.11.0

View File

@ -1,7 +1,7 @@
From 6a3faecd0b1eed41e865bdab721cc3a60492845d Mon Sep 17 00:00:00 2001
From: Jim MacArthur <jim.macarthur@codethink.co.uk>
Date: Wed, 7 Oct 2015 16:31:18 -0400
Subject: [PATCH 03/16] Convert LOGICAL to INTEGER for arithmetic ops, and vice
From cb3a42eb8e7ca26714c8dea383f2111230fdc0b5 Mon Sep 17 00:00:00 2001
From: Mark Eggleston <markeggleston@gcc.gnu.org>
Date: Mon, 3 Feb 2020 08:51:11 +0000
Subject: [PATCH 02/10] Convert LOGICAL to INTEGER for arithmetic ops, and vice
versa
We allow converting LOGICAL types to INTEGER when doing arithmetic
@ -26,10 +26,10 @@ Note: using this feature will disable bitwise logical operations enabled by
create mode 100644 gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_4.f
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 491d81ccaa5..13a8e9778bb 100644
index 6275dc3deff..5257da74b06 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -468,6 +468,10 @@ fdec-static
@@ -493,6 +493,10 @@ fdec-static
Fortran Var(flag_dec_static)
Enable DEC-style STATIC and AUTOMATIC attributes.
@ -41,10 +41,10 @@ index 491d81ccaa5..13a8e9778bb 100644
Fortran Var(flag_default_double)
Set the default double precision kind to an 8 byte wide type.
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 8232deb8170..32b8d504ff6 100644
index 354702bda0b..6e70eaf8812 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -3838,7 +3838,6 @@ lookup_uop_fuzzy (const char *op, gfc_symtree *uop)
@@ -3880,7 +3880,6 @@ lookup_uop_fuzzy (const char *op, gfc_symtree *uop)
return gfc_closest_fuzzy_match (op, candidates);
}
@ -52,8 +52,8 @@ index 8232deb8170..32b8d504ff6 100644
/* Callback finding an impure function as an operand to an .and. or
.or. expression. Remember the last function warned about to
avoid double warnings when recursing. */
@@ -3873,6 +3872,37 @@ impure_function_callback (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
return 0;
@@ -3940,6 +3939,22 @@ convert_hollerith_to_character (gfc_expr *e)
}
}
+/* If E is a logical, convert it to an integer and issue a warning
@ -72,6 +72,13 @@ index 8232deb8170..32b8d504ff6 100644
+ }
+}
+
/* Convert to numeric and issue a warning for the conversion. */
static void
@@ -3952,6 +3967,22 @@ convert_to_numeric (gfc_expr *a, gfc_expr *b)
gfc_convert_type_warn (a, &t, 2, 1);
}
+/* If E is a logical, convert it to an integer and issue a warning
+ for the conversion. */
+
@ -87,10 +94,11 @@ index 8232deb8170..32b8d504ff6 100644
+ gfc_convert_type_warn (e, &t, 2, 1);
+ }
+}
+
/* Resolve an operator expression node. This can involve replacing the
operation with a user defined function call. */
@@ -3938,6 +3968,12 @@ resolve_operator (gfc_expr *e)
@@ -4037,6 +4068,12 @@ resolve_operator (gfc_expr *e)
case INTRINSIC_TIMES:
case INTRINSIC_DIVIDE:
case INTRINSIC_POWER:
@ -103,7 +111,7 @@ index 8232deb8170..32b8d504ff6 100644
if (gfc_numeric_ts (&op1->ts) && gfc_numeric_ts (&op2->ts))
{
gfc_type_convert_binary (e, 1);
@@ -3974,6 +4010,13 @@ resolve_operator (gfc_expr *e)
@@ -4073,6 +4110,13 @@ resolve_operator (gfc_expr *e)
case INTRINSIC_OR:
case INTRINSIC_EQV:
case INTRINSIC_NEQV:
@ -117,7 +125,7 @@ index 8232deb8170..32b8d504ff6 100644
if (op1->ts.type == BT_LOGICAL && op2->ts.type == BT_LOGICAL)
{
e->ts.type = BT_LOGICAL;
@@ -4024,6 +4067,9 @@ resolve_operator (gfc_expr *e)
@@ -4123,6 +4167,9 @@ resolve_operator (gfc_expr *e)
goto simplify_op;
}
@ -127,11 +135,10 @@ index 8232deb8170..32b8d504ff6 100644
if (op1->ts.type == BT_LOGICAL)
{
e->ts.type = BT_LOGICAL;
@@ -4055,6 +4101,13 @@ resolve_operator (gfc_expr *e)
case INTRINSIC_EQ_OS:
case INTRINSIC_NE:
case INTRINSIC_NE_OS:
+
@@ -4163,6 +4210,12 @@ resolve_operator (gfc_expr *e)
convert_hollerith_to_character (op2);
}
+ if (flag_logical_as_integer)
+ {
+ convert_logical_to_integer (op1);

View File

@ -1,9 +1,9 @@
From d15e5e207e2a6b46edee2f2b5d3e4c1cc7cdb80f Mon Sep 17 00:00:00 2001
From: Jim MacArthur <jim.macarthur@codethink.co.uk>
Date: Mon, 5 Oct 2015 13:45:15 +0100
Subject: [PATCH 07/16] Allow more than one character as argument to ICHAR
From 2de74ecd251387201ab78f614e73f67c8ad89033 Mon Sep 17 00:00:00 2001
From: Mark Eggleston <markeggleston@gcc.gnu.org>
Date: Mon, 3 Feb 2020 08:52:58 +0000
Subject: [PATCH 03/10] Allow more than one character as argument to ICHAR
Use -fdec to enable..
Use -fdec to enable.
---
gcc/fortran/check.c | 2 +-
gcc/fortran/simplify.c | 4 ++--
@ -12,10 +12,10 @@ Use -fdec to enable..
create mode 100644 gcc/testsuite/gfortran.dg/dec_ichar_with_string_1.f
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index a04f0d66655..0ba4d0a031f 100644
index 148a3269815..4c0b83e8e6f 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -2603,7 +2603,7 @@ gfc_check_ichar_iachar (gfc_expr *c, gfc_expr *kind)
@@ -3154,7 +3154,7 @@ gfc_check_ichar_iachar (gfc_expr *c, gfc_expr *kind)
else
return true;
@ -25,7 +25,7 @@ index a04f0d66655..0ba4d0a031f 100644
gfc_error ("Argument of %s at %L must be of length one",
gfc_current_intrinsic, &c->where);
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 7d7e3f22f73..7aff256c6b3 100644
index eb8b2afeb29..248fe05ee48 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -3229,7 +3229,7 @@ gfc_simplify_iachar (gfc_expr *e, gfc_expr *kind)

View File

@ -1,860 +0,0 @@
From c1d6c81730ffda61eff8fccf4d0c7efa3ae6fd8d Mon Sep 17 00:00:00 2001
From: Jim MacArthur <jim.macarthur@codethink.co.uk>
Date: Thu, 4 Feb 2016 17:18:30 +0000
Subject: [PATCH 04/16] Allow CHARACTER literals in assignments and data
statements
Warnings are raised when this happens.
Enable using -fdec-char-as-int or -fdec
---
gcc/fortran/arith.c | 96 +++++++++++++++++++++-
gcc/fortran/arith.h | 4 +
gcc/fortran/expr.c | 5 ++
gcc/fortran/intrinsic.c | 32 +++++++-
gcc/fortran/lang.opt | 5 ++
gcc/fortran/options.c | 1 +
gcc/fortran/resolve.c | 11 ++-
gcc/fortran/simplify.c | 29 ++++++-
gcc/fortran/trans-const.c | 3 +-
.../dec_char_conversion_in_assignment_1.f90 | 61 ++++++++++++++
.../dec_char_conversion_in_assignment_2.f90 | 61 ++++++++++++++
.../dec_char_conversion_in_assignment_3.f90 | 61 ++++++++++++++
.../gfortran.dg/dec_char_conversion_in_data_1.f90 | 69 ++++++++++++++++
.../gfortran.dg/dec_char_conversion_in_data_2.f90 | 69 ++++++++++++++++
.../gfortran.dg/dec_char_conversion_in_data_3.f90 | 69 ++++++++++++++++
gcc/testsuite/gfortran.dg/hollerith5.f90 | 5 +-
gcc/testsuite/gfortran.dg/hollerith_legacy.f90 | 2 +-
.../gfortran.dg/no_char_to_int_assign.f90 | 20 +++++
18 files changed, 589 insertions(+), 14 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/dec_char_conversion_in_assignment_1.f90
create mode 100644 gcc/testsuite/gfortran.dg/dec_char_conversion_in_assignment_2.f90
create mode 100644 gcc/testsuite/gfortran.dg/dec_char_conversion_in_assignment_3.f90
create mode 100644 gcc/testsuite/gfortran.dg/dec_char_conversion_in_data_1.f90
create mode 100644 gcc/testsuite/gfortran.dg/dec_char_conversion_in_data_2.f90
create mode 100644 gcc/testsuite/gfortran.dg/dec_char_conversion_in_data_3.f90
create mode 100644 gcc/testsuite/gfortran.dg/no_char_to_int_assign.f90
diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c
index f2d311c044c..7e6d6dd3bb8 100644
--- a/gcc/fortran/arith.c
+++ b/gcc/fortran/arith.c
@@ -2553,11 +2553,11 @@ hollerith2representation (gfc_expr *result, gfc_expr *src)
src_len = src->representation.length - src->ts.u.pad;
gfc_target_expr_size (result, &result_len);
- if (src_len > result_len)
+ if (src_len > result_len && warn_character_truncation)
{
- gfc_warning (0,
- "The Hollerith constant at %L is too long to convert to %qs",
- &src->where, gfc_typename(&result->ts));
+ gfc_warning (OPT_Wcharacter_truncation, "The Hollerith constant at %L "
+ "is truncated in conversion to %qs", &src->where,
+ gfc_typename(&result->ts));
}
result->representation.string = XCNEWVEC (char, result_len + 1);
@@ -2572,6 +2572,36 @@ hollerith2representation (gfc_expr *result, gfc_expr *src)
}
+/* Helper function to set the representation in a character conversion.
+ This assumes that the ts.type and ts.kind of the result have already
+ been set. */
+
+static void
+character2representation (gfc_expr *result, gfc_expr *src)
+{
+ size_t src_len, result_len;
+ int i;
+ src_len = src->value.character.length;
+ gfc_target_expr_size (result, &result_len);
+
+ if (src_len > result_len && warn_character_truncation)
+ gfc_warning (OPT_Wcharacter_truncation, "The character constant at %L is "
+ "is truncated in conversion to %s", &src->where,
+ gfc_typename(&result->ts));
+
+ result->representation.string = XCNEWVEC (char, result_len + 1);
+
+ for (i = 0; i < MIN (result_len, src_len); i++)
+ result->representation.string[i] = (char) src->value.character.string[i];
+
+ if (src_len < result_len)
+ memset (&result->representation.string[src_len], ' ',
+ result_len - src_len);
+
+ result->representation.string[result_len] = '\0'; /* For debugger */
+ result->representation.length = result_len;
+}
+
/* Convert Hollerith to integer. The constant will be padded or truncated. */
gfc_expr *
@@ -2587,6 +2617,19 @@ gfc_hollerith2int (gfc_expr *src, int kind)
return result;
}
+/* Convert character to integer. The constant will be padded or truncated. */
+
+gfc_expr *
+gfc_character2int (gfc_expr *src, int kind)
+{
+ gfc_expr *result;
+ result = gfc_get_constant_expr (BT_INTEGER, kind, &src->where);
+
+ character2representation (result, src);
+ gfc_interpret_integer (kind, (unsigned char *) result->representation.string,
+ result->representation.length, result->value.integer);
+ return result;
+}
/* Convert Hollerith to real. The constant will be padded or truncated. */
@@ -2603,6 +2646,21 @@ gfc_hollerith2real (gfc_expr *src, int kind)
return result;
}
+/* Convert character to real. The constant will be padded or truncated. */
+
+gfc_expr *
+gfc_character2real (gfc_expr *src, int kind)
+{
+ gfc_expr *result;
+ result = gfc_get_constant_expr (BT_REAL, kind, &src->where);
+
+ character2representation (result, src);
+ gfc_interpret_float (kind, (unsigned char *) result->representation.string,
+ result->representation.length, result->value.real);
+
+ return result;
+}
+
/* Convert Hollerith to complex. The constant will be padded or truncated. */
@@ -2619,6 +2677,21 @@ gfc_hollerith2complex (gfc_expr *src, int kind)
return result;
}
+/* Convert character to complex. The constant will be padded or truncated. */
+
+gfc_expr *
+gfc_character2complex (gfc_expr *src, int kind)
+{
+ gfc_expr *result;
+ result = gfc_get_constant_expr (BT_COMPLEX, kind, &src->where);
+
+ character2representation (result, src);
+ gfc_interpret_complex (kind, (unsigned char *) result->representation.string,
+ result->representation.length, result->value.complex);
+
+ return result;
+}
+
/* Convert Hollerith to character. */
@@ -2654,3 +2727,18 @@ gfc_hollerith2logical (gfc_expr *src, int kind)
return result;
}
+
+/* Convert character to logical. The constant will be padded or truncated. */
+
+gfc_expr *
+gfc_character2logical (gfc_expr *src, int kind)
+{
+ gfc_expr *result;
+ result = gfc_get_constant_expr (BT_LOGICAL, kind, &src->where);
+
+ character2representation (result, src);
+ gfc_interpret_logical (kind, (unsigned char *) result->representation.string,
+ result->representation.length, &result->value.logical);
+
+ return result;
+}
diff --git a/gcc/fortran/arith.h b/gcc/fortran/arith.h
index e06c7059885..13ffd8d0b6c 100644
--- a/gcc/fortran/arith.h
+++ b/gcc/fortran/arith.h
@@ -82,7 +82,11 @@ gfc_expr *gfc_hollerith2real (gfc_expr *, int);
gfc_expr *gfc_hollerith2complex (gfc_expr *, int);
gfc_expr *gfc_hollerith2character (gfc_expr *, int);
gfc_expr *gfc_hollerith2logical (gfc_expr *, int);
+gfc_expr *gfc_character2int (gfc_expr *, int);
+gfc_expr *gfc_character2real (gfc_expr *, int);
+gfc_expr *gfc_character2complex (gfc_expr *, int);
gfc_expr *gfc_character2character (gfc_expr *, int);
+gfc_expr *gfc_character2logical (gfc_expr *, int);
#endif /* GFC_ARITH_H */
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 474e9ecc401..77600a5f2e8 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3695,6 +3695,11 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform,
|| rvalue->ts.type == BT_HOLLERITH)
return true;
+ if (flag_dec_char_conversions && (gfc_numeric_ts (&lvalue->ts)
+ || lvalue->ts.type == BT_LOGICAL)
+ && rvalue->ts.type == BT_CHARACTER)
+ return true;
+
if (lvalue->ts.type == BT_LOGICAL && rvalue->ts.type == BT_LOGICAL)
return true;
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index c21fbddd5fb..e94d5d3225f 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -4017,6 +4017,28 @@ add_conversions (void)
add_conv (BT_LOGICAL, gfc_logical_kinds[j].kind,
BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
}
+
+ /* Flang allows character conversions similar to Hollerith conversions
+ - the first characters will be turned into ascii values. */
+ if (flag_dec_char_conversions)
+ {
+ /* Character-Integer conversions. */
+ for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
+ add_conv (BT_CHARACTER, gfc_default_character_kind,
+ BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
+ /* Character-Real conversions. */
+ for (i = 0; gfc_real_kinds[i].kind != 0; i++)
+ add_conv (BT_CHARACTER, gfc_default_character_kind,
+ BT_REAL, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
+ /* Character-Complex conversions. */
+ for (i = 0; gfc_real_kinds[i].kind != 0; i++)
+ add_conv (BT_CHARACTER, gfc_default_character_kind,
+ BT_COMPLEX, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
+ /* Character-Logical conversions. */
+ for (i = 0; gfc_logical_kinds[i].kind != 0; i++)
+ add_conv (BT_CHARACTER, gfc_default_character_kind,
+ BT_LOGICAL, gfc_logical_kinds[i].kind, GFC_STD_LEGACY);
+ }
}
@@ -5128,8 +5150,16 @@ gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)
gfc_typename (&from_ts), gfc_typename (ts),
&expr->where);
}
+ else if (flag_dec_char_conversions && from_ts.type == BT_CHARACTER
+ && (gfc_numeric_ts (ts) || ts->type == BT_LOGICAL))
+ {
+ if (warn_conversion)
+ gfc_warning_now (OPT_Wconversion, "Conversion from %s to %s at %L",
+ gfc_typename (&from_ts), gfc_typename (ts),
+ &expr->where);
+ }
else
- gcc_unreachable ();
+ gcc_unreachable ();
}
/* Insert a pre-resolved function call to the right function. */
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 13a8e9778bb..5746b99b1d4 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -444,6 +444,11 @@ fdec-duplicates
Fortran Var(flag_dec_duplicates)
Allow varibles to be duplicated in the type specification matches.
+fdec-char-conversions
+Fortran Var(flag_dec_char_conversions)
+Enable the use of character literals in assignments and data statements
+for non-character variables.
+
fdec-include
Fortran Var(flag_dec_include)
Enable legacy parsing of INCLUDE as statement.
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index f93db8b6d7c..e97b1568810 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -76,6 +76,7 @@ set_dec_flags (int value)
SET_BITFLAG (flag_dec_include, value, value);
SET_BITFLAG (flag_dec_format_defaults, value, value);
SET_BITFLAG (flag_dec_duplicates, value, value);
+ SET_BITFLAG (flag_dec_char_conversions, value, value);
}
/* Finalize DEC flags. */
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 32b8d504ff6..43559185481 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -4320,7 +4320,6 @@ bad_op:
return false;
}
-
/************** Array resolution subroutines **************/
enum compare_result
@@ -10498,6 +10497,16 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
lhs = code->expr1;
rhs = code->expr2;
+ if ((gfc_numeric_ts (&lhs->ts) || lhs->ts.type == BT_LOGICAL)
+ && rhs->ts.type == BT_CHARACTER
+ && rhs->expr_type != EXPR_CONSTANT)
+ {
+ gfc_error ("Cannot convert CHARACTER into %s at %L",
+ gfc_typename (&lhs->ts),
+ &rhs->where);
+ return false;
+ }
+
if (rhs->is_boz
&& !gfc_notify_std (GFC_STD_GNU, "BOZ literal at %L outside "
"a DATA statement and outside INT/REAL/DBLE/CMPLX",
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 6c1f4bd4fce..7d7e3f22f73 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -8457,10 +8457,31 @@ gfc_convert_constant (gfc_expr *e, bt type, int kind)
break;
case BT_CHARACTER:
- if (type == BT_CHARACTER)
- f = gfc_character2character;
- else
- goto oops;
+ switch (type)
+ {
+ case BT_INTEGER:
+ f = gfc_character2int;
+ break;
+
+ case BT_REAL:
+ f = gfc_character2real;
+ break;
+
+ case BT_COMPLEX:
+ f = gfc_character2complex;
+ break;
+
+ case BT_CHARACTER:
+ f = gfc_character2character;
+ break;
+
+ case BT_LOGICAL:
+ f = gfc_character2logical;
+ break;
+
+ default:
+ goto oops;
+ }
break;
default:
diff --git a/gcc/fortran/trans-const.c b/gcc/fortran/trans-const.c
index 432d12bf168..b155e35cbdd 100644
--- a/gcc/fortran/trans-const.c
+++ b/gcc/fortran/trans-const.c
@@ -25,6 +25,7 @@ along with GCC; see the file COPYING3. If not see
#include "coretypes.h"
#include "tree.h"
#include "gfortran.h"
+#include "options.h"
#include "trans.h"
#include "fold-const.h"
#include "stor-layout.h"
@@ -330,7 +331,7 @@ gfc_conv_constant_to_tree (gfc_expr * expr)
gfc_get_int_type (expr->ts.kind),
gfc_build_string_const (expr->representation.length,
expr->representation.string));
- if (!integer_zerop (tmp) && !integer_onep (tmp))
+ if (!integer_zerop (tmp) && !integer_onep (tmp) && warn_surprising)
gfc_warning (0, "Assigning value other than 0 or 1 to LOGICAL"
" has undefined result at %L", &expr->where);
return fold_convert (gfc_get_logical_type (expr->ts.kind), tmp);
diff --git a/gcc/testsuite/gfortran.dg/dec_char_conversion_in_assignment_1.f90 b/gcc/testsuite/gfortran.dg/dec_char_conversion_in_assignment_1.f90
new file mode 100644
index 00000000000..d504f92fbbc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_char_conversion_in_assignment_1.f90
@@ -0,0 +1,61 @@
+! { dg-do run }
+! { dg-options "-fdec -Wsurprising -Wcharacter-truncation" }
+!
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+program test
+ integer(4) :: a
+ real(4) :: b
+ complex(4) :: c
+ logical(4) :: d
+ integer(4) :: e
+ real(4) :: f
+ complex(4) :: g
+ logical(4) :: h
+
+ a = '1234'
+ b = '1234'
+ c = '12341234'
+ d = '1234' ! { dg-warning "undefined result" }
+ e = 4h1234
+ f = 4h1234
+ g = 8h12341234
+ h = 4h1234 ! { dg-warning "undefined result" }
+
+ if (a.ne.e) stop 1
+ if (b.ne.f) stop 2
+ if (c.ne.g) stop 3
+ if (d.neqv.h) stop 4
+
+ ! padded values
+ a = '12'
+ b = '12'
+ c = '12234'
+ d = '124' ! { dg-warning "undefined result" }
+ e = 2h12
+ f = 2h12
+ g = 5h12234
+ h = 3h123 ! { dg-warning "undefined result" }
+
+ if (a.ne.e) stop 5
+ if (b.ne.f) stop 6
+ if (c.ne.g) stop 7
+ if (d.neqv.h) stop 8
+
+ ! truncated values
+ a = '123478' ! { dg-warning "truncated in" }
+ b = '123478' ! { dg-warning "truncated in" }
+ c = '12341234987' ! { dg-warning "truncated in" }
+ d = '1234abc' ! { dg-warning "truncated in|undefined result" }
+ e = 6h123478 ! { dg-warning "truncated in" }
+ f = 6h123478 ! { dg-warning "truncated in" }
+ g = 11h12341234987 ! { dg-warning "truncated in" }
+ h = 7h1234abc ! { dg-warning "truncated in|undefined result" }
+
+ if (a.ne.e) stop 5
+ if (b.ne.f) stop 6
+ if (c.ne.g) stop 7
+ if (d.neqv.h) stop 8
+
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/dec_char_conversion_in_assignment_2.f90 b/gcc/testsuite/gfortran.dg/dec_char_conversion_in_assignment_2.f90
new file mode 100644
index 00000000000..737ddc664de
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_char_conversion_in_assignment_2.f90
@@ -0,0 +1,61 @@
+! { dg-do run }
+! { dg-options "-fdec-char-conversions -std=legacy -Wcharacter-truncation -Wsurprising" }
+!
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+program test
+ integer(4) :: a
+ real(4) :: b
+ complex(4) :: c
+ logical(4) :: d
+ integer(4) :: e
+ real(4) :: f
+ complex(4) :: g
+ logical(4) :: h
+
+ a = '1234'
+ b = '1234'
+ c = '12341234'
+ d = '1234' ! { dg-warning "undefined result" }
+ e = 4h1234
+ f = 4h1234
+ g = 8h12341234
+ h = 4h1234 ! { dg-warning "undefined result" }
+
+ if (a.ne.e) stop 1
+ if (b.ne.f) stop 2
+ if (c.ne.g) stop 3
+ if (d.neqv.h) stop 4
+
+ ! padded values
+ a = '12'
+ b = '12'
+ c = '12234'
+ d = '124' ! { dg-warning "undefined result" }
+ e = 2h12
+ f = 2h12
+ g = 5h12234
+ h = 3h123 ! { dg-warning "undefined result" }
+
+ if (a.ne.e) stop 5
+ if (b.ne.f) stop 6
+ if (c.ne.g) stop 7
+ if (d.neqv.h) stop 8
+
+ ! truncated values
+ a = '123478' ! { dg-warning "truncated in" }
+ b = '123478' ! { dg-warning "truncated in" }
+ c = '12341234987' ! { dg-warning "truncated in" }
+ d = '1234abc' ! { dg-warning "truncated in|undefined result" }
+ e = 6h123478 ! { dg-warning "truncated in" }
+ f = 6h123478 ! { dg-warning "truncated in" }
+ g = 11h12341234987 ! { dg-warning "truncated in" }
+ h = 7h1234abc ! { dg-warning "truncated in|undefined result" }
+
+ if (a.ne.e) stop 5
+ if (b.ne.f) stop 6
+ if (c.ne.g) stop 7
+ if (d.neqv.h) stop 8
+
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/dec_char_conversion_in_assignment_3.f90 b/gcc/testsuite/gfortran.dg/dec_char_conversion_in_assignment_3.f90
new file mode 100644
index 00000000000..0ec494c4a92
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_char_conversion_in_assignment_3.f90
@@ -0,0 +1,61 @@
+! { dg-do compile }
+! { dg-options "-fdec -fno-dec-char-conversions" }
+!
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+program test
+ integer(4) :: a
+ real(4) :: b
+ complex(4) :: c
+ logical(4) :: d
+ integer(4) :: e
+ real(4) :: f
+ complex(4) :: g
+ logical(4) :: h
+
+ a = '1234' ! { dg-error "Cannot convert" }
+ b = '1234' ! { dg-error "Cannot convert" }
+ c = '12341234' ! { dg-error "Cannot convert" }
+ d = '1234' ! { dg-error "Cannot convert" }
+ e = 4h1234
+ f = 4h1234
+ g = 8h12341234
+ h = 4h1234
+
+ if (a.ne.e) stop 1
+ if (b.ne.f) stop 2
+ if (c.ne.g) stop 3
+ if (d.neqv.h) stop 4
+
+ ! padded values
+ a = '12' ! { dg-error "Cannot convert" }
+ b = '12' ! { dg-error "Cannot convert" }
+ c = '12234' ! { dg-error "Cannot convert" }
+ d = '124' ! { dg-error "Cannot convert" }
+ e = 2h12
+ f = 2h12
+ g = 5h12234
+ h = 3h123
+
+ if (a.ne.e) stop 5
+ if (b.ne.f) stop 6
+ if (c.ne.g) stop 7
+ if (d.neqv.h) stop 8
+
+ ! truncated values
+ a = '123478' ! { dg-error "Cannot convert" }
+ b = '123478' ! { dg-error "Cannot convert" }
+ c = '12341234987' ! { dg-error "Cannot convert" }
+ d = '1234abc' ! { dg-error "Cannot convert" }
+ e = 6h123478 !
+ f = 6h123478 !
+ g = 11h12341234987 !
+ h = 7h1234abc !
+
+ if (a.ne.e) stop 5
+ if (b.ne.f) stop 6
+ if (c.ne.g) stop 7
+ if (d.neqv.h) stop 8
+
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/dec_char_conversion_in_data_1.f90 b/gcc/testsuite/gfortran.dg/dec_char_conversion_in_data_1.f90
new file mode 100644
index 00000000000..c493be9314b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_char_conversion_in_data_1.f90
@@ -0,0 +1,69 @@
+! { dg-do run }
+! { dg-options "-fdec -Wsurprising" }
+!
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+
+subroutine normal
+ integer(4) :: a
+ real(4) :: b
+ complex(4) :: c
+ logical(4) :: d
+ integer(4) :: e
+ real(4) :: f
+ complex(4) :: g
+ logical(4) :: h
+
+ data a, b, c, d / '1234', '1234', '12341234', '1234' / ! { dg-warning "undefined result" }
+ data e, f, g, h / 4h1234, 4h1234, 8h12341234, 4h1234 / ! { dg-warning "undefined result" }
+
+ if (a.ne.e) stop 1
+ if (b.ne.f) stop 2
+ if (c.ne.g) stop 3
+ if (d.neqv.h) stop 4
+end subroutine
+
+subroutine padded
+ integer(4) :: a
+ real(4) :: b
+ complex(4) :: c
+ logical(4) :: d
+ integer(4) :: e
+ real(4) :: f
+ complex(4) :: g
+ logical(4) :: h
+
+ data a, b, c, d / '12', '12', '12334', '123' / ! { dg-warning "undefined result" }
+ data e, f, g, h / 2h12, 2h12, 5h12334, 3h123 / ! { dg-warning "undefined result" }
+
+ if (a.ne.e) stop 5
+ if (b.ne.f) stop 6
+ if (c.ne.g) stop 7
+ if (d.neqv.h) stop 8
+end subroutine
+
+subroutine truncated
+ integer(4) :: a
+ real(4) :: b
+ complex(4) :: c
+ logical(4) :: d
+ integer(4) :: e
+ real(4) :: f
+ complex(4) :: g
+ logical(4) :: h
+
+ data a, b, c, d / '123478', '123478', '1234123498', '12345' / ! { dg-warning "too long|undefined result" }
+ data e, f, g, h / 6h123478, 6h123478, 10h1234123498, 5h12345 / ! { dg-warning "too long|undefined result" }
+
+ if (a.ne.e) stop 9
+ if (b.ne.f) stop 10
+ if (c.ne.g) stop 11
+ if (d.neqv.h) stop 12
+end subroutine
+
+program test
+ call normal
+ call padded
+ call truncated
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/dec_char_conversion_in_data_2.f90 b/gcc/testsuite/gfortran.dg/dec_char_conversion_in_data_2.f90
new file mode 100644
index 00000000000..c7d8e241cec
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_char_conversion_in_data_2.f90
@@ -0,0 +1,69 @@
+! { dg-do run }
+! { dg-options "-fdec-char-conversions -std=legacy -Wsurprising" }
+!
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+
+subroutine normal
+ integer(4) :: a
+ real(4) :: b
+ complex(4) :: c
+ logical(4) :: d
+ integer(4) :: e
+ real(4) :: f
+ complex(4) :: g
+ logical(4) :: h
+
+ data a, b, c, d / '1234', '1234', '12341234', '1234' / ! { dg-warning "undefined result" }
+ data e, f, g, h / 4h1234, 4h1234, 8h12341234, 4h1234 / ! { dg-warning "undefined result" }
+
+ if (a.ne.e) stop 1
+ if (b.ne.f) stop 2
+ if (c.ne.g) stop 3
+ if (d.neqv.h) stop 4
+end subroutine
+
+subroutine padded
+ integer(4) :: a
+ real(4) :: b
+ complex(4) :: c
+ logical(4) :: d
+ integer(4) :: e
+ real(4) :: f
+ complex(4) :: g
+ logical(4) :: h
+
+ data a, b, c, d / '12', '12', '12334', '123' / ! { dg-warning "undefined result" }
+ data e, f, g, h / 2h12, 2h12, 5h12334, 3h123 / ! { dg-warning "undefined result" }
+
+ if (a.ne.e) stop 5
+ if (b.ne.f) stop 6
+ if (c.ne.g) stop 7
+ if (d.neqv.h) stop 8
+end subroutine
+
+subroutine truncated
+ integer(4) :: a
+ real(4) :: b
+ complex(4) :: c
+ logical(4) :: d
+ integer(4) :: e
+ real(4) :: f
+ complex(4) :: g
+ logical(4) :: h
+
+ data a, b, c, d / '123478', '123478', '1234123498', '12345' / ! { dg-warning "too long|undefined result" }
+ data e, f, g, h / 6h123478, 6h123478, 10h1234123498, 5h12345 / ! { dg-warning "too long|undefined result" }
+
+ if (a.ne.e) stop 9
+ if (b.ne.f) stop 10
+ if (c.ne.g) stop 11
+ if (d.neqv.h) stop 12
+end subroutine
+
+program test
+ call normal
+ call padded
+ call truncated
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/dec_char_conversion_in_data_3.f90 b/gcc/testsuite/gfortran.dg/dec_char_conversion_in_data_3.f90
new file mode 100644
index 00000000000..e7d084b5ffc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_char_conversion_in_data_3.f90
@@ -0,0 +1,69 @@
+! { dg-do compile }
+! { dg-options "-fdec -fno-dec-char-conversions" }
+!
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+
+subroutine normal
+ integer(4) :: a
+ real(4) :: b
+ complex(4) :: c
+ logical(4) :: d
+ integer(4) :: e
+ real(4) :: f
+ complex(4) :: g
+ logical(4) :: h
+
+ data a, b, c, d / '1234', '1234', '12341234', '1234' / ! { dg-error "Incompatible types" }
+ data e, f, g, h / 4h1234, 4h1234, 8h12341234, 4h1234 /
+
+ if (a.ne.e) stop 1
+ if (b.ne.f) stop 2
+ if (c.ne.g) stop 3
+ if (d.neqv.h) stop 4
+end subroutine
+
+subroutine padded
+ integer(4) :: a
+ real(4) :: b
+ complex(4) :: c
+ logical(4) :: d
+ integer(4) :: e
+ real(4) :: f
+ complex(4) :: g
+ logical(4) :: h
+
+ data a, b, c, d / '12', '12', '12334', '123' / ! { dg-error "Incompatible types" }
+ data e, f, g, h / 2h12, 2h12, 5h12334, 3h123 /
+
+ if (a.ne.e) stop 5
+ if (b.ne.f) stop 6
+ if (c.ne.g) stop 7
+ if (d.neqv.h) stop 8
+end subroutine
+
+subroutine truncated
+ integer(4) :: a
+ real(4) :: b
+ complex(4) :: c
+ logical(4) :: d
+ integer(4) :: e
+ real(4) :: f
+ complex(4) :: g
+ logical(4) :: h
+
+ data a, b, c, d / '123478', '123478', '1234123498', '12345' / ! { dg-error "Incompatible types" }
+ data e, f, g, h / 6h123478, 6h123478, 10h1234123498, 5h12345 /
+
+ if (a.ne.e) stop 9
+ if (b.ne.f) stop 10
+ if (c.ne.g) stop 11
+ if (d.neqv.h) stop 12
+end subroutine
+
+program test
+ call normal
+ call padded
+ call truncated
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/hollerith5.f90 b/gcc/testsuite/gfortran.dg/hollerith5.f90
index ebd0a117c4f..d17f9ae40cf 100644
--- a/gcc/testsuite/gfortran.dg/hollerith5.f90
+++ b/gcc/testsuite/gfortran.dg/hollerith5.f90
@@ -1,8 +1,9 @@
! { dg-do compile }
+ ! { dg-options "-Wsurprising" }
implicit none
logical b
b = 4Habcd ! { dg-warning "has undefined result" }
end
-! { dg-warning "Hollerith constant" "const" { target *-*-* } 4 }
-! { dg-warning "Conversion" "conversion" { target *-*-* } 4 }
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 5 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 5 }
diff --git a/gcc/testsuite/gfortran.dg/hollerith_legacy.f90 b/gcc/testsuite/gfortran.dg/hollerith_legacy.f90
index c3322498345..9d7e989b552 100644
--- a/gcc/testsuite/gfortran.dg/hollerith_legacy.f90
+++ b/gcc/testsuite/gfortran.dg/hollerith_legacy.f90
@@ -1,5 +1,5 @@
! { dg-do compile }
-! { dg-options "-std=legacy" }
+! { dg-options "-std=legacy -Wsurprising" }
! PR15966, PR18781 & PR16531
implicit none
complex(kind=8) x(2)
diff --git a/gcc/testsuite/gfortran.dg/no_char_to_int_assign.f90 b/gcc/testsuite/gfortran.dg/no_char_to_int_assign.f90
new file mode 100644
index 00000000000..ccfcc9ae512
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/no_char_to_int_assign.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! { dg-options "-fdec-char-conversions" }
+!
+! Test character to int conversion in DATA types
+!
+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+program test
+ integer a
+ real b
+ complex c
+ logical d
+ character e
+
+ e = "A"
+ a = e ! { dg-error "Cannot convert" }
+ b = e ! { dg-error "Cannot convert" }
+ c = e ! { dg-error "Cannot convert" }
+ d = e ! { dg-error "Cannot convert" }
+end program
--
2.11.0

View File

@ -1,7 +1,7 @@
From 96563a652406d3c8471d75e6527ba634fa013400 Mon Sep 17 00:00:00 2001
From: Jim MacArthur <jim.macarthur@codethink.co.uk>
Date: Mon, 5 Oct 2015 14:05:03 +0100
Subject: [PATCH 08/16] Allow non-integer substring indexes
From e61c233e6af3c392f5ac7d3f927b3fa8a55c6076 Mon Sep 17 00:00:00 2001
From: Mark Eggleston <markeggleston@gcc.gnu.org>
Date: Mon, 3 Feb 2020 09:11:38 +0000
Subject: [PATCH 04/10] Allow non-integer substring indexes
Use -fdec-non-integer-index compiler flag to enable. Also enabled by -fdec.
---
@ -17,10 +17,10 @@ Use -fdec-non-integer-index compiler flag to enable. Also enabled by -fdec.
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 3d8aaeaaf44..772cf5e81f1 100644
index 5257da74b06..0fea012b7b6 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -474,6 +474,10 @@ fdec-math
@@ -485,6 +485,10 @@ fdec-math
Fortran Var(flag_dec_math)
Enable legacy math intrinsics for compatibility.
@ -32,22 +32,22 @@ index 3d8aaeaaf44..772cf5e81f1 100644
Fortran Var(flag_dec_structure)
Enable support for DEC STRUCTURE/RECORD.
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index a8c2cf71c3b..e0ef03e6cc5 100644
index 75181ca6442..8c79a0bd122 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -79,6 +79,7 @@ set_dec_flags (int value)
SET_BITFLAG (flag_dec_char_conversions, value, value);
SET_BITFLAG (flag_dec_comparisons, value, 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);
}
/* Finalize DEC flags. */
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index c8b6333874b..04679d3a15d 100644
index 6e70eaf8812..044eed22c76 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -4992,6 +4992,16 @@ resolve_substring (gfc_ref *ref, bool *equal_length)
@@ -5087,6 +5087,16 @@ resolve_substring (gfc_ref *ref, bool *equal_length)
if (!gfc_resolve_expr (ref->u.ss.start))
return false;
@ -64,7 +64,7 @@ index c8b6333874b..04679d3a15d 100644
if (ref->u.ss.start->ts.type != BT_INTEGER)
{
gfc_error ("Substring start index at %L must be of type INTEGER",
@@ -5021,6 +5031,16 @@ resolve_substring (gfc_ref *ref, bool *equal_length)
@@ -5116,6 +5126,16 @@ resolve_substring (gfc_ref *ref, bool *equal_length)
if (!gfc_resolve_expr (ref->u.ss.end))
return false;

View File

@ -1,7 +1,7 @@
From 772fea9acdac79164f3496f54ef4f63dd2562a0c Mon Sep 17 00:00:00 2001
From: Jim MacArthur <jim.macarthur@codethink.co.uk>
Date: Thu, 4 Feb 2016 16:00:30 +0000
Subject: [PATCH 09/16] Allow old-style initializers in derived types
From 3a023e34ad6f2aca23079f9306ab6a56c7448896 Mon Sep 17 00:00:00 2001
From: Mark Eggleston <markeggleston@gcc.gnu.org>
Date: Mon, 3 Feb 2020 09:18:37 +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/
@ -21,10 +21,10 @@ Use -fdec-old-init to enable. Also enabled by -fdec.
create mode 100644 gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_3.f
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 66f1094aa3d..cdf161a7efa 100644
index 36326f77569..72194bda4a8 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -2739,12 +2739,29 @@ variable_decl (int elem)
@@ -2813,12 +2813,29 @@ variable_decl (int elem)
but not components of derived types. */
else if (gfc_current_state () == COMP_DERIVED)
{
@ -60,10 +60,10 @@ index 66f1094aa3d..cdf161a7efa 100644
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 772cf5e81f1..610d91b6cfd 100644
index 0fea012b7b6..7c53be28a20 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -478,6 +478,10 @@ fdec-non-integer-index
@@ -489,6 +489,10 @@ fdec-non-integer-index
Fortran Var(flag_dec_non_integer_index)
Enable support for non-integer substring indexes.
@ -75,12 +75,12 @@ index 772cf5e81f1..610d91b6cfd 100644
Fortran Var(flag_dec_structure)
Enable support for DEC STRUCTURE/RECORD.
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index e0ef03e6cc5..0aa16825980 100644
index 8c79a0bd122..c1c7f0bb671 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -80,6 +80,7 @@ set_dec_flags (int value)
SET_BITFLAG (flag_dec_comparisons, value, value);
SET_BITFLAG (flag_dec_blank_format_item, value, value);
@@ -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);
}

View File

@ -1,658 +0,0 @@
From 6946d3e3e6a1d839772f4c59a5ab08901111800c Mon Sep 17 00:00:00 2001
From: Mark Eggleston <markeggleston@codethink.com>
Date: Thu, 23 May 2019 09:42:26 +0100
Subject: [PATCH 05/16] dec comparisons
Allow comparison of Hollerith constants with numeric and character
expressions. Also allow comparison of character literalsa with numeric
expressions.
Enable using -fdec-comparisons or -fdec
---
gcc/fortran/intrinsic.c | 5 +-
gcc/fortran/invoke.texi | 32 +++++++++++--
gcc/fortran/lang.opt | 5 ++
gcc/fortran/options.c | 1 +
gcc/fortran/resolve.c | 53 +++++++++++++++++++++-
.../gfortran.dg/dec-comparison-character_1.f90 | 18 ++++++++
.../gfortran.dg/dec-comparison-character_2.f90 | 18 ++++++++
.../gfortran.dg/dec-comparison-character_3.f90 | 17 +++++++
.../gfortran.dg/dec-comparison-complex_1.f90 | 22 +++++++++
.../gfortran.dg/dec-comparison-complex_2.f90 | 22 +++++++++
.../gfortran.dg/dec-comparison-complex_3.f90 | 22 +++++++++
gcc/testsuite/gfortran.dg/dec-comparison-int_1.f90 | 31 +++++++++++++
gcc/testsuite/gfortran.dg/dec-comparison-int_2.f90 | 31 +++++++++++++
gcc/testsuite/gfortran.dg/dec-comparison-int_3.f90 | 21 +++++++++
.../gfortran.dg/dec-comparison-real_1.f90 | 31 +++++++++++++
.../gfortran.dg/dec-comparison-real_2.f90 | 31 +++++++++++++
.../gfortran.dg/dec-comparison-real_3.f90 | 31 +++++++++++++
gcc/testsuite/gfortran.dg/dec-comparison.f90 | 41 +++++++++++++++++
18 files changed, 424 insertions(+), 8 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/dec-comparison-character_1.f90
create mode 100644 gcc/testsuite/gfortran.dg/dec-comparison-character_2.f90
create mode 100644 gcc/testsuite/gfortran.dg/dec-comparison-character_3.f90
create mode 100644 gcc/testsuite/gfortran.dg/dec-comparison-complex_1.f90
create mode 100644 gcc/testsuite/gfortran.dg/dec-comparison-complex_2.f90
create mode 100644 gcc/testsuite/gfortran.dg/dec-comparison-complex_3.f90
create mode 100644 gcc/testsuite/gfortran.dg/dec-comparison-int_1.f90
create mode 100644 gcc/testsuite/gfortran.dg/dec-comparison-int_2.f90
create mode 100644 gcc/testsuite/gfortran.dg/dec-comparison-int_3.f90
create mode 100644 gcc/testsuite/gfortran.dg/dec-comparison-real_1.f90
create mode 100644 gcc/testsuite/gfortran.dg/dec-comparison-real_2.f90
create mode 100644 gcc/testsuite/gfortran.dg/dec-comparison-real_3.f90
create mode 100644 gcc/testsuite/gfortran.dg/dec-comparison.f90
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index e94d5d3225f..6d47ae3105f 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -4020,7 +4020,7 @@ add_conversions (void)
/* Flang allows character conversions similar to Hollerith conversions
- the first characters will be turned into ascii values. */
- if (flag_dec_char_conversions)
+ if (flag_dec_char_conversions || flag_dec_comparisons)
{
/* Character-Integer conversions. */
for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
@@ -5150,7 +5150,8 @@ gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)
gfc_typename (&from_ts), gfc_typename (ts),
&expr->where);
}
- else if (flag_dec_char_conversions && from_ts.type == BT_CHARACTER
+ else if ((flag_dec_char_conversions || flag_dec_comparisons)
+ && from_ts.type == BT_CHARACTER
&& (gfc_numeric_ts (ts) || ts->type == BT_LOGICAL))
{
if (warn_conversion)
diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi
index 8364c67b2df..d101b01e301 100644
--- a/gcc/fortran/invoke.texi
+++ b/gcc/fortran/invoke.texi
@@ -117,15 +117,16 @@ by type. Explanations are in the following sections.
@item Fortran Language Options
@xref{Fortran Dialect Options,,Options controlling Fortran dialect}.
@gccoptlist{-fall-intrinsics -fbackslash -fcray-pointer -fd-lines-as-code @gol
--fd-lines-as-comments @gol
--fdec -fdec-structure -fdec-intrinsic-ints -fdec-static -fdec-math @gol
--fdec-include -fdefault-double-8 -fdefault-integer-8 -fdefault-real-8 @gol
--fdefault-real-10 -fdefault-real-16 -fdollar-ok -ffixed-line-length-@var{n} @gol
+-fd-lines-as-comments -fdec -fdec-structure -fdec-intrinsic-ints @gol
+-fdec-static -fdec-math -fdec-include -fdec-format-defaults @gol
+-fdec-add-missing-indexes -fdec-blank-format-item -fdec-comparisons @gol
+-fdefault-double-8 -fdefault-integer-8 -fdefault-real-8 -fdefault-real-10 @gol
+-fdefault-real-16 -fdollar-ok -ffixed-line-length-@var{n} @gol
-ffixed-line-length-none -fpad-source -ffree-form -ffree-line-length-@var{n} @gol
-ffree-line-length-none -fimplicit-none -finteger-4-integer-8 @gol
-fmax-identifier-length -fmodule-private -ffixed-form -fno-range-check @gol
-fopenacc -fopenmp -freal-4-real-10 -freal-4-real-16 -freal-4-real-8 @gol
--freal-8-real-10 -freal-8-real-16 -freal-8-real-4 -std=@var{std}
+-freal-8-real-10 -freal-8-real-16 -freal-8-real-4 -std=@var{std} @gol
-ftest-forall-temp
}
@@ -283,6 +284,27 @@ Enable parsing of INCLUDE as a statement in addition to parsing it as
INCLUDE line. When parsed as INCLUDE statement, INCLUDE does not have to
be on a single line and can use line continuations.
+@item -fdec-add-missing-indexes
+@opindex @code{fdec-add-missing-indexes}
+Enable the insertion of missing dimensions using the lower bounds of those
+dimensions.
+
+@item -fdec-format-defaults
+@opindex @code{fdec-format-defaults}
+Enable format specifiers F, G and I to be used without width specifiers,
+default widths will be used instead.
+
+@item -fdec-blank-format-item
+@opindex @code{fdec-blank-format-item}
+Enable a blank format item at the end of a format specification i.e. nothing
+following the final comma.
+
+@item -fdec-comparisons
+@opindex @code{fdec-comparisons}
+Enable comparison of Hollerith constants and character literals with numeric and
+character expressions. Also enable comparison of Hollerith constants with numeric
+expressions.
+
@item -fdollar-ok
@opindex @code{fdollar-ok}
@cindex @code{$}
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 5746b99b1d4..a957b90707f 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -449,6 +449,11 @@ Fortran Var(flag_dec_char_conversions)
Enable the use of character literals in assignments and data statements
for non-character variables.
+fdec-comparisons
+Fortran Var(flag_dec_comparisons)
+Enable the use of hollerith constants in comparisons. Also enables comparison
+of character literals and numeric vaiables.
+
fdec-include
Fortran Var(flag_dec_include)
Enable legacy parsing of INCLUDE as statement.
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index e97b1568810..b652be70f3d 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -77,6 +77,7 @@ set_dec_flags (int value)
SET_BITFLAG (flag_dec_format_defaults, value, value);
SET_BITFLAG (flag_dec_duplicates, value, value);
SET_BITFLAG (flag_dec_char_conversions, value, value);
+ SET_BITFLAG (flag_dec_comparisons, value, value);
}
/* Finalize DEC flags. */
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 43559185481..c8b6333874b 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -3888,6 +3888,30 @@ convert_integer_to_logical (gfc_expr *e)
}
}
+/* Return true if TYPE is character based, false otherwise. */
+
+static int
+is_character_based (bt type)
+{
+ return type == BT_CHARACTER || type == BT_HOLLERITH;
+}
+
+
+/* If E is a hollerith, convert it to character and issue a warning
+ for the conversion. */
+
+static void
+convert_hollerith_to_character (gfc_expr *e)
+{
+ if (e->ts.type == BT_HOLLERITH)
+ {
+ gfc_typespec t;
+ t.type = BT_CHARACTER;
+ t.kind = e->ts.kind;
+ gfc_convert_type_warn (e, &t, 2, 1);
+ }
+}
+
/* If E is a logical, convert it to an integer and issue a warning
for the conversion. */
@@ -3904,6 +3928,17 @@ convert_logical_to_integer (gfc_expr *e)
}
}
+/* Convert to numeric and issue a warning for the conversion. */
+
+static void
+convert_to_numeric (gfc_expr *a, gfc_expr *b)
+{
+ gfc_typespec t;
+ t.type = b->ts.type;
+ t.kind = b->ts.kind;
+ gfc_convert_type_warn (a, &t, 2, 1);
+}
+
/* Resolve an operator expression node. This can involve replacing the
operation with a user defined function call. */
@@ -4108,6 +4143,13 @@ resolve_operator (gfc_expr *e)
convert_logical_to_integer (op2);
}
+ if (flag_dec_comparisons && is_character_based (op1->ts.type)
+ && is_character_based (op2->ts.type))
+ {
+ convert_hollerith_to_character (op1);
+ convert_hollerith_to_character (op2);
+ }
+
if (op1->ts.type == BT_CHARACTER && op2->ts.type == BT_CHARACTER
&& op1->ts.kind == op2->ts.kind)
{
@@ -4116,6 +4158,15 @@ resolve_operator (gfc_expr *e)
break;
}
+ if (flag_dec_comparisons && is_character_based (op1->ts.type)
+ && op1->expr_type == EXPR_CONSTANT && gfc_numeric_ts (&op2->ts))
+ convert_to_numeric (op1, op2);
+
+ if (flag_dec_comparisons && gfc_numeric_ts (&op1->ts)
+ && is_character_based (op2->ts.type)
+ && op2->expr_type == EXPR_CONSTANT)
+ convert_to_numeric (op2, op1);
+
if (gfc_numeric_ts (&op1->ts) && gfc_numeric_ts (&op2->ts))
{
gfc_type_convert_binary (e, 1);
@@ -10499,7 +10550,7 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
if ((gfc_numeric_ts (&lhs->ts) || lhs->ts.type == BT_LOGICAL)
&& rhs->ts.type == BT_CHARACTER
- && rhs->expr_type != EXPR_CONSTANT)
+ && (rhs->expr_type != EXPR_CONSTANT || !flag_dec_char_conversions))
{
gfc_error ("Cannot convert CHARACTER into %s at %L",
gfc_typename (&lhs->ts),
diff --git a/gcc/testsuite/gfortran.dg/dec-comparison-character_1.f90 b/gcc/testsuite/gfortran.dg/dec-comparison-character_1.f90
new file mode 100644
index 00000000000..d8209163a0e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec-comparison-character_1.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! { dg-options "-fdec -Wconversion" }
+!
+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+
+program convert
+ character(4) :: c = 4HJMAC ! { dg-warning "HOLLERITH to CHARACTER" }
+ if (4HJMAC.ne.4HJMAC) stop 1 ! { dg-warning "HOLLERITH to CHARACTER" }
+ if (4HJMAC.ne."JMAC") stop 2 ! { dg-warning "HOLLERITH to CHARACTER" }
+ if (4HJMAC.eq."JMAN") stop 3 ! { dg-warning "HOLLERITH to CHARACTER" }
+ if ("JMAC".eq.4HJMAN) stop 4 ! { dg-warning "HOLLERITH to CHARACTER" }
+ if ("AAAA".eq.5HAAAAA) stop 5 ! { dg-warning "HOLLERITH to CHARACTER" }
+ if ("BBBBB".eq.5HBBBB ) stop 6 ! { dg-warning "HOLLERITH to CHARACTER" }
+ if (4HJMAC.ne.c) stop 7 ! { dg-warning "HOLLERITH to CHARACTER" }
+ if (c.ne.4HJMAC) stop 8 ! { dg-warning "HOLLERITH to CHARACTER" }
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/dec-comparison-character_2.f90 b/gcc/testsuite/gfortran.dg/dec-comparison-character_2.f90
new file mode 100644
index 00000000000..7332acbaf5c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec-comparison-character_2.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! { dg-options "-fdec-comparisons -std=legacy -Wconversion" }
+!
+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+
+program convert
+ character(4) :: c = 4HJMAC ! { dg-warning "HOLLERITH to CHARACTER" }
+ if (4HJMAC.ne.4HJMAC) stop 1 ! { dg-warning "HOLLERITH to CHARACTER" }
+ if (4HJMAC.ne."JMAC") stop 2 ! { dg-warning "HOLLERITH to CHARACTER" }
+ if (4HJMAC.eq."JMAN") stop 3 ! { dg-warning "HOLLERITH to CHARACTER" }
+ if ("JMAC".eq.4HJMAN) stop 4 ! { dg-warning "HOLLERITH to CHARACTER" }
+ if ("AAAA".eq.5HAAAAA) stop 5 ! { dg-warning "HOLLERITH to CHARACTER" }
+ if ("BBBBB".eq.5HBBBB ) stop 6 ! { dg-warning "HOLLERITH to CHARACTER" }
+ if (4HJMAC.ne.c) stop 7 ! { dg-warning "HOLLERITH to CHARACTER" }
+ if (c.ne.4HJMAC) stop 8 ! { dg-warning "HOLLERITH to CHARACTER" }
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/dec-comparison-character_3.f90 b/gcc/testsuite/gfortran.dg/dec-comparison-character_3.f90
new file mode 100644
index 00000000000..c20c012478a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec-comparison-character_3.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! { dg-options "-fdec -fno-dec-comparisons" }
+!
+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+
+program convert
+ character(4) :: c = 4HJMAC
+ if (4HJMAC.ne.4HJMAC) stop 1 ! { dg-error "Operands of comparison" }
+ if (4HJMAC.ne."JMAC") stop 2 ! { dg-error "Operands of comparison" }
+ if (4HJMAC.eq."JMAN") stop 3 ! { dg-error "Operands of comparison" }
+ if ("JMAC".eq.4HJMAN) stop 4 ! { dg-error "Operands of comparison" }
+ if ("AAAA".eq.5HAAAAA) stop 5 ! { dg-error "Operands of comparison" }
+ if ("BBBBB".eq.5HBBBB ) stop 6 ! { dg-error "Operands of comparison" }
+ if (4HJMAC.ne.c) stop 7 ! { dg-error "Operands of comparison" }
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/dec-comparison-complex_1.f90 b/gcc/testsuite/gfortran.dg/dec-comparison-complex_1.f90
new file mode 100644
index 00000000000..3495f2ae414
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec-comparison-complex_1.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! { dg-options "-std=legacy -fdec -Wconversion" }
+!
+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+
+program convert
+ complex(4) :: a
+ complex(4) :: b
+ a = 8HABCDABCD ! { dg-warning "Conversion from HOLLERITH" }
+ b = transfer("ABCDABCD", b);
+ ! Hollerith constants
+ if (a.ne.8HABCDABCD) stop 1 ! { dg-warning "Conversion from HOLLERITH" }
+ if (a.eq.8HABCEABCE) stop 2 ! { dg-warning "Conversion from HOLLERITH" }
+ if (8HABCDABCD.ne.b) stop 3 ! { dg-warning "Conversion from HOLLERITH" }
+ if (8HABCEABCE.eq.b) stop 4 ! { dg-warning "Conversion from HOLLERITH" }
+ ! Character literals
+ if (a.ne."ABCDABCD") stop 5 ! { dg-warning "Conversion from CHARACTER" }
+ if (a.eq."ABCEABCE") stop 6 ! { dg-warning "Conversion from CHARACTER" }
+ if ("ABCDABCD".ne.b) stop 7 ! { dg-warning "Conversion from CHARACTER" }
+ if ("ABCEABCE".eq.b) stop 8 ! { dg-warning "Conversion from CHARACTER" }
+end program
diff --git a/gcc/testsuite/gfortran.dg/dec-comparison-complex_2.f90 b/gcc/testsuite/gfortran.dg/dec-comparison-complex_2.f90
new file mode 100644
index 00000000000..c38042cc600
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec-comparison-complex_2.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! { dg-options "-std=legacy -fdec-comparisons -Wconversion" }
+!
+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+
+program convert
+ complex(4) :: a
+ complex(4) :: b
+ a = 8HABCDABCD ! { dg-warning "Conversion from HOLLERITH" }
+ b = transfer("ABCDABCD", b);
+ ! Hollerith constants
+ if (a.ne.8HABCDABCD) stop 1 ! { dg-warning "Conversion from HOLLERITH" }
+ if (a.eq.8HABCEABCE) stop 2 ! { dg-warning "Conversion from HOLLERITH" }
+ if (8HABCDABCD.ne.b) stop 3 ! { dg-warning "Conversion from HOLLERITH" }
+ if (8HABCEABCE.eq.b) stop 4 ! { dg-warning "Conversion from HOLLERITH" }
+ ! Character literals
+ if (a.ne."ABCDABCD") stop 5 ! { dg-warning "Conversion from CHARACTER" }
+ if (a.eq."ABCEABCE") stop 6 ! { dg-warning "Conversion from CHARACTER" }
+ if ("ABCDABCD".ne.b) stop 7 ! { dg-warning "Conversion from CHARACTER" }
+ if ("ABCEABCE".eq.b) stop 8 ! { dg-warning "Conversion from CHARACTER" }
+end program
diff --git a/gcc/testsuite/gfortran.dg/dec-comparison-complex_3.f90 b/gcc/testsuite/gfortran.dg/dec-comparison-complex_3.f90
new file mode 100644
index 00000000000..9b27fc4d502
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec-comparison-complex_3.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! { dg-options "-std=legacy -fdec -fno-dec-comparisons -Wconversion" }
+!
+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+
+program convert
+ complex(4) :: a
+ complex(4) :: b
+ a = 8HABCDABCD ! { dg-warning "Conversion from HOLLERITH" }
+ b = transfer("ABCDABCD", b);
+ ! Hollerith constants
+ if (a.ne.8HABCDABCD) stop 1 ! { dg-error "Operands of comparison" }
+ if (a.eq.8HABCEABCE) stop 2 ! { dg-error "Operands of comparison" }
+ if (8HABCDABCD.ne.b) stop 3 ! { dg-error "Operands of comparison" }
+ if (8HABCEABCE.eq.b) stop 4 ! { dg-error "Operands of comparison" }
+ ! character literals
+ if (a.ne."ABCDABCD") stop 5 ! { dg-error "Operands of comparison" }
+ if (a.eq."ABCEABCE") stop 6 ! { dg-error "Operands of comparison" }
+ if ("ABCDABCD".ne.b) stop 7 ! { dg-error "Operands of comparison" }
+ if ("ABCEABCE".eq.b) stop 8 ! { dg-error "Operands of comparison" }
+end program
diff --git a/gcc/testsuite/gfortran.dg/dec-comparison-int_1.f90 b/gcc/testsuite/gfortran.dg/dec-comparison-int_1.f90
new file mode 100644
index 00000000000..c93b61e29cf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec-comparison-int_1.f90
@@ -0,0 +1,31 @@
+! { dg-do run }
+! { dg-options "-std=legacy -fdec -Wconversion" }
+!
+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+
+program convert
+ integer(4) :: a
+ integer(4) :: b
+ a = 4HABCD ! { dg-warning "Conversion from HOLLERITH" }
+ b = transfer("ABCD", b)
+ ! Hollerith constants
+ if (a.ne.4HABCD) stop 1 ! { dg-warning "Conversion from HOLLERITH" }
+ if (a.eq.4HABCE) stop 2 ! { dg-warning "Conversion from HOLLERITH" }
+ if (4HABCD.ne.b) stop 3 ! { dg-warning "Conversion from HOLLERITH" }
+ if (4HABCE.eq.b) stop 4 ! { dg-warning "Conversion from HOLLERITH" }
+ if (4HABCE.lt.a) stop 5 ! { dg-warning "Conversion from HOLLERITH" }
+ if (a.gt.4HABCE) stop 6 ! { dg-warning "Conversion from HOLLERITH" }
+ if (4HABCE.le.a) stop 7 ! { dg-warning "Conversion from HOLLERITH" }
+ if (a.ge.4HABCE) stop 8 ! { dg-warning "Conversion from HOLLERITH" }
+ ! Character literals
+ if (a.ne."ABCD") stop 9 ! { dg-warning "Conversion from CHARACTER" }
+ if (a.eq."ABCE") stop 10 ! { dg-warning "Conversion from CHARACTER" }
+ if ("ABCD".ne.b) stop 11 ! { dg-warning "Conversion from CHARACTER" }
+ if ("ABCE".eq.b) stop 12 ! { dg-warning "Conversion from CHARACTER" }
+ if ("ABCE".lt.a) stop 13 ! { dg-warning "Conversion from CHARACTER" }
+ if (a.gt."ABCE") stop 14 ! { dg-warning "Conversion from CHARACTER" }
+ if ("ABCE".le.a) stop 15 ! { dg-warning "Conversion from CHARACTER" }
+ if (a.ge."ABCE") stop 16 ! { dg-warning "Conversion from CHARACTER" }
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/dec-comparison-int_2.f90 b/gcc/testsuite/gfortran.dg/dec-comparison-int_2.f90
new file mode 100644
index 00000000000..cd1ae783d41
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec-comparison-int_2.f90
@@ -0,0 +1,31 @@
+! { dg-do run }
+! { dg-options "-std=legacy -fdec-comparisons -Wconversion" }
+!
+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+
+program convert
+ integer(4) :: a
+ integer(4) :: b
+ a = 4HABCD ! { dg-warning "Conversion from HOLLERITH" }
+ b = transfer("ABCD", b)
+ ! Hollerith constants
+ if (a.ne.4HABCD) stop 1 ! { dg-warning "Conversion from HOLLERITH" }
+ if (a.eq.4HABCE) stop 2 ! { dg-warning "Conversion from HOLLERITH" }
+ if (4HABCD.ne.b) stop 3 ! { dg-warning "Conversion from HOLLERITH" }
+ if (4HABCE.eq.b) stop 4 ! { dg-warning "Conversion from HOLLERITH" }
+ if (4HABCE.lt.a) stop 5 ! { dg-warning "Conversion from HOLLERITH" }
+ if (a.gt.4HABCE) stop 6 ! { dg-warning "Conversion from HOLLERITH" }
+ if (4HABCE.le.a) stop 7 ! { dg-warning "Conversion from HOLLERITH" }
+ if (a.ge.4HABCE) stop 8 ! { dg-warning "Conversion from HOLLERITH" }
+ ! Character literals
+ if (a.ne."ABCD") stop 9 ! { dg-warning "Conversion from CHARACTER" }
+ if (a.eq."ABCE") stop 10 ! { dg-warning "Conversion from CHARACTER" }
+ if ("ABCD".ne.b) stop 11 ! { dg-warning "Conversion from CHARACTER" }
+ if ("ABCE".eq.b) stop 12 ! { dg-warning "Conversion from CHARACTER" }
+ if ("ABCE".lt.a) stop 13 ! { dg-warning "Conversion from CHARACTER" }
+ if (a.gt."ABCE") stop 14 ! { dg-warning "Conversion from CHARACTER" }
+ if ("ABCE".le.a) stop 15 ! { dg-warning "Conversion from CHARACTER" }
+ if (a.ge."ABCE") stop 16 ! { dg-warning "Conversion from CHARACTER" }
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/dec-comparison-int_3.f90 b/gcc/testsuite/gfortran.dg/dec-comparison-int_3.f90
new file mode 100644
index 00000000000..b350075afe7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec-comparison-int_3.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-options "-fdec -fno-dec-comparisons -Wconversion" }
+!
+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+
+program convert
+ integer(4) :: a
+ integer(4) :: b
+ a = 4HABCD ! { dg-warning "Conversion from HOLLERITH" }
+ b = transfer("ABCD", b)
+ if (a.ne.4HABCD) stop 1 ! { dg-error "Operands of comparison" }
+ if (a.eq.4HABCE) stop 2 ! { dg-error "Operands of comparison" }
+ if (4HABCD.ne.b) stop 3 ! { dg-error "Operands of comparison" }
+ if (4HABCE.eq.b) stop 4 ! { dg-error "Operands of comparison" }
+ if (4HABCE.lt.a) stop 5 ! { dg-error "Operands of comparison" }
+ if (a.gt.4HABCE) stop 6 ! { dg-error "Operands of comparison" }
+ if (4HABCE.le.a) stop 7 ! { dg-error "Operands of comparison" }
+ if (a.ge.4HABCE) stop 8 ! { dg-error "Operands of comparison" }
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/dec-comparison-real_1.f90 b/gcc/testsuite/gfortran.dg/dec-comparison-real_1.f90
new file mode 100644
index 00000000000..08b66aaebfd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec-comparison-real_1.f90
@@ -0,0 +1,31 @@
+! { dg-do run }
+! { dg-options "-std=legacy -fdec -Wconversion" }
+!
+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+
+program convert
+ real(4) :: a
+ real(4) :: b
+ a = 4HABCD ! { dg-warning "Conversion from HOLLERITH" }
+ b = transfer("ABCD", b)
+ ! Hollerith constants
+ if (a.ne.4HABCD) stop 1 ! { dg-warning "Conversion from HOLLERITH" }
+ if (a.eq.4HABCE) stop 2 ! { dg-warning "Conversion from HOLLERITH" }
+ if (4HABCD.ne.b) stop 3 ! { dg-warning "Conversion from HOLLERITH" }
+ if (4HABCE.eq.b) stop 4 ! { dg-warning "Conversion from HOLLERITH" }
+ if (4HABCE.lt.a) stop 5 ! { dg-warning "Conversion from HOLLERITH" }
+ if (a.gt.4HABCE) stop 6 ! { dg-warning "Conversion from HOLLERITH" }
+ if (4HABCE.le.a) stop 7 ! { dg-warning "Conversion from HOLLERITH" }
+ if (a.ge.4HABCE) stop 8 ! { dg-warning "Conversion from HOLLERITH" }
+ ! Character literals
+ if (a.ne."ABCD") stop 9 ! { dg-warning "Conversion from CHARACTER" }
+ if (a.eq."ABCE") stop 10 ! { dg-warning "Conversion from CHARACTER" }
+ if ("ABCD".ne.b) stop 11 ! { dg-warning "Conversion from CHARACTER" }
+ if ("ABCE".eq.b) stop 12 ! { dg-warning "Conversion from CHARACTER" }
+ if ("ABCE".lt.a) stop 13 ! { dg-warning "Conversion from CHARACTER" }
+ if (a.gt."ABCE") stop 14 ! { dg-warning "Conversion from CHARACTER" }
+ if ("ABCE".le.a) stop 15 ! { dg-warning "Conversion from CHARACTER" }
+ if (a.ge."ABCE") stop 16 ! { dg-warning "Conversion from CHARACTER" }
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/dec-comparison-real_2.f90 b/gcc/testsuite/gfortran.dg/dec-comparison-real_2.f90
new file mode 100644
index 00000000000..244abb84868
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec-comparison-real_2.f90
@@ -0,0 +1,31 @@
+! { dg-do run }
+! { dg-options "-std=legacy -fdec-comparisons -Wconversion" }
+!
+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+
+program convert
+ real(4) :: a
+ real(4) :: b
+ a = 4HABCD ! { dg-warning "Conversion from HOLLERITH" }
+ b = transfer("ABCD", b)
+ ! Hollerith constants
+ if (a.ne.4HABCD) stop 1 ! { dg-warning "Conversion from HOLLERITH" }
+ if (a.eq.4HABCE) stop 2 ! { dg-warning "Conversion from HOLLERITH" }
+ if (4HABCD.ne.b) stop 3 ! { dg-warning "Conversion from HOLLERITH" }
+ if (4HABCE.eq.b) stop 4 ! { dg-warning "Conversion from HOLLERITH" }
+ if (4HABCE.lt.a) stop 5 ! { dg-warning "Conversion from HOLLERITH" }
+ if (a.gt.4HABCE) stop 6 ! { dg-warning "Conversion from HOLLERITH" }
+ if (4HABCE.le.a) stop 7 ! { dg-warning "Conversion from HOLLERITH" }
+ if (a.ge.4HABCE) stop 8 ! { dg-warning "Conversion from HOLLERITH" }
+ ! Character literals
+ if (a.ne."ABCD") stop 9 ! { dg-warning "Conversion from CHARACTER" }
+ if (a.eq."ABCE") stop 10 ! { dg-warning "Conversion from CHARACTER" }
+ if ("ABCD".ne.b) stop 11 ! { dg-warning "Conversion from CHARACTER" }
+ if ("ABCE".eq.b) stop 12 ! { dg-warning "Conversion from CHARACTER" }
+ if ("ABCE".lt.a) stop 13 ! { dg-warning "Conversion from CHARACTER" }
+ if (a.gt."ABCE") stop 14 ! { dg-warning "Conversion from CHARACTER" }
+ if ("ABCE".le.a) stop 15 ! { dg-warning "Conversion from CHARACTER" }
+ if (a.ge."ABCE") stop 16 ! { dg-warning "Conversion from CHARACTER" }
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/dec-comparison-real_3.f90 b/gcc/testsuite/gfortran.dg/dec-comparison-real_3.f90
new file mode 100644
index 00000000000..111c648f08c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec-comparison-real_3.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! { dg-options "-std=legacy -fdec -fno-dec-comparisons -Wconversion" }
+!
+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+
+program convert
+ real(4) :: a
+ real(4) :: b
+ a = 4HABCD ! { dg-warning "Conversion from HOLLERITH" }
+ b = transfer("ABCD", b)
+ ! Hollerith constants
+ if (a.ne.4HABCD) stop 1 ! { dg-error "Operands of comparison" }
+ if (a.eq.4HABCE) stop 2 ! { dg-error "Operands of comparison" }
+ if (4HABCD.ne.b) stop 3 ! { dg-error "Operands of comparison" }
+ if (4HABCE.eq.b) stop 4 ! { dg-error "Operands of comparison" }
+ if (4HABCE.lt.a) stop 5 ! { dg-error "Operands of comparison" }
+ if (a.gt.4HABCE) stop 6 ! { dg-error "Operands of comparison" }
+ if (4HABCE.le.a) stop 7 ! { dg-error "Operands of comparison" }
+ if (a.ge.4HABCE) stop 8 ! { dg-error "Operands of comparison" }
+ ! Character literals
+ if (a.ne."ABCD") stop 9 ! { dg-error "Operands of comparison" }
+ if (a.eq."ABCE") stop 10 ! { dg-error "Operands of comparison" }
+ if ("ABCD".ne.b) stop 11 ! { dg-error "Operands of comparison" }
+ if ("ABCE".eq.b) stop 12 ! { dg-error "Operands of comparison" }
+ if ("ABCE".lt.a) stop 13 ! { dg-error "Operands of comparison" }
+ if (a.gt."ABCE") stop 14 ! { dg-error "Operands of comparison" }
+ if ("ABCE".le.a) stop 15 ! { dg-error "Operands of comparison" }
+ if (a.ge."ABCE") stop 16 ! { dg-error "Operands of comparison" }
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/dec-comparison.f90 b/gcc/testsuite/gfortran.dg/dec-comparison.f90
new file mode 100644
index 00000000000..b0b28e55111
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec-comparison.f90
@@ -0,0 +1,41 @@
+! { dg-do compile }
+! { dg-options "-fdec" }
+!
+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+! Hollerith constants and character literals are allowed in comparisons,
+! check that character variables can not be compared with numeric variables.
+
+program convert
+ character(4) :: a = 4hJMAC
+ integer(4) :: b = "JMAC"
+ real(4) :: c = "JMAC"
+ complex(4) :: d = "JMACJMAC"
+ ! integers
+ if (a.ne.b) stop 1 ! { dg-error "Operands of comparison" }
+ if (b.eq.a) stop 2 ! { dg-error "Operands of comparison" }
+ if (a.ge.b) stop 3 ! { dg-error "Operands of comparison" }
+ if (b.ge.a) stop 4 ! { dg-error "Operands of comparison" }
+ if (a.gt.b) stop 5 ! { dg-error "Operands of comparison" }
+ if (b.gt.a) stop 6 ! { dg-error "Operands of comparison" }
+ if (a.le.b) stop 3 ! { dg-error "Operands of comparison" }
+ if (b.le.a) stop 4 ! { dg-error "Operands of comparison" }
+ if (a.lt.b) stop 5 ! { dg-error "Operands of comparison" }
+ if (b.lt.a) stop 6 ! { dg-error "Operands of comparison" }
+ ! reals
+ if (a.ne.c) stop 7 ! { dg-error "Operands of comparison" }
+ if (c.eq.a) stop 8 ! { dg-error "Operands of comparison" }
+ if (a.ge.c) stop 9 ! { dg-error "Operands of comparison" }
+ if (c.ge.a) stop 10 ! { dg-error "Operands of comparison" }
+ if (a.gt.c) stop 11 ! { dg-error "Operands of comparison" }
+ if (c.gt.a) stop 12 ! { dg-error "Operands of comparison" }
+ if (a.le.c) stop 13 ! { dg-error "Operands of comparison" }
+ if (c.le.a) stop 14 ! { dg-error "Operands of comparison" }
+ if (a.lt.c) stop 15 ! { dg-error "Operands of comparison" }
+ if (c.lt.a) stop 16 ! { dg-error "Operands of comparison" }
+ ! complexes
+ a = "JMACJMAC"
+ if (a.ne.d) stop 17 ! { dg-error "Operands of comparison" }
+ if (d.eq.a) stop 18 ! { dg-error "Operands of comparison" }
+end program
+
--
2.11.0

View File

@ -1,150 +0,0 @@
From 8a5920d930429f91b269d9265323bf2507a6b8e5 Mon Sep 17 00:00:00 2001
From: Jim MacArthur <jim.macarthur@codethink.co.uk>
Date: Thu, 4 Feb 2016 16:59:41 +0000
Subject: [PATCH 06/16] Allow blank format items in format strings
This has to be written in a slightly verbose manner because GCC 7
defaults to building with -Werror=implicit-fallthrough which prevents
us from just falling through to the default: case.
Test written by: Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
Use -fdec-blank-format-item to enable. Also enabled by -fdec.
---
gcc/fortran/io.c | 10 ++++++++++
gcc/fortran/lang.opt | 4 ++++
gcc/fortran/options.c | 1 +
gcc/testsuite/gfortran.dg/dec_format_empty_item_1.f | 19 +++++++++++++++++++
gcc/testsuite/gfortran.dg/dec_format_empty_item_2.f | 19 +++++++++++++++++++
gcc/testsuite/gfortran.dg/dec_format_empty_item_3.f | 19 +++++++++++++++++++
6 files changed, 72 insertions(+)
create mode 100644 gcc/testsuite/gfortran.dg/dec_format_empty_item_1.f
create mode 100644 gcc/testsuite/gfortran.dg/dec_format_empty_item_2.f
create mode 100644 gcc/testsuite/gfortran.dg/dec_format_empty_item_3.f
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index 57117579627..5b355952840 100644
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -756,6 +756,16 @@ format_item_1:
error = unexpected_end;
goto syntax;
+ case FMT_RPAREN:
+ /* Oracle allows a blank format item. */
+ if (flag_dec_blank_format_item)
+ goto finished;
+ else
+ {
+ error = unexpected_element;
+ goto syntax;
+ }
+
default:
error = unexpected_element;
goto syntax;
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index a957b90707f..3d8aaeaaf44 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -440,6 +440,10 @@ fdec
Fortran Var(flag_dec)
Enable all DEC language extensions.
+fdec-blank-format-item
+Fortran Var(flag_dec_blank_format_item)
+Enable the use of blank format items in format strings.
+
fdec-duplicates
Fortran Var(flag_dec_duplicates)
Allow varibles to be duplicated in the type specification matches.
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index b652be70f3d..a8c2cf71c3b 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -78,6 +78,7 @@ set_dec_flags (int value)
SET_BITFLAG (flag_dec_duplicates, value, value);
SET_BITFLAG (flag_dec_char_conversions, value, value);
SET_BITFLAG (flag_dec_comparisons, value, value);
+ SET_BITFLAG (flag_dec_blank_format_item, value, value);
}
/* Finalize DEC flags. */
diff --git a/gcc/testsuite/gfortran.dg/dec_format_empty_item_1.f b/gcc/testsuite/gfortran.dg/dec_format_empty_item_1.f
new file mode 100644
index 00000000000..ed27c18944b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_format_empty_item_1.f
@@ -0,0 +1,19 @@
+! { dg-do run }
+! { dg-options "-fdec" }
+!
+! Test blank/empty format items in format string
+!
+! Test case contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+ PROGRAM blank_format_items
+ INTEGER A/0/
+
+ OPEN(1, status="scratch")
+ WRITE(1, 10) 100
+ REWIND(1)
+ READ(1, 10) A
+ IF (a.NE.100) STOP 1
+ PRINT 10, A
+10 FORMAT( I5,)
+ END
diff --git a/gcc/testsuite/gfortran.dg/dec_format_empty_item_2.f b/gcc/testsuite/gfortran.dg/dec_format_empty_item_2.f
new file mode 100644
index 00000000000..2793cb16225
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_format_empty_item_2.f
@@ -0,0 +1,19 @@
+! { dg-do run }
+! { dg-options "-fdec-blank-format-item" }
+!
+! Test blank/empty format items in format string
+!
+! Test case contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+ PROGRAM blank_format_items
+ INTEGER A/0/
+
+ OPEN(1, status="scratch")
+ WRITE(1, 10) 100
+ REWIND(1)
+ READ(1, 10) A
+ IF (a.NE.100) STOP 1
+ PRINT 10, A
+10 FORMAT( I5,)
+ END
diff --git a/gcc/testsuite/gfortran.dg/dec_format_empty_item_3.f b/gcc/testsuite/gfortran.dg/dec_format_empty_item_3.f
new file mode 100644
index 00000000000..499db922876
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_format_empty_item_3.f
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! { dg-options "-fdec -fno-dec-blank-format-item" }
+!
+! Test blank/empty format items in format string
+!
+! Test case contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+ PROGRAM blank_format_items
+ INTEGER A/0/
+
+ OPEN(1, status="scratch")
+ WRITE(1, 10) 100 ! { dg-error "FORMAT label 10 at \\(1\\) not defined" }
+ REWIND(1)
+ READ(1, 10) A ! { dg-error "FORMAT label 10 at \\(1\\) not defined" }
+ IF (a.NE.100) STOP 1
+ PRINT 10, A ! { dg-error "FORMAT label 10 at \\(1\\) not defined" }
+10 FORMAT( I5,) ! { dg-error "Unexpected element" }
+ END
--
2.11.0

View File

@ -1,7 +1,7 @@
From 08e63b85674f146b5f242906d7d5f063b2abd31c Mon Sep 17 00:00:00 2001
From: Jim MacArthur <jim.macarthur@codethink.co.uk>
Date: Wed, 7 Oct 2015 17:04:06 -0400
Subject: [PATCH 10/16] Allow string length and kind to be specified on a per
From 7057f7dcb2b7ded072e0f628add2a0bcae517635 Mon Sep 17 00:00:00 2001
From: Mark Eggleston <markeggleston@gcc.gnu.org>
Date: Mon, 3 Feb 2020 09:28:01 +0000
Subject: [PATCH 06/10] Allow string length and kind to be specified on a per
variable basis.
This allows kind/length to be mixed with array specification in
@ -63,10 +63,10 @@ Contributed by Mark Eggleston <mark.eggleston@codethink.com>
create mode 100644 gcc/testsuite/gfortran.dg/dec_spec_in_variable_8.f
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index cdf161a7efa..eb26bf3bc2d 100644
index 72194bda4a8..d2ea3e5070e 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1153,6 +1153,54 @@ syntax:
@@ -1210,6 +1210,54 @@ syntax:
return MATCH_ERROR;
}
@ -121,7 +121,7 @@ index cdf161a7efa..eb26bf3bc2d 100644
/* Special subroutine for finding a symbol. Check if the name is found
in the current name space. If not, and we're compiling a function or
@@ -2390,6 +2438,35 @@ check_function_name (char *name)
@@ -2437,6 +2485,35 @@ check_function_name (char *name)
}
@ -157,7 +157,7 @@ index cdf161a7efa..eb26bf3bc2d 100644
/* Match a variable name with an optional initializer. When this
subroutine is called, a variable is expected to be parsed next.
Depending on what is happening at the moment, updates either the
@@ -2400,7 +2477,7 @@ variable_decl (int elem)
@@ -2447,7 +2524,7 @@ variable_decl (int elem)
{
char name[GFC_MAX_SYMBOL_LEN + 1];
static unsigned int fill_id = 0;
@ -166,13 +166,14 @@ index cdf161a7efa..eb26bf3bc2d 100644
gfc_array_spec *as;
gfc_array_spec *cp_as; /* Extra copy for Cray Pointees. */
gfc_charlen *cl;
@@ -2409,10 +2486,14 @@ variable_decl (int elem)
@@ -2456,11 +2533,15 @@ variable_decl (int elem)
match m;
bool t;
gfc_symbol *sym;
+ match cl_match;
+ match kind_match;
+ int overridden_kind;
char c;
initializer = NULL;
as = NULL;
@ -181,7 +182,7 @@ index cdf161a7efa..eb26bf3bc2d 100644
/* When we get here, we've just matched a list of attributes and
maybe a type and a double colon. The next thing we expect to see
@@ -2461,6 +2542,28 @@ variable_decl (int elem)
@@ -2513,6 +2594,28 @@ variable_decl (int elem)
var_locus = gfc_current_locus;
@ -210,7 +211,7 @@ index cdf161a7efa..eb26bf3bc2d 100644
/* Now we could see the optional array spec. or character length. */
m = gfc_match_array_spec (&as, true, true);
if (m == MATCH_ERROR)
@@ -2579,40 +2682,12 @@ variable_decl (int elem)
@@ -2653,40 +2756,12 @@ variable_decl (int elem)
}
}
@ -256,7 +257,7 @@ index cdf161a7efa..eb26bf3bc2d 100644
}
/* The dummy arguments and result of the abreviated form of MODULE
@@ -2714,6 +2789,19 @@ variable_decl (int elem)
@@ -2788,6 +2863,19 @@ variable_decl (int elem)
goto cleanup;
}
@ -277,10 +278,10 @@ index cdf161a7efa..eb26bf3bc2d 100644
{
m = MATCH_ERROR;
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 610d91b6cfd..38d31e620bf 100644
index 7c53be28a20..b378f467e2f 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -478,6 +478,10 @@ fdec-non-integer-index
@@ -489,6 +489,10 @@ fdec-non-integer-index
Fortran Var(flag_dec_non_integer_index)
Enable support for non-integer substring indexes.
@ -292,11 +293,11 @@ index 610d91b6cfd..38d31e620bf 100644
Fortran Var(flag_dec_old_init)
Enable support for old style initializers in derived types.
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index 0aa16825980..720fd25b570 100644
index c1c7f0bb671..fac23e83d70 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -81,6 +81,7 @@ set_dec_flags (int value)
SET_BITFLAG (flag_dec_blank_format_item, value, value);
@@ -80,6 +80,7 @@ set_dec_flags (int value)
SET_BITFLAG (flag_dec_duplicates, value, value);
SET_BITFLAG (flag_dec_non_integer_index, value, value);
SET_BITFLAG (flag_dec_old_init, value, value);
+ SET_BITFLAG (flag_dec_override_kind, value, value);

View File

@ -1,7 +1,7 @@
From f6197d0e59059a172f68a697e25cd585ad158937 Mon Sep 17 00:00:00 2001
From: Jim MacArthur <jim.macarthur@codethink.co.uk>
Date: Wed, 11 Nov 2015 15:37:00 +0000
Subject: [PATCH 11/16] Allow non-logical expressions in IF statements
From a47308b5badceb8038fcf5edd2b93f33f2d7997e Mon Sep 17 00:00:00 2001
From: Mark Eggleston <markeggleston@gcc.gnu.org>
Date: Mon, 3 Feb 2020 09:31:05 +0000
Subject: [PATCH 07/10] Allow non-logical expressions in IF statements
Use -fdec-non-logical-if to enable feature. Also enabled using -fdec.
---
@ -23,10 +23,10 @@ Use -fdec-non-logical-if to enable feature. Also enabled using -fdec.
create mode 100644 gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_6.f
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 38d31e620bf..fa2851ae837 100644
index b378f467e2f..0a6b4263e22 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -482,6 +482,10 @@ fdec-override-kind
@@ -493,6 +493,10 @@ fdec-override-kind
Fortran Var(flag_dec_override_kind)
Enable support for per variable kind specification.
@ -38,10 +38,10 @@ index 38d31e620bf..fa2851ae837 100644
Fortran Var(flag_dec_old_init)
Enable support for old style initializers in derived types.
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index 720fd25b570..7b04a681f7b 100644
index fac23e83d70..86b28cfe3e6 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -82,6 +82,7 @@ set_dec_flags (int value)
@@ -81,6 +81,7 @@ set_dec_flags (int value)
SET_BITFLAG (flag_dec_non_integer_index, value, value);
SET_BITFLAG (flag_dec_old_init, value, value);
SET_BITFLAG (flag_dec_override_kind, value, value);
@ -50,10 +50,10 @@ index 720fd25b570..7b04a681f7b 100644
/* Finalize DEC flags. */
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 04679d3a15d..a90f7f849b5 100644
index 044eed22c76..e4bb0e79c80 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -10398,10 +10398,31 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
@@ -10721,10 +10721,31 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
switch (b->op)
{
case EXEC_IF:
@ -89,7 +89,7 @@ index 04679d3a15d..a90f7f849b5 100644
break;
case EXEC_WHERE:
@@ -11690,11 +11711,32 @@ start:
@@ -12019,11 +12040,32 @@ start:
break;
case EXEC_IF:

View File

@ -1,7 +1,7 @@
From 79bc3c8c15122dd929703f5ca7e468ffd46c3c3e Mon Sep 17 00:00:00 2001
From: Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
Date: Mon, 9 Apr 2018 15:10:02 +0100
Subject: [PATCH 12/16] Support type promotion in calls to intrinsics
From f68aa5f6a6d710f12005ca2ee34f27d6a8a68745 Mon Sep 17 00:00:00 2001
From: Mark Eggleston <markeggleston@gcc.gnu.org>
Date: Mon, 3 Feb 2020 09:38:24 +0000
Subject: [PATCH 08/10] Support type promotion in calls to intrinsics
Use -fdec-promotion or -fdec to enable this feature.
@ -32,8 +32,8 @@ Re-worked by Mark Eggleston <mark.eggleston@codethink.com>
.../dec_intrinsic_int_real_promotion_7.f | 118 +++++++++
gcc/testsuite/gfortran.dg/dec_kind_promotion-1.f | 40 ++++
gcc/testsuite/gfortran.dg/dec_kind_promotion-2.f | 40 ++++
gcc/testsuite/gfortran.dg/dec_kind_promotion-3.f | 40 ++++
22 files changed, 1655 insertions(+), 91 deletions(-)
gcc/testsuite/gfortran.dg/dec_kind_promotion-3.f | 39 +++
22 files changed, 1654 insertions(+), 91 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_1.f
create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_2.f
create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_3.f
@ -52,10 +52,10 @@ Re-worked by Mark Eggleston <mark.eggleston@codethink.com>
create mode 100644 gcc/testsuite/gfortran.dg/dec_kind_promotion-3.f
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 0ba4d0a031f..89416ba368d 100644
index 4c0b83e8e6f..d428068674f 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -947,12 +947,40 @@ gfc_check_allocated (gfc_expr *array)
@@ -1393,12 +1393,40 @@ gfc_check_allocated (gfc_expr *array)
}
@ -96,7 +96,7 @@ index 0ba4d0a031f..89416ba368d 100644
if (!int_or_real_check (a, 0))
return false;
@@ -3126,6 +3154,41 @@ check_rest (bt type, int kind, gfc_actual_arglist *arglist)
@@ -3716,6 +3744,41 @@ check_rest (bt type, int kind, gfc_actual_arglist *arglist)
}
@ -138,7 +138,7 @@ index 0ba4d0a031f..89416ba368d 100644
bool
gfc_check_min_max (gfc_actual_arglist *arg)
{
@@ -3150,7 +3213,10 @@ gfc_check_min_max (gfc_actual_arglist *arg)
@@ -3740,7 +3803,10 @@ gfc_check_min_max (gfc_actual_arglist *arg)
return false;
}
@ -150,7 +150,7 @@ index 0ba4d0a031f..89416ba368d 100644
}
@@ -4488,6 +4554,9 @@ gfc_check_shift (gfc_expr *i, gfc_expr *shift)
@@ -5112,6 +5178,9 @@ gfc_check_shift (gfc_expr *i, gfc_expr *shift)
bool
gfc_check_sign (gfc_expr *a, gfc_expr *b)
{
@ -161,10 +161,10 @@ index 0ba4d0a031f..89416ba368d 100644
return false;
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 6d47ae3105f..a4b23bc244a 100644
index 30f9f14572b..1591f9dfc2f 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -4329,6 +4329,11 @@ check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym,
@@ -4430,6 +4430,11 @@ check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym,
if (ts.kind == 0)
ts.kind = actual->expr->ts.kind;
@ -177,10 +177,10 @@ index 6d47ae3105f..a4b23bc244a 100644
{
if (error_flag)
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 53338dda0a7..92d50c3deb9 100644
index 73769615c20..df8a2fd4119 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -893,19 +893,22 @@ gfc_resolve_dble (gfc_expr *f, gfc_expr *a)
@@ -817,19 +817,22 @@ gfc_resolve_dble (gfc_expr *f, gfc_expr *a)
void
gfc_resolve_dim (gfc_expr *f, gfc_expr *a, gfc_expr *p)
{
@ -212,7 +212,7 @@ index 53338dda0a7..92d50c3deb9 100644
f->value.function.name
= gfc_get_string ("__dim_%c%d", gfc_type_letter (f->ts.type), f->ts.kind);
@@ -1669,14 +1672,17 @@ gfc_resolve_minmax (const char *name, gfc_expr *f, gfc_actual_arglist *args)
@@ -1610,14 +1613,17 @@ gfc_resolve_minmax (const char *name, gfc_expr *f, gfc_actual_arglist *args)
/* Find the largest type kind. */
for (a = args->next; a; a = a->next)
{
@ -232,7 +232,7 @@ index 53338dda0a7..92d50c3deb9 100644
gfc_convert_type (a->expr, &f->ts, 2);
}
@@ -2169,19 +2175,22 @@ gfc_resolve_minval (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
@@ -2110,19 +2116,22 @@ gfc_resolve_minval (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
void
gfc_resolve_mod (gfc_expr *f, gfc_expr *a, gfc_expr *p)
{
@ -264,7 +264,7 @@ index 53338dda0a7..92d50c3deb9 100644
f->value.function.name
= gfc_get_string ("__mod_%c%d", gfc_type_letter (f->ts.type), f->ts.kind);
@@ -2191,19 +2200,22 @@ gfc_resolve_mod (gfc_expr *f, gfc_expr *a, gfc_expr *p)
@@ -2132,19 +2141,22 @@ gfc_resolve_mod (gfc_expr *f, gfc_expr *a, gfc_expr *p)
void
gfc_resolve_modulo (gfc_expr *f, gfc_expr *a, gfc_expr *p)
{
@ -296,7 +296,7 @@ index 53338dda0a7..92d50c3deb9 100644
f->value.function.name
= gfc_get_string ("__modulo_%c%d", gfc_type_letter (f->ts.type),
@@ -2578,9 +2590,26 @@ gfc_resolve_shift (gfc_expr *f, gfc_expr *i, gfc_expr *shift ATTRIBUTE_UNUSED)
@@ -2519,9 +2531,26 @@ gfc_resolve_shift (gfc_expr *f, gfc_expr *i, gfc_expr *shift ATTRIBUTE_UNUSED)
void
@ -326,10 +326,10 @@ index 53338dda0a7..92d50c3deb9 100644
= gfc_get_string ("__sign_%c%d", gfc_type_letter (a->ts.type), a->ts.kind);
}
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index fa2851ae837..2a8f5f661a8 100644
index 0a6b4263e22..aceef2aa180 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -490,6 +490,10 @@ fdec-old-init
@@ -501,6 +501,10 @@ fdec-old-init
Fortran Var(flag_dec_old_init)
Enable support for old style initializers in derived types.
@ -341,10 +341,10 @@ index fa2851ae837..2a8f5f661a8 100644
Fortran Var(flag_dec_structure)
Enable support for DEC STRUCTURE/RECORD.
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index 7b04a681f7b..7a2583a2076 100644
index 86b28cfe3e6..82e5c9edf4b 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -83,6 +83,7 @@ set_dec_flags (int value)
@@ -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);
@ -353,10 +353,10 @@ index 7b04a681f7b..7a2583a2076 100644
/* Finalize DEC flags. */
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 7aff256c6b3..cb5f93e293d 100644
index 248fe05ee48..cebc811b233 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -2256,39 +2256,79 @@ gfc_simplify_digits (gfc_expr *x)
@@ -2301,39 +2301,79 @@ gfc_simplify_digits (gfc_expr *x)
}
@ -457,7 +457,7 @@ index 7aff256c6b3..cb5f93e293d 100644
}
return range_check (result, "DIM");
@@ -4886,13 +4926,87 @@ min_max_choose (gfc_expr *arg, gfc_expr *extremum, int sign, bool back_val)
@@ -4921,13 +4961,87 @@ min_max_choose (gfc_expr *arg, gfc_expr *extremum, int sign, bool back_val)
{
int ret;
@ -546,7 +546,7 @@ index 7aff256c6b3..cb5f93e293d 100644
break;
case BT_REAL:
@@ -5841,7 +5955,9 @@ gfc_simplify_mod (gfc_expr *a, gfc_expr *p)
@@ -5876,7 +5990,9 @@ gfc_simplify_mod (gfc_expr *a, gfc_expr *p)
gfc_expr *result;
int kind;
@ -557,7 +557,7 @@ index 7aff256c6b3..cb5f93e293d 100644
if (p->expr_type != EXPR_CONSTANT)
return NULL;
@@ -5852,18 +5968,18 @@ gfc_simplify_mod (gfc_expr *a, gfc_expr *p)
@@ -5887,18 +6003,18 @@ gfc_simplify_mod (gfc_expr *a, gfc_expr *p)
if (mpz_cmp_ui (p->value.integer, 0) == 0)
{
gfc_error ("Argument %qs of MOD at %L shall not be zero",
@ -581,7 +581,7 @@ index 7aff256c6b3..cb5f93e293d 100644
default:
gfc_internal_error ("gfc_simplify_mod(): Bad arguments");
}
@@ -5871,16 +5987,24 @@ gfc_simplify_mod (gfc_expr *a, gfc_expr *p)
@@ -5906,16 +6022,24 @@ gfc_simplify_mod (gfc_expr *a, gfc_expr *p)
if (a->expr_type != EXPR_CONSTANT)
return NULL;
@ -612,7 +612,7 @@ index 7aff256c6b3..cb5f93e293d 100644
}
return range_check (result, "MOD");
@@ -5893,7 +6017,9 @@ gfc_simplify_modulo (gfc_expr *a, gfc_expr *p)
@@ -5928,7 +6052,9 @@ gfc_simplify_modulo (gfc_expr *a, gfc_expr *p)
gfc_expr *result;
int kind;
@ -623,7 +623,7 @@ index 7aff256c6b3..cb5f93e293d 100644
if (p->expr_type != EXPR_CONSTANT)
return NULL;
@@ -5904,44 +6030,52 @@ gfc_simplify_modulo (gfc_expr *a, gfc_expr *p)
@@ -5939,44 +6065,52 @@ gfc_simplify_modulo (gfc_expr *a, gfc_expr *p)
if (mpz_cmp_ui (p->value.integer, 0) == 0)
{
gfc_error ("Argument %qs of MODULO at %L shall not be zero",
@ -695,7 +695,7 @@ index 7aff256c6b3..cb5f93e293d 100644
}
return range_check (result, "MODULO");
@@ -7442,27 +7576,41 @@ gfc_expr *
@@ -7532,27 +7666,41 @@ gfc_expr *
gfc_simplify_sign (gfc_expr *x, gfc_expr *y)
{
gfc_expr *result;
@ -2102,10 +2102,10 @@ index 00000000000..7b1697ca665
+ end program
diff --git a/gcc/testsuite/gfortran.dg/dec_kind_promotion-3.f b/gcc/testsuite/gfortran.dg/dec_kind_promotion-3.f
new file mode 100644
index 00000000000..b9d550a5a48
index 00000000000..db8dff6c55d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_kind_promotion-3.f
@@ -0,0 +1,40 @@
@@ -0,0 +1,39 @@
+!{ dg-do compile }
+!{ dg-options "-fdec -fno-dec-promotion" }
+!
@ -2115,12 +2115,11 @@ index 00000000000..b9d550a5a48
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+ program test_small_type_promtion
+ implicit none
+ integer(1) :: a = 1
+ integer :: i
+ if (iiabs(-9_1).ne.9) stop 1
+ if (iabs(-9_1).ne.9) stop 2 ! { dg-error "Type of argument" }
+ if (iabs(-9_2).ne.9) stop 3 ! { dg-error "Type of argument" }
+ if (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
@ -2141,10 +2140,10 @@ index 00000000000..b9d550a5a48
+ if (knot(5_1).ne.-6) stop 21
+ if (knot(5_2).ne.-6) stop 22
+ if (knot(5_4).ne.-6) stop 23
+ if (isign(-77_1, 1).ne.77) stop 24 ! { dg-error "Type of argument" }
+ if (isign(-77_1, -1).ne.-77) stop 25 ! { dg-error "Type of argument" }
+ if (isign(-77_2, 1).ne.77) stop 26 ! { dg-error "Type of argument" }
+ if (isign(-77_2, -1).ne.-77) stop 27 ! { dg-error "Type of argument" }
+ 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.11.0

View File

@ -1,7 +1,7 @@
From aafd9c215d41b4a846c6724bc25025b124c65ec4 Mon Sep 17 00:00:00 2001
From: Jim MacArthur <jim.macarthur@codethink.co.uk>
Date: Wed, 18 Nov 2015 15:08:56 +0000
Subject: [PATCH 13/16] Add the SEQUENCE attribute by default if it's not
From fa06ba3a82777721696d78a5718804e508b5bb55 Mon Sep 17 00:00:00 2001
From: Mark Eggleston <markeggleston@gcc.gnu.org>
Date: Mon, 3 Feb 2020 09:39:48 +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.
@ -18,10 +18,10 @@ Use -fdec-sequence to enable this feature. Also enabled by -fdec.
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 2a8f5f661a8..ffd9ce6f270 100644
index aceef2aa180..ca2c0e17350 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -494,6 +494,10 @@ fdec-promotion
@@ -505,6 +505,10 @@ fdec-promotion
Fortran Var(flag_dec_promotion)
Add support for type promotion in intrinsic arguments.
@ -33,10 +33,10 @@ index 2a8f5f661a8..ffd9ce6f270 100644
Fortran Var(flag_dec_structure)
Enable support for DEC STRUCTURE/RECORD.
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index 7a2583a2076..b6fd327d057 100644
index 82e5c9edf4b..9f594c6b4a3 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -84,6 +84,7 @@ set_dec_flags (int value)
@@ -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);
@ -45,10 +45,10 @@ index 7a2583a2076..b6fd327d057 100644
/* Finalize DEC flags. */
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index a90f7f849b5..08627866c9c 100644
index e4bb0e79c80..10547704455 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -968,9 +968,16 @@ resolve_common_vars (gfc_common_head *common_block, bool named_common)
@@ -971,9 +971,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))

View File

@ -1,7 +1,7 @@
From 60b2e0b9ad2057f256591f56d5433e9ca54bf56f Mon Sep 17 00:00:00 2001
From: Jim MacArthur <jim.macarthur@codethink.co.uk>
Date: Fri, 26 Aug 2016 17:46:05 +0100
Subject: [PATCH 14/16] Fill in missing array dimensions using the lower bound
From 21fd7a71d28847103921036595e0dbeac125aa44 Mon Sep 17 00:00:00 2001
From: Mark Eggleston <markeggleston@gcc.gnu.org>
Date: Mon, 3 Feb 2020 10:56:36 +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.
---
@ -17,7 +17,7 @@ Use -fdec-add-missing-indexes to enable feature. Also enabled by fdec.
create mode 100644 gcc/testsuite/gfortran.dg/array_8.f90
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index ffd9ce6f270..dca3fd27aa3 100644
index ca2c0e17350..eb58f00f1c0 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -281,6 +281,10 @@ Wmissing-include-dirs
@ -31,7 +31,7 @@ index ffd9ce6f270..dca3fd27aa3 100644
Wuse-without-only
Fortran Var(warn_use_without_only) Warning
Warn about USE statements that have no ONLY qualifier.
@@ -440,6 +444,10 @@ fdec
@@ -456,6 +460,10 @@ fdec
Fortran Var(flag_dec)
Enable all DEC language extensions.
@ -43,10 +43,10 @@ index ffd9ce6f270..dca3fd27aa3 100644
Fortran Var(flag_dec_blank_format_item)
Enable the use of blank format items in format strings.
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index b6fd327d057..f417f48f6a7 100644
index 9f594c6b4a3..92dd74af21d 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -85,6 +85,7 @@ set_dec_flags (int value)
@@ -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);
@ -55,10 +55,10 @@ index b6fd327d057..f417f48f6a7 100644
/* Finalize DEC flags. */
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 08627866c9c..70093c952f6 100644
index 10547704455..2818d220975 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -4676,6 +4676,30 @@ compare_spec_to_ref (gfc_array_ref *ar)
@@ -4771,6 +4771,30 @@ compare_spec_to_ref (gfc_array_ref *ar)
if (ar->type == AR_FULL)
return true;

View File

@ -1,358 +0,0 @@
From e6f385f8258148890a097878a618b694be663db6 Mon Sep 17 00:00:00 2001
From: Mark Eggleston <markeggleston@codethink.com>
Date: Tue, 11 Sep 2018 12:50:11 +0100
Subject: [PATCH 15/16] Allow automatics in equivalence
If a variable with an automatic attribute appears in an
equivalence statement the storage should be allocated on
the stack.
Note: most of this patch was provided by Jeff Law <law@redhat.com>.
---
gcc/fortran/gfortran.h | 1 +
gcc/fortran/symbol.c | 4 +-
gcc/fortran/trans-common.c | 75 +++++++++++++++++++++++++--
gcc/testsuite/gfortran.dg/auto_in_equiv_1.f90 | 36 +++++++++++++
gcc/testsuite/gfortran.dg/auto_in_equiv_2.f90 | 38 ++++++++++++++
gcc/testsuite/gfortran.dg/auto_in_equiv_3.f90 | 63 ++++++++++++++++++++++
6 files changed, 210 insertions(+), 7 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/auto_in_equiv_1.f90
create mode 100644 gcc/testsuite/gfortran.dg/auto_in_equiv_2.f90
create mode 100644 gcc/testsuite/gfortran.dg/auto_in_equiv_3.f90
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 23d01b10728..eb2a29fea5f 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2993,6 +2993,7 @@ bool gfc_merge_new_implicit (gfc_typespec *);
void gfc_set_implicit_none (bool, bool, locus *);
void gfc_check_function_type (gfc_namespace *);
bool gfc_is_intrinsic_typename (const char *);
+bool check_conflict (symbol_attribute *, const char *, locus *);
gfc_typespec *gfc_get_default_type (const char *, gfc_namespace *);
bool gfc_set_default_type (gfc_symbol *, int, gfc_namespace *);
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 4247b5b60c8..5fdb46c4b32 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -407,7 +407,7 @@ gfc_check_function_type (gfc_namespace *ns)
goto conflict_std;\
}
-static bool
+bool
check_conflict (symbol_attribute *attr, const char *name, locus *where)
{
static const char *dummy = "DUMMY", *save = "SAVE", *pointer = "POINTER",
@@ -544,7 +544,6 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
conf (allocatable, elemental);
conf (in_common, automatic);
- conf (in_equivalence, automatic);
conf (result, automatic);
conf (use_assoc, automatic);
conf (dummy, automatic);
@@ -4261,6 +4260,7 @@ save_symbol (gfc_symbol *sym)
return;
if (sym->attr.in_common
+ || sym->attr.in_equivalence
|| sym->attr.dummy
|| sym->attr.result
|| sym->attr.flavor != FL_VARIABLE)
diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c
index debdbd98ac0..a5fb230bb1b 100644
--- a/gcc/fortran/trans-common.c
+++ b/gcc/fortran/trans-common.c
@@ -339,7 +339,7 @@ build_field (segment_info *h, tree union_type, record_layout_info rli)
/* Get storage for local equivalence. */
static tree
-build_equiv_decl (tree union_type, bool is_init, bool is_saved)
+build_equiv_decl (tree union_type, bool is_init, bool is_saved, bool is_auto)
{
tree decl;
char name[18];
@@ -359,8 +359,8 @@ build_equiv_decl (tree union_type, bool is_init, bool is_saved)
DECL_ARTIFICIAL (decl) = 1;
DECL_IGNORED_P (decl) = 1;
- if (!gfc_can_put_var_on_stack (DECL_SIZE_UNIT (decl))
- || is_saved)
+ if (!is_auto && (!gfc_can_put_var_on_stack (DECL_SIZE_UNIT (decl))
+ || is_saved))
TREE_STATIC (decl) = 1;
TREE_ADDRESSABLE (decl) = 1;
@@ -611,6 +611,7 @@ create_common (gfc_common_head *com, segment_info *head, bool saw_equiv)
tree decl;
bool is_init = false;
bool is_saved = false;
+ bool is_auto = false;
/* Declare the variables inside the common block.
If the current common block contains any equivalence object, then
@@ -654,6 +655,10 @@ create_common (gfc_common_head *com, segment_info *head, bool saw_equiv)
/* Has SAVE attribute. */
if (s->sym->attr.save)
is_saved = true;
+
+ /* Has AUTOMATIC attribute. */
+ if (s->sym->attr.automatic)
+ is_auto = true;
}
finish_record_layout (rli, true);
@@ -661,7 +666,7 @@ create_common (gfc_common_head *com, segment_info *head, bool saw_equiv)
if (com)
decl = build_common_decl (com, union_type, is_init);
else
- decl = build_equiv_decl (union_type, is_init, is_saved);
+ decl = build_equiv_decl (union_type, is_init, is_saved, is_auto);
if (is_init)
{
@@ -948,6 +953,61 @@ add_condition (segment_info *f, gfc_equiv *eq1, gfc_equiv *eq2)
confirm_condition (f, eq1, n, eq2);
}
+static void
+accumulate_equivalence_attributes (symbol_attribute *dummy_symbol, gfc_equiv *e)
+{
+ symbol_attribute attr = e->expr->symtree->n.sym->attr;
+
+ dummy_symbol->dummy |= attr.dummy;
+ dummy_symbol->pointer |= attr.pointer;
+ dummy_symbol->target |= attr.target;
+ dummy_symbol->external |= attr.external;
+ dummy_symbol->intrinsic |= attr.intrinsic;
+ dummy_symbol->allocatable |= attr.allocatable;
+ dummy_symbol->elemental |= attr.elemental;
+ dummy_symbol->recursive |= attr.recursive;
+ dummy_symbol->in_common |= attr.in_common;
+ dummy_symbol->result |= attr.result;
+ dummy_symbol->in_namelist |= attr.in_namelist;
+ dummy_symbol->optional |= attr.optional;
+ dummy_symbol->entry |= attr.entry;
+ dummy_symbol->function |= attr.function;
+ dummy_symbol->subroutine |= attr.subroutine;
+ dummy_symbol->dimension |= attr.dimension;
+ dummy_symbol->in_equivalence |= attr.in_equivalence;
+ dummy_symbol->use_assoc |= attr.use_assoc;
+ dummy_symbol->cray_pointer |= attr.cray_pointer;
+ dummy_symbol->cray_pointee |= attr.cray_pointee;
+ dummy_symbol->data |= attr.data;
+ dummy_symbol->value |= attr.value;
+ dummy_symbol->volatile_ |= attr.volatile_;
+ dummy_symbol->is_protected |= attr.is_protected;
+ dummy_symbol->is_bind_c |= attr.is_bind_c;
+ dummy_symbol->procedure |= attr.procedure;
+ dummy_symbol->proc_pointer |= attr.proc_pointer;
+ dummy_symbol->abstract |= attr.abstract;
+ dummy_symbol->asynchronous |= attr.asynchronous;
+ dummy_symbol->codimension |= attr.codimension;
+ dummy_symbol->contiguous |= attr.contiguous;
+ dummy_symbol->generic |= attr.generic;
+ dummy_symbol->automatic |= attr.automatic;
+ dummy_symbol->threadprivate |= attr.threadprivate;
+ dummy_symbol->omp_declare_target |= attr.omp_declare_target;
+ dummy_symbol->omp_declare_target_link |= attr.omp_declare_target_link;
+ dummy_symbol->oacc_declare_copyin |= attr.oacc_declare_copyin;
+ dummy_symbol->oacc_declare_create |= attr.oacc_declare_create;
+ dummy_symbol->oacc_declare_deviceptr |= attr.oacc_declare_deviceptr;
+ dummy_symbol->oacc_declare_device_resident
+ |= attr.oacc_declare_device_resident;
+
+ /* Not strictly correct, but probably close enough. */
+ if (attr.save > dummy_symbol->save)
+ dummy_symbol->save = attr.save;
+ if (attr.intent > dummy_symbol->intent)
+ dummy_symbol->intent = attr.intent;
+ if (attr.access > dummy_symbol->access)
+ dummy_symbol->access = attr.access;
+}
/* Given a segment element, search through the equivalence lists for unused
conditions that involve the symbol. Add these rules to the segment. */
@@ -965,9 +1025,12 @@ find_equivalence (segment_info *n)
eq = NULL;
/* Search the equivalence list, including the root (first) element
- for the symbol that owns the segment. */
+ for the symbol that owns the segment. */
+ symbol_attribute dummy_symbol;
+ memset (&dummy_symbol, 0, sizeof (dummy_symbol));
for (e2 = e1; e2; e2 = e2->eq)
{
+ accumulate_equivalence_attributes (&dummy_symbol, e2);
if (!e2->used && e2->expr->symtree->n.sym == n->sym)
{
eq = e2;
@@ -975,6 +1038,8 @@ find_equivalence (segment_info *n)
}
}
+ check_conflict (&dummy_symbol, e1->expr->symtree->name, &e1->expr->where);
+
/* Go to the next root element. */
if (eq == NULL)
continue;
diff --git a/gcc/testsuite/gfortran.dg/auto_in_equiv_1.f90 b/gcc/testsuite/gfortran.dg/auto_in_equiv_1.f90
new file mode 100644
index 00000000000..61bfd0738c5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/auto_in_equiv_1.f90
@@ -0,0 +1,36 @@
+! { dg-compile }
+
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
+program test
+ call suba(0)
+ call subb(0)
+ call suba(1)
+
+contains
+ subroutine suba(option)
+ integer, intent(in) :: option
+ integer, automatic :: a ! { dg-error "AUTOMATIC at \\(1\\) is a DEC extension" }
+ integer :: b
+ integer :: c
+ equivalence (a, b)
+ if (option.eq.0) then
+ ! initialise a and c
+ a = 9
+ c = 99
+ if (a.ne.b) stop 1
+ if (loc(a).ne.loc(b)) stop 2
+ else
+ ! a should've been overwritten
+ if (a.eq.9) stop 3
+ end if
+ end subroutine suba
+
+ subroutine subb(dummy)
+ integer, intent(in) :: dummy
+ integer, automatic :: x ! { dg-error "AUTOMATIC at \\(1\\) is a DEC extension" }
+ integer :: y
+ x = 77
+ y = 7
+ end subroutine subb
+
+end program test
diff --git a/gcc/testsuite/gfortran.dg/auto_in_equiv_2.f90 b/gcc/testsuite/gfortran.dg/auto_in_equiv_2.f90
new file mode 100644
index 00000000000..406e718604a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/auto_in_equiv_2.f90
@@ -0,0 +1,38 @@
+! { dg-run }
+! { dg-options "-fdec-static" }
+
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
+
+program test
+ call suba(0)
+ call subb(0)
+ call suba(1)
+
+contains
+ subroutine suba(option)
+ integer, intent(in) :: option
+ integer, automatic :: a
+ integer :: b
+ integer :: c
+ equivalence (a, b)
+ if (option.eq.0) then
+ ! initialise a and c
+ a = 9
+ c = 99
+ if (a.ne.b) stop 1
+ if (loc(a).ne.loc(b)) stop 2
+ else
+ ! a should've been overwritten
+ if (a.eq.9) stop 3
+ end if
+ end subroutine suba
+
+ subroutine subb(dummy)
+ integer, intent(in) :: dummy
+ integer, automatic :: x
+ integer :: y
+ x = 77
+ y = 7
+ end subroutine subb
+
+end program test
diff --git a/gcc/testsuite/gfortran.dg/auto_in_equiv_3.f90 b/gcc/testsuite/gfortran.dg/auto_in_equiv_3.f90
new file mode 100644
index 00000000000..c67aa8c6ac1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/auto_in_equiv_3.f90
@@ -0,0 +1,63 @@
+! { dg-run }
+! { dg-options "-fdec-static -fno-automatic" }
+
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
+
+! Storage is NOT on the static unless explicitly specified using the
+! DEC extension "automatic". The address of the first local variable
+! is used to determine that storage for the automatic local variable
+! is different to that of a local variable with no attributes. The
+! contents of the local variable in suba should be overwritten by the
+! call to subb.
+!
+program test
+ integer :: dummy
+ integer, parameter :: address = kind(loc(dummy))
+ integer(address) :: ad1
+ integer(address) :: ad2
+ integer(address) :: ad3
+ logical :: ok
+
+ call suba(0, ad1)
+ call subb(0, ad2)
+ call suba(1, ad1)
+ call subc(0, ad3)
+ ok = (ad1.eq.ad3).and.(ad1.ne.ad2)
+ if (.not.ok) stop 4
+
+contains
+ subroutine suba(option, addr)
+ integer, intent(in) :: option
+ integer(address), intent(out) :: addr
+ integer, automatic :: a
+ integer :: b
+ equivalence (a, b)
+ addr = loc(a)
+ if (option.eq.0) then
+ ! initialise a and c
+ a = 9
+ if (a.ne.b) stop 1
+ if (loc(a).ne.loc(b)) stop 2
+ else
+ ! a should've been overwritten
+ if (a.eq.9) stop 3
+ end if
+ end subroutine suba
+
+ subroutine subb(dummy, addr)
+ integer, intent(in) :: dummy
+ integer(address), intent(out) :: addr
+ integer :: x
+ addr = loc(x)
+ x = 77
+ end subroutine subb
+
+ subroutine subc(dummy, addr)
+ integer, intent(in) :: dummy
+ integer(address), intent(out) :: addr
+ integer, automatic :: y
+ addr = loc(y)
+ y = 77
+ end subroutine subc
+
+end program test
--
2.11.0

View File

@ -1,49 +0,0 @@
From 9bf3b68e118a749ab87f52649fd56aca059470e8 Mon Sep 17 00:00:00 2001
From: Mark Eggleston <markeggleston@codethink.com>
Date: Tue, 16 Apr 2019 09:09:12 +0100
Subject: [PATCH 16/16] Suppress warning with -Wno-overwrite-recursive
The message "Warning: Flag '-fno-automatic' overwrites '-frecursive'" is
output by default when -fno-automatic and -frecursive are used together.
It warns that recursion may be broken, however if all the relavent variables
in the recursive procedure have automatic attributes the warning is
unnecessary so -Wno-overwrite-recursive can be used to suppress it. This
will allow compilation when warnings are regarded as errors.
Suppress warning with -Wno-overwrite-recursive
---
gcc/fortran/lang.opt | 4 ++++
gcc/fortran/options.c | 2 +-
2 files changed, 5 insertions(+), 1 deletion(-)
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index dca3fd27aa3..e5074f614e3 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -293,6 +293,10 @@ Wopenmp-simd
Fortran
; Documented in C
+Woverwrite-recursive
+Fortran Warning Var(warn_overwrite_recursive) Init(1)
+Warn that -fno-automatic may break recursion.
+
Wpedantic
Fortran
; Documented in common.opt
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index f417f48f6a7..6cbc64bf1ae 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -418,7 +418,7 @@ gfc_post_options (const char **pfilename)
&& flag_max_stack_var_size != 0)
gfc_warning_now (0, "Flag %<-fno-automatic%> overwrites %<-fmax-stack-var-size=%d%>",
flag_max_stack_var_size);
- else if (!flag_automatic && flag_recursive)
+ else if (!flag_automatic && flag_recursive && warn_overwrite_recursive)
gfc_warning_now (0, "Flag %<-fno-automatic%> overwrites %<-frecursive%>");
else if (!flag_automatic && flag_openmp)
gfc_warning_now (0, "Flag %<-fno-automatic%> overwrites %<-frecursive%> implied by "
--
2.11.0

View File

@ -9650,6 +9650,8 @@
+asm (".hidden _ZNSt15_Sp_counted_ptrIDnLN9__gnu_cxx12_Lock_policyE2EE10_M_disposeEv");
+asm (".hidden _ZNSt16_Sp_counted_baseILN9__gnu_cxx12_Lock_policyE2EE10_M_destroyEv");
+asm (".hidden _ZNSt16_Sp_counted_baseILN9__gnu_cxx12_Lock_policyE2EE10_M_releaseEv");
+asm (".hidden _ZNSsC1ISaIcEEEPKcRKS0_");
+asm (".hidden _ZNSsC2ISaIcEEEPKcRKS0_");
+#ifndef __s390x__
+asm (".hidden _ZNSt5dequeINSt10filesystem4pathESaIS1_EE16_M_push_back_auxIIRKS1_EEEvDpOT_");
+asm (".hidden _ZNSt5dequeINSt10filesystem4pathESaIS1_EE12emplace_backIJS1_EEERS1_DpOT_");
@ -9693,8 +9695,6 @@
+#endif
+asm (".hidden _ZNSt10unique_ptrINSt10filesystem4path5_List5_ImplENS2_13_Impl_deleterEED1Ev");
+asm (".hidden _ZNSt10unique_ptrINSt10filesystem4path5_List5_ImplENS2_13_Impl_deleterEED2Ev");
+asm (".hidden _ZNSsC1EPKcRKSaIcE");
+asm (".hidden _ZNSsC2EPKcRKSaIcE");
+asm (".hidden _ZNKSt10filesystem4path8filenameEv");
+asm (".hidden _ZNSt10filesystem4pathD2Ev");
+#ifdef __i386__
@ -9705,7 +9705,7 @@
+#endif
--- libstdc++-v3/src/nonshared17/cow-fs_path.cc.jj 2020-05-27 15:11:04.994304406 +0200
+++ libstdc++-v3/src/nonshared17/cow-fs_path.cc 2020-05-27 16:18:15.273367217 +0200
@@ -0,0 +1,130 @@
@@ -0,0 +1,132 @@
+// Copyright (C) 2019-2020 Free Software Foundation, Inc.
+//
+// This file is part of the GNU ISO C++ Library. This library is free
@ -9759,6 +9759,7 @@
+asm (".hidden _ZNSt23_Sp_counted_ptr_inplaceINSt10filesystem16filesystem_error5_ImplESaIS2_ELN9__gnu_cxx12_Lock_policyE2EE14_M_get_deleterERKSt9type_info");
+asm (".hidden _ZNSt23_Sp_counted_ptr_inplaceINSt10filesystem16filesystem_error5_ImplESaIS2_ELN9__gnu_cxx12_Lock_policyE2EED0Ev");
+asm (".hidden _ZNSt23_Sp_counted_ptr_inplaceINSt10filesystem16filesystem_error5_ImplESaIS2_ELN9__gnu_cxx12_Lock_policyE2EED1Ev");
+asm (".hidden _ZNSt23_Sp_counted_ptr_inplaceINSt10filesystem16filesystem_error5_ImplESaIS2_ELN9__gnu_cxx12_Lock_policyE2EED2Ev");
+asm (".hidden _ZTISt11_Mutex_baseILN9__gnu_cxx12_Lock_policyE2EE");
+asm (".hidden _ZTISt16_Sp_counted_baseILN9__gnu_cxx12_Lock_policyE2EE");
+asm (".hidden _ZTISt23_Sp_counted_ptr_inplaceINSt10filesystem16filesystem_error5_ImplESaIS2_ELN9__gnu_cxx12_Lock_policyE2EE");
@ -9796,7 +9797,6 @@
+asm (".hidden _ZNSsC1ERKSsjj");
+asm (".hidden _ZNSsC2ERKSsjj");
+asm (".hidden _ZSt10__mismatchINSt10filesystem4path8iteratorES2_N9__gnu_cxx5__ops19_Iter_equal_to_iterEESt4pairIT_T0_ES7_S7_S8_S8_T1_");
+asm (".hidden _ZSt10__mismatchINSt10filesystem7__cxx114path8iteratorES3_N9__gnu_cxx5__ops19_Iter_equal_to_iterEESt4pairIT_T0_ES8_S8_S9_S9_T1_");
+#endif
+asm (".hidden _ZTIZNSt10filesystem4path4_CvtIwE10_S_convertEPKwS4_E5_UCvt");
+asm (".hidden _ZTSZNSt10filesystem4path4_CvtIwE10_S_convertEPKwS4_E5_UCvt");
@ -9835,6 +9835,8 @@
+asm (".hidden _ZNSt10filesystem4pathC2ERKS0_");
+asm (".hidden _ZNSt10filesystem4pathC1ESt17basic_string_viewIcSt11char_traitsIcEENS0_5_TypeE");
+asm (".hidden _ZNSt10filesystem4pathC2ESt17basic_string_viewIcSt11char_traitsIcEENS0_5_TypeE");
+asm (".hidden _ZNSsC1ISaIcEEEPKcRKS0_");
+asm (".hidden _ZNSsC2ISaIcEEEPKcRKS0_");
+#endif
--- libstdc++-v3/src/nonshared17/memory_resource.cc.jj 2020-05-27 15:11:04.996304376 +0200
+++ libstdc++-v3/src/nonshared17/memory_resource.cc 2020-05-27 16:21:24.634581462 +0200
@ -9912,7 +9914,7 @@
+asm (".hidden _ZNSt3pmr26synchronized_pool_resource7_TPoolsC2ERS0_RSt10lock_guardISt12shared_mutexE");
--- libstdc++-v3/src/nonshared17/fs_dir.cc.jj 2020-05-27 15:11:04.994304406 +0200
+++ libstdc++-v3/src/nonshared17/fs_dir.cc 2020-05-27 16:19:06.255617202 +0200
@@ -0,0 +1,92 @@
@@ -0,0 +1,94 @@
+// Copyright (C) 2019-2020 Free Software Foundation, Inc.
+//
+// This file is part of the GNU ISO C++ Library. This library is free
@ -9970,11 +9972,13 @@
+asm (".hidden _ZNSt23_Sp_counted_ptr_inplaceINSt10filesystem7__cxx1128recursive_directory_iterator10_Dir_stackESaIS3_ELN9__gnu_cxx12_Lock_policyE2EE14_M_get_deleterERKSt9type_info");
+asm (".hidden _ZNSt23_Sp_counted_ptr_inplaceINSt10filesystem7__cxx1128recursive_directory_iterator10_Dir_stackESaIS3_ELN9__gnu_cxx12_Lock_policyE2EED0Ev");
+asm (".hidden _ZNSt23_Sp_counted_ptr_inplaceINSt10filesystem7__cxx1128recursive_directory_iterator10_Dir_stackESaIS3_ELN9__gnu_cxx12_Lock_policyE2EED1Ev");
+asm (".hidden _ZNSt23_Sp_counted_ptr_inplaceINSt10filesystem7__cxx1128recursive_directory_iterator10_Dir_stackESaIS3_ELN9__gnu_cxx12_Lock_policyE2EED2Ev");
+asm (".hidden _ZNSt23_Sp_counted_ptr_inplaceINSt10filesystem7__cxx114_DirESaIS2_ELN9__gnu_cxx12_Lock_policyE2EE10_M_destroyEv");
+asm (".hidden _ZNSt23_Sp_counted_ptr_inplaceINSt10filesystem7__cxx114_DirESaIS2_ELN9__gnu_cxx12_Lock_policyE2EE10_M_disposeEv");
+asm (".hidden _ZNSt23_Sp_counted_ptr_inplaceINSt10filesystem7__cxx114_DirESaIS2_ELN9__gnu_cxx12_Lock_policyE2EE14_M_get_deleterERKSt9type_info");
+asm (".hidden _ZNSt23_Sp_counted_ptr_inplaceINSt10filesystem7__cxx114_DirESaIS2_ELN9__gnu_cxx12_Lock_policyE2EED0Ev");
+asm (".hidden _ZNSt23_Sp_counted_ptr_inplaceINSt10filesystem7__cxx114_DirESaIS2_ELN9__gnu_cxx12_Lock_policyE2EED1Ev");
+asm (".hidden _ZNSt23_Sp_counted_ptr_inplaceINSt10filesystem7__cxx114_DirESaIS2_ELN9__gnu_cxx12_Lock_policyE2EED2Ev");
+asm (".hidden _ZNSt5dequeINSt10filesystem7__cxx114_DirESaIS2_EE12emplace_backIIS2_EEERS2_DpOT_");
+asm (".hidden _ZNSt5dequeINSt10filesystem7__cxx114_DirESaIS2_EE12emplace_backIJS2_EEERS2_DpOT_");
+asm (".hidden _ZNSt5dequeINSt10filesystem7__cxx114_DirESaIS2_EE16_M_push_back_auxIIRP11__dirstreamRKNS1_4pathEEEEvDpOT_");
@ -10007,7 +10011,7 @@
+asm (".hidden _ZSt20__replacement_assertPKciS0_S0_");
--- libstdc++-v3/src/nonshared17/fs_path80.cc.jj 2020-05-27 15:11:04.994304406 +0200
+++ libstdc++-v3/src/nonshared17/fs_path80.cc 2020-05-27 15:11:04.994304406 +0200
@@ -0,0 +1,36 @@
@@ -0,0 +1,37 @@
+// Copyright (C) 2019-2020 Free Software Foundation, Inc.
+//
+// This file is part of the GNU ISO C++ Library. This library is free
@ -10043,10 +10047,11 @@
+asm (".hidden _ZNSt7__cxx1112basic_stringIcSt11char_traitsIcESaIcEE9_M_mutateEjjPKcj");
+asm (".hidden _ZNSt7__cxx1112basic_stringIwSt11char_traitsIwESaIwEE6resizeEjw");
+asm (".hidden _ZNSt7__cxx1112basic_stringIwSt11char_traitsIwESaIwEE9_M_mutateEjjPKwj");
+asm (".hidden _ZSt10__mismatchINSt10filesystem7__cxx114path8iteratorES3_N9__gnu_cxx5__ops19_Iter_equal_to_iterEESt4pairIT_T0_ES8_S8_S9_S9_T1_");
+#endif
--- libstdc++-v3/src/nonshared17/cow-fs_dir.cc.jj 2020-05-27 15:11:04.993304421 +0200
+++ libstdc++-v3/src/nonshared17/cow-fs_dir.cc 2020-05-27 16:16:29.824918505 +0200
@@ -0,0 +1,96 @@
@@ -0,0 +1,98 @@
+// Copyright (C) 2019-2020 Free Software Foundation, Inc.
+//
+// This file is part of the GNU ISO C++ Library. This library is free
@ -10104,11 +10109,13 @@
+asm (".hidden _ZNSt23_Sp_counted_ptr_inplaceINSt10filesystem28recursive_directory_iterator10_Dir_stackESaIS2_ELN9__gnu_cxx12_Lock_policyE2EE14_M_get_deleterERKSt9type_info");
+asm (".hidden _ZNSt23_Sp_counted_ptr_inplaceINSt10filesystem28recursive_directory_iterator10_Dir_stackESaIS2_ELN9__gnu_cxx12_Lock_policyE2EED0Ev");
+asm (".hidden _ZNSt23_Sp_counted_ptr_inplaceINSt10filesystem28recursive_directory_iterator10_Dir_stackESaIS2_ELN9__gnu_cxx12_Lock_policyE2EED1Ev");
+asm (".hidden _ZNSt23_Sp_counted_ptr_inplaceINSt10filesystem28recursive_directory_iterator10_Dir_stackESaIS2_ELN9__gnu_cxx12_Lock_policyE2EED2Ev");
+asm (".hidden _ZNSt23_Sp_counted_ptr_inplaceINSt10filesystem4_DirESaIS1_ELN9__gnu_cxx12_Lock_policyE2EE10_M_destroyEv");
+asm (".hidden _ZNSt23_Sp_counted_ptr_inplaceINSt10filesystem4_DirESaIS1_ELN9__gnu_cxx12_Lock_policyE2EE10_M_disposeEv");
+asm (".hidden _ZNSt23_Sp_counted_ptr_inplaceINSt10filesystem4_DirESaIS1_ELN9__gnu_cxx12_Lock_policyE2EE14_M_get_deleterERKSt9type_info");
+asm (".hidden _ZNSt23_Sp_counted_ptr_inplaceINSt10filesystem4_DirESaIS1_ELN9__gnu_cxx12_Lock_policyE2EED0Ev");
+asm (".hidden _ZNSt23_Sp_counted_ptr_inplaceINSt10filesystem4_DirESaIS1_ELN9__gnu_cxx12_Lock_policyE2EED1Ev");
+asm (".hidden _ZNSt23_Sp_counted_ptr_inplaceINSt10filesystem4_DirESaIS1_ELN9__gnu_cxx12_Lock_policyE2EED2Ev");
+asm (".hidden _ZNSt5dequeINSt10filesystem4_DirESaIS1_EE12emplace_backIIS1_EEERS1_DpOT_");
+asm (".hidden _ZNSt5dequeINSt10filesystem4_DirESaIS1_EE12emplace_backIJS1_EEERS1_DpOT_");
+asm (".hidden _ZNSt5dequeINSt10filesystem4_DirESaIS1_EE16_M_push_back_auxIIRP11__dirstreamRKNS0_4pathEEEEvDpOT_");
@ -10127,6 +10134,8 @@
+asm (".hidden _ZTVSt23_Sp_counted_ptr_inplaceINSt10filesystem28recursive_directory_iterator10_Dir_stackESaIS2_ELN9__gnu_cxx12_Lock_policyE2EE");
+asm (".hidden _ZTVSt23_Sp_counted_ptr_inplaceINSt10filesystem4_DirESaIS1_ELN9__gnu_cxx12_Lock_policyE2EE");
+asm (".hidden _ZZNSt19_Sp_make_shared_tag5_S_tiEvE5__tag");
+asm (".hidden _ZNSsC1ISaIcEEEPKcRKS0_");
+asm (".hidden _ZNSsC2ISaIcEEEPKcRKS0_");
+#if defined(__aarch64__) || defined(__x86_64__) || defined(__powerpc64__)
+asm (".hidden _ZNSt5dequeINSt10filesystem4_DirESaIS1_EE17_M_reallocate_mapEmb");
+#endif
@ -10137,8 +10146,6 @@
+#if !defined(__s390x__) && !defined(__aarch64__) && !defined(__powerpc64__)
+asm (".hidden _ZNSs4swapERSs");
+#endif
+asm (".hidden _ZNSsC1EPKcRKSaIcE");
+asm (".hidden _ZNSsC2EPKcRKSaIcE");
+#ifdef __s390x__
+asm (".hidden _ZNSt10filesystem4pathC1ERKS0_");
+asm (".hidden _ZNSt10filesystem4pathC2ERKS0_");
@ -10278,7 +10285,7 @@
+ $(OPT_LDFLAGS) $(SECTION_LDFLAGS) $(AM_CXXFLAGS) $(LTLDFLAGS) -o $@
--- libstdc++-v3/src/nonshared17/fs_path.cc.jj 2020-05-27 15:11:04.995304391 +0200
+++ libstdc++-v3/src/nonshared17/fs_path.cc 2020-05-27 16:20:43.631184679 +0200
@@ -0,0 +1,99 @@
@@ -0,0 +1,100 @@
+// Copyright (C) 2019-2020 Free Software Foundation, Inc.
+//
+// This file is part of the GNU ISO C++ Library. This library is free
@ -10334,6 +10341,7 @@
+asm (".hidden _ZNSt23_Sp_counted_ptr_inplaceINSt10filesystem7__cxx1116filesystem_error5_ImplESaIS3_ELN9__gnu_cxx12_Lock_policyE2EE14_M_get_deleterERKSt9type_info");
+asm (".hidden _ZNSt23_Sp_counted_ptr_inplaceINSt10filesystem7__cxx1116filesystem_error5_ImplESaIS3_ELN9__gnu_cxx12_Lock_policyE2EED0Ev");
+asm (".hidden _ZNSt23_Sp_counted_ptr_inplaceINSt10filesystem7__cxx1116filesystem_error5_ImplESaIS3_ELN9__gnu_cxx12_Lock_policyE2EED1Ev");
+asm (".hidden _ZNSt23_Sp_counted_ptr_inplaceINSt10filesystem7__cxx1116filesystem_error5_ImplESaIS3_ELN9__gnu_cxx12_Lock_policyE2EED2Ev");
+asm (".hidden _ZTISt11_Mutex_baseILN9__gnu_cxx12_Lock_policyE2EE");
+asm (".hidden _ZTISt16_Sp_counted_baseILN9__gnu_cxx12_Lock_policyE2EE");
+asm (".hidden _ZTISt23_Sp_counted_ptr_inplaceINSt10filesystem7__cxx1116filesystem_error5_ImplESaIS3_ELN9__gnu_cxx12_Lock_policyE2EE");

View File

@ -1,22 +0,0 @@
2020-08-03 Richard Biener <rguenther@suse.de>
PR lto/96385
libiberty/
* simple-object-elf.c
(simple_object_elf_copy_lto_debug_sections): Localize global
UNDEFs and reuse the prevailing name.
--- libiberty/simple-object-elf.c
+++ libiberty/simple-object-elf.c
@@ -1467,6 +1467,11 @@ simple_object_elf_copy_lto_debug_sections (simple_object_read *sobj,
&& st_shndx < shnum
&& pfnret[st_shndx - 1] == -1)
discard = 1;
+ /* We also need to remove global UNDEFs which can
+ cause link fails later. */
+ else if (st_shndx == SHN_UNDEF
+ && ELF_ST_BIND (*st_info) == STB_GLOBAL)
+ discard = 1;
if (discard)
{

View File

@ -0,0 +1,34 @@
2020-11-11 Jason Merrill <jason@redhat.com>
PR debug/97060
* dwarf2out.c (gen_subprogram_die): It's a declaration
if DECL_INITIAL isn't set.
* gcc.dg/debug/dwarf2/pr97060.c: New test.
--- gcc/dwarf2out.c
+++ gcc/dwarf2out.c
@@ -22859,6 +22859,7 @@ gen_subprogram_die (tree decl, dw_die_ref context_die)
available.
*/
int declaration = (current_function_decl != decl
+ || (!DECL_INITIAL (decl) && !origin)
|| class_or_namespace_scope_p (context_die));
/* A declaration that has been previously dumped needs no
--- gcc/testsuite/gcc.dg/debug/dwarf2/pr97060.c
+++ gcc/testsuite/gcc.dg/debug/dwarf2/pr97060.c
@@ -0,0 +1,13 @@
+/* PR debug/97060 */
+/* { dg-do compile } */
+/* { dg-options "-g -dA" } */
+/* { dg-final { scan-assembler-times "DW_AT_declaration" 2 } } */
+
+extern int foo (unsigned int, unsigned int);
+
+int
+bar (void)
+{
+ foo (1, 2);
+ return 0;
+}

View File

@ -0,0 +1,53 @@
commit 6fade5a6044b7102758f4ca66c8715ebc12a6306
Author: Martin Liska <mliska@suse.cz>
Date: Thu Oct 22 14:07:29 2020 +0200
LTO: check that make command works
gcc/ChangeLog:
PR lto/97524
* lto-wrapper.c (make_exists): New function.
(run_gcc): Use it to check that make is present and working
for parallel execution.
--- gcc/lto-wrapper.c
+++ gcc/lto-wrapper.c
@@ -1321,6 +1321,26 @@ jobserver_active_p (void)
&& is_valid_fd (wfd));
}
+/* Test that a make command is present and working, return true if so. */
+
+static bool
+make_exists (void)
+{
+ const char *make = "make";
+ char **make_argv = buildargv (getenv ("MAKE"));
+ if (make_argv)
+ make = make_argv[0];
+ const char *make_args[] = {make, "--version", NULL};
+
+ int exit_status = 0;
+ int err = 0;
+ const char *errmsg
+ = pex_one (PEX_SEARCH, make_args[0], CONST_CAST (char **, make_args),
+ "make", NULL, NULL, &exit_status, &err);
+ freeargv (make_argv);
+ return errmsg == NULL && exit_status == 0 && err == 0;
+}
+
/* Execute gcc. ARGC is the number of arguments. ARGV contains the arguments. */
static void
@@ -1541,6 +1561,10 @@ run_gcc (unsigned argc, char *argv[])
jobserver = 1;
}
+ /* We need make working for a parallel execution. */
+ if (parallel && !make_exists ())
+ parallel = 0;
+
if (linker_output)
{
char *output_dir, *base, *name;

View File

@ -2,13 +2,13 @@
%{?scl:%global __strip %%{_scl_root}/usr/bin/strip}
%{?scl:%global __objdump %%{_scl_root}/usr/bin/objdump}
%{?scl:%scl_package gcc}
%global DATE 20200804
%global gitrev 08d83635c2ab388f6139db6965e600b296ad85e6
%global DATE 20201112
%global gitrev 86495efb7a403b1ee3419fb3b3b1aaf26345ada5
%global gcc_version 10.2.1
%global gcc_major 10
# Note, gcc_release must be integer, if you want to add suffixes to
# %%{release}, append them after %%{gcc_release} on Release: line.
%global gcc_release 2
%global gcc_release 8
%global nvptx_tools_gitrev 5f6f343a302d620b0868edab376c00b15741e39e
%global newlib_cygwin_gitrev 50e2a63b04bdd018484605fbb954fd1bd5147fa0
%global mpc_version 0.8.1
@ -123,7 +123,7 @@
Summary: GCC version 10
Name: %{?scl_prefix}gcc
Version: %{gcc_version}
Release: %{gcc_release}%{?dist}
Release: %{gcc_release}.2%{?dist}
# libgcc, libgfortran, libgomp, libstdc++ and crtstuff have
# GCC Runtime Exception.
License: GPLv3+ and GPLv3+ with exceptions and GPLv2+ with exceptions and LGPLv2+ and BSD
@ -172,19 +172,14 @@ BuildRequires: glibc-static
%if 0%{?scl:1}
BuildRequires: %{?scl_prefix}binutils >= 2.31
# For testing
%if 0%{?rhel} >= 6
# FIXME gcc-toolset-10-gdb isn't yet in the buildroot.
BuildRequires: gdb
%else
BuildRequires: %{?scl_prefix}gdb >= 7.4.50
%endif
%endif
BuildRequires: zlib-devel, gettext, dejagnu, bison, flex, sharutils
BuildRequires: texinfo, texinfo-tex, /usr/bin/pod2man
#BuildRequires: systemtap-sdt-devel >= 1.3
#BuildRequires: gmp-devel >= 4.1.2-8, mpfr-devel >= 2.2.1, libmpc-devel >= 0.8.1
#BuildRequires: python3-devel, /usr/bin/python
BuildRequires: gcc, gcc-c++
BuildRequires: gcc, gcc-c++, make
# For VTA guality testing
BuildRequires: gdb
# Make sure pthread.h doesn't contain __thread tokens
@ -235,9 +230,9 @@ Requires: glibc-devel >= 2.2.90-12
# Make sure glibc supports TFmode long double
Requires: glibc >= 2.3.90-35
%endif
BuildRequires: gmp-devel >= 4.1.2-8
BuildRequires: mpfr-devel >= 3.1.0
%if 0%{?rhel} >= 7
BuildRequires: gmp-devel >= 4.3.2
BuildRequires: mpfr-devel >= 3.1.0
BuildRequires: libmpc-devel >= 0.8.1
%endif
%if %{build_libstdcxx_docs}
@ -250,6 +245,8 @@ BuildRequires: dblatex, texlive-collection-latex, docbook5-style-xsl
%endif
Requires: libgcc >= 4.1.2-43
Requires: libgomp >= 4.4.4-13
# lto-wrapper invokes make
Requires: make
%{?scl:Requires:%scl_runtime}
AutoReq: true
Provides: bundled(libiberty)
@ -310,29 +307,24 @@ Patch10: gcc10-rh1574936.patch
Patch11: gcc10-d-shared-libphobos.patch
Patch12: gcc10-pr94540.patch
Patch13: gcc10-pr96383.patch
Patch14: gcc10-pr96385.patch
Patch14: gcc10-pr97060.patch
Patch15: gcc10-pr97524.patch
Patch1000: gcc10-libstdc++-compat.patch
Patch1002: gcc10-isl-dl2.patch
Patch1003: gcc10-libgfortran-compat.patch
Patch1004: gcc10-libgfortran-compat-2.patch
Patch3001: 0001-Default-widths-for-i-f-and-g-format-specifiers-in-fo.patch
Patch3002: 0002-Allow-duplicate-declarations.patch
Patch3003: 0003-Convert-LOGICAL-to-INTEGER-for-arithmetic-ops-and-vi.patch
Patch3004: 0004-Allow-CHARACTER-literals-in-assignments-and-data-sta.patch
Patch3005: 0005-dec-comparisons.patch
Patch3006: 0006-Allow-blank-format-items-in-format-strings.patch
Patch3007: 0007-Allow-more-than-one-character-as-argument-to-ICHAR.patch
Patch3008: 0008-Allow-non-integer-substring-indexes.patch
Patch3009: 0009-Allow-old-style-initializers-in-derived-types.patch
Patch3010: 0010-Allow-string-length-and-kind-to-be-specified-on-a-pe.patch
Patch3011: 0011-Allow-non-logical-expressions-in-IF-statements.patch
Patch3012: 0012-Support-type-promotion-in-calls-to-intrinsics.patch
Patch3013: 0013-Add-the-SEQUENCE-attribute-by-default-if-it-s-not-pr.patch
Patch3014: 0014-Fill-in-missing-array-dimensions-using-the-lower-bou.patch
Patch3015: 0015-Allow-automatics-in-equivalence.patch
Patch3016: 0016-Suppress-warning-with-Wno-overwrite-recursive.patch
Patch3001: 0001-Allow-duplicate-declarations.patch
Patch3002: 0002-Convert-LOGICAL-to-INTEGER-for-arithmetic-ops-and-vi.patch
Patch3003: 0003-Allow-more-than-one-character-as-argument-to-ICHAR.patch
Patch3004: 0004-Allow-non-integer-substring-indexes.patch
Patch3005: 0005-Allow-old-style-initializers-in-derived-types.patch
Patch3006: 0006-Allow-string-length-and-kind-to-be-specified-on-a-pe.patch
Patch3007: 0007-Allow-non-logical-expressions-in-IF-statements.patch
Patch3008: 0008-Support-type-promotion-in-calls-to-intrinsics.patch
Patch3009: 0009-Add-the-SEQUENCE-attribute-by-default-if-it-s-not.patch
Patch3010: 0010-Fill-in-missing-array-dimensions-using-the-lower-bou.patch
%if 0%{?rhel} > 7
%global nonsharedver 80
@ -525,9 +517,9 @@ GNU Transactional Memory library.
%package plugin-devel
Summary: Support for compiling GCC plugins
Requires: %{?scl_prefix}gcc%{!?scl:10} = %{version}-%{release}
Requires: gmp-devel >= 4.1.2-8
Requires: mpfr-devel >= 3.1.0
%if 0%{?rhel} >= 7
Requires: gmp-devel >= 4.3.2
Requires: mpfr-devel >= 3.1.0
Requires: libmpc-devel >= 0.8.1
%endif
@ -566,8 +558,12 @@ which is used for -fsanitize=address instrumented programs.
%package -n %{?scl_prefix}libasan-devel
Summary: The Address Sanitizer static library
%if 0%{?rhel} > 8
Requires: libasan%{_isa} >= 8.3.1
Obsoletes: libasan5
%else
Requires: libasan6%{_isa} >= 10.2.1
%endif
Obsoletes: libasan5 <= 8.3.1
%description -n %{?scl_prefix}libasan-devel
This package contains Address Sanitizer static runtime library.
@ -601,7 +597,7 @@ which is used for -fsanitize=undefined instrumented programs.
Summary: The Undefined Behavior Sanitizer static library
%if 0%{?rhel} > 7
Requires: libubsan%{_isa} >= 8.3.1
Obsoletes: libubsan1
Obsoletes: libubsan1 <= 8.3.1
%else
Requires: libubsan1%{_isa} >= 8.3.1
%endif
@ -662,7 +658,8 @@ to NVidia PTX capable devices if available.
%patch11 -p0 -b .d-shared-libphobos~
%patch12 -p0 -b .pr94540~
%patch13 -p0 -b .pr96383~
%patch14 -p0 -b .pr96385~
%patch14 -p0 -b .pr97060~
%patch15 -p0 -b .pr97524~
%patch1000 -p0 -b .libstdc++-compat~
%if %{build_isl}
@ -671,7 +668,6 @@ to NVidia PTX capable devices if available.
%patch1003 -p0 -b .libgfortran-compat~
%patch1004 -p0 -b .libgfortran-compat-2~
%if 0
%patch3001 -p1 -b .fortran01~
%patch3002 -p1 -b .fortran02~
%patch3003 -p1 -b .fortran03~
@ -682,13 +678,6 @@ to NVidia PTX capable devices if available.
%patch3008 -p1 -b .fortran08~
%patch3009 -p1 -b .fortran09~
%patch3010 -p1 -b .fortran10~
%patch3011 -p1 -b .fortran11~
%patch3012 -p1 -b .fortran12~
%patch3013 -p1 -b .fortran13~
%patch3014 -p1 -b .fortran14~
%patch3015 -p1 -b .fortran15~
%patch3016 -p1 -b .fortran16~
%endif
echo 'Red Hat %{version}-%{gcc_release}' > gcc/DEV-PHASE
@ -1303,6 +1292,23 @@ GROUP ( /lib/libgcc_s.so.1 libgcc.a )' > $FULLPATH/32/libgcc_s.so
mv -f %{buildroot}%{_prefix}/%{_lib}/libgomp.spec $FULLPATH/
cp -a %{gcc_target_platform}/libstdc++-v3/src/.libs/libstdc++_nonshared%{nonsharedver}.a \
$FULLLPATH/libstdc++_nonshared.a
cp -a %{gcc_target_platform}/libgfortran/.libs/libgfortran_nonshared80.a \
$FULLLPATH/libgfortran_nonshared.a
%if 0%{?rhel} <= 7
# Build libgomp_nonshared.a with the system RHEL 7 compiler. Use -O2 to
# get tailcalls.
gcc %{SOURCE4} -O2 -c
ar rcs libgomp_nonshared.a libgomp_nonshared.o
cp -a libgomp_nonshared.a $FULLLPATH
%ifarch x86_64
# Only need this for -m32 on x86_64. devtoolset-N-gcc isn't multilib,
# and we don't have a devtoolset-N-libgomp-devel subpackage.
gcc %{SOURCE4} -O2 -c -m32 -o libgomp_nonshared32.o
ar rcs libgomp_nonshared32.a libgomp_nonshared32.o
cp -a libgomp_nonshared32.a $FULLLPATH/32/libgomp_nonshared.a
%endif
%endif
rm -f $FULLEPATH/libgccjit.so
mkdir -p %{buildroot}%{_prefix}/%{_lib}/
@ -1317,9 +1323,18 @@ gzip -9 %{buildroot}/%{_infodir}/libgccjit.info
pushd $FULLPATH
%if 0%{?rhel} <= 7
echo '/* GNU ld script
Use the shared library, but some functions are only in
the static library, so try that secondarily. */
%{oformat}
INPUT ( %{?scl:%{_root_prefix}}%{!?scl:%{_prefix}}/%{_lib}/libgomp.so.1 -lgomp_nonshared )' > libgomp.so
%else
echo '/* GNU ld script */
%{oformat}
INPUT ( %{?scl:%{_root_prefix}}%{!?scl:%{_prefix}}/%{_lib}/libgomp.so.1 )' > libgomp.so
%endif
%if 0%{?rhel} <= 8
echo '/* GNU ld script
Use the shared library, but some functions are only in
@ -1335,7 +1350,7 @@ echo '/* GNU ld script
Use the shared library, but some functions are only in
the static library, so try that secondarily. */
%{oformat}
INPUT ( %{?scl:%{_root_prefix}}%{!?scl:%{_prefix}}/%{_lib}/libgfortran.so.5 )' > libgfortran.so
INPUT ( %{?scl:%{_root_prefix}}%{!?scl:%{_prefix}}/%{_lib}/libgfortran.so.5 -lgfortran_nonshared )' > libgfortran.so
%if %{build_libquadmath}
rm -f libquadmath.so
echo '/* GNU ld script */
@ -1435,7 +1450,7 @@ echo '/* GNU ld script
Use the shared library, but some functions are only in
the static library, so try that secondarily. */
%{oformat2}
INPUT ( %{?scl:%{_root_prefix}}%{!?scl:%{_prefix}}/lib64/libgfortran.so.5 )' > 64/libgfortran.so
INPUT ( %{?scl:%{_root_prefix}}%{!?scl:%{_prefix}}/lib64/libgfortran.so.5 -lgfortran_nonshared )' > 64/libgfortran.so
echo '/* GNU ld script */
%{oformat2}
INPUT ( %{?scl:%{_root_prefix}}%{!?scl:%{_prefix}}/lib64/libgomp.so.1 )' > 64/libgomp.so
@ -1535,10 +1550,20 @@ echo '/* GNU ld script
Use the shared library, but some functions are only in
the static library, so try that secondarily. */
%{oformat2}
INPUT ( %{?scl:%{_root_prefix}}%{!?scl:%{_prefix}}/lib/libgfortran.so.5 )' > 32/libgfortran.so
INPUT ( %{?scl:%{_root_prefix}}%{!?scl:%{_prefix}}/lib/libgfortran.so.5 -lgfortran_nonshared )' > 32/libgfortran.so
%if 0%{?rhel} <= 7
echo '/* GNU ld script
Use the shared library, but some functions are only in
the static library, so try that secondarily. */
%{oformat2}
INPUT ( %{?scl:%{_root_prefix}}%{!?scl:%{_prefix}}/lib/libgomp.so.1 -lgomp_nonshared )' > 32/libgomp.so
%else
echo '/* GNU ld script */
%{oformat2}
INPUT ( %{?scl:%{_root_prefix}}%{!?scl:%{_prefix}}/lib/libgomp.so.1 )' > 32/libgomp.so
%endif
echo '/* GNU ld script */
%{oformat2}
INPUT ( %{_prefix}/lib/libgccjit.so.0 )' > 32/libgccjit.so
@ -1596,6 +1621,11 @@ ln -sf lib64/libstdc++fs.a libstdc++fs.a
ln -sf ../lib32/libstdc++_nonshared.a 32/libstdc++_nonshared.a
ln -sf lib64/libstdc++_nonshared.a libstdc++_nonshared.a
%endif
%if 0%{?rhel} <= 8
ln -sf ../lib32/libgfortran_nonshared.a 32/libgfortran_nonshared.a
ln -sf lib64/libgfortran_nonshared.a libgfortran_nonshared.a
ln -sf lib64/libgomp_nonshared.a libgomp_nonshared.a
%endif
%if %{build_libquadmath}
ln -sf ../lib32/libquadmath.a 32/libquadmath.a
ln -sf lib64/libquadmath.a libquadmath.a
@ -1625,6 +1655,9 @@ ln -sf ../../../%{multilib_32_arch}-%{_vendor}-%{_target_os}%{?_gnu}/%{gcc_major
%if 0%{?rhel} <= 8
ln -sf ../../../%{multilib_32_arch}-%{_vendor}-%{_target_os}%{?_gnu}/%{gcc_major}/libstdc++_nonshared.a 32/libstdc++_nonshared.a
%endif
%if 0%{?rhel} <= 8
ln -sf ../../../%{multilib_32_arch}-%{_vendor}-%{_target_os}%{?_gnu}/%{gcc_major}/libgfortran_nonshared.a 32/libgfortran_nonshared.a
%endif
%if %{build_libquadmath}
ln -sf ../../../%{multilib_32_arch}-%{_vendor}-%{_target_os}%{?_gnu}/%{gcc_major}/libquadmath.a 32/libquadmath.a
%endif
@ -1661,6 +1694,8 @@ for f in `find $adirs -maxdepth 1 -a \
-o -name liblsan.a \
-o -name libcc1.a \
-o -name libstdc++_nonshared.a \
-o -name libgomp_nonshared.a \
-o -name libgfortran_nonshared.a \
-o -name libsupc++.a \
-o -name libstdc++.a -o -name libcaf_single.a \
-o -name libstdc++fs.a \) -a -type f`; do
@ -1809,7 +1844,6 @@ chmod 755 %{buildroot}%{_prefix}/bin/%{multilib_32_arch}-%{_vendor}-%{_target_os
%endif
# Help plugins find out nvra.
# ??? Fedora uses _arch
echo gcc-%{version}-%{release}.%{arch} > $FULLPATH/rpmver
# Add symlink to lto plugin in the binutils plugin directory.
@ -2181,6 +2215,11 @@ fi
%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/libgomp.spec
%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/libgomp.a
%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/libgomp.so
%if 0%{?rhel} <= 7
%ifnarch ppc
%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/libgomp_nonshared.a
%endif
%endif
%if %{build_libitm}
%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/libitm.spec
%endif
@ -2237,6 +2276,20 @@ fi
%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/32/libgcc_s.so
%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/32/libgomp.a
%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/32/libgomp.so
# Add libgomp_nonshared.a
%if 0%{?rhel} <= 7
%ifarch x86_64
# Need it for -m32.
%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/32/libgomp_nonshared.a
%endif
%ifarch ppc64
# We've created a symlink to lib64/libgomp_nonshared.a, so add it.
%dir %{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/lib64
%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/lib64/libgomp_nonshared.a
%endif
%endif
%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/32/libgccjit.so
%if %{build_libquadmath}
%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/32/libquadmath.a
@ -2402,6 +2455,7 @@ fi
%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/libcaf_single.a
%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/libgfortran.a
%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/libgfortran.so
%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/libgfortran_nonshared.a
%ifarch sparcv9 ppc
%dir %{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/64
%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/64/libcaf_single.a
@ -2414,8 +2468,13 @@ fi
%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/32/libcaf_single.a
%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/32/libgfortran.a
%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/32/libgfortran.so
%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/32/libgfortran_nonshared.a
%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/32/finclude
%endif
%ifarch ppc64
%dir %{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/lib64
%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/lib64/libgfortran_nonshared.a
%endif
%doc rpm.doc/gfortran/*
%if %{build_libquadmath}
@ -2438,6 +2497,11 @@ fi
%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/libquadmath.a
%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/libquadmath.so
%endif
%dir %{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}
%ifarch %{ix86}
# Need it for -m32.
%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/libgfortran_nonshared.a
%endif
%doc rpm.doc/libquadmath/ChangeLog*
%endif
@ -2617,6 +2681,27 @@ fi
%endif
%changelog
* Tue Mar 16 2021 Marek Polacek <polacek@redhat.com> 10.2.1-8.2
- actually use libgfortran_nonshared.a (#1929375)
- have libasan-devel require libasan6 (#1939638)
* Mon Nov 16 2020 Marek Polacek <polacek@redhat.com> 10.2.1-8.1
- apply fix for -flto=auto with missing make (#1896093, PR lto/97524)
* Thu Nov 12 2020 Marek Polacek <polacek@redhat.com> 10.2.1-8
- update from Fedora gcc 10.2.1-8 (#1878887)
- emit DW_AT_declaration on declaration-only DIEs (#1897272, PR debug/97060)
- add BuildRequires: make and Requires: make, the latter for -flto reasons
* Tue Nov 03 2020 Marek Polacek <polacek@redhat.com> 10.2.1-7.1
- adjust some libstdc++_nonshared.a symbol
* Tue Nov 03 2020 Marek Polacek <polacek@redhat.com> 10.2.1-7
- update from Fedora gcc 10.2.1-7 (#1878887)
* Mon Aug 17 2020 Marek Polacek <polacek@redhat.com> 10.2.1-2.1
- re-apply Fortran patches
* Tue Aug 4 2020 Marek Polacek <polacek@redhat.com> 10.2.1-2
- update from Fedora gcc 10.2.1-2
- emit debug info for C/C++ external function declarations used in the TU