rpms/gcc-toolset-9-gcc
7
0
Fork 0
Code Issues Pull Requests Releases Activity

import gcc-toolset-9-gcc-9.2.1-2.2.el8

Browse Source
This commit is contained in:
CentOS Sources 2020-01-21 17:25:40 -05:00 committed by Stepan Oksanichenko
parent e2d5a87755
commit 06b0a95731
49 changed files with 9158 additions and 5169 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
.gcc-toolset-9-gcc.metadata
View File

@ -1,4 +1,6 @@
7f4348418dc3efefd357b32a2b5c8010211ab284 SOURCES/doxygen-1.8.0.src.tar.gz
574d80f9840124e0ad45b84e8a59b29419726ce8 SOURCES/gcc-9.1.1-20190503.tar.xz
f98fd29e9c3faf986b48404be3ae4201e6a1b492 SOURCES/gcc-9.2.1-20191120.tar.xz
c5a2b201bf05229647e73203c0bf2d9679d4d21f SOURCES/isl-0.16.1.tar.bz2
5ef03ca7aee134fe7dfecb6c9d048799f0810278 SOURCES/mpc-0.8.1.tar.gz
3bdb3cc01fa7690a0e20ea5cfffcbe690f7665eb SOURCES/nvptx-newlib-aadc8eb0ec43b7cd0dd2dfb484bae63c8b05ef24.tar.xz
ce8eb83be0ac37fb5d5388df455a980fe37b4f13 SOURCES/nvptx-tools-c28050f60193b3b95a18866a96f03334e874e78f.tar.xz

4
.gitignore vendored
View File

@ -1,4 +1,6 @@
SOURCES/doxygen-1.8.0.src.tar.gz
SOURCES/gcc-9.1.1-20190503.tar.xz
SOURCES/gcc-9.2.1-20191120.tar.xz
SOURCES/isl-0.16.1.tar.bz2
SOURCES/mpc-0.8.1.tar.gz
SOURCES/nvptx-newlib-aadc8eb0ec43b7cd0dd2dfb484bae63c8b05ef24.tar.xz
SOURCES/nvptx-tools-c28050f60193b3b95a18866a96f03334e874e78f.tar.xz

81
SOURCES/0001-Allow-repeated-compatible-type-specifications.patch
View File

@ -1,81 +0,0 @@
From f96f2f273741ea19311c6e7a6f556c09b6ff9415 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 01/23] Allow repeated compatible type specifications.
Add a check to see if a repeated type specification is compatible
with the previous specification. Only create an error on incompatible
type specifications for the same symbol.
Some fixes by Jim MacArthur <jim.macarthur@codethink.co.uk>
---
0001-Allow-repeated-compatible-type-specifications.patch
0015-Allow-redefinition-of-types-for-procedures.patch
0021-Correct-internal-fault-in-select_type_9.f90.patch
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index ec43e63..67ad504 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -1877,6 +1877,8 @@ gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where)
if (sym->attr.result && type == BT_UNKNOWN && sym->ns->proc_name)
type = sym->ns->proc_name->ts.type;
+ flavor = sym->attr.flavor;
+
if (type != BT_UNKNOWN && !(sym->attr.function && sym->attr.implicit_type)
&& !(gfc_state_stack->previous && gfc_state_stack->previous->previous
&& gfc_state_stack->previous->previous->state == COMP_SUBMODULE)
@@ -1886,6 +1888,20 @@ 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);
+ else if (gfc_option.allow_std & GFC_STD_EXTRA_LEGACY)
+ {
+ /* Ignore temporaries and class/procedure names */
+ if (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS || sym->ts.type == BT_PROCEDURE)
+ return false;
+
+ if (gfc_compare_types (&sym->ts, ts)
+ && (flavor == FL_UNKNOWN || flavor == FL_VARIABLE || flavor == FL_PROCEDURE))
+ {
+ return gfc_notify_std (GFC_STD_LEGACY,
+ "Symbol '%qs' at %L already has basic type of %s", sym->name,
+ where, gfc_basic_typename (type));
+ }
+ }
else
gfc_error ("Symbol %qs at %L already has basic type of %s", sym->name,
where, gfc_basic_typename (type));
@@ -1899,8 +1915,6 @@ gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where)
return false;
}
- flavor = sym->attr.flavor;
-
if (flavor == FL_PROGRAM || flavor == FL_BLOCK_DATA || flavor == FL_MODULE
|| flavor == FL_LABEL
|| (flavor == FL_PROCEDURE && sym->attr.subroutine)
diff --git a/gcc/testsuite/gfortran.dg/duplicate_type_4.f90 b/gcc/testsuite/gfortran.dg/duplicate_type_4.f90
new file mode 100644
index 0000000..cdd29ea
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/duplicate_type_4.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+
+! PR fortran/30239
+! Check for errors when a symbol gets declared a type twice, even if it
+! is the same.
+
+INTEGER FUNCTION foo ()
+ IMPLICIT NONE
+ INTEGER :: x
+ INTEGER :: x ! { dg-error "basic type of" }
+ x = 42
+END FUNCTION foo

873
SOURCES/0001-Default-widths-for-i-f-and-g-format-specifiers-in-fo.patch Normal file
View File

@ -0,0 +1,873 @@
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

219
SOURCES/0002-Allow-duplicate-declarations.patch Normal file
View File

@ -0,0 +1,219 @@
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.
Enabled by -fdec-duplicates and -fdec.
Some fixes by Jim MacArthur <jim.macarthur@codethink.co.uk>
Addition of -fdec-duplicates by Mark Eggleston <mark.eggleston@codethink.com>
---
gcc/fortran/lang.opt | 4 ++++
gcc/fortran/options.c | 1 +
gcc/fortran/symbol.c | 23 ++++++++++++++++++++---
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(-)
create mode 100644 gcc/testsuite/gfortran.dg/duplicate_type_4.f90
create mode 100644 gcc/testsuite/gfortran.dg/duplicate_type_5.f90
create mode 100644 gcc/testsuite/gfortran.dg/duplicate_type_6.f90
create mode 100644 gcc/testsuite/gfortran.dg/duplicate_type_7.f90
create mode 100644 gcc/testsuite/gfortran.dg/duplicate_type_8.f90
create mode 100644 gcc/testsuite/gfortran.dg/duplicate_type_9.f90
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 26e82601b62..491d81ccaa5 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-duplicates
+Fortran Var(flag_dec_duplicates)
+Allow varibles to be duplicated in the type specification matches.
+
fdec-include
Fortran Var(flag_dec_include)
Enable legacy parsing of INCLUDE as statement.
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index 4f91486e977..f93db8b6d7c 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);
SET_BITFLAG (flag_dec_format_defaults, 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
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -1995,6 +1995,8 @@ gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where)
if (sym->attr.result && type == BT_UNKNOWN && sym->ns->proc_name)
type = sym->ns->proc_name->ts.type;
+ flavor = sym->attr.flavor;
+
if (type != BT_UNKNOWN && !(sym->attr.function && sym->attr.implicit_type)
&& !(gfc_state_stack->previous && gfc_state_stack->previous->previous
&& gfc_state_stack->previous->previous->state == COMP_SUBMODULE)
@@ -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);
+ else if (flag_dec_duplicates)
+ {
+ /* Ignore temporaries and class/procedure names */
+ if (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS
+ || sym->ts.type == BT_PROCEDURE)
+ return false;
+
+ if (gfc_compare_types (&sym->ts, ts)
+ && (flavor == FL_UNKNOWN || flavor == FL_VARIABLE
+ || flavor == FL_PROCEDURE))
+ {
+ return gfc_notify_std (GFC_STD_LEGACY,
+ "Symbol '%qs' at %L already has "
+ "basic type of %s", sym->name, where,
+ gfc_basic_typename (type));
+ }
+ }
else
gfc_error ("Symbol %qs at %L already has basic type of %s", sym->name,
- where, gfc_basic_typename (type));
+ where, gfc_basic_typename (type));
return false;
}
@@ -2017,8 +2036,6 @@ gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where)
return false;
}
- flavor = sym->attr.flavor;
-
if (flavor == FL_PROGRAM || flavor == FL_BLOCK_DATA || flavor == FL_MODULE
|| flavor == FL_LABEL
|| (flavor == FL_PROCEDURE && sym->attr.subroutine)
diff --git a/gcc/testsuite/gfortran.dg/duplicate_type_4.f90 b/gcc/testsuite/gfortran.dg/duplicate_type_4.f90
new file mode 100644
index 00000000000..cdd29ea8846
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/duplicate_type_4.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+
+! PR fortran/30239
+! Check for errors when a symbol gets declared a type twice, even if it
+! is the same.
+
+INTEGER FUNCTION foo ()
+ IMPLICIT NONE
+ INTEGER :: x
+ INTEGER :: x ! { dg-error "basic type of" }
+ x = 42
+END FUNCTION foo
diff --git a/gcc/testsuite/gfortran.dg/duplicate_type_5.f90 b/gcc/testsuite/gfortran.dg/duplicate_type_5.f90
new file mode 100644
index 00000000000..00f931809aa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/duplicate_type_5.f90
@@ -0,0 +1,13 @@
+! { dg-do run }
+! { dg-options "-fdec" }
+!
+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+
+program test
+ implicit none
+ integer :: x
+ integer :: x
+ x = 42
+ if (x /= 42) stop 1
+end program test
diff --git a/gcc/testsuite/gfortran.dg/duplicate_type_6.f90 b/gcc/testsuite/gfortran.dg/duplicate_type_6.f90
new file mode 100644
index 00000000000..f0df27e323c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/duplicate_type_6.f90
@@ -0,0 +1,13 @@
+! { dg-do run }
+! { dg-options "-std=legacy -fdec-duplicates" }
+!
+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+
+program test
+ implicit none
+ integer :: x
+ integer :: x
+ x = 42
+ if (x /= 42) stop 1
+end program test
diff --git a/gcc/testsuite/gfortran.dg/duplicate_type_7.f90 b/gcc/testsuite/gfortran.dg/duplicate_type_7.f90
new file mode 100644
index 00000000000..f32472ff586
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/duplicate_type_7.f90
@@ -0,0 +1,13 @@
+! { dg-do run }
+! { dg-options "-fdec-duplicates" }
+!
+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+
+program test
+ implicit none
+ integer :: x
+ integer :: x! { dg-warning "Legacy Extension" }
+ x = 42
+ if (x /= 42) stop 1
+end program test
diff --git a/gcc/testsuite/gfortran.dg/duplicate_type_8.f90 b/gcc/testsuite/gfortran.dg/duplicate_type_8.f90
new file mode 100644
index 00000000000..23c94add179
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/duplicate_type_8.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-fdec -fno-dec-duplicates" }
+!
+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+
+integer function foo ()
+ implicit none
+ integer :: x
+ integer :: x ! { dg-error "basic type of" }
+ x = 42
+end function foo
diff --git a/gcc/testsuite/gfortran.dg/duplicate_type_9.f90 b/gcc/testsuite/gfortran.dg/duplicate_type_9.f90
new file mode 100644
index 00000000000..d5edee4d8ee
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/duplicate_type_9.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-fdec-duplicates -fno-dec-duplicates" }
+!
+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+
+integer function foo ()
+ implicit none
+ integer :: x
+ integer :: x ! { dg-error "basic type of" }
+ x = 42
+end function foo
--
2.11.0

106
SOURCES/0002-Pad-character-to-int-conversions-with-spaces-instead.patch
View File

@ -1,106 +0,0 @@
From 40d6590b03a9f92c19b7097b1cae296276d6ce22 Mon Sep 17 00:00:00 2001
From: Jim MacArthur <jim.macarthur@codethink.co.uk>
Date: Mon, 28 Sep 2015 16:06:30 +0100
Subject: [PATCH 02/23] Pad character-to-int conversions with spaces instead of
zeros.
The pad character is 'undefined' or 'processor dependent' depending on which
standard you read. This makes it 0x20 which matches the Oracle Fortran
compiler. One of the tests tests this undefined behaviour, so I had to modify
it.
0002-Pad-character-to-int-conversions-with-spaces-instead.patch
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 4808c27..93908f8 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -428,6 +428,10 @@ fdec
Fortran Var(flag_dec)
Enable all DEC language extensions.
+fdec-pad-with-spaces
+Fortran Var(flag_dec_pad_with_spaces)
+For character to integer conversions, use spaces for the pad rather than NUL.
+
fdec-intrinsic-ints
Fortran Var(flag_dec_intrinsic_ints)
Enable kind-specific variants of integer intrinsic functions.
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index d12ae5f..09da1d2 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -6623,7 +6623,7 @@ gfc_simplify_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size)
/* Allocate the buffer to store the binary version of the source. */
buffer_size = MAX (source_size, result_size);
buffer = (unsigned char*)alloca (buffer_size);
- memset (buffer, 0, buffer_size);
+ memset (buffer, (flag_dec_pad_with_spaces ? 0x20 : 0x0), buffer_size);
/* Now write source to the buffer. */
gfc_target_encode_expr (source, buffer, buffer_size);
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_ptr_tests_20.f90
@@ -0,0 +1,62 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-optimized -O -fdec-pad-with-spaces" }
+!
+! PR fortran/46974
+
+program test
+ use ISO_C_BINDING
+ implicit none
+ type(c_ptr) :: m
+ integer(c_intptr_t) :: a
+ integer(transfer(transfer(4_c_intptr_t, c_null_ptr),1_c_intptr_t)) :: b
+ a = transfer (transfer("ABCE", m), 1_c_intptr_t)
+ print '(z8)', a
+ if ( int(z'45434241') /= a &
+ .and. int(z'41424345') /= a &
+ .and. int(z'4142434520202020',kind=8) /= a &
+ .and. int(z'2020202045434241',kind=8) /= a ) &
+ call i_do_not_exist()
+end program test
+
+! Examples contributed by Steve Kargl and James Van Buskirk
+
+subroutine bug1
+ use ISO_C_BINDING
+ implicit none
+ type(c_ptr) :: m
+ type mytype
+ integer a, b, c
+ end type mytype
+ type(mytype) x
+ print *, transfer(32512, x) ! Works.
+ print *, transfer(32512, m) ! Caused ICE.
+end subroutine bug1
+
+subroutine bug6
+ use ISO_C_BINDING
+ implicit none
+ interface
+ function fun()
+ use ISO_C_BINDING
+ implicit none
+ type(C_FUNPTR) fun
+ end function fun
+ end interface
+ type(C_PTR) array(2)
+ type(C_FUNPTR) result
+ integer(C_INTPTR_T), parameter :: const(*) = [32512,32520]
+
+ result = fun()
+ array = transfer([integer(C_INTPTR_T)::32512,32520],array)
+! write(*,*) transfer(result,const)
+! write(*,*) transfer(array,const)
+end subroutine bug6
+
+function fun()
+ use ISO_C_BINDING
+ implicit none
+ type(C_FUNPTR) fun
+ fun = transfer(32512_C_INTPTR_T,fun)
+end function fun
+
+! { dg-final { scan-tree-dump-times "i_do_not_exist" 0 "optimized" } }

54
SOURCES/0003-Add-std-extra-legacy.patch
View File

@ -1,54 +0,0 @@
From d1bb76287ec58fdde7ced70088559136555bd7bd Mon Sep 17 00:00:00 2001
From: Jim MacArthur <jim.macarthur@codethink.co.uk>
Date: Fri, 11 Dec 2015 17:04:09 +0000
Subject: [PATCH 03/23] Add -std=extra-legacy
0003-Add-std-extra-legacy.patch
0023-Add-a-full-stop-to-the-std-extra-legacy-help-text.patch
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 4421ce4..4808c27 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -790,6 +790,10 @@ std=legacy
Fortran
Accept extensions to support legacy code.
+std=extra-legacy
+Fortran
+Accept even more legacy extensions, including things disallowed in f90.
+
undef
Fortran
; Documented in C
diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h
index c5ff992..dcc923b 100644
--- a/gcc/fortran/libgfortran.h
+++ b/gcc/fortran/libgfortran.h
@@ -22,6 +22,7 @@ along with GCC; see the file COPYING3.
Note that no features were obsoleted nor deleted in F2003.
Please remember to keep those definitions in sync with
gfortran.texi. */
+#define GFC_STD_EXTRA_LEGACY (1<<13) /* Even more backward compatibility. */
#define GFC_STD_F2018_DEL (1<<12) /* Deleted in F2018. */
#define GFC_STD_F2018_OBS (1<<11) /* Obsolescent in F2018. */
#define GFC_STD_F2018 (1<<10) /* New in F2018. */
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index 1af76aa..9ebf8e3 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -733,6 +733,12 @@ gfc_handle_option (size_t scode, const char *arg, int value,
gfc_option.warn_std = 0;
break;
+ case OPT_std_extra_legacy:
+ set_default_std_flags ();
+ gfc_option.warn_std = 0;
+ gfc_option.allow_std |= GFC_STD_EXTRA_LEGACY;
+ break;
+
case OPT_fshort_enums:
/* Handled in language-independent code. */
break;

298
SOURCES/0003-Convert-LOGICAL-to-INTEGER-for-arithmetic-ops-and-vi.patch Normal file
View File

@ -0,0 +1,298 @@
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
versa
We allow converting LOGICAL types to INTEGER when doing arithmetic
operations, and converting INTEGER types to LOGICAL for use in
boolean operations.
This feature is enabled with the -flogical-as-integer flag.
Note: using this feature will disable bitwise logical operations enabled by
-fdec.
---
gcc/fortran/lang.opt | 4 ++
gcc/fortran/resolve.c | 55 +++++++++++++++++++++-
.../logical_to_integer_and_vice_versa_1.f | 31 ++++++++++++
.../logical_to_integer_and_vice_versa_2.f | 31 ++++++++++++
.../logical_to_integer_and_vice_versa_3.f | 33 +++++++++++++
.../logical_to_integer_and_vice_versa_4.f | 33 +++++++++++++
6 files changed, 186 insertions(+), 1 deletion(-)
create mode 100644 gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_1.f
create mode 100644 gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_2.f
create mode 100644 gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_3.f
create mode 100644 gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_4.f
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 491d81ccaa5..13a8e9778bb 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -468,6 +468,10 @@ fdec-static
Fortran Var(flag_dec_static)
Enable DEC-style STATIC and AUTOMATIC attributes.
+flogical-as-integer
+Fortran Var(flag_logical_as_integer)
+Convert from integer to logical or logical to integer for arithmetic operations.
+
fdefault-double-8
Fortran Var(flag_default_double)
Set the default double precision kind to an 8 byte wide type.
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 8232deb8170..32b8d504ff6 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -3838,7 +3838,6 @@ lookup_uop_fuzzy (const char *op, gfc_symtree *uop)
return gfc_closest_fuzzy_match (op, candidates);
}
-
/* Callback finding an impure function as an operand to an .and. or
.or. expression. Remember the last function warned about to
avoid double warnings when recursing. */
@@ -3873,6 +3872,37 @@ impure_function_callback (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
return 0;
}
+/* If E is a logical, convert it to an integer and issue a warning
+ for the conversion. */
+
+static void
+convert_integer_to_logical (gfc_expr *e)
+{
+ if (e->ts.type == BT_INTEGER)
+ {
+ /* Convert to LOGICAL */
+ gfc_typespec t;
+ t.type = BT_LOGICAL;
+ t.kind = 1;
+ gfc_convert_type_warn (e, &t, 2, 1);
+ }
+}
+
+/* If E is a logical, convert it to an integer and issue a warning
+ for the conversion. */
+
+static void
+convert_logical_to_integer (gfc_expr *e)
+{
+ if (e->ts.type == BT_LOGICAL)
+ {
+ /* Convert to INTEGER */
+ gfc_typespec t;
+ t.type = BT_INTEGER;
+ t.kind = 1;
+ gfc_convert_type_warn (e, &t, 2, 1);
+ }
+}
/* Resolve an operator expression node. This can involve replacing the
operation with a user defined function call. */
@@ -3938,6 +3968,12 @@ resolve_operator (gfc_expr *e)
case INTRINSIC_TIMES:
case INTRINSIC_DIVIDE:
case INTRINSIC_POWER:
+ if (flag_logical_as_integer)
+ {
+ convert_logical_to_integer (op1);
+ convert_logical_to_integer (op2);
+ }
+
if (gfc_numeric_ts (&op1->ts) && gfc_numeric_ts (&op2->ts))
{
gfc_type_convert_binary (e, 1);
@@ -3974,6 +4010,13 @@ resolve_operator (gfc_expr *e)
case INTRINSIC_OR:
case INTRINSIC_EQV:
case INTRINSIC_NEQV:
+
+ if (flag_logical_as_integer)
+ {
+ convert_integer_to_logical (op1);
+ convert_integer_to_logical (op2);
+ }
+
if (op1->ts.type == BT_LOGICAL && op2->ts.type == BT_LOGICAL)
{
e->ts.type = BT_LOGICAL;
@@ -4024,6 +4067,9 @@ resolve_operator (gfc_expr *e)
goto simplify_op;
}
+ if (flag_logical_as_integer)
+ convert_integer_to_logical (op1);
+
if (op1->ts.type == BT_LOGICAL)
{
e->ts.type = BT_LOGICAL;
@@ -4055,6 +4101,13 @@ resolve_operator (gfc_expr *e)
case INTRINSIC_EQ_OS:
case INTRINSIC_NE:
case INTRINSIC_NE_OS:
+
+ if (flag_logical_as_integer)
+ {
+ convert_logical_to_integer (op1);
+ convert_logical_to_integer (op2);
+ }
+
if (op1->ts.type == BT_CHARACTER && op2->ts.type == BT_CHARACTER
&& op1->ts.kind == op2->ts.kind)
{
diff --git a/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_1.f b/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_1.f
new file mode 100644
index 00000000000..938a91d9e9a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_1.f
@@ -0,0 +1,31 @@
+! { dg-do run }
+! { dg-options "-std=legacy -flogical-as-integer" }
+!
+! Test conversion between logical and integer for logical operators
+!
+! Test case contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
+! Modified for -flogical-as-integer by Mark Eggleston
+! <mark.eggleston@codethink.com>
+!
+ PROGRAM logical_integer_conversion
+ LOGICAL lpos /.true./
+ INTEGER ineg/0/
+ INTEGER ires
+ LOGICAL lres
+
+ ! Test Logicals converted to Integers
+ if ((lpos.AND.ineg).EQ.1) STOP 3
+ if ((ineg.AND.lpos).NE.0) STOP 4
+ ires = (.true..AND.0)
+ if (ires.NE.0) STOP 5
+ ires = (1.AND..false.)
+ if (ires.EQ.1) STOP 6
+
+ ! Test Integers converted to Logicals
+ if (lpos.EQ.ineg) STOP 7
+ if (ineg.EQ.lpos) STOP 8
+ lres = (.true..EQ.0)
+ if (lres) STOP 9
+ lres = (1.EQ..false.)
+ if (lres) STOP 10
+ END
diff --git a/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_2.f b/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_2.f
new file mode 100644
index 00000000000..9f146202ba5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_2.f
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! { dg-options "-std=legacy -flogical-as-integer -fno-logical-as-integer" }
+!
+! Based on logical_to_integer_and_vice_versa_1.f but with option disabled
+! to test for error messages.
+!
+! Test case contributed by by Mark Eggleston <mark.eggleston@codethink.com>
+!
+!
+ PROGRAM logical_integer_conversion
+ LOGICAL lpos /.true./
+ INTEGER ineg/0/
+ INTEGER ires
+ LOGICAL lres
+
+ ! Test Logicals converted to Integers
+ if ((lpos.AND.ineg).EQ.1) STOP 3 ! { dg-error "Operands of logical operator" }
+ if ((ineg.AND.lpos).NE.0) STOP 4 ! { dg-error "Operands of logical operator" }
+ ires = (.true..AND.0) ! { dg-error "Operands of logical operator" }
+ if (ires.NE.0) STOP 5
+ ires = (1.AND..false.) ! { dg-error "Operands of logical operator" }
+ if (ires.EQ.1) STOP 6
+
+ ! Test Integers converted to Logicals
+ if (lpos.EQ.ineg) STOP 7 ! { dg-error "Operands of comparison operator" }
+ if (ineg.EQ.lpos) STOP 8 ! { dg-error "Operands of comparison operator" }
+ lres = (.true..EQ.0) ! { dg-error "Operands of comparison operator" }
+ if (lres) STOP 9
+ lres = (1.EQ..false.) ! { dg-error "Operands of comparison operator" }
+ if (lres) STOP 10
+ END
diff --git a/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_3.f b/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_3.f
new file mode 100644
index 00000000000..446873eb2dc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_3.f
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! { dg-options "-std=legacy -flogical-as-integer" }
+!
+! Test conversion between logical and integer for logical operators
+!
+ program test
+ logical f /.false./
+ logical t /.true./
+ real x
+
+ x = 7.7
+ x = x + t*3.0
+ if (abs(x - 10.7).gt.0.00001) stop 1
+ x = x + .false.*5.0
+ if (abs(x - 10.7).gt.0.00001) stop 2
+ x = x - .true.*5.0
+ if (abs(x - 5.7).gt.0.00001) stop 3
+ x = x + t
+ if (abs(x - 6.7).gt.0.00001) stop 4
+ x = x + f
+ if (abs(x - 6.7).gt.0.00001) stop 5
+ x = x - t
+ if (abs(x - 5.7).gt.0.00001) stop 6
+ x = x - f
+ if (abs(x - 5.7).gt.0.00001) stop 7
+ x = x**.true.
+ if (abs(x - 5.7).gt.0.00001) stop 8
+ x = x**.false.
+ if (abs(x - 1.0).gt.0.00001) stop 9
+ x = x/t
+ if (abs(x - 1.0).gt.0.00001) stop 10
+ if ((x/.false.).le.huge(x)) stop 11
+ end
diff --git a/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_4.f b/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_4.f
new file mode 100644
index 00000000000..4301a4988d8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_4.f
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! { dg-options "-std=legacy -flogical-as-integer -fno-logical-as-integer" }
+!
+! Test conversion between logical and integer for logical operators
+!
+ program test
+ logical f /.false./
+ logical t /.true./
+ real x
+
+ x = 7.7
+ x = x + t*3.0 ! { dg-error "Operands of binary numeric" }
+ if (abs(x - 10.7).gt.0.00001) stop 1
+ x = x + .false.*5.0 ! { dg-error "Operands of binary numeric" }
+ if (abs(x - 10.7).gt.0.00001) stop 2
+ x = x - .true.*5.0 ! { dg-error "Operands of binary numeric" }
+ if (abs(x - 5.7).gt.0.00001) stop 3
+ x = x + t ! { dg-error "Operands of binary numeric" }
+ if (abs(x - 6.7).gt.0.00001) stop 4
+ x = x + f ! { dg-error "Operands of binary numeric" }
+ if (abs(x - 6.7).gt.0.00001) stop 5
+ x = x - t ! { dg-error "Operands of binary numeric" }
+ if (abs(x - 5.7).gt.0.00001) stop 6
+ x = x - f ! { dg-error "Operands of binary numeric" }
+ if (abs(x - 5.7).gt.0.00001) stop 7
+ x = x**.true. ! { dg-error "Operands of binary numeric" }
+ if (abs(x - 5.7).gt.0.00001) stop 8
+ x = x**.false. ! { dg-error "Operands of binary numeric" }
+ if (abs(x - 1.0).gt.0.00001) stop 9
+ x = x/t ! { dg-error "Operands of binary numeric" }
+ if (abs(x - 1.0).gt.0.00001) stop 10
+ if ((x/.false.).le.huge(x)) stop 11 ! { dg-error "Operands of binary numeric" }
+ end
--
2.11.0

860
SOURCES/0004-Allow-CHARACTER-literals-in-assignments-and-data-sta.patch Normal file
View File

@ -0,0 +1,860 @@
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

318
SOURCES/0004-Allow-conversion-between-Hollerith-constants-and-CHA.patch
View File

@ -1,318 +0,0 @@
From 7420e95a0ebb2401d67ad405670fb6a8d33f02da 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/23] Allow conversion between Hollerith constants and
CHARACTER and INTEGER
Warnings are raised when this happens.
This feature is enabled with the `-std=extra-legacy` compiler flag.
0004-Allow-conversion-between-Hollerith-constants-and-CHA.patch
diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c
index 8fa305c..fc1be48 100644
--- a/gcc/fortran/arith.c
+++ b/gcc/fortran/arith.c
@@ -2562,6 +2562,34 @@ hollerith2representation (gfc_expr *resu
}
+/* 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;
+ size_t i;
+ src_len = src->value.character.length;
+ gfc_target_expr_size (result, &result_len);
+
+ if (src_len > result_len)
+ gfc_warning (0, "The character constant at %L is too long to convert 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 *
@@ -2577,6 +2605,19 @@ gfc_hollerith2int (gfc_expr *src, int ki
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. */
diff --git a/gcc/fortran/arith.h b/gcc/fortran/arith.h
index 85aca5b..1f56aea 100644
--- a/gcc/fortran/arith.h
+++ b/gcc/fortran/arith.h
@@ -83,6 +83,7 @@ gfc_expr *gfc_hollerith2complex (gfc_expr *, int);
gfc_expr *gfc_hollerith2character (gfc_expr *, int);
gfc_expr *gfc_hollerith2logical (gfc_expr *, int);
gfc_expr *gfc_character2character (gfc_expr *, int);
+gfc_expr *gfc_character2int (gfc_expr *, int);
#endif /* GFC_ARITH_H */
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index f304154..ed3d440 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -2643,9 +2643,14 @@ gfc_check_index (gfc_expr *string, gfc_expr *substring, gfc_expr *back,
}
+/* This is the check function for the argument to the INT intrinsic */
bool
gfc_check_int (gfc_expr *x, gfc_expr *kind)
{
+ if ((gfc_option.allow_std & GFC_STD_EXTRA_LEGACY)
+ && x->ts.type == BT_CHARACTER)
+ return true;
+
if (!numeric_check (x, 0))
return false;
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 2f60fe8..371f5b8 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -3928,6 +3928,17 @@ add_conversions (void)
add_conv (BT_LOGICAL, gfc_logical_kinds[j].kind,
BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
}
+
+ /* Oracle allows character values to be converted to integers,
+ similar to Hollerith-Integer conversion - the first characters will
+ be turned into ascii values. */
+ if (gfc_option.allow_std & GFC_STD_EXTRA_LEGACY)
+ {
+ /* 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);
+ }
}
@@ -5008,6 +5019,15 @@ 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 ((gfc_option.allow_std & GFC_STD_EXTRA_LEGACY)
+ && from_ts.type == BT_CHARACTER
+ && ts->type == BT_INTEGER)
+ {
+ if (warn_conversion_extra || warn_conversion)
+ gfc_warning_now (0, "Conversion from %s to %s at %L",
+ gfc_typename (&from_ts), gfc_typename (ts),
+ &expr->where);
+ }
else
gcc_unreachable ();
}
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index d09cfa6..07c8c9a 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -3803,6 +3803,30 @@ lookup_uop_fuzzy (const char *op, gfc_symtree *uop)
return gfc_closest_fuzzy_match (op, candidates);
}
+/* 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 logical, convert it to an integer and issue a warning
+ for the conversion. */
+
+static void
+convert_logical_to_integer (gfc_expr *e)
+{
+ if (e->ts.type == BT_LOGICAL)
+ {
+ /* Convert to INTEGER */
+ gfc_typespec t;
+ t.type = BT_INTEGER;
+ t.kind = 1;
+ gfc_convert_type_warn (e, &t, 2, 1);
+ }
+}
+
/* Resolve an operator expression node. This can involve replacing the
operation with a user defined function call. */
@@ -3976,6 +4000,38 @@ resolve_operator (gfc_expr *e)
case INTRINSIC_EQ_OS:
case INTRINSIC_NE:
case INTRINSIC_NE_OS:
+
+ if (gfc_option.allow_std & GFC_STD_EXTRA_LEGACY)
+ {
+ convert_logical_to_integer (op1);
+ convert_logical_to_integer (op2);
+ }
+
+ /* If you're comparing hollerith contants to character expresisons,
+ convert the hollerith constant */
+ if ((gfc_option.allow_std & GFC_STD_EXTRA_LEGACY)
+ && is_character_based (op1->ts.type)
+ && is_character_based (op2->ts.type))
+ {
+ gfc_typespec ts;
+ ts.type = BT_CHARACTER;
+ ts.kind = op1->ts.kind;
+ if (op1->ts.type == BT_HOLLERITH)
+ {
+ gfc_convert_type_warn (op1, &ts, 2, 1);
+ gfc_warning (0, "Promoting argument for comparison from HOLLERITH "
+ "to CHARACTER at %L", &op1->where);
+ }
+ ts.type = BT_CHARACTER;
+ ts.kind = op2->ts.kind;
+ if (op2->ts.type == BT_HOLLERITH)
+ {
+ gfc_convert_type_warn (op2, &ts, 2, 1);
+ gfc_warning (0, "Promoting argument for comparison from HOLLERITH "
+ "to CHARACTER at %L", &op2->where);
+ }
+ }
+
if (op1->ts.type == BT_CHARACTER && op2->ts.type == BT_CHARACTER
&& op1->ts.kind == op2->ts.kind)
{
@@ -3984,6 +4040,29 @@ resolve_operator (gfc_expr *e)
break;
}
+ /* Numeric to hollerith comparisons */
+ if ((gfc_option.allow_std & GFC_STD_EXTRA_LEGACY)
+ && gfc_numeric_ts (&op1->ts)
+ && (op2->ts.type == BT_HOLLERITH || op2->ts.type == BT_CHARACTER))
+ {
+ gfc_warning (0, "Promoting argument for comparison from character type to INTEGER at %L", &op2->where);
+ gfc_typespec ts;
+ ts.type = BT_INTEGER;
+ ts.kind = 4;
+ gfc_convert_type_warn (op2, &ts, 2, 1);
+ }
+
+ if ((gfc_option.allow_std & GFC_STD_EXTRA_LEGACY)
+ && gfc_numeric_ts (&op2->ts)
+ && (op1->ts.type == BT_HOLLERITH || op1->ts.type == BT_CHARACTER))
+ {
+ gfc_warning (0, "Promoting argument for comparison from character type to INTEGER at %L", &op1->where);
+ gfc_typespec ts;
+ ts.type = BT_INTEGER;
+ ts.kind = 4;
+ gfc_convert_type_warn (op1, &ts, 2, 1);
+ }
+
if (gfc_numeric_ts (&op1->ts) && gfc_numeric_ts (&op2->ts))
{
gfc_type_convert_binary (e, 1);
@@ -4188,7 +4267,6 @@ bad_op:
return false;
}
-
/************** Array resolution subroutines **************/
enum compare_result
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 3c85c52..e03384c 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -7987,10 +7987,19 @@ 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_CHARACTER:
+ f = gfc_character2character;
+ break;
+
+ case BT_INTEGER:
+ f = gfc_character2int;
+ break;
+
+ default:
+ goto oops;
+ }
break;
default:
diff --git a/gcc/testsuite/gfortran.dg/hollerith-character-comparison.f90 b/gcc/testsuite/gfortran.dg/hollerith-character-comparison.f90
new file mode 100644
index 0000000..9c462b9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/hollerith-character-comparison.f90
@@ -0,0 +1,15 @@
+ ! { dg-options "-std=extra-legacy" }
+
+ program convert
+ REAL*4 a
+ INTEGER*4 b
+ b = 1000
+ print *, 4HJMAC.eq.4HJMAC ! { dg-warning "Promoting argument for comparison from HOLLERITH to CHARACTER at" }
+ print *, 4HJMAC.eq."JMAC" ! { dg-warning "Promoting argument for comparison from HOLLERITH to CHARACTER at" }
+ print *, 4HJMAC.eq."JMAN" ! { dg-warning "Promoting argument for comparison from HOLLERITH to CHARACTER at" }
+ print *, "JMAC".eq.4HJMAN ! { dg-warning "Promoting argument for comparison from HOLLERITH to CHARACTER at" }
+ print *, "AAAA".eq.5HAAAAA ! { dg-warning "Promoting argument for comparison from HOLLERITH to CHARACTER at" }
+ print *, "BBBBB".eq.5HBBBB ! { dg-warning "Promoting argument for comparison from HOLLERITH to CHARACTER at" }
+
+ end program
+
diff --git a/gcc/testsuite/gfortran.dg/hollerith-int-comparison.f90 b/gcc/testsuite/gfortran.dg/hollerith-int-comparison.f90
new file mode 100644
index 0000000..f44c1f8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/hollerith-int-comparison.f90
@@ -0,0 +1,11 @@
+ ! { dg-options "-std=extra-legacy" }
+
+ program convert
+ INTEGER*4 b
+ b = 5HRIVET ! { dg-warning "Legacy Extension: Hollerith constant|Conversion from HOLLERITH to INTEGER|too long to convert" }
+ print *, 4HJMAC.eq.400 ! { dg-warning "Legacy Extension: Hollerith constant|Promoting argument for comparison from character|Conversion from HOLLERITH to INTEGER" }
+ print *, 4HRIVE.eq.1163282770 ! { dg-warning "Legacy Extension: Hollerith constant|Promoting argument for comparison from character|Conversion from HOLLERITH to INTEGER" }
+ print *, b
+ print *, 1163282770.eq.4HRIVE ! { dg-warning "Legacy Extension: Hollerith constant|Promoting argument for comparison from character|Conversion from HOLLERITH to INTEGER" }
+ end program
+

1143
SOURCES/0005-Allow-comparisons-between-INTEGER-and-REAL.patch
View File

File diff suppressed because it is too large Load Diff

658
SOURCES/0005-dec-comparisons.patch Normal file
View File

@ -0,0 +1,658 @@
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

136
SOURCES/0006-Allow-blank-format-items-in-format-strings.patch
View File

@ -1,42 +1,39 @@
From f50b0452c10d514860e08e1ea091b17aa97d6a90 Mon Sep 17 00:00:00 2001
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/23] Allow blank format items in format strings
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.
This feature is enabled by the `-std=extra-legacy` compiler flag.
Test written by: Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
Use -fdec-blank-format-item to enable. Also enabled by -fdec.
---
0006-Allow-blank-format-items-in-format-strings.patch
commit 8e205f3940a364318d0cd2197a9897142632b336
Author: Jim MacArthur <jim.macarthur@codethink.co.uk>
Date: Thu Feb 4 16:59:41 2016 +0000
Allow blank format items in format strings
This has to be written in a slightly verbose manner because GCC 7
defaults to building with -Werror=implicit-fallthrough which prevents
us from just falling through to the default: case.
This feature is enabled by the `-std=extra-legacy` compiler flag.
Test written by: Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
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 0bec4ee39b2..d93dcfadd61 100644
index 57117579627..5b355952840 100644
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -752,6 +752,16 @@ format_item_1:
@@ -756,6 +756,16 @@ format_item_1:
error = unexpected_end;
goto syntax;
+ case FMT_RPAREN:
+ /* Oracle allows a blank format item. */
+ if (gfc_option.allow_std & GFC_STD_EXTRA_LEGACY)
+ goto finished;
+ if (flag_dec_blank_format_item)
+ goto finished;
+ else
+ {
+ error = unexpected_element;
@ -46,17 +43,47 @@ index 0bec4ee39b2..d93dcfadd61 100644
default:
error = unexpected_element;
goto syntax;
diff --git a/gcc/testsuite/gfortran.dg/dec_format_empty_item.f b/gcc/testsuite/gfortran.dg/dec_format_empty_item.f
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..e817001e38a
index 00000000000..ed27c18944b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_format_empty_item.f
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! { dg-options "-std=extra-legacy" }
+++ 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/
+
@ -68,3 +95,56 @@ index 00000000000..e817001e38a
+ 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

55
SOURCES/0007-Allow-more-than-one-character-as-argument-to-ICHAR.patch
View File

@ -1,67 +1,65 @@
From d75972937274489189a151a47da9b9aadfdefe8d Mon Sep 17 00:00:00 2001
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/23] Allow more than one character as argument to ICHAR
Subject: [PATCH 07/16] Allow more than one character as argument to ICHAR
This feature is enabled by the `-std=extra-legacy` compiler flag.
Use -fdec to enable..
---
commit 44861a8907c8d849193287231a464d34fcce522d
Author: Jim MacArthur <jim.macarthur@codethink.co.uk>
Date: Mon Oct 5 13:45:15 2015 +0100
Allow more than one character as argument to ICHAR
This feature is enabled by the `-std=extra-legacy` compiler flag.
Test written by: Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
gcc/fortran/check.c | 2 +-
gcc/fortran/simplify.c | 4 ++--
gcc/testsuite/gfortran.dg/dec_ichar_with_string_1.f | 21 +++++++++++++++++++++
3 files changed, 24 insertions(+), 3 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/dec_ichar_with_string_1.f
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 4f2d21610b9..38a90519c81 100644
index a04f0d66655..0ba4d0a031f 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -2472,7 +2472,7 @@ gfc_check_ichar_iachar (gfc_expr *c, gfc_expr *kind)
@@ -2603,7 +2603,7 @@ gfc_check_ichar_iachar (gfc_expr *c, gfc_expr *kind)
else
return true;
- if (i != 1)
+ if (i != 1 && !(gfc_option.allow_std & GFC_STD_EXTRA_LEGACY))
+ if (i != 1 && !flag_dec)
{
gfc_error ("Argument of %s at %L must be of length one",
gfc_current_intrinsic, &c->where);
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 80c96371ad9..6e05bb444ed 100644
index 7d7e3f22f73..7aff256c6b3 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -2774,7 +2774,7 @@ gfc_simplify_iachar (gfc_expr *e, gfc_expr *kind)
@@ -3229,7 +3229,7 @@ gfc_simplify_iachar (gfc_expr *e, gfc_expr *kind)
if (e->expr_type != EXPR_CONSTANT)
return NULL;
- if (e->value.character.length != 1)
+ if (e->value.character.length != 1 && !(gfc_option.allow_std & GFC_STD_EXTRA_LEGACY))
+ if (e->value.character.length != 1 && !flag_dec)
{
gfc_error ("Argument of IACHAR at %L must be of length one", &e->where);
return &gfc_bad_expr;
@@ -2972,7 +2972,7 @@ gfc_simplify_ichar (gfc_expr *e, gfc_expr *kind)
@@ -3427,7 +3427,7 @@ gfc_simplify_ichar (gfc_expr *e, gfc_expr *kind)
if (e->expr_type != EXPR_CONSTANT)
return NULL;
- if (e->value.character.length != 1)
+ if (e->value.character.length != 1 && !(gfc_option.allow_std & GFC_STD_EXTRA_LEGACY))
+ if (e->value.character.length != 1 && !flag_dec)
{
gfc_error ("Argument of ICHAR at %L must be of length one", &e->where);
return &gfc_bad_expr;
diff --git a/gcc/testsuite/gfortran.dg/dec_ichar_with_string.f b/gcc/testsuite/gfortran.dg/dec_ichar_with_string.f
diff --git a/gcc/testsuite/gfortran.dg/dec_ichar_with_string_1.f b/gcc/testsuite/gfortran.dg/dec_ichar_with_string_1.f
new file mode 100644
index 00000000000..c97746d4a4e
index 00000000000..85efccecc0f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_ichar_with_string.f
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! { dg-options "-std=extra-legacy" }
+++ b/gcc/testsuite/gfortran.dg/dec_ichar_with_string_1.f
@@ -0,0 +1,21 @@
+! { dg-do run }
+! { dg-options "-fdec" }
+!
+! Test ICHAR and IACHAR with more than one character as argument
+!
+! Test case contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+ PROGRAM ichar_more_than_one_character
+ CHARACTER*4 st/'Test'/
+ INTEGER i
@ -75,3 +73,6 @@ index 00000000000..c97746d4a4e
+ i = IACHAR('Test')
+ if (i.NE.84) STOP 4
+ END
--
2.11.0

141
SOURCES/0008-Allow-non-integer-substring-indexes.patch
View File

@ -1,32 +1,58 @@
From a6e02ad7b8b66823629a9703af4662b8b4037e2b Mon Sep 17 00:00:00 2001
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/23] Allow non-integer substring indexes
Subject: [PATCH 08/16] Allow non-integer substring indexes
This feature is enabled by the `-std=extra-legacy` compiler flag.
Use -fdec-non-integer-index compiler flag to enable. Also enabled by -fdec.
---
gcc/fortran/lang.opt | 4 ++++
gcc/fortran/options.c | 1 +
gcc/fortran/resolve.c | 20 ++++++++++++++++++++
.../dec_not_integer_substring_indexes_1.f | 18 ++++++++++++++++++
.../dec_not_integer_substring_indexes_2.f | 18 ++++++++++++++++++
.../dec_not_integer_substring_indexes_3.f | 18 ++++++++++++++++++
6 files changed, 79 insertions(+)
create mode 100644 gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_1.f
create mode 100644 gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_2.f
create mode 100644 gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_3.f
commit 9f05bda69f21d7a7c17b58ff0b6392bfd1a06bae
Author: Jim MacArthur <jim.macarthur@codethink.co.uk>
Date: Mon Oct 5 14:05:03 2015 +0100
Allow non-integer substring indexes
This feature is enabled by the `-std=extra-legacy` compiler flag.
Test written by: Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 3d8aaeaaf44..772cf5e81f1 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -474,6 +474,10 @@ fdec-math
Fortran Var(flag_dec_math)
Enable legacy math intrinsics for compatibility.
+fdec-non-integer-index
+Fortran Var(flag_dec_non_integer_index)
+Enable support for non-integer substring indexes.
+
fdec-structure
Fortran Var(flag_dec_structure)
Enable support for DEC STRUCTURE/RECORD.
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index a8c2cf71c3b..e0ef03e6cc5 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);
SET_BITFLAG (flag_dec_blank_format_item, 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 84a4827a1b7..667cc5073e3 100644
index c8b6333874b..04679d3a15d 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -4680,6 +4680,17 @@ resolve_substring (gfc_ref *ref)
@@ -4992,6 +4992,16 @@ resolve_substring (gfc_ref *ref, bool *equal_length)
if (!gfc_resolve_expr (ref->u.ss.start))
return false;
+ /* In legacy mode, allow non-integer string indexes by converting */
+ if ((gfc_option.allow_std & GFC_STD_EXTRA_LEGACY)
+ && ref->u.ss.start->ts.type != BT_INTEGER
+ if (flag_dec_non_integer_index && ref->u.ss.start->ts.type != BT_INTEGER
+ && gfc_numeric_ts (&ref->u.ss.start->ts))
+ {
+ gfc_typespec t;
@ -38,13 +64,12 @@ index 84a4827a1b7..667cc5073e3 100644
if (ref->u.ss.start->ts.type != BT_INTEGER)
{
gfc_error ("Substring start index at %L must be of type INTEGER",
@@ -4709,6 +4720,17 @@ resolve_substring (gfc_ref *ref)
@@ -5021,6 +5031,16 @@ resolve_substring (gfc_ref *ref, bool *equal_length)
if (!gfc_resolve_expr (ref->u.ss.end))
return false;
+ /* Non-integer string index endings, as for start */
+ if ((gfc_option.allow_std & GFC_STD_EXTRA_LEGACY)
+ && ref->u.ss.end->ts.type != BT_INTEGER
+ if (flag_dec_non_integer_index && ref->u.ss.end->ts.type != BT_INTEGER
+ && gfc_numeric_ts (&ref->u.ss.end->ts))
+ {
+ gfc_typespec t;
@ -56,26 +81,78 @@ index 84a4827a1b7..667cc5073e3 100644
if (ref->u.ss.end->ts.type != BT_INTEGER)
{
gfc_error ("Substring end index at %L must be of type INTEGER",
diff --git a/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes.f b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes.f
diff --git a/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_1.f b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_1.f
new file mode 100644
index 00000000000..8f5c8eb3c0e
index 00000000000..0be28abaa4b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes.f
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! { dg-options "-std=extra-legacy" }
+++ b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_1.f
@@ -0,0 +1,18 @@
+! { dg-do run }
+! { dg-options "-fdec" }
+!
+! Test not integer substring indexes
+!
+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+ PROGRAM not_integer_substring_indexes
+ CHARACTER*5 st/'Tests'/
+ CHARACTER*4 st2
+ REAL ir/1.0/
+ REAL ir2/4.0/
+
+ st2 = st(ir:4)
+ st2 = st(1:ir2)
+ st2 = st(1.0:4)
+ st2 = st(1:4.0)
+ st2 = st(1.5:4)
+ if (st(ir:4).ne.'Test') stop 1
+ if (st(1:ir2).ne.'Test') stop 2
+ if (st(1.0:4).ne.'Test') stop 3
+ if (st(1:4.0).ne.'Test') stop 4
+ if (st(2.5:4).ne.'est') stop 5
+ END
diff --git a/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_2.f b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_2.f
new file mode 100644
index 00000000000..3cf05296d0c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_2.f
@@ -0,0 +1,18 @@
+! { dg-do run }
+! { dg-options "-fdec-non-integer-index" }
+!
+! Test not integer substring indexes
+!
+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+ PROGRAM not_integer_substring_indexes
+ CHARACTER*5 st/'Tests'/
+ REAL ir/1.0/
+ REAL ir2/4.0/
+
+ if (st(ir:4).ne.'Test') stop 1
+ if (st(1:ir2).ne.'Test') stop 2
+ if (st(1.0:4).ne.'Test') stop 3
+ if (st(1:4.0).ne.'Test') stop 4
+ if (st(2.5:4).ne.'est') stop 5
+ END
diff --git a/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_3.f b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_3.f
new file mode 100644
index 00000000000..703de995897
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_3.f
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! { dg-options "-fdec -fno-dec-non-integer-index" }
+!
+! Test not integer substring indexes
+!
+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+ PROGRAM not_integer_substring_indexes
+ CHARACTER*5 st/'Tests'/
+ REAL ir/1.0/
+ REAL ir2/4.0/
+
+ if (st(ir:4).ne.'Test') stop 1 ! { dg-error "Substring start index" }
+ if (st(1:ir2).ne.'Test') stop 2 ! { dg-error "Substring end index" }
+ if (st(1.0:4).ne.'Test') stop 3 ! { dg-error "Substring start index" }
+ if (st(1:4.0).ne.'Test') stop 4 ! { dg-error "Substring end index" }
+ if (st(2.5:4).ne.'est') stop 5 ! { dg-error "Substring start index" }
+ END
--
2.11.0

185
SOURCES/0009-Allow-old-style-initializers-in-derived-types.patch Normal file
View File

@ -0,0 +1,185 @@
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
This allows simple declarations in derived types and structures, such as:
LOGICAL*1 NIL /0/
Only single value expressions are allowed at the moment.
Use -fdec-old-init to enable. Also enabled by -fdec.
---
gcc/fortran/decl.c | 27 ++++++++++++++++++----
gcc/fortran/lang.opt | 4 ++++
gcc/fortran/options.c | 1 +
.../dec_derived_types_initialised_old_style_1.f | 25 ++++++++++++++++++++
.../dec_derived_types_initialised_old_style_2.f | 25 ++++++++++++++++++++
.../dec_derived_types_initialised_old_style_3.f | 26 +++++++++++++++++++++
6 files changed, 103 insertions(+), 5 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_1.f
create mode 100644 gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_2.f
create mode 100644 gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_3.f
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 66f1094aa3d..cdf161a7efa 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -2739,12 +2739,29 @@ variable_decl (int elem)
but not components of derived types. */
else if (gfc_current_state () == COMP_DERIVED)
{
- gfc_error ("Invalid old style initialization for derived type "
- "component at %C");
- m = MATCH_ERROR;
- goto cleanup;
+ if (flag_dec_old_init)
+ {
+ /* Attempt to match an old-style initializer which is a simple
+ integer or character expression; this will not work with
+ multiple values. */
+ m = gfc_match_init_expr (&initializer);
+ if (m == MATCH_ERROR)
+ goto cleanup;
+ else if (m == MATCH_YES)
+ {
+ m = gfc_match ("/");
+ if (m != MATCH_YES)
+ goto cleanup;
+ }
+ }
+ else
+ {
+ gfc_error ("Invalid old style initialization for derived type "
+ "component at %C");
+ m = MATCH_ERROR;
+ goto cleanup;
+ }
}
-
/* For structure components, read the initializer as a special
expression and let the rest of this function apply the initializer
as usual. */
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 772cf5e81f1..610d91b6cfd 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -478,6 +478,10 @@ fdec-non-integer-index
Fortran Var(flag_dec_non_integer_index)
Enable support for non-integer substring indexes.
+fdec-old-init
+Fortran Var(flag_dec_old_init)
+Enable support for old style initializers in derived types.
+
fdec-structure
Fortran Var(flag_dec_structure)
Enable support for DEC STRUCTURE/RECORD.
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index e0ef03e6cc5..0aa16825980 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);
SET_BITFLAG (flag_dec_non_integer_index, value, value);
+ SET_BITFLAG (flag_dec_old_init, value, value);
}
/* Finalize DEC flags. */
diff --git a/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_1.f b/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_1.f
new file mode 100644
index 00000000000..eac4f9bfcf1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_1.f
@@ -0,0 +1,25 @@
+! { dg-do run }
+! { dg-options "-fdec" }
+!
+! Test old style initializers in derived types
+!
+! Contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+ PROGRAM spec_in_var
+ TYPE STRUCT1
+ INTEGER*4 ID /8/
+ INTEGER*4 TYPE /5/
+ INTEGER*8 DEFVAL /0/
+ CHARACTER*(5) NAME /'tests'/
+ LOGICAL*1 NIL /0/
+ END TYPE STRUCT1
+
+ TYPE (STRUCT1) SINST
+
+ IF(SINST%ID.NE.8) STOP 1
+ IF(SINST%TYPE.NE.5) STOP 2
+ IF(SINST%DEFVAL.NE.0) STOP 3
+ IF(SINST%NAME.NE.'tests') STOP 4
+ IF(SINST%NIL) STOP 5
+ END
diff --git a/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_2.f b/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_2.f
new file mode 100644
index 00000000000..d904c8b2974
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_2.f
@@ -0,0 +1,25 @@
+! { dg-do run }
+! { dg-options "-std=legacy -fdec-old-init" }
+!
+! Test old style initializers in derived types
+!
+! Contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+ PROGRAM spec_in_var
+ TYPE STRUCT1
+ INTEGER*4 ID /8/
+ INTEGER*4 TYPE /5/
+ INTEGER*8 DEFVAL /0/
+ CHARACTER*(5) NAME /'tests'/
+ LOGICAL*1 NIL /0/
+ END TYPE STRUCT1
+
+ TYPE (STRUCT1) SINST
+
+ IF(SINST%ID.NE.8) STOP 1
+ IF(SINST%TYPE.NE.5) STOP 2
+ IF(SINST%DEFVAL.NE.0) STOP 3
+ IF(SINST%NAME.NE.'tests') STOP 4
+ IF(SINST%NIL) STOP 5
+ END
diff --git a/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_3.f b/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_3.f
new file mode 100644
index 00000000000..58c2b4b66cf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_3.f
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! { dg-options "-std=legacy -fdec -fno-dec-old-init" }
+!
+! Test old style initializers in derived types
+!
+! Contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+
+ PROGRAM spec_in_var
+ TYPE STRUCT1
+ INTEGER*4 ID /8/ ! { dg-error "Invalid old style initialization" }
+ INTEGER*4 TYPE /5/ ! { dg-error "Invalid old style initialization" }
+ INTEGER*8 DEFVAL /0/ ! { dg-error "Invalid old style initialization" }
+ CHARACTER*(5) NAME /'tests'/ ! { dg-error "Invalid old style initialization" }
+ LOGICAL*1 NIL /0/ ! { dg-error "Invalid old style initialization" }
+ END TYPE STRUCT1
+
+ TYPE (STRUCT1) SINST
+
+ IF(SINST%ID.NE.8) STOP 1 ! { dg-error "'id' at \\(1\\) is not a member" }
+ IF(SINST%TYPE.NE.5) STOP 2 ! { dg-error "'type' at \\(1\\) is not a member" }
+ IF(SINST%DEFVAL.NE.0) STOP 3 ! { dg-error "'defval' at \\(1\\) is not a member" }
+ IF(SINST%NAME.NE.'tests') STOP 4 ! { dg-error "'name' at \\(1\\) is not a member" }
+ IF(SINST%NIL) STOP 5 ! { dg-error "'nil' at \\(1\\) is not a member" }
+ END
--
2.11.0

111
SOURCES/0009-Convert-LOGICAL-to-INTEGER-for-arithmetic-ops-and-vi.patch
View File

@ -1,111 +0,0 @@
From 00f13a60974cb4145799593398cc61894326c222 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 09/23] Convert LOGICAL to INTEGER for arithmetic ops, and vice
versa
We allow converting LOGICAL types to INTEGER when doing arithmetic
operations, and converting INTEGER types to LOGICAL for use in
boolean operations.
This feature is enabled with the `-std=extra-legacy` compiler flag.
commit f40dbd54915de8155aad94bfa19c22f11b8a8eae
Author: Jim MacArthur <jim.macarthur@codethink.co.uk>
Date: Wed Oct 7 16:31:18 2015 -0400
Convert LOGICAL to INTEGER for arithmetic ops, and vice versa
We allow converting LOGICAL types to INTEGER when doing arithmetic
operations, and converting INTEGER types to LOGICAL for use in
boolean operations.
This feature is enabled with the `-std=extra-legacy` compiler flag.
Test written by: Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 667cc5073e3..33b441aa1bc 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -3623,6 +3623,22 @@ is_character_based (bt type)
return type == BT_CHARACTER || type == BT_HOLLERITH;
}
+/* If E is a logical, convert it to an integer and issue a warning
+ for the conversion. */
+
+static void
+convert_integer_to_logical (gfc_expr *e)
+{
+ if (e->ts.type == BT_INTEGER)
+ {
+ /* Convert to LOGICAL */
+ gfc_typespec t;
+ t.type = BT_LOGICAL;
+ t.kind = 1;
+ gfc_convert_type_warn (e, &t, 2, 1);
+ }
+}
+
/* If E is a logical, convert it to an integer and issue a warning
for the conversion. */
@@ -3733,6 +3749,12 @@ resolve_operator (gfc_expr *e)
case INTRINSIC_OR:
case INTRINSIC_EQV:
case INTRINSIC_NEQV:
+ if (gfc_option.allow_std & GFC_STD_EXTRA_LEGACY)
+ {
+ convert_integer_to_logical (op1);
+ convert_integer_to_logical (op2);
+ }
+
if (op1->ts.type == BT_LOGICAL && op2->ts.type == BT_LOGICAL)
{
e->ts.type = BT_LOGICAL;
@@ -3774,6 +3796,11 @@ resolve_operator (gfc_expr *e)
break;
}
+ if (gfc_option.allow_std & GFC_STD_EXTRA_LEGACY)
+ {
+ convert_integer_to_logical (op1);
+ }
+
if (op1->ts.type == BT_LOGICAL)
{
e->ts.type = BT_LOGICAL;
diff --git a/gcc/testsuite/gfortran.dg/dec_logical_to_integer_and_vice_versa.f b/gcc/testsuite/gfortran.dg/dec_logical_to_integer_and_vice_versa.f
new file mode 100644
index 00000000000..7b9ec0d0cd2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_logical_to_integer_and_vice_versa.f
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! { dg-options "-std=extra-legacy" }
+!
+! Test convertion between logical and integer for logical operators
+!
+ PROGRAM logical_integer_conversion
+ LOGICAL lpos /.true./
+ INTEGER ineg/0/
+ INTEGER ires
+ LOGICAL lres
+
+ ! Test Logicals converted to Integers
+ if ((lpos.AND.ineg).EQ.1) STOP 3
+ if ((ineg.AND.lpos).NE.0) STOP 4
+ ires = (.true..AND.0)
+ if (ires.NE.0) STOP 5
+ ires = (1.AND..false.)
+ if (ires.EQ.1) STOP 6
+
+ ! Test Integers converted to Logicals
+ if (lpos.EQ.ineg) STOP 7
+ if (ineg.EQ.lpos) STOP 8
+ lres = (.true..EQ.0)
+ if (lres) STOP 9
+ lres = (1.EQ..false.)
+ if (lres) STOP 10
+ END

158
SOURCES/0010-Allow-mixed-string-length-and-array-specification-in.patch
View File

@ -1,158 +0,0 @@
From e4c3d25a9133224535b3142ed31e8a8be1ad356b 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/23] Allow mixed string length and array specification in
character declarations.
---
0010-Allow-mixed-string-length-and-array-specification-in.patch
commit 05124ea7df2ee14620d5c24ffe972db3dcab4f4e
Author: Jim MacArthur <jim.macarthur@codethink.co.uk>
Date: Wed Oct 7 17:04:06 2015 -0400
Allow mixed string length and array specification in character declarations.
Test written by: Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 6d3d28af127..c90f9de5a78 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -2264,6 +2264,35 @@ check_function_name (char *name)
}
+static match
+match_character_length_clause (gfc_charlen **cl, bool *cl_deferred, int elem)
+{
+ gfc_expr* char_len;
+ char_len = NULL;
+
+ match m = match_char_length (&char_len, cl_deferred, false);
+ if (m == MATCH_YES)
+ {
+ *cl = gfc_new_charlen (gfc_current_ns, NULL);
+ (*cl)->length = char_len;
+ }
+ else if (m == MATCH_NO)
+ {
+ if (elem > 1
+ && (current_ts.u.cl->length == NULL
+ || current_ts.u.cl->length->expr_type != EXPR_CONSTANT))
+ {
+ *cl = gfc_new_charlen (gfc_current_ns, NULL);
+ (*cl)->length = gfc_copy_expr (current_ts.u.cl->length);
+ }
+ else
+ *cl = current_ts.u.cl;
+
+ *cl_deferred = current_ts.deferred;
+ }
+ return m;
+}
+
/* Match a variable name with an optional initializer. When this
subroutine is called, a variable is expected to be parsed next.
Depending on what is happening at the moment, updates either the
@@ -2274,7 +2303,7 @@ variable_decl (int elem)
{
char name[GFC_MAX_SYMBOL_LEN + 1];
static unsigned int fill_id = 0;
- gfc_expr *initializer, *char_len;
+ gfc_expr *initializer;
gfc_array_spec *as;
gfc_array_spec *cp_as; /* Extra copy for Cray Pointees. */
gfc_charlen *cl;
@@ -2283,6 +2312,7 @@ variable_decl (int elem)
match m;
bool t;
gfc_symbol *sym;
+ match cl_match;
initializer = NULL;
as = NULL;
@@ -2335,6 +2365,20 @@ variable_decl (int elem)
var_locus = gfc_current_locus;
+
+ cl = NULL;
+ cl_deferred = false;
+ cl_match = MATCH_NO;
+
+ /* Check for a character length clause before an array clause */
+ if ((gfc_option.allow_std & GFC_STD_EXTRA_LEGACY)
+ && current_ts.type == BT_CHARACTER)
+ {
+ cl_match = match_character_length_clause (&cl, &cl_deferred, elem);
+ if (cl_match == MATCH_ERROR)
+ goto cleanup;
+ }
+
/* Now we could see the optional array spec. or character length. */
m = gfc_match_array_spec (&as, true, true);
if (m == MATCH_ERROR)
@@ -2453,40 +2497,12 @@ variable_decl (int elem)
}
}
- char_len = NULL;
- cl = NULL;
- cl_deferred = false;
-
- if (current_ts.type == BT_CHARACTER)
+ /* Second chance for a character length clause */
+ if (cl_match == MATCH_NO && current_ts.type == BT_CHARACTER)
{
- switch (match_char_length (&char_len, &cl_deferred, false))
- {
- case MATCH_YES:
- cl = gfc_new_charlen (gfc_current_ns, NULL);
-
- cl->length = char_len;
- break;
-
- /* Non-constant lengths need to be copied after the first
- element. Also copy assumed lengths. */
- case MATCH_NO:
- if (elem > 1
- && (current_ts.u.cl->length == NULL
- || current_ts.u.cl->length->expr_type != EXPR_CONSTANT))
- {
- cl = gfc_new_charlen (gfc_current_ns, NULL);
- cl->length = gfc_copy_expr (current_ts.u.cl->length);
- }
- else
- cl = current_ts.u.cl;
-
- cl_deferred = current_ts.deferred;
-
- break;
-
- case MATCH_ERROR:
- goto cleanup;
- }
+ m = match_character_length_clause( &cl, &cl_deferred, elem );
+ if (m == MATCH_ERROR)
+ goto cleanup;
}
/* The dummy arguments and result of the abreviated form of MODULE
diff --git a/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration.f b/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration.f
new file mode 100644
index 00000000000..69b110edb25
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration.f
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-options "-std=extra-legacy" }
+!
+! Test character declaration with mixed string length and array specification
+!
+ PROGRAM character_declaration
+ CHARACTER ASPEC_SLENGTH*2 (5) /'01','02','03','04','05'/
+ CHARACTER SLENGTH_ASPEC(5)*2 /'01','02','03','04','05'/
+ if (ASPEC_SLENGTH(3).NE.SLENGTH_ASPEC(3)) STOP 1
+ END

587
SOURCES/0010-Allow-string-length-and-kind-to-be-specified-on-a-pe.patch Normal file
View File

@ -0,0 +1,587 @@
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
variable basis.
This allows kind/length to be mixed with array specification in
declarations.
e.g.
INTEGER*4 x*2, y*8
CHARACTER names*20(10)
REAL v(100)*8, vv*4(50)
The per-variable size overrides the kind or length specified for the type.
Use -fdec-override-kind to enable. Also enabled by -fdec.
Note: this feature is a merger of two previously separate features.
Now accepts named constants as kind parameters:
INTEGER A
PARAMETER (A=2)
INTEGER B*(A)
Contributed by Mark Eggleston <mark.eggleston@codethink.com>
Now rejects invalid kind parameters and prints error messages:
INTEGER X*3
caused an internal compiler error.
Contributed by Mark Eggleston <mark.eggleston@codethink.com>
---
gcc/fortran/decl.c | 156 ++++++++++++++++-----
gcc/fortran/lang.opt | 4 +
gcc/fortran/options.c | 1 +
.../dec_mixed_char_array_declaration_1.f | 13 ++
.../dec_mixed_char_array_declaration_2.f | 13 ++
.../dec_mixed_char_array_declaration_3.f | 13 ++
gcc/testsuite/gfortran.dg/dec_spec_in_variable_1.f | 31 ++++
gcc/testsuite/gfortran.dg/dec_spec_in_variable_2.f | 31 ++++
gcc/testsuite/gfortran.dg/dec_spec_in_variable_3.f | 31 ++++
gcc/testsuite/gfortran.dg/dec_spec_in_variable_4.f | 14 ++
gcc/testsuite/gfortran.dg/dec_spec_in_variable_5.f | 19 +++
gcc/testsuite/gfortran.dg/dec_spec_in_variable_6.f | 19 +++
gcc/testsuite/gfortran.dg/dec_spec_in_variable_7.f | 15 ++
gcc/testsuite/gfortran.dg/dec_spec_in_variable_8.f | 14 ++
14 files changed, 340 insertions(+), 34 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration_1.f
create mode 100644 gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration_2.f
create mode 100644 gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration_3.f
create mode 100644 gcc/testsuite/gfortran.dg/dec_spec_in_variable_1.f
create mode 100644 gcc/testsuite/gfortran.dg/dec_spec_in_variable_2.f
create mode 100644 gcc/testsuite/gfortran.dg/dec_spec_in_variable_3.f
create mode 100644 gcc/testsuite/gfortran.dg/dec_spec_in_variable_4.f
create mode 100644 gcc/testsuite/gfortran.dg/dec_spec_in_variable_5.f
create mode 100644 gcc/testsuite/gfortran.dg/dec_spec_in_variable_6.f
create mode 100644 gcc/testsuite/gfortran.dg/dec_spec_in_variable_7.f
create mode 100644 gcc/testsuite/gfortran.dg/dec_spec_in_variable_8.f
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index cdf161a7efa..eb26bf3bc2d 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1153,6 +1153,54 @@ syntax:
return MATCH_ERROR;
}
+/* This matches the nonstandard kind given after a variable name, like:
+ INTEGER x*2, y*4
+ The per-variable kind will override any kind given in the type
+ declaration.
+*/
+
+static match
+match_per_symbol_kind (int *length)
+{
+ match m;
+ gfc_expr *expr = NULL;
+
+ m = gfc_match_char ('*');
+ if (m != MATCH_YES)
+ return m;
+
+ m = gfc_match_small_literal_int (length, NULL);
+ if (m == MATCH_YES || m == MATCH_ERROR)
+ return m;
+
+ if (gfc_match_char ('(') == MATCH_NO)
+ return MATCH_ERROR;
+
+ m = gfc_match_expr (&expr);
+ if (m == MATCH_YES)
+ {
+ m = MATCH_ERROR; // Assume error
+ if (gfc_expr_check_typed (expr, gfc_current_ns, false))
+ {
+ if ((expr->expr_type == EXPR_CONSTANT)
+ && (expr->ts.type == BT_INTEGER))
+ {
+ *length = mpz_get_si(expr->value.integer);
+ m = MATCH_YES;
+ }
+ }
+
+ if (m == MATCH_YES)
+ {
+ if (gfc_match_char (')') == MATCH_NO)
+ m = MATCH_ERROR;
+ }
+ }
+
+ if (expr != NULL)
+ gfc_free_expr (expr);
+ return m;
+}
/* Special subroutine for finding a symbol. Check if the name is found
in the current name space. If not, and we're compiling a function or
@@ -2390,6 +2438,35 @@ check_function_name (char *name)
}
+static match
+match_character_length_clause (gfc_charlen **cl, bool *cl_deferred, int elem)
+{
+ gfc_expr* char_len;
+ char_len = NULL;
+
+ match m = match_char_length (&char_len, cl_deferred, false);
+ if (m == MATCH_YES)
+ {
+ *cl = gfc_new_charlen (gfc_current_ns, NULL);
+ (*cl)->length = char_len;
+ }
+ else if (m == MATCH_NO)
+ {
+ if (elem > 1
+ && (current_ts.u.cl->length == NULL
+ || current_ts.u.cl->length->expr_type != EXPR_CONSTANT))
+ {
+ *cl = gfc_new_charlen (gfc_current_ns, NULL);
+ (*cl)->length = gfc_copy_expr (current_ts.u.cl->length);
+ }
+ else
+ *cl = current_ts.u.cl;
+
+ *cl_deferred = current_ts.deferred;
+ }
+ return m;
+}
+
/* Match a variable name with an optional initializer. When this
subroutine is called, a variable is expected to be parsed next.
Depending on what is happening at the moment, updates either the
@@ -2400,7 +2477,7 @@ variable_decl (int elem)
{
char name[GFC_MAX_SYMBOL_LEN + 1];
static unsigned int fill_id = 0;
- gfc_expr *initializer, *char_len;
+ gfc_expr *initializer;
gfc_array_spec *as;
gfc_array_spec *cp_as; /* Extra copy for Cray Pointees. */
gfc_charlen *cl;
@@ -2409,10 +2486,14 @@ variable_decl (int elem)
match m;
bool t;
gfc_symbol *sym;
+ match cl_match;
+ match kind_match;
+ int overridden_kind;
initializer = NULL;
as = NULL;
cp_as = NULL;
+ kind_match = MATCH_NO;
/* When we get here, we've just matched a list of attributes and
maybe a type and a double colon. The next thing we expect to see
@@ -2461,6 +2542,28 @@ variable_decl (int elem)
var_locus = gfc_current_locus;
+
+ cl = NULL;
+ cl_deferred = false;
+ cl_match = MATCH_NO;
+
+ /* Check for a character length clause before an array clause */
+ if (flag_dec_override_kind)
+ {
+ if (current_ts.type == BT_CHARACTER)
+ {
+ cl_match = match_character_length_clause (&cl, &cl_deferred, elem);
+ if (cl_match == MATCH_ERROR)
+ goto cleanup;
+ }
+ else
+ {
+ kind_match = match_per_symbol_kind (&overridden_kind);
+ if (kind_match == MATCH_ERROR)
+ goto cleanup;
+ }
+ }
+
/* Now we could see the optional array spec. or character length. */
m = gfc_match_array_spec (&as, true, true);
if (m == MATCH_ERROR)
@@ -2579,40 +2682,12 @@ variable_decl (int elem)
}
}
- char_len = NULL;
- cl = NULL;
- cl_deferred = false;
-
- if (current_ts.type == BT_CHARACTER)
+ /* Second chance for a character length clause */
+ if (cl_match == MATCH_NO && current_ts.type == BT_CHARACTER)
{
- switch (match_char_length (&char_len, &cl_deferred, false))
- {
- case MATCH_YES:
- cl = gfc_new_charlen (gfc_current_ns, NULL);
-
- cl->length = char_len;
- break;
-
- /* Non-constant lengths need to be copied after the first
- element. Also copy assumed lengths. */
- case MATCH_NO:
- if (elem > 1
- && (current_ts.u.cl->length == NULL
- || current_ts.u.cl->length->expr_type != EXPR_CONSTANT))
- {
- cl = gfc_new_charlen (gfc_current_ns, NULL);
- cl->length = gfc_copy_expr (current_ts.u.cl->length);
- }
- else
- cl = current_ts.u.cl;
-
- cl_deferred = current_ts.deferred;
-
- break;
-
- case MATCH_ERROR:
- goto cleanup;
- }
+ m = match_character_length_clause (&cl, &cl_deferred, elem);
+ if (m == MATCH_ERROR)
+ goto cleanup;
}
/* The dummy arguments and result of the abreviated form of MODULE
@@ -2714,6 +2789,19 @@ variable_decl (int elem)
goto cleanup;
}
+ if (kind_match == MATCH_YES)
+ {
+ gfc_find_symbol (name, gfc_current_ns, 1, &sym);
+ /* sym *must* be found at this point */
+ sym->ts.kind = overridden_kind;
+ if (gfc_validate_kind (sym->ts.type, sym->ts.kind, true) < 0)
+ {
+ gfc_error ("Kind %d not supported for type %s at %C",
+ sym->ts.kind, gfc_basic_typename (sym->ts.type));
+ return MATCH_ERROR;
+ }
+ }
+
if (!check_function_name (name))
{
m = MATCH_ERROR;
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 610d91b6cfd..38d31e620bf 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -478,6 +478,10 @@ fdec-non-integer-index
Fortran Var(flag_dec_non_integer_index)
Enable support for non-integer substring indexes.
+fdec-override-kind
+Fortran Var(flag_dec_override_kind)
+Enable support for per variable kind specification.
+
fdec-old-init
Fortran Var(flag_dec_old_init)
Enable support for old style initializers in derived types.
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index 0aa16825980..720fd25b570 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);
SET_BITFLAG (flag_dec_non_integer_index, value, value);
SET_BITFLAG (flag_dec_old_init, value, value);
+ SET_BITFLAG (flag_dec_override_kind, value, value);
}
/* Finalize DEC flags. */
diff --git a/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration_1.f b/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration_1.f
new file mode 100644
index 00000000000..706ea4112a4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration_1.f
@@ -0,0 +1,13 @@
+! { dg-do run }
+! { dg-options "-fdec" }
+!
+! Test character declaration with mixed string length and array specification
+!
+! Contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+ PROGRAM character_declaration
+ CHARACTER ASPEC_SLENGTH*2 (5) /'01','02','03','04','05'/
+ CHARACTER SLENGTH_ASPEC(5)*2 /'01','02','03','04','05'/
+ if (ASPEC_SLENGTH(3).NE.SLENGTH_ASPEC(3)) STOP 1
+ END
diff --git a/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration_2.f b/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration_2.f
new file mode 100644
index 00000000000..26d2acf01de
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration_2.f
@@ -0,0 +1,13 @@
+! { dg-do run }
+! { dg-options "-fdec-override-kind" }
+!
+! Test character declaration with mixed string length and array specification
+!
+! Contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+ PROGRAM character_declaration
+ CHARACTER ASPEC_SLENGTH*2 (5) /'01','02','03','04','05'/
+ CHARACTER SLENGTH_ASPEC(5)*2 /'01','02','03','04','05'/
+ if (ASPEC_SLENGTH(3).NE.SLENGTH_ASPEC(3)) STOP 1
+ END
diff --git a/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration_3.f b/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration_3.f
new file mode 100644
index 00000000000..76e4f0bdb93
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration_3.f
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! { dg-options "-fdec-override-kind -fno-dec-override-kind" }
+!
+! Test character declaration with mixed string length and array specification
+!
+! Contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+ PROGRAM character_declaration
+ CHARACTER ASPEC_SLENGTH*2 (5) /'01','02','03','04','05'/ ! { dg-error "Syntax error" }
+ CHARACTER SLENGTH_ASPEC(5)*2 /'01','02','03','04','05'/
+ if (ASPEC_SLENGTH(3).NE.SLENGTH_ASPEC(3)) STOP 1 ! { dg-error " Operands of comparison operator" }
+ END
diff --git a/gcc/testsuite/gfortran.dg/dec_spec_in_variable_1.f b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_1.f
new file mode 100644
index 00000000000..edd0f5874b7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_1.f
@@ -0,0 +1,31 @@
+! { dg-do run }
+! { dg-options "-fdec" }
+!
+! Test kind specification in variable not in type
+!
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+ program spec_in_var
+ integer*8 ai*1, bi*4, ci
+ real*4 ar*4, br*8, cr
+
+ ai = 1
+ ar = 1.0
+ bi = 2
+ br = 2.0
+ ci = 3
+ cr = 3.0
+
+ if (ai .ne. 1) stop 1
+ if (abs(ar - 1.0) > 1.0D-6) stop 2
+ if (bi .ne. 2) stop 3
+ if (abs(br - 2.0) > 1.0D-6) stop 4
+ if (ci .ne. 3) stop 5
+ if (abs(cr - 3.0) > 1.0D-6) stop 6
+ if (kind(ai) .ne. 1) stop 7
+ if (kind(ar) .ne. 4) stop 8
+ if (kind(bi) .ne. 4) stop 9
+ if (kind(br) .ne. 8) stop 10
+ if (kind(ci) .ne. 8) stop 11
+ if (kind(cr) .ne. 4) stop 12
+ end
diff --git a/gcc/testsuite/gfortran.dg/dec_spec_in_variable_2.f b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_2.f
new file mode 100644
index 00000000000..bfaba584dbb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_2.f
@@ -0,0 +1,31 @@
+! { dg-do run }
+! { dg-options "-fdec-override-kind" }
+!
+! Test kind specification in variable not in type
+!
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+ program spec_in_var
+ integer*8 ai*1, bi*4, ci
+ real*4 ar*4, br*8, cr
+
+ ai = 1
+ ar = 1.0
+ bi = 2
+ br = 2.0
+ ci = 3
+ cr = 3.0
+
+ if (ai .ne. 1) stop 1
+ if (abs(ar - 1.0) > 1.0D-6) stop 2
+ if (bi .ne. 2) stop 3
+ if (abs(br - 2.0) > 1.0D-6) stop 4
+ if (ci .ne. 3) stop 5
+ if (abs(cr - 3.0) > 1.0D-6) stop 6
+ if (kind(ai) .ne. 1) stop 7
+ if (kind(ar) .ne. 4) stop 8
+ if (kind(bi) .ne. 4) stop 9
+ if (kind(br) .ne. 8) stop 10
+ if (kind(ci) .ne. 8) stop 11
+ if (kind(cr) .ne. 4) stop 12
+ end
diff --git a/gcc/testsuite/gfortran.dg/dec_spec_in_variable_3.f b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_3.f
new file mode 100644
index 00000000000..5ff434e7466
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_3.f
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! { dg-options "-fdec -fno-dec-override-kind" }
+!
+! Test kind specification in variable not in type
+!
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+ program spec_in_var
+ integer*8 ai*1, bi*4, ci ! { dg-error "Syntax error" }
+ real*4 ar*4, br*8, cr ! { dg-error "Syntax error" }
+
+ ai = 1
+ ar = 1.0
+ bi = 2
+ br = 2.0
+ ci = 3
+ cr = 3.0
+
+ if (ai .ne. 1) stop 1
+ if (abs(ar - 1.0) > 1.0D-6) stop 2
+ if (bi .ne. 2) stop 3
+ if (abs(br - 2.0) > 1.0D-6) stop 4
+ if (ci .ne. 3) stop 5
+ if (abs(cr - 3.0) > 1.0D-6) stop 6
+ if (kind(ai) .ne. 1) stop 7
+ if (kind(ar) .ne. 4) stop 8
+ if (kind(bi) .ne. 4) stop 9
+ if (kind(br) .ne. 8) stop 10
+ if (kind(ci) .ne. 8) stop 11
+ if (kind(cr) .ne. 4) stop 12
+ end
diff --git a/gcc/testsuite/gfortran.dg/dec_spec_in_variable_4.f b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_4.f
new file mode 100644
index 00000000000..c01980e8b9d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_4.f
@@ -0,0 +1,14 @@
+! { dg-do compile }
+!
+! Test kind specification in variable not in type. The per variable
+! kind specification is not enabled so these should fail
+!
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+ program spec_in_var
+ integer a
+ parameter(a=2)
+ integer b*(a) ! { dg-error "Syntax error" }
+ real c*(8) ! { dg-error "Syntax error" }
+ logical d*1_1 ! { dg-error "Syntax error" }
+ end
diff --git a/gcc/testsuite/gfortran.dg/dec_spec_in_variable_5.f b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_5.f
new file mode 100644
index 00000000000..e2f39da3f4f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_5.f
@@ -0,0 +1,19 @@
+! { dg-do run }
+! { dg-options "-fdec-override-kind" }
+!
+! Test kind specification in variable not in type
+!
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+ program spec_in_var
+ integer a
+ parameter(a=2)
+ integer b*(a)
+ real c*(8)
+ logical d*(1_1)
+ character e*(a)
+ if (kind(b).ne.2) stop 1
+ if (kind(c).ne.8) stop 2
+ if (kind(d).ne.1) stop 3
+ if (len(e).ne.2) stop 4
+ end
diff --git a/gcc/testsuite/gfortran.dg/dec_spec_in_variable_6.f b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_6.f
new file mode 100644
index 00000000000..569747874e3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_6.f
@@ -0,0 +1,19 @@
+! { dg-do run }
+! { dg-options "-fdec" }
+!
+! Test kind specification in variable not in type
+!
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+ program spec_in_var
+ integer a
+ parameter(a=2)
+ integer b*(a)
+ real c*(8)
+ logical d*(1_1)
+ character e*(a)
+ if (kind(b).ne.2) stop 1
+ if (kind(c).ne.8) stop 2
+ if (kind(d).ne.1) stop 3
+ if (len(e).ne.2) stop 4
+ end
diff --git a/gcc/testsuite/gfortran.dg/dec_spec_in_variable_7.f b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_7.f
new file mode 100644
index 00000000000..b975bfd15c5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_7.f
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! { dg-options "-fdec -fno-dec-override-kind" }
+!
+! Test kind specification in variable not in type as the per variable
+! kind specification is not enables these should fail
+!
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+ program spec_in_var
+ integer a
+ parameter(a=2)
+ integer b*(a) ! { dg-error "Syntax error" }
+ real c*(8) ! { dg-error "Syntax error" }
+ logical d*1_1 ! { dg-error "Syntax error" }
+ end
diff --git a/gcc/testsuite/gfortran.dg/dec_spec_in_variable_8.f b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_8.f
new file mode 100644
index 00000000000..85732e0bd85
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_8.f
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! { dg-options "-fdec" }
+!
+! Check that invalid kind values are rejected.
+!
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+ program spec_in_var
+ integer a
+ parameter(a=3)
+ integer b*(a) ! { dg-error "Kind 3 not supported" }
+ real c*(78) ! { dg-error "Kind 78 not supported" }
+ logical d*(*) ! { dg-error "Invalid character" }
+ end
--
2.11.0

52
SOURCES/0011-Allow-character-to-int-conversions-in-DATA-statement.patch
View File

@ -1,52 +0,0 @@
From ced1b6638459f33dc9f22a0cd959f97c05a62e22 Mon Sep 17 00:00:00 2001
From: Jim MacArthur <jim.macarthur@codethink.co.uk>
Date: Wed, 7 Oct 2015 18:23:31 -0400
Subject: [PATCH 11/23] Allow character-to-int conversions in DATA statements
This feature is enabled by the `-std=extra-legacy` compiler flag.
---
0011-Allow-character-to-int-conversions-in-DATA-statement.patch
commit 11b148af8967669bcebd91ea6fdae28e9ec8e97c
Author: Jim MacArthur <jim.macarthur@codethink.co.uk>
Date: Wed Oct 7 18:23:31 2015 -0400
Allow character-to-int conversions in DATA statements
This feature is enabled by the `-std=extra-legacy` compiler flag.
Test written by: Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index f347c753702..9982b8d0e85 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3294,6 +3294,10 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform,
|| rvalue->ts.type == BT_HOLLERITH)
return true;
+ if ((gfc_option.allow_std & GFC_STD_EXTRA_LEGACY)
+ && gfc_numeric_ts (&lvalue->ts) && rvalue->ts.type == BT_CHARACTER)
+ return true;
+
if (lvalue->ts.type == BT_LOGICAL && rvalue->ts.type == BT_LOGICAL)
return true;
diff --git a/gcc/testsuite/gfortran.dg/dec_char_to_int_conversion_in_data.f b/gcc/testsuite/gfortran.dg/dec_char_to_int_conversion_in_data.f
new file mode 100644
index 00000000000..e0e4f735243
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_char_to_int_conversion_in_data.f
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-std=extra-legacy" }
+!
+! Test character to int conversion in DATA types
+!
+ PROGRAM char_int_data_type
+ INTEGER*1 ai(2)
+
+ DATA ai/'1',1/
+ if(ai(1).NE.49) STOP 1
+ END

378
SOURCES/0011-Allow-non-logical-expressions-in-IF-statements.patch Normal file
View File

@ -0,0 +1,378 @@
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
Use -fdec-non-logical-if to enable feature. Also enabled using -fdec.
---
gcc/fortran/lang.opt | 4 ++
gcc/fortran/options.c | 1 +
gcc/fortran/resolve.c | 60 ++++++++++++++++++----
...ec_logical_expressions_if_statements_blocks_1.f | 25 +++++++++
...ec_logical_expressions_if_statements_blocks_2.f | 25 +++++++++
...ec_logical_expressions_if_statements_blocks_3.f | 25 +++++++++
...ec_logical_expressions_if_statements_blocks_4.f | 45 ++++++++++++++++
...ec_logical_expressions_if_statements_blocks_5.f | 45 ++++++++++++++++
...ec_logical_expressions_if_statements_blocks_6.f | 45 ++++++++++++++++
9 files changed, 266 insertions(+), 9 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_1.f
create mode 100644 gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_2.f
create mode 100644 gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_3.f
create mode 100644 gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_4.f
create mode 100644 gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_5.f
create mode 100644 gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_6.f
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 38d31e620bf..fa2851ae837 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -482,6 +482,10 @@ fdec-override-kind
Fortran Var(flag_dec_override_kind)
Enable support for per variable kind specification.
+fdec-non-logical-if
+Fortran Var(flag_dec_non_logical_if)
+Enable support for non-logical expressions in if statements.
+
fdec-old-init
Fortran Var(flag_dec_old_init)
Enable support for old style initializers in derived types.
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index 720fd25b570..7b04a681f7b 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -82,6 +82,7 @@ set_dec_flags (int value)
SET_BITFLAG (flag_dec_non_integer_index, value, value);
SET_BITFLAG (flag_dec_old_init, value, value);
SET_BITFLAG (flag_dec_override_kind, value, value);
+ SET_BITFLAG (flag_dec_non_logical_if, value, value);
}
/* Finalize DEC flags. */
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 04679d3a15d..a90f7f849b5 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -10398,10 +10398,31 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
switch (b->op)
{
case EXEC_IF:
- if (t && b->expr1 != NULL
- && (b->expr1->ts.type != BT_LOGICAL || b->expr1->rank != 0))
- gfc_error ("IF clause at %L requires a scalar LOGICAL expression",
- &b->expr1->where);
+ if (t && b->expr1 != NULL)
+ {
+ if (flag_dec_non_logical_if && b->expr1->ts.type != BT_LOGICAL)
+ {
+ gfc_expr* cast;
+ cast = gfc_ne (b->expr1,
+ gfc_get_int_expr (1, &gfc_current_locus, 0),
+ INTRINSIC_NE);
+ if (cast == NULL)
+ gfc_internal_error ("gfc_resolve_blocks(): Failed to cast "
+ "to LOGICAL in IF");
+ b->expr1 = cast;
+ if (warn_conversion_extra)
+ {
+ gfc_warning (OPT_Wconversion_extra, "Non-LOGICAL type in"
+ " IF statement condition %L will be true if"
+ " it evaluates to nonzero",
+ &b->expr1->where);
+ }
+ }
+
+ if ((b->expr1->ts.type != BT_LOGICAL || b->expr1->rank != 0))
+ gfc_error ("IF clause at %L requires a scalar LOGICAL "
+ "expression", &b->expr1->where);
+ }
break;
case EXEC_WHERE:
@@ -11690,11 +11711,32 @@ start:
break;
case EXEC_IF:
- if (t && code->expr1 != NULL
- && (code->expr1->ts.type != BT_LOGICAL
- || code->expr1->rank != 0))
- gfc_error ("IF clause at %L requires a scalar LOGICAL expression",
- &code->expr1->where);
+ if (t && code->expr1 != NULL)
+ {
+ if (flag_dec_non_logical_if
+ && code->expr1->ts.type != BT_LOGICAL)
+ {
+ gfc_expr* cast;
+ cast = gfc_ne (code->expr1,
+ gfc_get_int_expr (1, &gfc_current_locus, 0),
+ INTRINSIC_NE);
+ if (cast == NULL)
+ gfc_internal_error ("gfc_resolve_code(): Failed to cast "
+ "to LOGICAL in IF");
+ code->expr1 = cast;
+ if (warn_conversion_extra)
+ {
+ gfc_warning (OPT_Wconversion_extra, "Non-LOGICAL type in"
+ " IF statement condition %L will be true if"
+ " it evaluates to nonzero",
+ &code->expr1->where);
+ }
+ }
+
+ if (code->expr1->ts.type != BT_LOGICAL || code->expr1->rank != 0)
+ gfc_error ("IF clause at %L requires a scalar LOGICAL "
+ "expression", &code->expr1->where);
+ }
break;
case EXEC_CALL:
diff --git a/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_1.f b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_1.f
new file mode 100644
index 00000000000..0101db893ca
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_1.f
@@ -0,0 +1,25 @@
+! { dg-do run }
+! { dg-options "-fdec -Wconversion-extra" }
+!
+! Allow logical expressions in if statements and blocks
+!
+! Contributed by Francisco Redondo Marchena <francisco.marchema@codethink.co.uk>
+! and Jeff Law <law@redhat.com>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+ PROGRAM logical_exp_if_st_bl
+ INTEGER ipos/1/
+ INTEGER ineg/0/
+
+ ! Test non logical variables
+ if (ineg) STOP 1 ! { dg-warning "if it evaluates to nonzero" }
+ if (0) STOP 2 ! { dg-warning "if it evaluates to nonzero" }
+
+ ! Test non logical expressions in if statements
+ if (MOD(ipos, 1)) STOP 3 ! { dg-warning "if it evaluates to nonzero" }
+
+ ! Test non logical expressions in if blocks
+ if (MOD(2 * ipos, 2)) then ! { dg-warning "if it evaluates to nonzero" }
+ STOP 4
+ endif
+ END
diff --git a/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_2.f b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_2.f
new file mode 100644
index 00000000000..876f4e09508
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_2.f
@@ -0,0 +1,25 @@
+! { dg-do run }
+! { dg-options "-fdec-non-logical-if -Wconversion-extra" }
+!
+! Allow logical expressions in if statements and blocks
+!
+! Contributed by Francisco Redondo Marchena <francisco.marchema@codethink.co.uk>
+! and Jeff Law <law@redhat.com>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+ PROGRAM logical_exp_if_st_bl
+ INTEGER ipos/1/
+ INTEGER ineg/0/
+
+ ! Test non logical variables
+ if (ineg) STOP 1 ! { dg-warning "if it evaluates to nonzero" }
+ if (0) STOP 2 ! { dg-warning "if it evaluates to nonzero" }
+
+ ! Test non logical expressions in if statements
+ if (MOD(ipos, 1)) STOP 3 ! { dg-warning "if it evaluates to nonzero" }
+
+ ! Test non logical expressions in if blocks
+ if (MOD(2 * ipos, 2)) then ! { dg-warning "if it evaluates to nonzero" }
+ STOP 4
+ endif
+ END
diff --git a/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_3.f b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_3.f
new file mode 100644
index 00000000000..35cb4c51b8d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_3.f
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! { dg-options "-fdec -fno-dec-non-logical-if" }
+!
+! Allow logical expressions in if statements and blocks
+!
+! Contributed by Francisco Redondo Marchena <francisco.marchema@codethink.co.uk>
+! and Jeff Law <law@redhat.com>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+ PROGRAM logical_exp_if_st_bl
+ INTEGER ipos/1/
+ INTEGER ineg/0/
+
+ ! Test non logical variables
+ if (ineg) STOP 1 ! { dg-error "IF clause at" }
+ if (0) STOP 2 ! { dg-error "IF clause at" }
+
+ ! Test non logical expressions in if statements
+ if (MOD(ipos, 1)) STOP 3 ! { dg-error "IF clause at" }
+
+ ! Test non logical expressions in if blocks
+ if (MOD(2 * ipos, 2)) then ! { dg-error "IF clause at" }
+ STOP 4
+ endif
+ END
diff --git a/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_4.f b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_4.f
new file mode 100644
index 00000000000..7b60b60827f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_4.f
@@ -0,0 +1,45 @@
+! { dg-do run }
+! { dg-options "-fdec -Wconversion-extra" }
+!
+! Contributed by Francisco Redondo Marchena <francisco.marchema@codethink.co.uk>
+! and Jeff Law <law@redhat.com>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+ function othersub1()
+ integer*4 othersub1
+ othersub1 = 9
+ end
+
+ function othersub2()
+ integer*4 othersub2
+ othersub2 = 0
+ end
+
+ program MAIN
+ integer*4 othersub1
+ integer*4 othersub2
+ integer a /1/
+ integer b /2/
+
+ if (othersub1()) then ! { dg-warning "if it evaluates to nonzero" }
+ write(*,*) "OK"
+ else
+ stop 1
+ end if
+ if (othersub2()) then ! { dg-warning "if it evaluates to nonzero" }
+ stop 2
+ else
+ write(*,*) "OK"
+ end if
+ if (a-b) then ! { dg-warning "if it evaluates to nonzero" }
+ write(*,*) "OK"
+ else
+ stop 3
+ end if
+ if (b-(a+1)) then ! { dg-warning "if it evaluates to nonzero" }
+ stop 3
+ else
+ write(*,*) "OK"
+ end if
+ end
+
diff --git a/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_5.f b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_5.f
new file mode 100644
index 00000000000..80336f48ca1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_5.f
@@ -0,0 +1,45 @@
+! { dg-do run }
+! { dg-options "-fdec-non-logical-if -Wconversion-extra" }
+!
+! Contributed by Francisco Redondo Marchena <francisco.marchema@codethink.co.uk>
+! and Jeff Law <law@redhat.com>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+ function othersub1()
+ integer*4 othersub1
+ othersub1 = 9
+ end
+
+ function othersub2()
+ integer*4 othersub2
+ othersub2 = 0
+ end
+
+ program MAIN
+ integer*4 othersub1
+ integer*4 othersub2
+ integer a /1/
+ integer b /2/
+
+ if (othersub1()) then ! { dg-warning "Non-LOGICAL type in IF statement" }
+ write(*,*) "OK"
+ else
+ stop 1
+ end if
+ if (othersub2()) then ! { dg-warning "Non-LOGICAL type in IF statement" }
+ stop 2
+ else
+ write(*,*) "OK"
+ end if
+ if (a-b) then ! { dg-warning "Non-LOGICAL type in IF statement" }
+ write(*,*) "OK"
+ else
+ stop 3
+ end if
+ if (b-(a+1)) then ! { dg-warning "Non-LOGICAL type in IF statement" }
+ stop 3
+ else
+ write(*,*) "OK"
+ end if
+ end
+
diff --git a/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_6.f b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_6.f
new file mode 100644
index 00000000000..e1125ca717a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_6.f
@@ -0,0 +1,45 @@
+! { dg-do compile }
+! { dg-options "-fdec -fno-dec-non-logical-if" }
+!
+! Contributed by Francisco Redondo Marchena <francisco.marchema@codethink.co.uk>
+! and Jeff Law <law@redhat.com>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+ function othersub1()
+ integer*4 othersub1
+ othersub1 = 9
+ end
+
+ function othersub2()
+ integer*4 othersub2
+ othersub2 = 0
+ end
+
+ program MAIN
+ integer*4 othersub1
+ integer*4 othersub2
+ integer a /1/
+ integer b /2/
+
+ if (othersub1()) then ! { dg-error "IF clause at" }
+ write(*,*) "OK"
+ else
+ stop 1
+ end if
+ if (othersub2()) then ! { dg-error "IF clause at" }
+ stop 2
+ else
+ write(*,*) "OK"
+ end if
+ if (a-b) then ! { dg-error "IF clause at" }
+ write(*,*) "OK"
+ else
+ stop 3
+ end if
+ if (b-(a+1)) then ! { dg-error "IF clause at" }
+ stop 3
+ else
+ write(*,*) "OK"
+ end if
+ end
+
--
2.11.0

94
SOURCES/0012-Allow-old-style-initializers-in-derived-types.patch
View File

@ -1,94 +0,0 @@
From 5d5a6c9d8c5a8db252d972ec32dd70d2510404fb 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 12/23] Allow old-style initializers in derived types
This allows simple declarations in derived types and structures, such as:
LOGICAL*1 NIL /0/
Only single value expressions are allowed at the moment.
This feature is enabled by the `-std=extra-legacy` compiler flag.
---
commit a9ee9b2c45580d0e52670cec4d3d68095dabc178
Author: Jim MacArthur <jim.macarthur@codethink.co.uk>
Date: Thu Feb 4 16:00:30 2016 +0000
Allow old-style initializers in derived types
This allows simple declarations in derived types and structures, such as:
LOGICAL*1 NIL /0/
Only single value expressions are allowed at the moment.
This feature is enabled by the `-std=extra-legacy` compiler flag.
Test written by: Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index c90f9de5a78..3ad9c2c8b40 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -2437,12 +2437,30 @@ variable_decl (int elem)
but not components of derived types. */
else if (gfc_current_state () == COMP_DERIVED)
{
- gfc_error ("Invalid old style initialization for derived type "
- "component at %C");
- m = MATCH_ERROR;
- goto cleanup;
- }
+ if (gfc_option.allow_std & GFC_STD_EXTRA_LEGACY)
+ {
+ /* Attempt to match an old-style initializer which is a simple
+ integer or character expression; this will not work with
+ multiple values. */
+ m = gfc_match_init_expr (&initializer);
+ if (m == MATCH_ERROR)
+ goto cleanup;
+ else if (m == MATCH_YES)
+ {
+ m = gfc_match ("/");
+ if (m != MATCH_YES)
+ goto cleanup;
+ }
+ }
+ else
+ {
+ gfc_error ("Invalid old style initialization for derived type "
+ "component at %C");
+ m = MATCH_ERROR;
+ goto cleanup;
+ }
+ }
/* For structure components, read the initializer as a special
expression and let the rest of this function apply the initializer
as usual. */
diff --git a/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style.f b/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style.f
new file mode 100644
index 00000000000..eac7de987e8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style.f
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! { dg-options "-std=extra-legacy" }
+!
+! Test old style initializers in derived types
+!
+ PROGRAM spec_in_var
+ TYPE STRUCT1
+ INTEGER*4 ID /8/
+ INTEGER*4 TYPE /5/
+ INTEGER*8 DEFVAL /0/
+ CHARACTER*(5) NAME /'tests'/
+ LOGICAL*1 NIL /0/
+ END TYPE STRUCT1
+
+ TYPE (STRUCT1) SINST
+
+ if(SINST%ID.NE.8) STOP 1
+ if(SINST%TYPE.NE.5) STOP 2
+ if(SINST%DEFVAL.NE.0) STOP 3
+ if(SINST%NAME.NE.'tests') STOP 4
+ if(SINST%NIL) STOP 5
+ END

2151
SOURCES/0012-Support-type-promotion-in-calls-to-intrinsics.patch Normal file
View File

File diff suppressed because it is too large Load Diff

262
SOURCES/0013-Add-the-SEQUENCE-attribute-by-default-if-it-s-not-pr.patch Normal file
View File

@ -0,0 +1,262 @@
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
present.
Use -fdec-sequence to enable this feature. Also enabled by -fdec.
---
gcc/fortran/lang.opt | 4 ++
gcc/fortran/options.c | 1 +
gcc/fortran/resolve.c | 13 +++--
...dec_add_SEQUENCE_to_COMMON_block_by_default_1.f | 57 ++++++++++++++++++++++
...dec_add_SEQUENCE_to_COMMON_block_by_default_2.f | 57 ++++++++++++++++++++++
...dec_add_SEQUENCE_to_COMMON_block_by_default_3.f | 57 ++++++++++++++++++++++
6 files changed, 186 insertions(+), 3 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_1.f
create mode 100644 gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_2.f
create mode 100644 gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_3.f
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 2a8f5f661a8..ffd9ce6f270 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -494,6 +494,10 @@ fdec-promotion
Fortran Var(flag_dec_promotion)
Add support for type promotion in intrinsic arguments.
+fdec-sequence
+Fortran Var(flag_dec_sequence)
+Add the SEQUENCE attribute by default if it's not present.
+
fdec-structure
Fortran Var(flag_dec_structure)
Enable support for DEC STRUCTURE/RECORD.
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index 7a2583a2076..b6fd327d057 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -84,6 +84,7 @@ set_dec_flags (int value)
SET_BITFLAG (flag_dec_override_kind, value, value);
SET_BITFLAG (flag_dec_non_logical_if, value, value);
SET_BITFLAG (flag_dec_promotion, value, value);
+ SET_BITFLAG (flag_dec_sequence, value, value);
}
/* Finalize DEC flags. */
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index a90f7f849b5..08627866c9c 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)
if (!(csym->ts.u.derived->attr.sequence
|| csym->ts.u.derived->attr.is_bind_c))
- gfc_error_now ("Derived type variable %qs in COMMON at %L "
- "has neither the SEQUENCE nor the BIND(C) "
- "attribute", csym->name, &csym->declared_at);
+ {
+ if (flag_dec_sequence)
+ /* Assume sequence. */
+ csym->ts.u.derived->attr.sequence = 1;
+ else
+ gfc_error_now ("Derived type variable '%s' in COMMON at %L "
+ "has neither the SEQUENCE nor the BIND(C) "
+ "attribute", csym->name, &csym->declared_at);
+ }
+
if (csym->ts.u.derived->attr.alloc_comp)
gfc_error_now ("Derived type variable %qs in COMMON at %L "
"has an ultimate component that is "
diff --git a/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_1.f b/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_1.f
new file mode 100644
index 00000000000..fe7b39625eb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_1.f
@@ -0,0 +1,57 @@
+! { dg-do run }
+! { dg-options "-fdec" }
+!
+! Test add default SEQUENCE attribute derived types appearing in
+! COMMON blocks and EQUIVALENCE statements.
+!
+! Contributed by Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+ MODULE SEQ
+ TYPE STRUCT1
+ INTEGER*4 ID
+ INTEGER*4 TYPE
+ INTEGER*8 DEFVAL
+ CHARACTER*(4) NAME
+ LOGICAL*1 NIL
+ END TYPE STRUCT1
+ END MODULE
+
+ SUBROUTINE A
+ USE SEQ
+ TYPE (STRUCT1) S
+ COMMON /BLOCK1/ S
+ IF (S%ID.NE.5) STOP 1
+ IF (S%TYPE.NE.1000) STOP 2
+ IF (S%DEFVAL.NE.-99) STOP 3
+ IF (S%NAME.NE."JANE") STOP 4
+ IF (S%NIL.NEQV..FALSE.) STOP 5
+ END SUBROUTINE
+
+ PROGRAM sequence_att_common
+ USE SEQ
+ IMPLICIT NONE
+ TYPE (STRUCT1) S1
+ TYPE (STRUCT1) S2
+ TYPE (STRUCT1) S3
+
+ EQUIVALENCE (S1,S2)
+ COMMON /BLOCK1/ S3
+
+ S1%ID = 5
+ S1%TYPE = 1000
+ S1%DEFVAL = -99
+ S1%NAME = "JANE"
+ S1%NIL = .FALSE.
+
+ IF (S2%ID.NE.5) STOP 1
+ IF (S2%TYPE.NE.1000) STOP 2
+ IF (S2%DEFVAL.NE.-99) STOP 3
+ IF (S2%NAME.NE."JANE") STOP 4
+ IF (S2%NIL.NEQV..FALSE.) STOP 5
+
+ S3 = S1
+
+ CALL A
+
+ END
diff --git a/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_2.f b/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_2.f
new file mode 100644
index 00000000000..83512f0f3a2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_2.f
@@ -0,0 +1,57 @@
+! { dg-do run }
+! { dg-options "-fdec-sequence" }
+!
+! Test add default SEQUENCE attribute derived types appearing in
+! COMMON blocks and EQUIVALENCE statements.
+!
+! Contributed by Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+ MODULE SEQ
+ TYPE STRUCT1
+ INTEGER*4 ID
+ INTEGER*4 TYPE
+ INTEGER*8 DEFVAL
+ CHARACTER*(4) NAME
+ LOGICAL*1 NIL
+ END TYPE STRUCT1
+ END MODULE
+
+ SUBROUTINE A
+ USE SEQ
+ TYPE (STRUCT1) S
+ COMMON /BLOCK1/ S
+ IF (S%ID.NE.5) STOP 1
+ IF (S%TYPE.NE.1000) STOP 2
+ IF (S%DEFVAL.NE.-99) STOP 3
+ IF (S%NAME.NE."JANE") STOP 4
+ IF (S%NIL.NEQV..FALSE.) STOP 5
+ END SUBROUTINE
+
+ PROGRAM sequence_att_common
+ USE SEQ
+ IMPLICIT NONE
+ TYPE (STRUCT1) S1
+ TYPE (STRUCT1) S2
+ TYPE (STRUCT1) S3
+
+ EQUIVALENCE (S1,S2)
+ COMMON /BLOCK1/ S3
+
+ S1%ID = 5
+ S1%TYPE = 1000
+ S1%DEFVAL = -99
+ S1%NAME = "JANE"
+ S1%NIL = .FALSE.
+
+ IF (S2%ID.NE.5) STOP 1
+ IF (S2%TYPE.NE.1000) STOP 2
+ IF (S2%DEFVAL.NE.-99) STOP 3
+ IF (S2%NAME.NE."JANE") STOP 4
+ IF (S2%NIL.NEQV..FALSE.) STOP 5
+
+ S3 = S1
+
+ CALL A
+
+ END
diff --git a/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_3.f b/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_3.f
new file mode 100644
index 00000000000..26cd59f9090
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_3.f
@@ -0,0 +1,57 @@
+! { dg-do compile }
+! { dg-options "-fdec -fno-dec-sequence" }
+!
+! Test add default SEQUENCE attribute derived types appearing in
+! COMMON blocks and EQUIVALENCE statements.
+!
+! Contributed by Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+ MODULE SEQ
+ TYPE STRUCT1
+ INTEGER*4 ID
+ INTEGER*4 TYPE
+ INTEGER*8 DEFVAL
+ CHARACTER*(4) NAME
+ LOGICAL*1 NIL
+ END TYPE STRUCT1
+ END MODULE
+
+ SUBROUTINE A
+ USE SEQ
+ TYPE (STRUCT1) S ! { dg-error "Derived type variable" }
+ COMMON /BLOCK1/ S
+ IF (S%ID.NE.5) STOP 1
+ IF (S%TYPE.NE.1000) STOP 2
+ IF (S%DEFVAL.NE.-99) STOP 3
+ IF (S%NAME.NE."JANE") STOP 4
+ IF (S%NIL.NEQV..FALSE.) STOP 5
+ END SUBROUTINE
+
+ PROGRAM sequence_att_common
+ USE SEQ
+ IMPLICIT NONE
+ TYPE (STRUCT1) S1
+ TYPE (STRUCT1) S2
+ TYPE (STRUCT1) S3 ! { dg-error "Derived type variable" }
+
+ EQUIVALENCE (S1,S2) ! { dg-error "Derived type variable" }
+ COMMON /BLOCK1/ S3
+
+ S1%ID = 5
+ S1%TYPE = 1000
+ S1%DEFVAL = -99
+ S1%NAME = "JANE"
+ S1%NIL = .FALSE.
+
+ IF (S2%ID.NE.5) STOP 1
+ IF (S2%TYPE.NE.1000) STOP 2
+ IF (S2%DEFVAL.NE.-99) STOP 3
+ IF (S2%NAME.NE."JANE") STOP 4
+ IF (S2%NIL.NEQV..FALSE.) STOP 5
+
+ S3 = S1
+
+ CALL A
+
+ END
--
2.11.0

129
SOURCES/0013-Allow-per-variable-kind-specification.patch
View File

@ -1,129 +0,0 @@
From 72d3915eadd1121d8b2f0be04fafc17e9232be81 Mon Sep 17 00:00:00 2001
From: Jim MacArthur <jim.macarthur@codethink.co.uk>
Date: Thu, 5 Nov 2015 18:57:53 +0000
Subject: [PATCH 13/23] Allow per-variable kind specification.
INTEGER*4 x*2, y*8
The per-variable sizes override the kind specified in the type.
At the moment, you can follow this with an array specification, so
INTEGER x*2(10) is OK, but not the other way round.
This feature is enabled by the `-std=extra-legacy` compiler flag.
---
0013-Allow-per-variable-kind-specification.patch
Allow per-variable kind specification.
INTEGER*4 x*2, y*8
The per-variable sizes override the kind specified in the type.
At the moment, you can follow this with an array specification, so
INTEGER x*2(10) is OK, but not the other way round.
This feature is enabled by the `-std=extra-legacy` compiler flag.
Test written by: Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 3ad9c2c8b40..faa08d9c4bb 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1019,6 +1019,24 @@ syntax:
return MATCH_ERROR;
}
+/* This matches the nonstandard kind given after a variable name, like:
+ INTEGER x*2, y*4
+ The per-variable kind will override any kind given in the type
+ declaration.
+*/
+
+static match
+match_per_symbol_kind (int *length)
+{
+ match m;
+
+ m = gfc_match_char ('*');
+ if (m != MATCH_YES)
+ return m;
+
+ m = gfc_match_small_literal_int (length, NULL);
+ return m;
+}
/* Special subroutine for finding a symbol. Check if the name is found
in the current name space. If not, and we're compiling a function or
@@ -2193,10 +2211,13 @@ variable_decl (int elem)
bool t;
gfc_symbol *sym;
match cl_match;
+ match kind_match;
+ int overridden_kind;
initializer = NULL;
as = NULL;
cp_as = NULL;
+ kind_match = MATCH_NO;
/* When we get here, we've just matched a list of attributes and
maybe a type and a double colon. The next thing we expect to see
@@ -2213,12 +2234,20 @@ variable_decl (int elem)
cl_match = MATCH_NO;
/* Check for a character length clause before an array clause */
- if ((gfc_option.allow_std & GFC_STD_EXTRA_LEGACY)
- && current_ts.type == BT_CHARACTER)
+ if (gfc_option.allow_std & GFC_STD_EXTRA_LEGACY)
{
- cl_match = match_character_length_clause (&cl, &cl_deferred, elem);
- if (cl_match == MATCH_ERROR)
- goto cleanup;
+ if (current_ts.type == BT_CHARACTER)
+ {
+ cl_match = match_character_length_clause (&cl, &cl_deferred, elem);
+ if (cl_match == MATCH_ERROR)
+ goto cleanup;
+ }
+ else
+ {
+ kind_match = match_per_symbol_kind (&overridden_kind);
+ if (kind_match == MATCH_ERROR)
+ goto cleanup;
+ }
}
/* Now we could see the optional array spec. or character length. */
@@ -2412,6 +2441,13 @@ variable_decl (int elem)
goto cleanup;
}
+ if (kind_match == MATCH_YES)
+ {
+ gfc_find_symbol (name, gfc_current_ns, 1, &sym);
+ /* sym *must* be found at this point */
+ sym->ts.kind = overridden_kind;
+ }
+
if (!check_function_name (name))
{
m = MATCH_ERROR;
diff --git a/gcc/testsuite/gfortran.dg/dec_spec_in_variable.f b/gcc/testsuite/gfortran.dg/dec_spec_in_variable.f
new file mode 100644
index 00000000000..0341a176aca
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_spec_in_variable.f
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-std=extra-legacy" }
+!
+! Test kind specification in variable not in type
+!
+ PROGRAM spec_in_var
+ INTEGER ai*1/1/
+ REAL ar*4/1.0/
+
+ if(ai.NE.1) STOP 1
+ if(abs(ar - 1.0) > 1.0D-6) STOP 2
+ END

143
SOURCES/0014-Allow-non-logical-expressions-in-IF-statements.patch
View File

@ -1,143 +0,0 @@
From 99c791361468b61976d6054e1ec1c81fe43e6559 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 14/23] Allow non-logical expressions in IF statements
This feature is enabled by the `-std=extra-legacy` compiler flag.
---
0014-Allow-non-logical-expressions-in-IF-statements.patch
Allow non-logical expressions in IF statements
This feature is enabled by the `-std=extra-legacy` compiler flag.
Signed-off-by: Ben Brewer <ben.brewer@codethink.co.uk>
Signed-off-by: Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 33b441aa1bc..f979915e856 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -9919,10 +9919,23 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
switch (b->op)
{
case EXEC_IF:
- if (t && b->expr1 != NULL
- && (b->expr1->ts.type != BT_LOGICAL || b->expr1->rank != 0))
- gfc_error ("IF clause at %L requires a scalar LOGICAL expression",
- &b->expr1->where);
+ if (t && b->expr1 != NULL)
+ {
+ if (gfc_option.allow_std & GFC_STD_EXTRA_LEGACY && b->expr1->ts.type != BT_LOGICAL)
+ {
+ gfc_expr* cast;
+ cast = gfc_ne (b->expr1, gfc_get_int_expr (1, &gfc_current_locus, 0), INTRINSIC_NE);
+ if (cast == NULL)
+ gfc_internal_error ("gfc_resolve_blocks(): Failed to cast to LOGICAL in IF");
+ b->expr1 = cast;
+ gfc_warning (0, "Non-LOGICAL type in IF statement condition %L"
+ " will be true if it evaluates to nonzero", &b->expr1->where);
+ }
+
+ if ((b->expr1->ts.type != BT_LOGICAL || b->expr1->rank != 0))
+ gfc_error ("IF clause at %L requires a scalar LOGICAL expression",
+ &b->expr1->where);
+ }
break;
case EXEC_WHERE:
@@ -11182,11 +11195,23 @@ start:
break;
case EXEC_IF:
- if (t && code->expr1 != NULL
- && (code->expr1->ts.type != BT_LOGICAL
- || code->expr1->rank != 0))
- gfc_error ("IF clause at %L requires a scalar LOGICAL expression",
- &code->expr1->where);
+ if (t && code->expr1 != NULL)
+ {
+ if (gfc_option.allow_std & GFC_STD_EXTRA_LEGACY && code->expr1->ts.type != BT_LOGICAL)
+ {
+ gfc_expr* cast;
+ cast = gfc_ne (code->expr1, gfc_get_int_expr (1, &gfc_current_locus, 0), INTRINSIC_NE);
+ if (cast == NULL)
+ gfc_internal_error ("gfc_resolve_code(): Failed to cast to LOGICAL in IF");
+ code->expr1 = cast;
+ gfc_warning (0, "Non-LOGICAL type in IF statement condition %L"
+ " will be true if it evaluates to nonzero", &code->expr1->where);
+ }
+
+ if ((code->expr1->ts.type != BT_LOGICAL || code->expr1->rank != 0))
+ gfc_error ("IF clause at %L requires a scalar LOGICAL expression",
+ &code->expr1->where);
+ }
break;
case EXEC_CALL:
diff --git a/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks.f b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks.f
new file mode 100644
index 00000000000..ad23fcfc9af
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks.f
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-options "-std=extra-legacy" }
+!
+! Allow logical expressions in if statements and blocks
+!
+ PROGRAM logical_exp_if_st_bl
+ INTEGER ipos/1/
+ INTEGER ineg/0/
+
+ ! Test non logical variables
+ if (ineg) STOP 1 ! { dg-warning "if it evaluates to nonzero" }
+ if (0) STOP 2 ! { dg-warning "if it evaluates to nonzero" }
+
+ ! Test non logical expressions in if statements
+ if (MOD(ipos, 1)) STOP 3 ! { dg-warning "if it evaluates to nonzero" }
+
+ ! Test non logical expressions in if blocks
+ if (MOD(2 * ipos, 2)) then ! { dg-warning "if it evaluates to nonzero" }
+ STOP 4
+ endif
+ END
commit cf72338b9468fad669b60600bcce7918a8d4591e
Author: Jeff Law <law@redhat.com>
Date: Tue Jun 5 15:45:41 2018 -0600
Additional test for
0014-Allow-non-logical-expressions-in-IF-statements.patch
"Allow non-logical expressions in IF statements"
diff --git a/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks-2.f b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks-2.f
new file mode 100644
index 00000000000..7da6aaceec7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks-2.f
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! { dg-options "-std=extra-legacy" }
+
+ function othersub1()
+ integer*4 othersub1
+ othersub1 = 1
+ end
+ function othersub2()
+ integer*4 othersub2
+ othersub2 = 2
+ end
+ program MAIN
+ integer*4 othersub1
+ integer*4 othersub2
+c the if (integer) works here
+ if (othersub2()) then ! { dg-warning "" }
+ write (*,*), 'othersub2 is true'
+c but fails in the "else if"
+ else if (othersub1()) then ! { dg-warning "" }
+ write (*,*), 'othersub2 is false, othersub1 is true'
+ endif
+ end
+

181
SOURCES/0014-Fill-in-missing-array-dimensions-using-the-lower-bou.patch Normal file
View File

@ -0,0 +1,181 @@
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
Use -fdec-add-missing-indexes to enable feature. Also enabled by fdec.
---
gcc/fortran/lang.opt | 8 ++++++++
gcc/fortran/options.c | 1 +
gcc/fortran/resolve.c | 24 ++++++++++++++++++++++++
gcc/testsuite/gfortran.dg/array_6.f90 | 23 +++++++++++++++++++++++
gcc/testsuite/gfortran.dg/array_7.f90 | 23 +++++++++++++++++++++++
gcc/testsuite/gfortran.dg/array_8.f90 | 23 +++++++++++++++++++++++
6 files changed, 102 insertions(+)
create mode 100644 gcc/testsuite/gfortran.dg/array_6.f90
create mode 100644 gcc/testsuite/gfortran.dg/array_7.f90
create mode 100644 gcc/testsuite/gfortran.dg/array_8.f90
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index ffd9ce6f270..dca3fd27aa3 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -281,6 +281,10 @@ Wmissing-include-dirs
Fortran
; Documented in C/C++
+Wmissing-index
+Fortran Var(warn_missing_index) Warning LangEnabledBy(Fortran,Wall)
+Warn that the lower bound of a missing index will be used.
+
Wuse-without-only
Fortran Var(warn_use_without_only) Warning
Warn about USE statements that have no ONLY qualifier.
@@ -440,6 +444,10 @@ fdec
Fortran Var(flag_dec)
Enable all DEC language extensions.
+fdec-add-missing-indexes
+Fortran Var(flag_dec_add_missing_indexes)
+Enable the addition of missing indexes using their lower bounds.
+
fdec-blank-format-item
Fortran Var(flag_dec_blank_format_item)
Enable the use of blank format items in format strings.
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index b6fd327d057..f417f48f6a7 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -85,6 +85,7 @@ set_dec_flags (int value)
SET_BITFLAG (flag_dec_non_logical_if, value, value);
SET_BITFLAG (flag_dec_promotion, value, value);
SET_BITFLAG (flag_dec_sequence, value, value);
+ SET_BITFLAG (flag_dec_add_missing_indexes, value, value);
}
/* Finalize DEC flags. */
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 08627866c9c..70093c952f6 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -4676,6 +4676,30 @@ compare_spec_to_ref (gfc_array_ref *ar)
if (ar->type == AR_FULL)
return true;
+ if (flag_dec_add_missing_indexes && as->rank > ar->dimen)
+ {
+ /* Add in the missing dimensions, assuming they are the lower bound
+ of that dimension if not specified. */
+ int j;
+ if (warn_missing_index)
+ {
+ gfc_warning (OPT_Wmissing_index, "Using the lower bound for "
+ "unspecified dimensions in array reference at %L",
+ &ar->where);
+ }
+ /* Other parts of the code iterate ar->start and ar->end from 0 to
+ ar->dimen, so it is safe to assume slots from ar->dimen upwards
+ are unused (i.e. there are no gaps; the specified indexes are
+ contiguous and start at zero. */
+ for(j = ar->dimen; j <= as->rank; j++)
+ {
+ ar->start[j] = gfc_copy_expr (as->lower[j]);
+ ar->end[j] = gfc_copy_expr (as->lower[j]);
+ ar->dimen_type[j] = DIMEN_ELEMENT;
+ }
+ ar->dimen = as->rank;
+ }
+
if (as->rank != ar->dimen)
{
gfc_error ("Rank mismatch in array reference at %L (%d/%d)",
diff --git a/gcc/testsuite/gfortran.dg/array_6.f90 b/gcc/testsuite/gfortran.dg/array_6.f90
new file mode 100644
index 00000000000..5c26e18ab3e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_6.f90
@@ -0,0 +1,23 @@
+! { dg-do run }
+! { dg-options "-fdec -Wmissing-index" }!
+! Checks that under-specified arrays (referencing arrays with fewer
+! dimensions than the array spec) generates a warning.
+!
+! Contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
+! Updated by Mark Eggleston <mark.eggleston@codethink.co.uk>
+!
+
+program under_specified_array
+ integer chessboard(8,8)
+ integer chessboard3d(8,8,3:5)
+ chessboard(3,1) = 5
+ chessboard(3,2) = 55
+ chessboard3d(4,1,3) = 6
+ chessboard3d(4,1,4) = 66
+ chessboard3d(4,4,3) = 7
+ chessboard3d(4,4,4) = 77
+
+ if (chessboard(3).ne.5) stop 1 ! { dg-warning "Using the lower bound for unspecified dimensions in array reference" }
+ if (chessboard3d(4).ne.6) stop 2 ! { dg-warning "Using the lower bound for unspecified dimensions in array reference" }
+ if (chessboard3d(4,4).ne.7) stop 3 ! { dg-warning "Using the lower bound for unspecified dimensions in array reference" }
+end program
diff --git a/gcc/testsuite/gfortran.dg/array_7.f90 b/gcc/testsuite/gfortran.dg/array_7.f90
new file mode 100644
index 00000000000..5588a5bd02d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_7.f90
@@ -0,0 +1,23 @@
+! { dg-do run }
+! { dg-options "-fdec-add-missing-indexes -Wmissing-index" }!
+! Checks that under-specified arrays (referencing arrays with fewer
+! dimensions than the array spec) generates a warning.
+!
+! Contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
+! Updated by Mark Eggleston <mark.eggleston@codethink.co.uk>
+!
+
+program under_specified_array
+ integer chessboard(8,8)
+ integer chessboard3d(8,8,3:5)
+ chessboard(3,1) = 5
+ chessboard(3,2) = 55
+ chessboard3d(4,1,3) = 6
+ chessboard3d(4,1,4) = 66
+ chessboard3d(4,4,3) = 7
+ chessboard3d(4,4,4) = 77
+
+ if (chessboard(3).ne.5) stop 1 ! { dg-warning "Using the lower bound for unspecified dimensions in array reference" }
+ if (chessboard3d(4).ne.6) stop 2 ! { dg-warning "Using the lower bound for unspecified dimensions in array reference" }
+ if (chessboard3d(4,4).ne.7) stop 3 ! { dg-warning "Using the lower bound for unspecified dimensions in array reference" }
+end program
diff --git a/gcc/testsuite/gfortran.dg/array_8.f90 b/gcc/testsuite/gfortran.dg/array_8.f90
new file mode 100644
index 00000000000..f0d2ef5e37d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_8.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! { dg-options "-fdec -fno-dec-add-missing-indexes" }!
+! Checks that under-specified arrays (referencing arrays with fewer
+! dimensions than the array spec) generates a warning.
+!
+! Contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
+! Updated by Mark Eggleston <mark.eggleston@codethink.co.uk>
+!
+
+program under_specified_array
+ integer chessboard(8,8)
+ integer chessboard3d(8,8,3:5)
+ chessboard(3,1) = 5
+ chessboard(3,2) = 55
+ chessboard3d(4,1,3) = 6
+ chessboard3d(4,1,4) = 66
+ chessboard3d(4,4,3) = 7
+ chessboard3d(4,4,4) = 77
+
+ if (chessboard(3).ne.5) stop 1 ! { dg-error "Rank mismatch" }
+ if (chessboard3d(4).ne.6) stop 2 ! { dg-error "Rank mismatch" }
+ if (chessboard3d(4,4).ne.7) stop 3 ! { dg-error "Rank mismatch" }
+end program
--
2.11.0

358
SOURCES/0015-Allow-automatics-in-equivalence.patch Normal file
View File

@ -0,0 +1,358 @@
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

277
SOURCES/0016-Allow-calls-to-intrinsics-with-smaller-types-than-sp.patch
View File

@ -1,277 +0,0 @@
From 109b1eeba24e5091bf3bdb6caedf7101a9dcaa6a Mon Sep 17 00:00:00 2001
From: Jim MacArthur <jim.macarthur@codethink.co.uk>
Date: Wed, 18 Nov 2015 11:50:41 +0000
Subject: [PATCH 16/23] Allow calls to intrinsics with smaller types than
specified
This feature is enabled by the `-std=extra-legacy` compiler flag.
---
0016-Allow-calls-to-intrinsics-with-smaller-types-than-sp.patch
diff -Nrup a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
--- a/gcc/fortran/gfortran.h 2018-06-05 11:59:14.269337049 -0600
+++ b/gcc/fortran/gfortran.h 2018-06-05 11:59:52.830081690 -0600
@@ -656,6 +656,13 @@ enum gfc_param_spec_type
SPEC_DEFERRED
};
+enum match_type
+{
+ MATCH_EXACT,
+ MATCH_PROMOTABLE,
+ MATCH_INVALID
+};
+
/************************* Structures *****************************/
/* Used for keeping things in balanced binary trees. */
@@ -3251,7 +3253,7 @@ bool gfc_add_interface (gfc_symbol *);
gfc_interface *gfc_current_interface_head (void);
void gfc_set_current_interface_head (gfc_interface *);
gfc_symtree* gfc_find_sym_in_symtree (gfc_symbol*);
-bool gfc_arglist_matches_symbol (gfc_actual_arglist**, gfc_symbol*);
+bool gfc_arglist_matches_symbol (gfc_actual_arglist**, gfc_symbol*, enum match_type mtype);
bool gfc_check_operator_interface (gfc_symbol*, gfc_intrinsic_op, locus);
bool gfc_has_vector_subscript (gfc_expr*);
gfc_intrinsic_op gfc_equivalent_op (gfc_intrinsic_op);
diff -Nrup a/gcc/fortran/interface.c b/gcc/fortran/interface.c
--- a/gcc/fortran/interface.c 2018-03-03 06:51:39.000000000 -0700
+++ b/gcc/fortran/interface.c 2018-06-05 12:01:11.218559539 -0600
@@ -682,7 +682,7 @@ gfc_compare_derived_types (gfc_symbol *d
/* Compare two typespecs, recursively if necessary. */
bool
-gfc_compare_types (gfc_typespec *ts1, gfc_typespec *ts2)
+gfc_compare_types_generic (gfc_typespec *ts1, gfc_typespec *ts2, enum match_type mtype)
{
/* See if one of the typespecs is a BT_VOID, which is what is being used
to allow the funcs like c_f_pointer to accept any pointer type.
@@ -721,12 +721,23 @@ gfc_compare_types (gfc_typespec *ts1, gf
return compare_union_types (ts1->u.derived, ts2->u.derived);
if (ts1->type != BT_DERIVED && ts1->type != BT_CLASS)
- return (ts1->kind == ts2->kind);
+ {
+ if (mtype == MATCH_PROMOTABLE)
+ return (ts1->kind >= ts2->kind);
+ else
+ return (ts1->kind == ts2->kind);
+ }
+
/* Compare derived types. */
return gfc_type_compatible (ts1, ts2);
}
+bool
+gfc_compare_types (gfc_typespec *ts1, gfc_typespec *ts2)
+{
+ return gfc_compare_types_generic (ts1, ts2, MATCH_EXACT);
+}
static bool
compare_type (gfc_symbol *s1, gfc_symbol *s2)
@@ -743,7 +754,9 @@ compare_type (gfc_symbol *s1, gfc_symbol
return compare_type (s1, s2);
}
-
+/* Given two symbols that are formal arguments, compare their ranks
+ and types. Returns nonzero if they have the same rank and type,
+ zero otherwise. */
static bool
compare_rank (gfc_symbol *s1, gfc_symbol *s2)
{
@@ -2150,7 +2163,7 @@ argument_rank_mismatch (const char *name
static bool
compare_parameter (gfc_symbol *formal, gfc_expr *actual,
- int ranks_must_agree, int is_elemental, locus *where)
+ int ranks_must_agree, int is_elemental, locus *where, enum match_type mtype)
{
gfc_ref *ref;
bool rank_check, is_pointer;
@@ -2242,7 +2255,7 @@ compare_parameter (gfc_symbol *formal, g
&& actual->ts.type != BT_HOLLERITH
&& formal->ts.type != BT_ASSUMED
&& !(formal->attr.ext_attr & (1 << EXT_ATTR_NO_ARG_CHECK))
- && !gfc_compare_types (&formal->ts, &actual->ts)
+ && !gfc_compare_types_generic (&formal->ts, &actual->ts, mtype)
&& !(formal->ts.type == BT_DERIVED && actual->ts.type == BT_CLASS
&& gfc_compare_derived_types (formal->ts.u.derived,
CLASS_DATA (actual)->ts.u.derived)))
@@ -2792,7 +2805,8 @@ is_procptr_result (gfc_expr *expr)
static bool
compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
int ranks_must_agree, int is_elemental,
- bool in_statement_function, locus *where)
+ bool in_statement_function, locus *where,
+ enum match_type mtype)
{
gfc_actual_arglist **new_arg, *a, *actual;
gfc_formal_arglist *f;
@@ -2918,7 +2932,7 @@ compare_actual_formal (gfc_actual_arglis
}
if (!compare_parameter (f->sym, a->expr, ranks_must_agree,
- is_elemental, where))
+ is_elemental, where, mtype))
return false;
/* TS 29113, 6.3p2. */
@@ -3666,7 +3680,7 @@ gfc_procedure_use (gfc_symbol *sym, gfc_
/* For a statement function, check that types and type parameters of actual
arguments and dummy arguments match. */
if (!compare_actual_formal (ap, dummy_args, 0, sym->attr.elemental,
- sym->attr.proc == PROC_ST_FUNCTION, where))
+ sym->attr.proc == PROC_ST_FUNCTION, where, MATCH_PROMOTABLE))
return false;
if (!check_intents (dummy_args, *ap))
@@ -3715,7 +3730,7 @@ gfc_ppc_use (gfc_component *comp, gfc_ac
}
if (!compare_actual_formal (ap, comp->ts.interface->formal, 0,
- comp->attr.elemental, false, where))
+ comp->attr.elemental, false, where, MATCH_EXACT))
return;
check_intents (comp->ts.interface->formal, *ap);
@@ -3729,7 +3744,7 @@ gfc_ppc_use (gfc_component *comp, gfc_ac
GENERIC resolution. */
bool
-gfc_arglist_matches_symbol (gfc_actual_arglist** args, gfc_symbol* sym)
+gfc_arglist_matches_symbol (gfc_actual_arglist** args, gfc_symbol* sym, enum match_type mtype)
{
gfc_formal_arglist *dummy_args;
bool r;
@@ -3740,7 +3755,7 @@ gfc_arglist_matches_symbol (gfc_actual_a
dummy_args = gfc_sym_get_dummy_args (sym);
r = !sym->attr.elemental;
- if (compare_actual_formal (args, dummy_args, r, !r, false, NULL))
+ if (compare_actual_formal (args, dummy_args, r, !r, false, NULL, mtype))
{
check_intents (dummy_args, *args);
if (warn_aliasing)
@@ -3766,7 +3781,8 @@ gfc_search_interface (gfc_interface *int
locus null_expr_loc;
gfc_actual_arglist *a;
bool has_null_arg = false;
-
+ enum match_type mtypes[] = { MATCH_EXACT, MATCH_PROMOTABLE };
+ int i;
for (a = *ap; a; a = a->next)
if (a->expr && a->expr->expr_type == EXPR_NULL
&& a->expr->ts.type == BT_UNKNOWN)
@@ -3776,38 +3792,43 @@ gfc_search_interface (gfc_interface *int
break;
}
- for (; intr; intr = intr->next)
+ for (i=0; i<2; i++)
{
+ for (; intr; intr = intr->next)
+ {
+ if (intr->sym->attr.flavor == FL_DERIVED)
+ continue;
if (gfc_fl_struct (intr->sym->attr.flavor))
continue;
- if (sub_flag && intr->sym->attr.function)
- continue;
- if (!sub_flag && intr->sym->attr.subroutine)
+ if (sub_flag && intr->sym->attr.function)
+ continue;
+ if (!sub_flag && intr->sym->attr.subroutine)
continue;
- if (gfc_arglist_matches_symbol (ap, intr->sym))
- {
- if (has_null_arg && null_sym)
- {
- gfc_error ("MOLD= required in NULL() argument at %L: Ambiguity "
- "between specific functions %s and %s",
- &null_expr_loc, null_sym->name, intr->sym->name);
- return NULL;
- }
- else if (has_null_arg)
+ if (gfc_arglist_matches_symbol (ap, intr->sym, mtypes[i]))
{
- null_sym = intr->sym;
- continue;
- }
+ if (has_null_arg && null_sym)
+ {
+ gfc_error ("MOLD= required in NULL() argument at %L: Ambiguity "
+ "between specific functions %s and %s",
+ &null_expr_loc, null_sym->name, intr->sym->name);
+ return NULL;
+ }
+ else if (has_null_arg)
+ {
+ null_sym = intr->sym;
+ continue;
+ }
- /* Satisfy 12.4.4.1 such that an elemental match has lower
- weight than a non-elemental match. */
- if (intr->sym->attr.elemental)
- {
- elem_sym = intr->sym;
- continue;
+ /* Satisfy 12.4.4.1 such that an elemental match has lower
+ weight than a non-elemental match. */
+ if (intr->sym->attr.elemental)
+ {
+ elem_sym = intr->sym;
+ continue;
+ }
+ return intr->sym;
}
- return intr->sym;
}
}
@@ -3942,7 +3963,7 @@ matching_typebound_op (gfc_expr** tb_bas
/* Check if this arglist matches the formal. */
argcopy = gfc_copy_actual_arglist (args);
- matches = gfc_arglist_matches_symbol (&argcopy, target);
+ matches = gfc_arglist_matches_symbol (&argcopy, target, MATCH_EXACT);
gfc_free_actual_arglist (argcopy);
/* Return if we found a match. */
diff -Nrup a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
--- a/gcc/fortran/intrinsic.c 2018-06-05 11:59:14.278336990 -0600
+++ b/gcc/fortran/intrinsic.c 2018-06-05 11:59:52.831081683 -0600
@@ -4229,6 +4229,16 @@ check_arglist (gfc_actual_arglist **ap,
if (ts.kind == 0)
ts.kind = actual->expr->ts.kind;
+ /* ts.kind is the argument spec. actual is what was passed. */
+
+ if (actual->expr->ts.kind < ts.kind
+ && ts.type == BT_INTEGER)
+ {
+ /* If it was OK to overwrite ts.kind in the previous case, it
+ should be fine here... */
+ ts.kind = actual->expr->ts.kind;
+ }
+
if (!gfc_compare_types (&ts, &actual->expr->ts))
{
if (error_flag)
diff -Nrup a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
--- a/gcc/fortran/resolve.c 2018-06-05 11:59:14.291336904 -0600
+++ b/gcc/fortran/resolve.c 2018-06-05 11:59:52.833081670 -0600
@@ -6055,7 +6055,7 @@ resolve_typebound_generic_call (gfc_expr
&& gfc_sym_get_dummy_args (target) == NULL);
/* Check if this arglist matches the formal. */
- matches = gfc_arglist_matches_symbol (&args, target);
+ matches = gfc_arglist_matches_symbol (&args, target, MATCH_EXACT);
/* Clean up and break out of the loop if we've found it. */
gfc_free_actual_arglist (args);

49
SOURCES/0016-Suppress-warning-with-Wno-overwrite-recursive.patch Normal file
View File

@ -0,0 +1,49 @@
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

68
SOURCES/0017-Add-the-SEQUENCE-attribute-by-default-if-it-s-not-pr.patch
View File

@ -1,68 +0,0 @@
From fdda38024c7151ca632cb338085af80ceb63ec4d 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 17/23] Add the SEQUENCE attribute by default if it's not
present.
This feature is enabled by the `-std=extra-legacy` compiler flag.
0017-Add-the-SEQUENCE-attribute-by-default-if-it-s-not-pr.patch
commit 1635277d719de05fbd37a2887273ce893bf43198
Author: Jim MacArthur <jim.macarthur@codethink.co.uk>
Date: Wed Nov 18 15:08:56 2015 +0000
Add the SEQUENCE attribute by default if it's not present.
This feature is enabled by the `-std=extra-legacy` compiler flag.
Test written by: Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 2e60984b3bd..022b9230ec9 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -963,9 +963,16 @@ resolve_common_vars (gfc_common_head *common_block, bool named_common)
if (!(csym->ts.u.derived->attr.sequence
|| csym->ts.u.derived->attr.is_bind_c))
- gfc_error_now ("Derived type variable %qs in COMMON at %L "
- "has neither the SEQUENCE nor the BIND(C) "
- "attribute", csym->name, &csym->declared_at);
+ {
+ if (gfc_option.allow_std & GFC_STD_EXTRA_LEGACY)
+ /* Assume sequence. */
+ csym->ts.u.derived->attr.sequence = 1;
+ else
+ gfc_error_now ("Derived type variable '%s' in COMMON at %L "
+ "has neither the SEQUENCE nor the BIND(C) "
+ "attribute", csym->name, &csym->declared_at);
+ }
+
if (csym->ts.u.derived->attr.alloc_comp)
gfc_error_now ("Derived type variable %qs in COMMON at %L "
"has an ultimate component that is "
diff --git a/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default.f b/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default.f
new file mode 100644
index 00000000000..c0851c8bc77
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default.f
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! { dg-options "-std=extra-legacy" }
+!
+! Test add default SEQUENCE attribute to COMMON blocks
+!
+ PROGRAM sequence_att_common
+ TYPE STRUCT1
+ INTEGER*4 ID
+ INTEGER*4 TYPE
+ INTEGER*8 DEFVAL
+ CHARACTER*(4) NAME
+ LOGICAL*1 NIL
+ END TYPE STRUCT1
+
+ TYPE (STRUCT1) SINST
+ COMMON /BLOCK1/ SINST
+ END

62
SOURCES/0018-Fill-in-missing-array-dimensions-using-the-lower-bou.patch
View File

@ -1,62 +0,0 @@
From b8527b8f03c4c50869c4f9a063f5c7686e58e5e9 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 18/23] Fill in missing array dimensions using the lower bound
This feature is enabled by the `-fstd=extra-legacy` compiler flag
---
0018-Fill-in-missing-array-dimensions-using-the-lower-bou.patch
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index a831f70..ac35357 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -4396,6 +4396,27 @@ compare_spec_to_ref (gfc_array_ref *ar)
if (ar->type == AR_FULL)
return true;
+ if ((gfc_option.allow_std & GFC_STD_EXTRA_LEGACY)
+ && as->rank > ar->dimen)
+ {
+ /* Add in the missing dimensions, assuming they are the lower bound
+ of that dimension if not specified. */
+ int j;
+ gfc_warning (0, "Using the lower bound for unspecified dimensions "
+ "in array reference at %L", &ar->where);
+ /* Other parts of the code iterate ar->start and ar->end from 0 to
+ ar->dimen, so it is safe to assume slots from ar->dimen upwards
+ are unused (i.e. there are no gaps; the specified indexes are
+ contiguous and start at zero */
+ for(j = ar->dimen; j <= as->rank; j++)
+ {
+ ar->start[j] = gfc_copy_expr (as->lower[j]);
+ ar->end[j] = gfc_copy_expr (as->lower[j]);
+ ar->dimen_type[j] = DIMEN_ELEMENT;
+ }
+ ar->dimen = as->rank;
+ }
+
if (as->rank != ar->dimen)
{
gfc_error ("Rank mismatch in array reference at %L (%d/%d)",
diff --git a/gcc/testsuite/gfortran.dg/array_6.f90 b/gcc/testsuite/gfortran.dg/array_6.f90
new file mode 100644
index 0000000..20752a1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_6.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! { dg-options "-std=extra-legacy" }!
+! Checks that under-specified arrays (referencing arrays with fewer
+! dimensions than the array spec) generates a warning.
+!
+! Contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
+!
+
+program under_specified_array
+ INTEGER chsbrd(8,8)
+ chsbrd(3,1) = 5
+ print *, chsbrd(3) ! { dg-warning "Using the lower bound for unspecified dimensions in array reference" }
+end program

35
SOURCES/0019-Add-tests-for-AUTOMATIC-keyword.patch
View File

@ -1,35 +0,0 @@
From 52e49e5edaf2c4de5974b42dd359c0f57546c640 Mon Sep 17 00:00:00 2001
From: Mark Doffman <mark.doffman@codethink.co.uk>
Date: Thu, 5 Jun 2014 20:47:51 +0000
Subject: [PATCH 19/23] Add tests for AUTOMATIC keyword
These tests were written by Mark Doffman for his own implementation of
the AUTOMATIC keyword. Since then, Fritz Reese's implementation was
merged upstream so we no longer carry Mark's patches but the tests
may add some useful extra test coverage. Or they might not.
---
gcc/testsuite/gfortran.dg/automatic_1.f90 | 31 ++++++++++++++++++++++++++
gcc/testsuite/gfortran.dg/automatic_common.f90 | 6 +++++
gcc/testsuite/gfortran.dg/automatic_repeat.f90 | 8 +++++++
gcc/testsuite/gfortran.dg/automatic_save.f90 | 8 +++++++
4 files changed, 53 insertions(+)
create mode 100644 gcc/testsuite/gfortran.dg/automatic_1.f90
create mode 100644 gcc/testsuite/gfortran.dg/automatic_common.f90
create mode 100644 gcc/testsuite/gfortran.dg/automatic_repeat.f90
create mode 100644 gcc/testsuite/gfortran.dg/automatic_save.f90
diff --git a/gcc/testsuite/gfortran.dg/automatic_common.f90 b/gcc/testsuite/gfortran.dg/automatic_common.f90
new file mode 100644
index 0000000..5ec016f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/automatic_common.f90
@@ -0,0 +1,6 @@
+! { dg-do compile }
+! { dg-options "-fdec-static" }
+! A common variable may not have the AUTOMATIC attribute.
+INTEGER, AUTOMATIC :: X
+COMMON /COM/ X ! { dg-error "conflicts with AUTOMATIC attribute" }
+END
--
2.9.5

516
SOURCES/0022-Default-values-for-certain-field-descriptors-in-form.patch
View File

@ -1,516 +0,0 @@
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index d93dcfa..f47565c 100644
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -909,6 +909,13 @@ data_desc:
if (u != FMT_POSINT)
{
+ if (flag_dec)
+ {
+ /* 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),
@@ -1030,6 +1037,13 @@ data_desc:
goto fail;
if (t != FMT_ZERO && t != FMT_POSINT)
{
+ if (flag_dec)
+ {
+ /* 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;
}
@@ -1099,8 +1113,17 @@ data_desc:
goto fail;
if (t != FMT_ZERO && t != FMT_POSINT)
{
- error = nonneg_required;
- goto syntax;
+ if (flag_dec)
+ {
+ /* 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)
{
diff --git a/gcc/testsuite/gfortran.dg/fmt_f_default_field_width.f90 b/gcc/testsuite/gfortran.dg/fmt_f_default_field_width.f90
new file mode 100644
index 0000000..b087b8f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_f_default_field_width.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:") call abort
+
+ real_4 = 0.00000018
+ write(buffer, '(A, F, A)') ':',real_4,':'
+ print *,buffer
+ if (buffer.ne.": 0.0000002:") call abort
+
+ real_8 = 4.18
+ write(buffer, '(A, F, A)') ':',real_8,':'
+ print *,buffer
+ len = len_trim(buffer)
+ if (len /= 27) call abort
+
+ real_16 = 4.18
+ write(buffer, '(A, F, A)') ':',real_16,':'
+ print *,buffer
+ len = len_trim(buffer)
+ if (len /= 44) call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/fmt_g_default_field_width.f90 b/gcc/testsuite/gfortran.dg/fmt_g_default_field_width.f90
new file mode 100644
index 0000000..3d3a476
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_g_default_field_width.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 :") call abort
+
+ real_4 = 0.00000018
+ write(buffer, '(A, G, A)') ':',real_4,':'
+ print *,buffer
+ if (buffer.ne.": 0.1800000E-06:") call abort
+
+ real_4 = 18000000.4
+ write(buffer, '(A, G, A)') ':',real_4,':'
+ print *,buffer
+ if (buffer.ne.": 0.1800000E+08:") call abort
+
+ real_8 = 4.18
+ write(buffer, '(A, G, A)') ':',real_8,':'
+ print *,buffer
+ len = len_trim(buffer)
+ if (len /= 27) call abort
+
+ real_16 = 4.18
+ write(buffer, '(A, G, A)') ':',real_16,':'
+ print *,buffer
+ len = len_trim(buffer)
+ if (len /= 44) call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/fmt_i_default_field_width.f90 b/gcc/testsuite/gfortran.dg/fmt_i_default_field_width.f90
new file mode 100644
index 0000000..ac4e165
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_i_default_field_width.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:") call abort
+
+ read(buffer, '(A1, I, A1)') colon, integer_4, colon
+ if (integer_4.ne.12340) call abort
+
+ integer_2 = -99
+ write(buffer, '(A, I, A)') ':',integer_2,':'
+ print *,buffer
+ if (buffer.ne.": -99:") call abort
+
+ integer_8 = -11112222
+ write(buffer, '(A, I, A)') ':',integer_8,':'
+ print *,buffer
+ if (buffer.ne.": -11112222:") call abort
+
+! 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) call abort
+end
diff --git a/libgfortran/io/format.c b/libgfortran/io/format.c
index c2abdd7..692b1ff 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;
}
@@ -1099,6 +1120,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;
}
@@ -1107,6 +1135,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 5583183..d1d08e8 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -981,5 +981,55 @@ 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
diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c
index 2c9de48..e911e35 100644
--- a/libgfortran/io/read.c
+++ b/libgfortran/io/read.c
@@ -629,6 +629,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 a7307a8..c8e52fb 100644
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -684,9 +684,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;
@@ -719,6 +718,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);
@@ -845,6 +847,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;
@@ -1187,13 +1191,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);
}
}
@@ -1208,13 +1212,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);
}
}
@@ -1228,13 +1232,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);
}
}
@@ -1504,7 +1508,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 7f0aa1d..73dc910 100644
--- a/libgfortran/io/write_float.def
+++ b/libgfortran/io/write_float.def
@@ -113,7 +113,8 @@ determine_precision (st_parameter_dt * d
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
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;
@@ -959,6 +969,11 @@ determine_en_precision (st_parameter_dt
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:\
@@ -1034,7 +1049,8 @@ determine_en_precision (st_parameter_dt
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\
@@ -1044,7 +1060,8 @@ determine_en_precision (st_parameter_dt
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);\
}\
}\
@@ -1058,6 +1075,16 @@ get_float_string (st_parameter_dt *dtp,
{
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)
{

202
SOURCES/gcc8-fortran-equivalence.patch
View File

@ -1,202 +0,0 @@
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index c373419..880630a 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2867,6 +2867,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 67ad504..29b40fd 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -363,7 +363,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",
@@ -496,7 +496,9 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
conf (allocatable, elemental);
conf (in_common, automatic);
+#if 0
conf (in_equivalence, automatic);
+#endif
conf (result, automatic);
conf (use_assoc, automatic);
conf (dummy, automatic);
diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c
index 36370eb..4cfaf61 100644
--- a/gcc/fortran/trans-common.c
+++ b/gcc/fortran/trans-common.c
@@ -948,6 +948,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. */
@@ -966,8 +1021,11 @@ find_equivalence (segment_info *n)
/* Search the equivalence list, including the root (first) element
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 +1033,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 -Nrcp gcc-8.2.1-20180801/gcc/fortran/trans-common.c save/gcc/fortran/trans-common.c
*** a/gcc/fortran/trans-common.c 2018-08-14 18:17:28.000000000 -0400
--- b/gcc/fortran/trans-common.c 2018-08-14 17:57:51.000000000 -0400
*************** build_field (segment_info *h, tree union
*** 339,345 ****
/* Get storage for local equivalence. */
static tree
! build_equiv_decl (tree union_type, bool is_init, bool is_saved)
{
tree decl;
char name[18];
--- 339,345 ----
/* Get storage for local equivalence. */
static tree
! build_equiv_decl (tree union_type, bool is_init, bool is_saved, bool is_auto)
{
tree decl;
char name[18];
*************** build_equiv_decl (tree union_type, bool
*** 359,366 ****
DECL_ARTIFICIAL (decl) = 1;
DECL_IGNORED_P (decl) = 1;
! if (!gfc_can_put_var_on_stack (DECL_SIZE_UNIT (decl))
! || is_saved)
TREE_STATIC (decl) = 1;
TREE_ADDRESSABLE (decl) = 1;
--- 359,367 ----
DECL_ARTIFICIAL (decl) = 1;
DECL_IGNORED_P (decl) = 1;
! if (!is_auto
! && (!gfc_can_put_var_on_stack (DECL_SIZE_UNIT (decl))
! || is_saved))
TREE_STATIC (decl) = 1;
TREE_ADDRESSABLE (decl) = 1;
*************** create_common (gfc_common_head *com, seg
*** 611,616 ****
--- 612,618 ----
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
*************** create_common (gfc_common_head *com, seg
*** 654,659 ****
--- 656,665 ----
/* 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);
*************** create_common (gfc_common_head *com, seg
*** 661,667 ****
if (com)
decl = build_common_decl (com, union_type, is_init);
else
! decl = build_equiv_decl (union_type, is_init, is_saved);
if (is_init)
{
--- 667,673 ----
if (com)
decl = build_common_decl (com, union_type, is_init);
else
! decl = build_equiv_decl (union_type, is_init, is_saved, is_auto);
if (is_init)
{

30
SOURCES/gcc8-fortran-fdec-include-doc.patch
View File

@ -1,30 +0,0 @@
2018-11-21 Jakub Jelinek <jakub@redhat.com>
* invoke.texi (-fdec-include): Document.
diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi
index ee84a0be8b1..33afab1517f 100644
--- a/gcc/fortran/invoke.texi
+++ b/gcc/fortran/invoke.texi
@@ -119,7 +119,7 @@ by type. Explanations are in the following sections.
@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
--fdefault-double-8 -fdefault-integer-8 -fdefault-real-8 @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
-ffixed-line-length-none -ffree-form -ffree-line-length-@var{n} @gol
-ffree-line-length-none -fimplicit-none -finteger-4-integer-8 @gol
@@ -277,6 +277,12 @@ functions (e.g. TAND, ATAND, etc...) for compatability with older code.
Enable DEC-style STATIC and AUTOMATIC attributes to explicitly specify
the storage of variables and other objects.
+@item -fdec-include
+@opindex @code{fdec-include}
+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 -fdollar-ok
@opindex @code{fdollar-ok}
@cindex @code{$}

687
SOURCES/gcc8-fortran-fdec-include.patch
View File

@ -1,687 +0,0 @@
2018-11-21 Jakub Jelinek <jakub@redhat.com>
Mark Eggleston <mark.eggleston@codethink.com>
* lang.opt (fdec-include): New option.
* options.c (set_dec_flags): Set also flag_dec_include.
* scanner.c (include_line): Change return type from bool to int.
In fixed form allow spaces in between include keyword letters.
For -fdec-include, allow in fixed form 0 in column 6. With
-fdec-include return -1 if the parsed line is not full include
statement and it could be successfully completed on continuation
lines.
(include_stmt): New function.
(load_file): Adjust include_line caller. If it returns -1, keep
trying include_stmt until it stops returning -1 whenever adding
further line of input.
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 2b7f2903761..fe0c6934220 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -440,6 +440,10 @@ fdec
Fortran Var(flag_dec_pad_with_spaces)
For character to integer conversions, use spaces for the pad rather than NUL.
+fdec-include
+Fortran Var(flag_dec_include)
+Enable legacy parsing of INCLUDE as statement.
+
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 73f5389361d..e59ba31ba7b 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -68,6 +68,7 @@ set_dec_flags (int value)
flag_dec_intrinsic_ints |= value;
flag_dec_static |= value;
flag_dec_math |= value;
+ flag_dec_include |= value;
}
diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c
index 55d6dafdb5d..5b27ab5e52d 100644
--- a/gcc/fortran/scanner.c
+++ b/gcc/fortran/scanner.c
@@ -2135,14 +2135,18 @@ static bool load_file (const char *, const char *, bool);
/* include_line()-- Checks a line buffer to see if it is an include
line. If so, we call load_file() recursively to load the included
file. We never return a syntax error because a statement like
- "include = 5" is perfectly legal. We return false if no include was
- processed or true if we matched an include. */
+ "include = 5" is perfectly legal. We return 0 if no include was
+ processed, 1 if we matched an include or -1 if include was
+ partially processed, but will need continuation lines. */
-static bool
+static int
include_line (gfc_char_t *line)
{
gfc_char_t quote, *c, *begin, *stop;
char *filename;
+ const char *include = "include";
+ bool allow_continuation = flag_dec_include;
+ int i;
c = line;
@@ -2158,42 +2162,133 @@ include_line (gfc_char_t *line)
else
{
if ((*c == '!' || *c == 'c' || *c == 'C' || *c == '*')
- && c[1] == '$' && (c[2] == ' ' || c[2] == '\t'))
+ && c[1] == '$' && c[2] == ' ')
c += 3;
}
}
- while (*c == ' ' || *c == '\t')
- c++;
+ if (gfc_current_form == FORM_FREE)
+ {
+ while (*c == ' ' || *c == '\t')
+ c++;
+ if (gfc_wide_strncasecmp (c, "include", 7))
+ {
+ if (!allow_continuation)
+ return 0;
+ for (i = 0; i < 7; ++i)
+ {
+ gfc_char_t c1 = gfc_wide_tolower (*c);
+ if (c1 != (unsigned char) include[i])
+ break;
+ c++;
+ }
+ if (i == 0 || *c != '&')
+ return 0;
+ c++;
+ while (*c == ' ' || *c == '\t')
+ c++;
+ if (*c == '\0' || *c == '!')
+ return -1;
+ return 0;
+ }
- if (gfc_wide_strncasecmp (c, "include", 7))
- return false;
+ c += 7;
+ }
+ else
+ {
+ while (*c == ' ' || *c == '\t')
+ c++;
+ if (flag_dec_include && *c == '0' && c - line == 5)
+ {
+ c++;
+ while (*c == ' ' || *c == '\t')
+ c++;
+ }
+ if (c - line < 6)
+ allow_continuation = false;
+ for (i = 0; i < 7; ++i)
+ {
+ gfc_char_t c1 = gfc_wide_tolower (*c);
+ if (c1 != (unsigned char) include[i])
+ break;
+ c++;
+ while (*c == ' ' || *c == '\t')
+ c++;
+ }
+ if (!allow_continuation)
+ {
+ if (i != 7)
+ return 0;
+ }
+ else if (i != 7)
+ {
+ if (i == 0)
+ return 0;
+
+ /* At the end of line or comment this might be continued. */
+ if (*c == '\0' || *c == '!')
+ return -1;
+
+ return 0;
+ }
+ }
- c += 7;
while (*c == ' ' || *c == '\t')
c++;
/* Find filename between quotes. */
-
+
quote = *c++;
if (quote != '"' && quote != '\'')
- return false;
+ {
+ if (allow_continuation)
+ {
+ if (gfc_current_form == FORM_FREE)
+ {
+ if (quote == '&')
+ {
+ while (*c == ' ' || *c == '\t')
+ c++;
+ if (*c == '\0' || *c == '!')
+ return -1;
+ }
+ }
+ else if (quote == '\0' || quote == '!')
+ return -1;
+ }
+ return 0;
+ }
begin = c;
+ bool cont = false;
while (*c != quote && *c != '\0')
- c++;
+ {
+ if (allow_continuation && gfc_current_form == FORM_FREE)
+ {
+ if (*c == '&')
+ cont = true;
+ else if (*c != ' ' && *c != '\t')
+ cont = false;
+ }
+ c++;
+ }
if (*c == '\0')
- return false;
+ {
+ if (allow_continuation
+ && (cont || gfc_current_form != FORM_FREE))
+ return -1;
+ return 0;
+ }
stop = c++;
-
+
while (*c == ' ' || *c == '\t')
c++;
if (*c != '\0' && *c != '!')
- return false;
+ return 0;
/* We have an include line at this point. */
@@ -2205,9 +2300,130 @@ include_line (gfc_char_t *line)
exit (FATAL_EXIT_CODE);
free (filename);
- return true;
+ return 1;
}
+/* Similarly, but try to parse an INCLUDE statement, using gfc_next_char etc.
+ APIs. Return 1 if recognized as valid INCLUDE statement and load_file has
+ been called, 0 if it is not a valid INCLUDE statement and -1 if eof has
+ been encountered while parsing it. */
+static int
+include_stmt (gfc_linebuf *b)
+{
+ int ret = 0, i, length;
+ const char *include = "include";
+ gfc_char_t c, quote = 0;
+ locus str_locus;
+ char *filename;
+
+ continue_flag = 0;
+ end_flag = 0;
+ gcc_attribute_flag = 0;
+ openmp_flag = 0;
+ openacc_flag = 0;
+ continue_count = 0;
+ continue_line = 0;
+ gfc_current_locus.lb = b;
+ gfc_current_locus.nextc = b->line;
+
+ gfc_skip_comments ();
+ gfc_gobble_whitespace ();
+
+ for (i = 0; i < 7; i++)
+ {
+ c = gfc_next_char ();
+ if (c != (unsigned char) include[i])
+ {
+ if (gfc_current_form == FORM_FIXED
+ && i == 0
+ && c == '0'
+ && gfc_current_locus.nextc == b->line + 6)
+ {
+ gfc_gobble_whitespace ();
+ i--;
+ continue;
+ }
+ gcc_assert (i != 0);
+ if (c == '\n')
+ {
+ gfc_advance_line ();
+ gfc_skip_comments ();
+ if (gfc_at_eof ())
+ ret = -1;
+ }
+ goto do_ret;
+ }
+ }
+ gfc_gobble_whitespace ();
+
+ c = gfc_next_char ();
+ if (c == '\'' || c == '"')
+ quote = c;
+ else
+ {
+ if (c == '\n')
+ {
+ gfc_advance_line ();
+ gfc_skip_comments ();
+ if (gfc_at_eof ())
+ ret = -1;
+ }
+ goto do_ret;
+ }
+
+ str_locus = gfc_current_locus;
+ length = 0;
+ do
+ {
+ c = gfc_next_char_literal (INSTRING_NOWARN);
+ if (c == quote)
+ break;
+ if (c == '\n')
+ {
+ gfc_advance_line ();
+ gfc_skip_comments ();
+ if (gfc_at_eof ())
+ ret = -1;
+ goto do_ret;
+ }
+ length++;
+ }
+ while (1);
+
+ gfc_gobble_whitespace ();
+ c = gfc_next_char ();
+ if (c != '\n')
+ goto do_ret;
+
+ gfc_current_locus = str_locus;
+ ret = 1;
+ filename = XNEWVEC (char, length + 1);
+ for (i = 0; i < length; i++)
+ {
+ c = gfc_next_char_literal (INSTRING_WARN);
+ gcc_assert (gfc_wide_fits_in_byte (c));
+ filename[i] = (unsigned char) c;
+ }
+ filename[length] = '\0';
+ if (!load_file (filename, NULL, false))
+ exit (FATAL_EXIT_CODE);
+
+ free (filename);
+
+do_ret:
+ continue_flag = 0;
+ end_flag = 0;
+ gcc_attribute_flag = 0;
+ openmp_flag = 0;
+ openacc_flag = 0;
+ continue_count = 0;
+ continue_line = 0;
+ memset (&gfc_current_locus, '\0', sizeof (locus));
+ memset (&openmp_locus, '\0', sizeof (locus));
+ memset (&openacc_locus, '\0', sizeof (locus));
+ memset (&gcc_attribute_locus, '\0', sizeof (locus));
+ return ret;
+}
/* Load a file into memory by calling load_line until the file ends. */
@@ -2215,7 +2431,7 @@ static bool
load_file (const char *realfilename, const char *displayedname, bool initial)
{
gfc_char_t *line;
- gfc_linebuf *b;
+ gfc_linebuf *b, *include_b = NULL;
gfc_file *f;
FILE *input;
int len, line_len;
@@ -2318,6 +2534,7 @@ load_file (const char *realfilename, const char *displayedname, bool initial)
for (;;)
{
int trunc = load_line (input, &line, &line_len, NULL);
+ int inc_line;
len = gfc_wide_strlen (line);
if (feof (input) && len == 0)
@@ -2366,11 +2583,12 @@ load_file (const char *realfilename, const char *displayedname, bool initial)
}
/* Preprocessed files have preprocessor lines added before the byte
- order mark, so first_line is not about the first line of the file
+ order mark, so first_line is not about the first line of the file
but the first line that's not a preprocessor line. */
first_line = false;
- if (include_line (line))
+ inc_line = include_line (line);
+ if (inc_line > 0)
{
current_file->line++;
continue;
@@ -2403,6 +2621,36 @@ load_file (const char *realfilename, const char *displayedname, bool initial)
while (file_changes_cur < file_changes_count)
file_changes[file_changes_cur++].lb = b;
+
+ if (flag_dec_include)
+ {
+ if (include_b && b != include_b)
+ {
+ int inc_line2 = include_stmt (include_b);
+ if (inc_line2 == 0)
+ include_b = NULL;
+ else if (inc_line2 > 0)
+ {
+ do
+ {
+ if (gfc_current_form == FORM_FIXED)
+ {
+ for (gfc_char_t *p = include_b->line; *p; p++)
+ *p = ' ';
+ }
+ else
+ include_b->line[0] = '\0';
+ if (include_b == b)
+ break;
+ include_b = include_b->next;
+ }
+ while (1);
+ include_b = NULL;
+ }
+ }
+ if (inc_line == -1 && !include_b)
+ include_b = b;
+ }
}
/* Release the line buffer allocated in load_line. */
diff --git a/gcc/testsuite/gfortran.dg/gomp/include_1.f b/gcc/testsuite/gfortran.dg/gomp/include_1.f
new file mode 100644
index 00000000000..715eb5b97e3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/include_1.f
@@ -0,0 +1,49 @@
+c { dg-do compile }
+c { dg-options "-fopenmp -fdec" }
+ subroutine foo
+ implicit none
+c$ 0include 'include_1.inc'
+ i = 1
+ end subroutine foo
+ subroutine bar
+ implicit none
+ i
+C$ ;n
+ +c
+
+c some comment
+
+*$ ll
+C comment line
+ uu
+ DD
+ ee'include_1.inc'
+ i = 1
+ end subroutine bar
+ subroutine baz
+ implicit none
+ 0include
+ + 'include_1.inc'
+ i = 1
+ end subroutine baz
+ subroutine qux
+ implicit none
+!$ i n C lude 'inc
+* another comment line
+ &lude_1.inc'
+ i = 1
+ end subroutine qux
+ subroutine quux
+ implicit none
+C$ 0inc
+*$ 1lud
+c$ 2e '
+!$ 3include_1.inc'
+ i = 1
+ end subroutine quux
+ program include_12
+ implicit none
+ include
+! comment
+c$ +'include_1.inc'
+ end program
diff --git a/gcc/testsuite/gfortran.dg/gomp/include_1.inc b/gcc/testsuite/gfortran.dg/gomp/include_1.inc
new file mode 100644
index 00000000000..5dd841c5573
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/include_1.inc
@@ -0,0 +1 @@
+ integer i
diff --git a/gcc/testsuite/gfortran.dg/gomp/include_2.f90 b/gcc/testsuite/gfortran.dg/gomp/include_2.f90
new file mode 100644
index 00000000000..9c4ff15afb8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/include_2.f90
@@ -0,0 +1,32 @@
+! { dg-do compile }
+! { dg-options "-fopenmp -fdec-include" }
+subroutine foo
+ implicit none
+!$ incl& ! comment1
+!$ &u&
+!$ &de & ! comment2
+!$ 'include&
+ &_1.inc'
+ i = 1
+end subroutine foo
+subroutine bar
+ implicit none
+!$ include &
+
+! comment3
+
+!$ "include_1.inc"
+ i = 1
+end subroutine bar
+subroutine baz
+ implicit none
+!$ include&
+!$ &'include_1.&
+!$ &inc'
+ i = 1
+end subroutine baz
+subroutine qux
+ implicit none
+!$ include '&
+include_1.inc'
+end subroutine qux
diff --git a/gcc/testsuite/gfortran.dg/include_10.f b/gcc/testsuite/gfortran.dg/include_10.f
new file mode 100644
index 00000000000..7df2a196954
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/include_10.f
@@ -0,0 +1,11 @@
+c { dg-do compile }
+ subroutine foo
+ implicit none
+ include 'include_10.inc'
+ i = 1
+ end subroutine foo
+ subroutine bar
+ implicit none
+ i n cl UD e'include_10.inc'
+ i = 1
+ end subroutine bar
diff --git a/gcc/testsuite/gfortran.dg/include_10.inc b/gcc/testsuite/gfortran.dg/include_10.inc
new file mode 100644
index 00000000000..5dd841c5573
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/include_10.inc
@@ -0,0 +1 @@
+ integer i
diff --git a/gcc/testsuite/gfortran.dg/include_11.f b/gcc/testsuite/gfortran.dg/include_11.f
new file mode 100644
index 00000000000..0e68a78c236
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/include_11.f
@@ -0,0 +1,20 @@
+c { dg-do compile }
+ subroutine foo
+ implicit none
+c We used to accept following in fixed mode. Shall we at least
+c warn about it?
+include 'include_10.inc'
+ i = 1
+ end subroutine foo
+ subroutine bar
+c Likewise here.
+ implicit none
+ include'include_10.inc'
+ i = 1
+ end subroutine bar
+ subroutine baz
+c And here.
+ implicit none
+ include 'include_10.inc'
+ i = 1
+ end subroutine baz
diff --git a/gcc/testsuite/gfortran.dg/include_12.f b/gcc/testsuite/gfortran.dg/include_12.f
new file mode 100644
index 00000000000..4b3e3bed075
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/include_12.f
@@ -0,0 +1,65 @@
+c { dg-do compile }
+c { dg-options "-fdec-include" }
+ subroutine foo
+ implicit none
+ 0include 'include_10.inc'
+ i = 1
+ end subroutine foo
+ subroutine bar
+ implicit none
+ i
+ ;n
+ +c
+
+c some comment
+
+ ll
+C comment line
+ uu
+ DD
+ ee'include_10.inc'
+ i = 1
+ end subroutine bar
+ subroutine baz
+ implicit none
+ 0include
+ + 'include_10.inc'
+ i = 1
+ end subroutine baz
+ subroutine qux
+ implicit none
+ i n C lude 'inc
+* another comment line
+ &lude_10.inc'
+ i = 1
+ end subroutine qux
+ subroutine quux
+ implicit none
+ 0inc
+ 1lud
+ 2e '
+ 3include_10.inc'
+ i = 1
+ end subroutine quux
+ program include_12
+ implicit none
+ include
+! comment
+ +'include_10.inc'
+ end program
+ subroutine quuz
+ implicit none
+ integer include
+ include
+ +"include_10.inc"
+ i = 1
+ include
+ + = 2
+ write (*,*) include
+ end subroutine quuz
+ subroutine corge
+ implicit none
+ include
+ +'include_10.inc'
+ i = 1
+ end subroutine corge
diff --git a/gcc/testsuite/gfortran.dg/include_13.f90 b/gcc/testsuite/gfortran.dg/include_13.f90
new file mode 100644
index 00000000000..418ee5585e2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/include_13.f90
@@ -0,0 +1,44 @@
+! { dg-do compile }
+! { dg-options "-fdec" }
+subroutine foo
+ implicit none
+ incl& ! comment1
+&u&
+ &de & ! comment2
+'include&
+ &_10.inc'
+ i = 1
+end subroutine foo
+subroutine bar
+ implicit none
+include &
+
+! comment3
+
+"include_10.inc"
+ i = 1
+end subroutine bar
+subroutine baz
+ implicit none
+ include&
+&'include_10.&
+&inc'
+ i = 1
+end subroutine baz
+subroutine qux
+ implicit none
+ include '&
+include_10.inc'
+end subroutine qux
+subroutine quux
+ implicit none
+ include &
+ &'include_10.inc'
+ i = 1
+end subroutine quux
+subroutine quuz
+ implicit none
+ include &
+ &"include_10.inc"
+ i = 1
+end subroutine quuz

144
SOURCES/gcc8-fortran-fpad-source.patch
View File

@ -1,144 +0,0 @@
2018-11-23 Jakub Jelinek <jakub@redhat.com>
* lang.opt (fpad-source): New option.
* scanner.c (load_line): Don't pad fixed form lines if
!flag_pad_source.
* invoke.texi (-fno-pad-source): Document.
diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi
index 33afab1517f..d6a278b1cc2 100644
--- a/gcc/fortran/invoke.texi
+++ b/gcc/fortran/invoke.texi
@@ -121,7 +121,7 @@ by type. Explanations are in the following sections.
-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
--ffixed-line-length-none -ffree-form -ffree-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
@@ -321,8 +321,9 @@ declared as @code{PUBLIC}.
@opindex @code{ffixed-line-length-}@var{n}
@cindex file format, fixed
Set column after which characters are ignored in typical fixed-form
-lines in the source file, and through which spaces are assumed (as
-if padded to that length) after the ends of short fixed-form lines.
+lines in the source file, and, unless @code{-fno-pad-source}, through which
+spaces are assumed (as if padded to that length) after the ends of short
+fixed-form lines.
Popular values for @var{n} include 72 (the
standard and the default), 80 (card image), and 132 (corresponding
@@ -333,6 +334,15 @@ to them to fill out the line.
@option{-ffixed-line-length-0} means the same thing as
@option{-ffixed-line-length-none}.
+@item -fno-pad-source
+@opindex @code{fpad-source}
+By default fixed-form lines have spaces assumed (as if padded to that length)
+after the ends of short fixed-form lines. This is not done either if
+@option{-ffixed-line-length-0}, @option{-ffixed-line-length-none} or
+if @option{-fno-pad-source} option is used. With any of those options
+continued character constants never have implicit spaces appended
+to them to fill out the line.
+
@item -ffree-line-length-@var{n}
@opindex @code{ffree-line-length-}@var{n}
@cindex file format, free
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index fe0c6934220..ae4957e176c 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -536,6 +536,10 @@ ffixed-line-length-
Fortran RejectNegative Joined UInteger Var(flag_fixed_line_length) Init(72)
-ffixed-line-length-<n> Use n as character line width in fixed mode.
+fpad-source
+Fortran Var(flag_pad_source) Init(1)
+Pad shorter fixed form lines to line width with spaces.
+
ffpe-trap=
Fortran RejectNegative JoinedOrMissing
-ffpe-trap=[...] Stop on following floating point exceptions.
diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c
index 5b27ab5e52d..2ef32b279fe 100644
--- a/gcc/fortran/scanner.c
+++ b/gcc/fortran/scanner.c
@@ -1924,6 +1924,7 @@ next_char:
/* Pad lines to the selected line length in fixed form. */
if (gfc_current_form == FORM_FIXED
&& flag_fixed_line_length != 0
+ && flag_pad_source
&& !preprocessor_flag
&& c != EOF)
{
diff --git a/gcc/testsuite/gfortran.dg/pad_source_1.f b/gcc/testsuite/gfortran.dg/pad_source_1.f
new file mode 100644
index 00000000000..a616bba60de
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pad_source_1.f
@@ -0,0 +1,8 @@
+c { dg-do run }
+c { dg-skip-if "non-standard options" { *-*-* } { "-ffixed-line-length*" "-f*pad-source" } }
+ character(80) a
+ a = 'abc
+ +def'
+ if (a(:61) .ne. 'abc') stop 1
+ if (a(62:) .ne. 'def') stop 2
+ end
diff --git a/gcc/testsuite/gfortran.dg/pad_source_2.f b/gcc/testsuite/gfortran.dg/pad_source_2.f
new file mode 100644
index 00000000000..bcf9439cd14
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pad_source_2.f
@@ -0,0 +1,9 @@
+c { dg-do run }
+c { dg-skip-if "non-standard options" { *-*-* } { "-ffixed-line-length*" } }
+c { dg-options "-fpad-source" }
+ character(80) a
+ a = 'abc
+ +def'
+ if (a(:61) .ne. 'abc') stop 1
+ if (a(62:) .ne. 'def') stop 2
+ end
diff --git a/gcc/testsuite/gfortran.dg/pad_source_3.f b/gcc/testsuite/gfortran.dg/pad_source_3.f
new file mode 100644
index 00000000000..8fbdae0d67d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pad_source_3.f
@@ -0,0 +1,8 @@
+c { dg-do run }
+c { dg-skip-if "non-standard options" { *-*-* } { "-ffixed-line-length*" } }
+c { dg-options "-fno-pad-source" }
+ character(80) a
+ a = 'abc
+ +def'
+ if (a .ne. 'abcdef') stop 1
+ end
diff --git a/gcc/testsuite/gfortran.dg/pad_source_4.f b/gcc/testsuite/gfortran.dg/pad_source_4.f
new file mode 100644
index 00000000000..5479cec217a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pad_source_4.f
@@ -0,0 +1,7 @@
+c { dg-do run }
+c { dg-options "-ffixed-line-length-none" }
+ character(80) a
+ a = 'abc
+ +def'
+ if (a .ne. 'abcdef') stop 1
+ end
diff --git a/gcc/testsuite/gfortran.dg/pad_source_5.f b/gcc/testsuite/gfortran.dg/pad_source_5.f
new file mode 100644
index 00000000000..4122c85ba66
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pad_source_5.f
@@ -0,0 +1,7 @@
+c { dg-do run }
+c { dg-options "-ffixed-line-length-0" }
+ character(80) a
+ a = 'abc
+ +def'
+ if (a .ne. 'abcdef') stop 1
+ end

87
SOURCES/gcc8-fortran-pr87919-2.patch
View File

@ -1,87 +0,0 @@
2018-12-03 Fritz Reese <fritzoreese@gmail.com>
Mark Eggleston <mark.eggleston@codethink.co.uk>
PR fortran/87919
* options.c (SET_FLAG, SET_BITFLAG, SET_BITFLAG2): New macros.
(set_dec_flags): Set/unset DEC and std flags according to value.
(post_dec_flags, set_init_local_zero): New functions.
(gfc_init_options): Use set_init_local_zero and post_dec_flags.
(gfc_handle_options) <case OPT_fcheck_array_temporaries>: Use
SET_BITFLAG.
<case OPT_finit_local_zero>: Use set_init_local_zero.
<case OPT_fdec>: Pass value to set_dec_flags.
<case OPT_fdec_structure>: Remove.
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index b35bed32974..48e35e3524d 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -147,11 +147,7 @@ gfc_init_options (unsigned int decoded_options_count,
gfc_option.flag_preprocessed = 0;
gfc_option.flag_d_lines = -1;
- gfc_option.flag_init_integer = GFC_INIT_INTEGER_OFF;
- gfc_option.flag_init_integer_value = 0;
- gfc_option.flag_init_logical = GFC_INIT_LOGICAL_OFF;
- gfc_option.flag_init_character = GFC_INIT_CHARACTER_OFF;
- gfc_option.flag_init_character_value = (char)0;
+ set_init_local_zero (0);
gfc_option.fpe = 0;
/* All except GFC_FPE_INEXACT. */
@@ -261,6 +257,9 @@ gfc_post_options (const char **pfilename)
char *source_path;
int i;
+ /* Finalize DEC flags. */
+ post_dec_flags (flag_dec);
+
/* Excess precision other than "fast" requires front-end
support. */
if (flag_excess_precision_cmdline == EXCESS_PRECISION_STANDARD)
@@ -644,7 +643,7 @@ gfc_handle_option (size_t scode, const char *arg, HOST_WIDE_INT value,
break;
case OPT_fcheck_array_temporaries:
- gfc_option.rtcheck |= GFC_RTCHECK_ARRAY_TEMPS;
+ SET_BITFLAG (gfc_option.rtcheck, value, GFC_RTCHECK_ARRAY_TEMPS);
break;
case OPT_fd_lines_as_code:
@@ -694,12 +693,7 @@ gfc_handle_option (size_t scode, const char *arg, HOST_WIDE_INT value,
break;
case OPT_finit_local_zero:
- gfc_option.flag_init_integer = GFC_INIT_INTEGER_ON;
- gfc_option.flag_init_integer_value = 0;
- flag_init_real = GFC_INIT_REAL_ZERO;
- gfc_option.flag_init_logical = GFC_INIT_LOGICAL_FALSE;
- gfc_option.flag_init_character = GFC_INIT_CHARACTER_ON;
- gfc_option.flag_init_character_value = (char)0;
+ set_init_local_zero (value);
break;
case OPT_finit_logical_:
@@ -798,12 +792,8 @@ gfc_handle_option (size_t scode, const char *arg, HOST_WIDE_INT value,
break;
case OPT_fdec:
- /* Enable all DEC extensions. */
- set_dec_flags (1);
- break;
-
- case OPT_fdec_structure:
- flag_dec_structure = 1;
+ /* Set (or unset) the DEC extension flags. */
+ set_dec_flags (value);
break;
}
@@ -895,3 +885,7 @@ gfc_get_option_string (void)
result[--pos] = '\0';
return result;
}
+
+#undef SET_BITFLAG
+#undef SET_BITFLAG2
+#undef SET_FLAG

419
SOURCES/gcc8-fortran-pr87919.patch
View File

@ -1,419 +0,0 @@
2018-12-03 Fritz Reese <fritzoreese@gmail.com>
Mark Eggleston <mark.eggleston@codethink.co.uk>
PR fortran/87919
* options.c (SET_FLAG, SET_BITFLAG, SET_BITFLAG2): New macros.
(set_dec_flags): Set/unset DEC and std flags according to value.
(set_init_local_zero): New helper for -finit-local-zero flag group.
(gfc_init_options): Fix disabling of init flags, array temporaries
check, and dec flags when value is zero (from -fno-*).
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index e59ba31ba7b..b35bed32974 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -32,6 +32,20 @@ along with GCC; see the file COPYING3. If not see
gfc_option_t gfc_option;
+#define SET_FLAG(flag, condition, on_value, off_value) \
+ do \
+ { \
+ if (condition) \
+ flag = (on_value); \
+ else \
+ flag = (off_value); \
+ } while (0)
+
+#define SET_BITFLAG2(m) m
+
+#define SET_BITFLAG(flag, condition, value) \
+ SET_BITFLAG2 (SET_FLAG (flag, condition, (flag | (value)), (flag & ~(value))))
+
/* Set flags that control warnings and errors for different
Fortran standards to their default values. Keep in sync with
@@ -47,30 +61,55 @@ set_default_std_flags (void)
gfc_option.warn_std = GFC_STD_F95_DEL | GFC_STD_LEGACY;
}
-
-/* Set all the DEC extension flags. */
+/* Set (or unset) the DEC extension flags. */
static void
set_dec_flags (int value)
{
+ /* Set (or unset) other DEC compatibility extensions. */
+ SET_BITFLAG (flag_dollar_ok, value, value);
+ SET_BITFLAG (flag_cray_pointer, value, value);
+ SET_BITFLAG (flag_dec_structure, value, value);
+ SET_BITFLAG (flag_dec_intrinsic_ints, value, value);
+ SET_BITFLAG (flag_dec_static, value, value);
+ SET_BITFLAG (flag_dec_math, value, value);
+ SET_BITFLAG (flag_dec_include, value, value);
+}
+
+/* Finalize DEC flags. */
+
+static void
+post_dec_flags (int value)
+{
+ /* Don't warn for legacy code if -fdec is given; however, setting -fno-dec
+ does not force these warnings. We make one final determination on this
+ at the end because -std= is always set first; thus, we can avoid
+ clobbering the user's desired standard settings in gfc_handle_option
+ e.g. when -fdec and -fno-dec are both given. */
if (value)
{
- /* Allow legacy code without warnings. */
gfc_option.allow_std |= GFC_STD_F95_OBS | GFC_STD_F95_DEL
- | GFC_STD_GNU | GFC_STD_LEGACY;
+ | GFC_STD_GNU | GFC_STD_LEGACY;
gfc_option.warn_std &= ~(GFC_STD_LEGACY | GFC_STD_F95_DEL);
}
-
- /* Set other DEC compatibility extensions. */
- flag_dollar_ok |= value;
- flag_cray_pointer |= value;
- flag_dec_structure |= value;
- flag_dec_intrinsic_ints |= value;
- flag_dec_static |= value;
- flag_dec_math |= value;
- flag_dec_include |= value;
}
+/* Enable (or disable) -finit-local-zero. */
+
+static void
+set_init_local_zero (int value)
+{
+ gfc_option.flag_init_integer_value = 0;
+ gfc_option.flag_init_character_value = (char)0;
+
+ SET_FLAG (gfc_option.flag_init_integer, value, GFC_INIT_INTEGER_ON,
+ GFC_INIT_INTEGER_OFF);
+ SET_FLAG (gfc_option.flag_init_logical, value, GFC_INIT_LOGICAL_FALSE,
+ GFC_INIT_LOGICAL_OFF);
+ SET_FLAG (gfc_option.flag_init_character, value, GFC_INIT_CHARACTER_ON,
+ GFC_INIT_CHARACTER_OFF);
+ SET_FLAG (flag_init_real, value, GFC_INIT_REAL_ZERO, GFC_INIT_REAL_OFF);
+}
/* Return language mask for Fortran options. */
diff --git a/gcc/testsuite/gfortran.dg/array_temporaries_5.f90 b/gcc/testsuite/gfortran.dg/array_temporaries_5.f90
new file mode 100644
index 00000000000..dd147ba38ed
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_temporaries_5.f90
@@ -0,0 +1,10 @@
+! { dg-do run }
+! { dg-options "-fcheck-array-temporaries -fno-check-array-temporaries" }
+!
+! PR fortran/87919
+!
+! Ensure -fno-check-array-temporaries disables array temporary checking.
+!
+
+! Note that 'include' drops the dg-output check from the original test case.
+include 'array_temporaries_2.f90'
diff --git a/gcc/testsuite/gfortran.dg/dec_bitwise_ops_3.f90 b/gcc/testsuite/gfortran.dg/dec_bitwise_ops_3.f90
new file mode 100644
index 00000000000..c28cf81fc04
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_bitwise_ops_3.f90
@@ -0,0 +1,29 @@
+! { dg-do compile }
+! { dg-options "-std=legacy -fdec -fno-dec" }
+!
+! PR fortran/87919
+!
+! Make sure -fno-dec disables bitwise ops and check for the right errors.
+! -std=legacy is added to avoid the .XOR. extension warning.
+!
+
+include 'dec_bitwise_ops_1.f90'
+
+! { dg-error "Operands of logical operator" " " { target *-*-* } 33 }
+! { dg-error "Operands of logical operator" " " { target *-*-* } 34 }
+! { dg-error "Operands of logical operator" " " { target *-*-* } 35 }
+! { dg-error "Operands of logical operator" " " { target *-*-* } 46 }
+! { dg-error "Operands of logical operator" " " { target *-*-* } 47 }
+! { dg-error "Operands of logical operator" " " { target *-*-* } 48 }
+! { dg-error "Operands of logical operator" " " { target *-*-* } 59 }
+! { dg-error "Operands of logical operator" " " { target *-*-* } 60 }
+! { dg-error "Operands of logical operator" " " { target *-*-* } 61 }
+! { dg-error "Operand of .not. operator" " " { target *-*-* } 72 }
+! { dg-error "Operand of .not. operator" " " { target *-*-* } 73 }
+! { dg-error "Operand of .not. operator" " " { target *-*-* } 74 }
+! { dg-error "Operands of logical operator" " " { target *-*-* } 85 }
+! { dg-error "Operands of logical operator" " " { target *-*-* } 86 }
+! { dg-error "Operands of logical operator" " " { target *-*-* } 87 }
+! { dg-error "Operands of logical operator" " " { target *-*-* } 98 }
+! { dg-error "Operands of logical operator" " " { target *-*-* } 99 }
+! { dg-error "Operands of logical operator" " " { target *-*-* } 100 }
diff --git a/gcc/testsuite/gfortran.dg/dec_d_lines_3.f b/gcc/testsuite/gfortran.dg/dec_d_lines_3.f
new file mode 100644
index 00000000000..2df4341c0e4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_d_lines_3.f
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! { dg-options "-ffixed-form -fdec -fno-dec" }
+!
+! PR fortran/87919
+!
+! Ensure -fno-dec disables -fdec, leaving d-lines as code by default.
+!
+
+include 'dec_d_lines_2.f'
+
+! { dg-error "character in statement label" " " { target *-*-*} 6 }
+! { dg-error "Unclassifiable statement" " " { target *-*-*} 6 }
+! { dg-error "character in statement label" " " { target *-*-*} 7 }
+! { dg-error "Unclassifiable statement" " " { target *-*-*} 7 }
diff --git a/gcc/testsuite/gfortran.dg/dec_exp_4.f90 b/gcc/testsuite/gfortran.dg/dec_exp_4.f90
new file mode 100644
index 00000000000..9d8b10db6a7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_exp_4.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-fdec -fno-dec" }
+!
+! PR fortran/87919
+!
+! Make sure -fno-dec disables -fdec as with dec_exp_2.
+!
+
+include 'dec_exp_2.f90'
+
+! { dg-error "Missing exponent" "" { target *-*-* } 9 }
+! { dg-error "Missing exponent" "" { target *-*-* } 11 }
diff --git a/gcc/testsuite/gfortran.dg/dec_exp_5.f90 b/gcc/testsuite/gfortran.dg/dec_exp_5.f90
new file mode 100644
index 00000000000..faf3a9b306b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_exp_5.f90
@@ -0,0 +1,11 @@
+! { dg-do run "xfail *-*-*" }
+! { dg-options "-fdec -fno-dec" }
+!
+! PR fortran/87919
+!
+! Make sure -fno-dec disables -fdec as with dec_exp_3.
+!
+
+include 'dec_exp_3.f90'
+
+! { XFAIL "Bad real number" "" { target *-*-* } 13 }
diff --git a/gcc/testsuite/gfortran.dg/dec_io_7.f90 b/gcc/testsuite/gfortran.dg/dec_io_7.f90
new file mode 100644
index 00000000000..4a931c15fe7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_io_7.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! { dg-options "-fdec -fno-dec" }
+!
+! PR fortran/87919
+!
+! Make sure -fno-dec rejects -fdec I/O specifiers as with dec_io_1.
+!
+
+include 'dec_io_1.f90'
+
+! { dg-error "is a DEC extension" "" { target *-*-* } 12 }
+! { dg-error "is a DEC extension" "" { target *-*-* } 24 }
+! { dg-error "is a DEC extension" "" { target *-*-* } 58 }
+! { dg-error "is a DEC extension" "" { target *-*-* } 64 }
+! { dg-error "is a DEC extension" "" { target *-*-* } 68 }
+! { dg-error "is a DEC extension" "" { target *-*-* } 74 }
+! { dg-error "is a DEC extension" "" { target *-*-* } 78 }
+! { dg-error "is a DEC extension" "" { target *-*-* } 84 }
+! { dg-error "is a DEC extension" "" { target *-*-* } 90 }
+! { dg-error "is a DEC extension" "" { target *-*-* } 96 }
diff --git a/gcc/testsuite/gfortran.dg/dec_structure_24.f90 b/gcc/testsuite/gfortran.dg/dec_structure_24.f90
new file mode 100644
index 00000000000..02842b315dc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_structure_24.f90
@@ -0,0 +1,32 @@
+! { dg-do compile }
+!
+! PR fortran/87919
+!
+! Should fail to compile without the -fdec or -fdec-structure options.
+!
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
+
+include 'dec_structure_1.f90'
+
+! { dg-error "-fdec-structure" " " { target *-*-* } 14 }
+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 19 }
+! { dg-error "-fdec-structure" " " { target *-*-* } 21 }
+! { dg-error "-fdec-structure" " " { target *-*-* } 22 }
+! { dg-error "Unclassifiable statement" " " { target *-*-* } 25 }
+! { dg-error "Unclassifiable statement" " " { target *-*-* } 26 }
+! { dg-error "Unclassifiable statement" " " { target *-*-* } 27 }
+! { dg-error "Unclassifiable statement" " " { target *-*-* } 28 }
+! { dg-error "is not a variable" " " { target *-*-* } 30 }
+! { dg-error "Bad character" " " { target *-*-* } 32 }
+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 34 }
+! { dg-error "Bad character" " " { target *-*-* } 36 }
+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 38 }
+! { dg-error "Bad character" " " { target *-*-* } 40 }
+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 42 }
+! { dg-error "Bad character" " " { target *-*-* } 44 }
+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 46 }
+! { dg-error "Bad character" " " { target *-*-* } 48 }
+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 50 }
+! { dg-error "Bad character" " " { target *-*-* } 52 }
+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 54 }
+! { dg-error "function result" " " { target *-*-* } 29 }
diff --git a/gcc/testsuite/gfortran.dg/dec_structure_25.f90 b/gcc/testsuite/gfortran.dg/dec_structure_25.f90
new file mode 100644
index 00000000000..a64d85a88a4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_structure_25.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+! { dg-options "-fdec" }
+!
+! PR fortran/87919
+!
+! Should compile and run with the -fdec option.
+!
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+
+include 'dec_structure_1.f90'
diff --git a/gcc/testsuite/gfortran.dg/dec_structure_26.f90 b/gcc/testsuite/gfortran.dg/dec_structure_26.f90
new file mode 100644
index 00000000000..7829103b995
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_structure_26.f90
@@ -0,0 +1,34 @@
+! { dg-do compile }
+! { dg-options "-fdec -fno-dec-structure" }
+!
+! PR fortran/87919
+!
+! Should fail to compile with -fdec and -fno-dec-structure.
+!
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+
+include 'dec_structure_1.f90'
+
+! { dg-error "-fdec-structure" " " { target *-*-* } 14 }
+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 19 }
+! { dg-error "-fdec-structure" " " { target *-*-* } 21 }
+! { dg-error "-fdec-structure" " " { target *-*-* } 22 }
+! { dg-error "Unclassifiable statement" " " { target *-*-* } 25 }
+! { dg-error "Unclassifiable statement" " " { target *-*-* } 26 }
+! { dg-error "Unclassifiable statement" " " { target *-*-* } 27 }
+! { dg-error "Unclassifiable statement" " " { target *-*-* } 28 }
+! { dg-error "is not a variable" " " { target *-*-* } 30 }
+! { dg-error "Bad character" " " { target *-*-* } 32 }
+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 34 }
+! { dg-error "Bad character" " " { target *-*-* } 36 }
+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 38 }
+! { dg-error "Bad character" " " { target *-*-* } 40 }
+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 42 }
+! { dg-error "Bad character" " " { target *-*-* } 44 }
+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 46 }
+! { dg-error "Bad character" " " { target *-*-* } 48 }
+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 50 }
+! { dg-error "Bad character" " " { target *-*-* } 52 }
+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 54 }
+! { dg-error "function result" " " { target *-*-* } 29 }
diff --git a/gcc/testsuite/gfortran.dg/dec_structure_27.f90 b/gcc/testsuite/gfortran.dg/dec_structure_27.f90
new file mode 100644
index 00000000000..1257365deb8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_structure_27.f90
@@ -0,0 +1,34 @@
+! { dg-do compile }
+! { dg-options "-fdec-structure -fno-dec-structure" }
+!
+! PR fortran/87919
+!
+! Should fail to compile with -fdec-structure and -fno-dec-structure.
+!
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+
+include 'dec_structure_1.f90'
+
+! { dg-error "-fdec-structure" " " { target *-*-* } 14 }
+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 19 }
+! { dg-error "-fdec-structure" " " { target *-*-* } 21 }
+! { dg-error "-fdec-structure" " " { target *-*-* } 22 }
+! { dg-error "Unclassifiable statement" " " { target *-*-* } 25 }
+! { dg-error "Unclassifiable statement" " " { target *-*-* } 26 }
+! { dg-error "Unclassifiable statement" " " { target *-*-* } 27 }
+! { dg-error "Unclassifiable statement" " " { target *-*-* } 28 }
+! { dg-error "is not a variable" " " { target *-*-* } 30 }
+! { dg-error "Bad character" " " { target *-*-* } 32 }
+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 34 }
+! { dg-error "Bad character" " " { target *-*-* } 36 }
+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 38 }
+! { dg-error "Bad character" " " { target *-*-* } 40 }
+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 42 }
+! { dg-error "Bad character" " " { target *-*-* } 44 }
+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 46 }
+! { dg-error "Bad character" " " { target *-*-* } 48 }
+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 50 }
+! { dg-error "Bad character" " " { target *-*-* } 52 }
+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 54 }
+! { dg-error "function result" " " { target *-*-* } 29 }
diff --git a/gcc/testsuite/gfortran.dg/dec_type_print_3.f90 b/gcc/testsuite/gfortran.dg/dec_type_print_3.f90
new file mode 100644
index 00000000000..f766bdf0022
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_type_print_3.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-options "-fdec -fno-dec" }
+!
+! PR fortran/87919
+!
+! Ensure that -fno-dec disables the usage of TYPE as an alias for PRINT.
+!
+
+include 'dec_type_print.f90'
+
+! { dg-error "Invalid character in name" "" { target *-*-* } 52 }
+! { dg-error "Invalid character in name" "" { target *-*-* } 53 }
+! { dg-error "Invalid character in name" "" { target *-*-* } 54 }
+! { dg-error "Invalid character in name" "" { target *-*-* } 55 }
+! { dg-error "Invalid character in name" "" { target *-*-* } 56 }
+! { dg-error "Invalid character in name" "" { target *-*-* } 57 }
+! { dg-error "Invalid character in name" "" { target *-*-* } 58 }
+! { dg-error "Unclassifiable statement" "" { target *-*-* } 59 }
+! { dg-error "conflicts with PROCEDURE" "" { target *-*-* } 60 }
+! { dg-error "Cannot assign to a named constant" "" { target *-*-* } 80 }
+
diff --git a/gcc/testsuite/gfortran.dg/init_flag_20.f90 b/gcc/testsuite/gfortran.dg/init_flag_20.f90
new file mode 100644
index 00000000000..6f15c1ace0d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/init_flag_20.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! { dg-options "-fbackslash -finit-local-zero -fno-init-local-zero -fdump-tree-original" }
+!
+! PR fortran/87919
+!
+! Make sure -fno-init-local-zero disables -finit-local-zero.
+!
+
+include 'init_flag_1.f90'
+
+! Make sure no initialization code is generated.
+! { dg-final { scan-tree-dump-times "r\[1-4] *= *\[0\{]" 0 "original" } }
+! { dg-final { scan-tree-dump-times "l\[12] *= *\[0\{]" 0 "original" } }
+! { dg-final { scan-tree-dump-times "i\[1-4] *= *\[0\{]" 0 "original" } }
+! { dg-final { scan-tree-dump-times "memmove *\[(]\[^,]*c\[1-4]" 0 "original" } }

36
SOURCES/gcc8-fortranlines.patch
View File

@ -1,36 +0,0 @@
diff -Nrup a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c
--- a/gcc/fortran/scanner.c 2017-03-08 12:35:48.000000000 -0500
+++ b/gcc/fortran/scanner.c 2018-05-03 19:01:52.000000000 -0400
@@ -2097,6 +2097,10 @@ preprocessor_line (gfc_char_t *c)
in the linemap. Alternative could be using GC or updating linemap to
point to the new name, but there is no API for that currently. */
current_file->filename = xstrdup (filename);
+
+ /* We need to tell the linemap API that the filename changed. Just
+ changing current_file is insufficient. */
+ linemap_add (line_table, LC_RENAME, false, current_file->filename, line);
}
/* Set new line number. */
diff -Nrup a/gcc/testsuite/gfortran.dg/linefile.f90 b/gcc/testsuite/gfortran.dg/linefile.f90
--- a/gcc/testsuite/gfortran.dg/linefile.f90 1969-12-31 19:00:00.000000000 -0500
+++ b/gcc/testsuite/gfortran.dg/linefile.f90 2018-05-07 13:34:22.000000000 -0400
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! { dg-options "-Wall" }
+
+! This will verify that the # <line> <file> directive later does not
+! mess up the diagnostic on this line
+SUBROUTINE s(dummy) ! { dg-warning "Unused" }
+ INTEGER, INTENT(in) :: dummy
+END SUBROUTINE
+
+# 12345 "foo-f"
+SUBROUTINE s2(dummy)
+ INTEGER, INTENT(in) :: dummy
+END SUBROUTINE
+! We want to check that the # directive changes the filename in the
+! diagnostic. Nothing else really matters here. dg-regexp allows us
+! to see the entire diagnostic. We just have to make sure to consume
+! the entire message.
+! { dg-regexp "foo-f\[^\n]*" }

159
SOURCES/gcc9-add-sve-tests.patch Normal file
View File

@ -0,0 +1,159 @@
These tests are missing from the r273140 commit in gcc-9-branch.
--- /dev/null
+++ gcc/testsuite/gcc.target/aarch64/pcs_attribute-2.c
@@ -0,0 +1,93 @@
+/* { dg-do compile } */
+/* { dg-require-effective-target aarch64_variant_pcs } */
+
+/* Test that .variant_pcs is emitted for vector PCS symbol references. */
+
+#define ATTR __attribute__ ((aarch64_vector_pcs))
+
+void f_undef_basepcs (void);
+
+void f_def_basepcs (void)
+{
+}
+
+ATTR void f_undef_vpcs (void);
+
+ATTR void f_def_vpcs (void)
+{
+}
+
+__attribute__ ((alias ("f_def_vpcs")))
+ATTR void f_alias_vpcs (void);
+
+__attribute__ ((weak, alias ("f_def_vpcs")))
+ATTR void f_weak_alias_vpcs (void);
+
+__attribute__ ((weak))
+ATTR void f_weak_undef_vpcs (void);
+
+__attribute__ ((visibility ("protected")))
+ATTR void f_protected_vpcs (void)
+{
+}
+
+__attribute__ ((visibility ("hidden")))
+ATTR void f_hidden_vpcs (void)
+{
+}
+
+ATTR static void f_local_vpcs (void)
+{
+}
+
+__attribute__((weakref ("f_undef_vpcs")))
+ATTR static void f_local_weakref_undef_vpcs (void);
+
+__attribute__((weakref ("f_hidden_vpcs")))
+ATTR static void f_local_weakref_def_vpcs (void);
+
+ATTR void bar_undef_vpcs (void) __asm__ ("f_undef_renamed_vpcs");
+
+ATTR void bar_def_vpcs (void) __asm__ ("f_def_renamed_vpcs");
+ATTR void bar_def_vpcs (void)
+{
+}
+
+void (*refs_basepcs[]) (void) = {
+ f_undef_basepcs,
+ f_def_basepcs,
+};
+
+void (*ATTR refs_vpcs[]) (void) = {
+ f_undef_vpcs,
+ f_def_vpcs,
+ f_alias_vpcs,
+ f_weak_alias_vpcs,
+ f_weak_undef_vpcs,
+ f_protected_vpcs,
+ f_hidden_vpcs,
+ f_local_vpcs,
+ f_local_weakref_undef_vpcs,
+ f_local_weakref_def_vpcs,
+ bar_undef_vpcs,
+ bar_def_vpcs,
+};
+
+/* Note: local symbols don't need .variant_pcs, but gcc generates it, so
+ we check them here. An undefined weakref does not show up in the
+ symbol table, only the target symbol, so it does not need .variant_pcs. */
+
+/* { dg-final { scan-assembler-not {\.variant_pcs\tf_undef_basepcs} } } */
+/* { dg-final { scan-assembler-not {\.variant_pcs\tf_def_basepcs} } } */
+/* { dg-final { scan-assembler-times {\.variant_pcs\tf_undef_vpcs} 1 } } */
+/* { dg-final { scan-assembler-times {\.variant_pcs\tf_def_vpcs} 1 } } */
+/* { dg-final { scan-assembler-times {\.variant_pcs\tf_alias_vpcs} 1 } } */
+/* { dg-final { scan-assembler-times {\.variant_pcs\tf_weak_alias_vpcs} 1 } } */
+/* { dg-final { scan-assembler-times {\.variant_pcs\tf_weak_undef_vpcs} 1 } } */
+/* { dg-final { scan-assembler-times {\.variant_pcs\tf_protected_vpcs} 1 } } */
+/* { dg-final { scan-assembler-times {\.variant_pcs\tf_hidden_vpcs} 1 } } */
+/* { dg-final { scan-assembler-times {\.variant_pcs\tf_local_vpcs} 1 } } */
+/* { dg-final { scan-assembler-not {\.variant_pcs\tf_local_weakref_undef_vpcs} } } */
+/* { dg-final { scan-assembler-times {\.variant_pcs\tf_local_weakref_def_vpcs} 1 } } */
+/* { dg-final { scan-assembler-times {\.variant_pcs\tf_undef_renamed_vpcs} 1 } } */
+/* { dg-final { scan-assembler-times {\.variant_pcs\tf_def_renamed_vpcs} 1 } } */
--- /dev/null
+++ gcc/testsuite/gcc.target/aarch64/pcs_attribute-3.c
@@ -0,0 +1,58 @@
+/* { dg-do compile } */
+/* { dg-require-ifunc "" } */
+/* { dg-require-effective-target aarch64_variant_pcs } */
+
+/* Test that .variant_pcs is emitted for vector PCS symbol references. */
+
+#define ATTR __attribute__ ((aarch64_vector_pcs))
+
+static void f_local_basepcs (void)
+{
+}
+
+static void (*f_ifunc_basepcs_resolver ()) (void)
+{
+ return (void (*)(void))f_local_basepcs;
+}
+
+__attribute__ ((ifunc ("f_ifunc_basepcs_resolver")))
+void f_ifunc_basepcs (void);
+
+ATTR static void f_local_vpcs (void)
+{
+}
+
+static void (*f_ifunc_vpcs_resolver ()) (void)
+{
+ return (void (*)(void))f_local_vpcs;
+}
+
+__attribute__ ((ifunc ("f_ifunc_vpcs_resolver")))
+ATTR void f_ifunc_vpcs (void);
+
+__attribute__ ((visibility ("hidden")))
+__attribute__ ((ifunc ("f_ifunc_vpcs_resolver")))
+ATTR void f_hidden_ifunc_vpcs (void);
+
+__attribute__ ((ifunc ("f_ifunc_vpcs_resolver")))
+ATTR static void f_local_ifunc_vpcs (void);
+
+void (*refs_basepcs[]) (void) = {
+ f_ifunc_basepcs,
+};
+
+void (*ATTR refs_vpcs[]) (void) = {
+ f_ifunc_vpcs,
+ f_hidden_ifunc_vpcs,
+ f_local_ifunc_vpcs,
+};
+
+/* Note: local symbols don't need .variant_pcs, but gcc generates it, so
+ we check them here. */
+
+/* { dg-final { scan-assembler-not {\.variant_pcs\tf_local_basepcs} } } */
+/* { dg-final { scan-assembler-not {\.variant_pcs\tf_ifunc_basepcs} } } */
+/* { dg-final { scan-assembler-times {\.variant_pcs\tf_local_vpcs} 1 } } */
+/* { dg-final { scan-assembler-times {\.variant_pcs\tf_ifunc_vpcs} 1 } } */
+/* { dg-final { scan-assembler-times {\.variant_pcs\tf_hidden_ifunc_vpcs} 1 } } */
+/* { dg-final { scan-assembler-times {\.variant_pcs\tf_local_ifunc_vpcs} 1 } } */

481
SOURCES/gcc9-fixes.patch Normal file
View File

@ -0,0 +1,481 @@
2019-11-22 Jonathan Wakely <jwakely@redhat.com>
Backport from mainline
2019-10-29 Jonathan Wakely <jwakely@redhat.com>
PR libstdc++/92267
* include/bits/stl_deque.h (_Deque_iterator(const _Deque_iterator&)):
Do not define as defaulted.
* testsuite/23_containers/deque/types/92267.cc: New test.
2019-11-21 Jakub Jelinek <jakub@redhat.com>
PR tree-optimization/91355
* tree-ssa-sink.c (select_best_block): Use >= rather than >
for early_bb scaled count with best_bb count comparison.
2019-11-21 Richard Biener <rguenther@suse.de>
Revert
2019-09-17 Richard Biener <rguenther@suse.de>
PR tree-optimization/91790
* tree-vect-stmts.c (vectorizable_load): For BB vectorization
use the correct DR for setting up realignment.
2019-11-20 Peter Bergner <bergner@linux.ibm.com>
Backport from mainline
2019-11-07 Peter Bergner <bergner@linux.ibm.com>
PR other/92090
* config/rs6000/predicates.md (input_operand): Allow MODE_PARTIAL_INT
modes for integer constants.
2019-11-20 Michael Matz <matz@suse.de>
Backport from mainline
PR middle-end/90796
* gimple-loop-jam.c (any_access_function_variant_p): New function.
(adjust_unroll_factor): Use it to constrain safety, new parameter.
(tree_loop_unroll_and_jam): Adjust call and profitable unroll factor.
2019-11-20 Joseph Myers <joseph@codesourcery.com>
* doc/invoke.texi (-Wc11-c2x-compat): Document.
--- libstdc++-v3/include/bits/stl_deque.h (revision 278492)
+++ libstdc++-v3/include/bits/stl_deque.h (revision 278614)
@@ -158,13 +158,16 @@
#else
// Conversion from iterator to const_iterator.
template<typename _Iter,
- typename = _Require<is_same<_Self, const_iterator>,
- is_same<_Iter, iterator>>>
+ typename = _Require<is_same<_Self, const_iterator>,
+ is_same<_Iter, iterator>>>
_Deque_iterator(const _Iter& __x) noexcept
: _M_cur(__x._M_cur), _M_first(__x._M_first),
- _M_last(__x._M_last), _M_node(__x._M_node) { }
+ _M_last(__x._M_last), _M_node(__x._M_node) { }
- _Deque_iterator(const _Deque_iterator&) = default;
+ _Deque_iterator(const _Deque_iterator& __x) noexcept
+ : _M_cur(__x._M_cur), _M_first(__x._M_first),
+ _M_last(__x._M_last), _M_node(__x._M_node) { }
+
_Deque_iterator& operator=(const _Deque_iterator&) = default;
#endif
--- libstdc++-v3/testsuite/23_containers/deque/types/92267.cc (nonexistent)
+++ libstdc++-v3/testsuite/23_containers/deque/types/92267.cc (revision 278614)
@@ -0,0 +1,27 @@
+// Copyright (C) 2019 Free Software Foundation, Inc.
+//
+// This file is part of the GNU ISO C++ Library. This library is free
+// software; you can redistribute it and/or modify it under the
+// terms of the GNU General Public License as published by the
+// Free Software Foundation; either version 3, or (at your option)
+// any later version.
+
+// This library is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// GNU General Public License for more details.
+
+// You should have received a copy of the GNU General Public License along
+// with this library; see the file COPYING3. If not see
+// <http://www.gnu.org/licenses/>.
+
+// { dg-do compile { target c++11 } }
+
+#include <deque>
+
+using std::deque;
+using std::is_trivially_copy_constructible;
+
+// PR libstdc++/92267
+static_assert(!is_trivially_copy_constructible<deque<int>::iterator>::value);
+static_assert(!is_trivially_copy_constructible<deque<int>::const_iterator>::value);
--- gcc/doc/invoke.texi (revision 278492)
+++ gcc/doc/invoke.texi (revision 278614)
@@ -292,6 +292,7 @@
-Wbool-compare -Wbool-operation @gol
-Wno-builtin-declaration-mismatch @gol
-Wno-builtin-macro-redefined -Wc90-c99-compat -Wc99-c11-compat @gol
+-Wc11-c2x-compat @gol
-Wc++-compat -Wc++11-compat -Wc++14-compat -Wc++17-compat @gol
-Wcast-align -Wcast-align=strict -Wcast-function-type -Wcast-qual @gol
-Wchar-subscripts -Wcatch-value -Wcatch-value=@var{n} @gol
@@ -6698,6 +6699,14 @@
and so on. This option is independent of the standards mode. Warnings are
disabled in the expression that follows @code{__extension__}.
+@item -Wc11-c2x-compat @r{(C and Objective-C only)}
+@opindex Wc11-c2x-compat
+@opindex Wno-c11-c2x-compat
+Warn about features not present in ISO C11, but present in ISO C2X.
+For instance, warn about omitting the string in @code{_Static_assert}.
+This option is independent of the standards mode. Warnings are
+disabled in the expression that follows @code{__extension__}.
+
@item -Wc++-compat @r{(C and Objective-C only)}
@opindex Wc++-compat
@opindex Wno-c++-compat
--- gcc/testsuite/gcc.target/powerpc/pr92090-2.c (nonexistent)
+++ gcc/testsuite/gcc.target/powerpc/pr92090-2.c (revision 278614)
@@ -0,0 +1,45 @@
+/* { dg-do compile } */
+/* { dg-options "-mdejagnu-cpu=power8 -Os -w" } */
+/* { dg-additional-options "-mbig" { target powerpc64le-*-* } } */
+
+/* Verify that we don't ICE. */
+
+int a;
+static _Atomic long double b, c, d, m;
+double n;
+extern int foo (void);
+extern void bar (int, int, int, int);
+
+void
+bug (void)
+{
+ b = 1.79769313486231580793728971405301199e308L;
+ for (int i = 0; i < 10000; i++)
+ if (__builtin_isinf (n))
+ b;
+ c = 1;
+ int e, f, g, h;
+ while (a)
+ ;
+ for (int i; i; i++)
+ {
+ double j = c /= foo ();
+ if (__builtin_isinf (j))
+ {
+ if (foo == 1 << 31)
+ e++;
+ f++;
+ c = 0;
+ }
+ else
+ {
+ if (foo == 1 << 30)
+ g++;
+ h++;
+ c = 1;
+ }
+ }
+ bar (e, f, g, h);
+ d = 1.79769313486231580793728971405301199e308L;
+ m = 1;
+}
--- gcc/testsuite/gcc.target/powerpc/pr92090.c (nonexistent)
+++ gcc/testsuite/gcc.target/powerpc/pr92090.c (revision 278614)
@@ -0,0 +1,43 @@
+/* { dg-do compile } */
+/* { dg-options "-mdejagnu-cpu=power8 -Os" } */
+/* { dg-additional-options "-mbig" { target powerpc64le-*-* } } */
+
+/* Verify that we don't ICE. */
+
+_Atomic int a;
+_Atomic long double b, c;
+int j;
+void foo (void);
+void bar (int, int, int, int);
+
+void
+bug (void)
+{
+ b = 1;
+ int d, e, f, g;
+ while (a)
+ ;
+ for (int h = 0; h < 10000; h++)
+ {
+ double i = b /= 3;
+ foo ();
+ if (i)
+ {
+ if (i == 1)
+ d++;
+ e++;
+ b = 0;
+ }
+ else
+ {
+ if (i == 2)
+ f++;
+ g++;
+ b = 1;
+ }
+ }
+ bar (d, e, f, g);
+ c = 1;
+ for (int h; h; h++)
+ j = 0;
+}
--- gcc/testsuite/gcc.dg/unroll-and-jam.c (revision 278492)
+++ gcc/testsuite/gcc.dg/unroll-and-jam.c (revision 278614)
@@ -1,5 +1,5 @@
/* { dg-do run } */
-/* { dg-options "-O3 -floop-unroll-and-jam --param unroll-jam-min-percent=0 -fdump-tree-unrolljam-details" } */
+/* { dg-options "-O3 -floop-unroll-and-jam -fno-tree-loop-im --param unroll-jam-min-percent=0 -fdump-tree-unrolljam-details" } */
/* { dg-require-effective-target int32plus } */
#include <stdio.h>
@@ -34,7 +34,7 @@
#define TEST(name, body, test) \
static void __attribute__((noinline,noclone)) name (unsigned long n, unsigned long m) \
{ \
- unsigned long i, j; \
+ unsigned i, j; \
for (i = 1; i < m; i++) { \
for (j = 1; j < n; j++) { \
body; \
@@ -58,9 +58,14 @@
TEST(foo4, aa[i][j] = aa[i-1][j+1] * aa[i-1][j+1] / 2, checkaa()) //notok, -1,1
TEST(foo5, aa[i][j] = aa[i+1][j+1] * aa[i+1][j+1] / 2, checkaa()) //ok, 1,1
TEST(foo6, aa[i][j] = aa[i+1][j] * aa[i+1][j] / 2, checkaa()) //ok, -1,0
+TEST(foo61, aa[i][0] = aa[i+1][0] * aa[i+1][0] / 2, checkaa()) //notok, -1,0
+TEST(foo62, aa[i][j/2] = aa[i+1][j/2] * aa[i+1][j/2] / 2, checkaa()) //notok, not affine
+TEST(foo63, aa[i][j%2] = aa[i+1][j%2] * aa[i+1][j%2] / 2, checkaa()) //notok, not affine
TEST(foo7, aa[i+1][j] = aa[i][j] * aa[i][j] / 2, checkaa()) //ok, 1,0
TEST(foo9, b[j] = 3*b[j+1] + 1, checkb()) //notok, 0,-1
TEST(foo10, b[j] = 3*b[j] + 1, checkb()) //ok, 0,0
+extern int f;
+TEST(foo11, f = b[i-1] = 1 + 3* b[i+1], checkb()) //ok, 2,0 but must reduce unroll factor to 2, (it would be incorrect with unroll-by-3, which the profitability would suggest)
/* foo8 should work as well, but currently doesn't because the distance
vectors we compute are too pessimistic. We compute
@@ -68,6 +73,7 @@
and the last one causes us to lose. */
TEST(foo8, b[j+1] = 3*b[j] + 1, checkb()) //ok, 0,1
+int f;
unsigned int a[1024];
unsigned int b[1024];
unsigned int aa[16][1024];
@@ -88,10 +94,12 @@
printf(" %s\n", #name); \
init();for(i=0;i<4;i++)name##noopt(32,8); checka = checksum; \
init();for(i=0;i<4;i++)name(32,8); \
+ if (checka != checksum) fail = 1; \
printf("%sok %s\n", checka != checksum ? "NOT " : "", #name);
int main()
{
+ int fail = 0;
int i;
unsigned checka;
RUN(foo1);
@@ -100,12 +108,18 @@
RUN(foo4);
RUN(foo5);
RUN(foo6);
+ RUN(foo61);
+ RUN(foo62);
+ RUN(foo63);
RUN(foo7);
RUN(foo8);
RUN(foo9);
RUN(foo10);
- return 0;
+ RUN(foo11);
+ if (fail)
+ __builtin_abort();
+ return fail;
}
-/* Five loops should be unroll-jammed (actually six, but see above). */
-/* { dg-final { scan-tree-dump-times "applying unroll and jam" 5 "unrolljam" } } */
+/* Six loops should be unroll-jammed (actually seven, but see above). */
+/* { dg-final { scan-tree-dump-times "applying unroll and jam" 6 "unrolljam" } } */
--- gcc/testsuite/g++.dg/torture/pr91355.C (nonexistent)
+++ gcc/testsuite/g++.dg/torture/pr91355.C (revision 278614)
@@ -0,0 +1,28 @@
+// PR tree-optimization/91355
+// { dg-do run }
+// { dg-options "-std=c++14" }
+
+unsigned int d = 0;
+
+struct S {
+ S () { d++; }
+ S (const S &) { d++; }
+ ~S () { d--; }
+};
+
+void
+foo (int i) throw (int) // { dg-warning "dynamic exception specifications are deprecated" }
+{
+ if (i == 0)
+ throw 3;
+ S d;
+ throw 3;
+}
+
+int
+main ()
+{
+ try { foo (1); } catch (...) {}
+ if (d)
+ __builtin_abort ();
+}
--- gcc/tree-ssa-sink.c (revision 278492)
+++ gcc/tree-ssa-sink.c (revision 278614)
@@ -229,7 +229,7 @@
/* If result of comparsion is unknown, preffer EARLY_BB.
Thus use !(...>=..) rather than (...<...) */
&& !(best_bb->count.apply_scale (100, 1)
- > (early_bb->count.apply_scale (threshold, 1))))
+ >= early_bb->count.apply_scale (threshold, 1)))
return best_bb;
/* No better block found, so return EARLY_BB, which happens to be the
--- gcc/tree-vect-stmts.c (revision 278492)
+++ gcc/tree-vect-stmts.c (revision 278614)
@@ -8276,9 +8276,7 @@
|| alignment_support_scheme == dr_explicit_realign)
&& !compute_in_loop)
{
- msq = vect_setup_realignment (first_stmt_info_for_drptr
- ? first_stmt_info_for_drptr
- : first_stmt_info, gsi, &realignment_token,
+ msq = vect_setup_realignment (first_stmt_info, gsi, &realignment_token,
alignment_support_scheme, NULL_TREE,
&at_loop);
if (alignment_support_scheme == dr_explicit_realign_optimized)
--- gcc/gimple-loop-jam.c (revision 278492)
+++ gcc/gimple-loop-jam.c (revision 278614)
@@ -360,9 +360,26 @@
rewrite_into_loop_closed_ssa_1 (NULL, 0, SSA_OP_USE, loop);
}
+/* Return true if any of the access functions for dataref A
+ isn't invariant with respect to loop LOOP_NEST. */
+static bool
+any_access_function_variant_p (const struct data_reference *a,
+ const class loop *loop_nest)
+{
+ unsigned int i;
+ vec<tree> fns = DR_ACCESS_FNS (a);
+ tree t;
+
+ FOR_EACH_VEC_ELT (fns, i, t)
+ if (!evolution_function_is_invariant_p (t, loop_nest->num))
+ return true;
+
+ return false;
+}
+
/* Returns true if the distance in DDR can be determined and adjusts
the unroll factor in *UNROLL to make unrolling valid for that distance.
- Otherwise return false.
+ Otherwise return false. DDR is with respect to the outer loop of INNER.
If this data dep can lead to a removed memory reference, increment
*REMOVED and adjust *PROFIT_UNROLL to be the necessary unroll factor
@@ -369,7 +386,7 @@
for this to happen. */
static bool
-adjust_unroll_factor (struct data_dependence_relation *ddr,
+adjust_unroll_factor (class loop *inner, struct data_dependence_relation *ddr,
unsigned *unroll, unsigned *profit_unroll,
unsigned *removed)
{
@@ -392,9 +409,59 @@
gcc_unreachable ();
else if ((unsigned)dist >= *unroll)
;
- else if (lambda_vector_lexico_pos (dist_v + 1, DDR_NB_LOOPS (ddr) - 1)
- || (lambda_vector_zerop (dist_v + 1, DDR_NB_LOOPS (ddr) - 1)
- && dist > 0))
+ else if (lambda_vector_zerop (dist_v + 1, DDR_NB_LOOPS (ddr) - 1))
+ {
+ /* We have (a,0) with a < N, so this will be transformed into
+ (0,0) after unrolling by N. This might potentially be a
+ problem, if it's not a read-read dependency. */
+ if (DR_IS_READ (DDR_A (ddr)) && DR_IS_READ (DDR_B (ddr)))
+ ;
+ else
+ {
+ /* So, at least one is a write, and we might reduce the
+ distance vector to (0,0). This is still no problem
+ if both data-refs are affine with respect to the inner
+ loops. But if one of them is invariant with respect
+ to an inner loop our reordering implicit in loop fusion
+ corrupts the program, as our data dependences don't
+ capture this. E.g. for:
+ for (0 <= i < n)
+ for (0 <= j < m)
+ a[i][0] = a[i+1][0] + 2; // (1)
+ b[i][j] = b[i+1][j] + 2; // (2)
+ the distance vector for both statements is (-1,0),
+ but exchanging the order for (2) is okay, while
+ for (1) it is not. To see this, write out the original
+ accesses (assume m is 2):
+ a i j original
+ 0 0 0 r a[1][0] b[1][0]
+ 1 0 0 w a[0][0] b[0][0]
+ 2 0 1 r a[1][0] b[1][1]
+ 3 0 1 w a[0][0] b[0][1]
+ 4 1 0 r a[2][0] b[2][0]
+ 5 1 0 w a[1][0] b[1][0]
+ after unroll-by-2 and fusion the accesses are done in
+ this order (from column a): 0,1, 4,5, 2,3, i.e. this:
+ a i j transformed
+ 0 0 0 r a[1][0] b[1][0]
+ 1 0 0 w a[0][0] b[0][0]
+ 4 1 0 r a[2][0] b[2][0]
+ 5 1 0 w a[1][0] b[1][0]
+ 2 0 1 r a[1][0] b[1][1]
+ 3 0 1 w a[0][0] b[0][1]
+ Note how access 2 accesses the same element as access 5
+ for array 'a' but not for array 'b'. */
+ if (any_access_function_variant_p (DDR_A (ddr), inner)
+ && any_access_function_variant_p (DDR_B (ddr), inner))
+ ;
+ else
+ /* And if any dataref of this pair is invariant with
+ respect to the inner loop, we have no chance than
+ to reduce the unroll factor. */
+ *unroll = dist;
+ }
+ }
+ else if (lambda_vector_lexico_pos (dist_v + 1, DDR_NB_LOOPS (ddr) - 1))
;
else
*unroll = dist;
@@ -486,7 +553,7 @@
/* Now check the distance vector, for determining a sensible
outer unroll factor, and for validity of merging the inner
loop copies. */
- if (!adjust_unroll_factor (ddr, &unroll_factor, &profit_unroll,
+ if (!adjust_unroll_factor (loop, ddr, &unroll_factor, &profit_unroll,
&removed))
{
/* Couldn't get the distance vector. For two reads that's
@@ -506,7 +573,7 @@
to ignore all profitability concerns and apply the transformation
always. */
if (!PARAM_VALUE (PARAM_UNROLL_JAM_MIN_PERCENT))
- profit_unroll = 2;
+ profit_unroll = MAX(2, profit_unroll);
else if (removed * 100 / datarefs.length ()
< (unsigned)PARAM_VALUE (PARAM_UNROLL_JAM_MIN_PERCENT))
profit_unroll = 1;
--- gcc/config/rs6000/predicates.md (revision 278492)
+++ gcc/config/rs6000/predicates.md (revision 278614)
@@ -1053,8 +1053,7 @@
return 1;
/* Allow any integer constant. */
- if (GET_MODE_CLASS (mode) == MODE_INT
- && CONST_SCALAR_INT_P (op))
+ if (SCALAR_INT_MODE_P (mode) && CONST_SCALAR_INT_P (op))
return 1;
/* Allow easy vector constants. */

14
SOURCES/gcc9-libstdc++-compat.patch
View File

@ -9692,7 +9692,7 @@
} // namespace
--- libstdc++-v3/src/nonshared17/cow-fs_ops.cc.jj 2019-05-13 10:33:09.443939688 +0200
+++ libstdc++-v3/src/nonshared17/cow-fs_ops.cc 2019-05-14 19:54:55.667219247 +0200
@@ -0,0 +1,41 @@
@@ -0,0 +1,40 @@
+// Copyright (C) 2019 Free Software Foundation, Inc.
+//
+// This file is part of the GNU ISO C++ Library. This library is free
@ -9728,7 +9728,6 @@
+asm (".hidden _ZNSt5dequeINSt10filesystem4pathESaIS1_EED2Ev");
+#ifdef __x86_64__
+asm (".hidden _ZNSt11_Deque_baseINSt10filesystem4pathESaIS1_EE17_M_initialize_mapEm");
+asm (".hidden _ZSt13move_backwardINSt10filesystem4pathEESt15_Deque_iteratorIT_RS3_PS3_ES2_IS3_RKS3_PS7_ESA_S6_");
+asm (".hidden _ZNSt5dequeINSt10filesystem4pathESaIS1_EE13_M_insert_auxINS1_8iteratorEEEvSt15_Deque_iteratorIS1_RS1_PS1_ET_SA_m");
+asm (".hidden _ZNSt5dequeINSt10filesystem4pathESaIS1_EE17_M_reallocate_mapEmb");
+asm (".hidden _ZNSt5dequeINSt10filesystem4pathESaIS1_EE23_M_new_elements_at_backEm");
@ -11128,7 +11127,7 @@
+.NOEXPORT:
--- libstdc++-v3/src/nonshared17/fs_ops.cc.jj 2019-05-13 10:33:09.456939472 +0200
+++ libstdc++-v3/src/nonshared17/fs_ops.cc 2019-05-14 20:00:02.088105705 +0200
@@ -0,0 +1,53 @@
@@ -0,0 +1,52 @@
+// Copyright (C) 2019 Free Software Foundation, Inc.
+//
+// This file is part of the GNU ISO C++ Library. This library is free
@ -11180,7 +11179,6 @@
+asm (".hidden _ZNSt5dequeINSt10filesystem7__cxx114pathESaIS2_EE13_M_insert_auxINS2_8iteratorEEEvSt15_Deque_iteratorIS2_RS2_PS2_ET_SB_m");
+asm (".hidden _ZNSt5dequeINSt10filesystem7__cxx114pathESaIS2_EE23_M_new_elements_at_backEm");
+asm (".hidden _ZNSt5dequeINSt10filesystem7__cxx114pathESaIS2_EE24_M_new_elements_at_frontEm");
+asm (".hidden _ZSt13move_backwardINSt10filesystem7__cxx114pathEESt15_Deque_iteratorIT_RS4_PS4_ES3_IS4_RKS4_PS8_ESB_S7_");
+#endif
--- libstdc++-v3/src/nonshared17/ostream-inst.cc.jj 2019-05-13 10:33:09.466939305 +0200
+++ libstdc++-v3/src/nonshared17/ostream-inst.cc 2019-05-14 18:43:03.283254489 +0200
@ -11878,17 +11876,17 @@
}
void
@@ -127,6 +129,7 @@ namespace std _GLIBCXX_VISIBILITY(defaul
_M_mt.seed(_M_strtoul(token));
@@ -147,6 +149,7 @@
#endif
}
+#ifndef _GLIBCXX_NONSHARED_CXX11_48
void
random_device::_M_fini()
{
@@ -172,6 +175,7 @@ namespace std _GLIBCXX_VISIBILITY(defaul
{
@@ -196,6 +199,7 @@
return _M_mt();
#endif
}
+#endif

39
SOURCES/gcc9-pr90303.patch
View File

@ -1,39 +0,0 @@
2019-05-03 Jakub Jelinek <jakub@redhat.com>
PR tree-optimization/90303
* ipa-devirt.c (obj_type_ref_class, get_odr_type): Don't use
TYPE_CANONICAL for TYPE_STRUCTURAL_EQUALITY_P types in !in_lto_p mode.
* g++.target/i386/pr90303.C: New test.
--- gcc/ipa-devirt.c (revision 270834)
+++ gcc/ipa-devirt.c (revision 270835)
@@ -2020,7 +2020,7 @@ obj_type_ref_class (const_tree ref)
ref = TREE_VALUE (TYPE_ARG_TYPES (ref));
gcc_checking_assert (TREE_CODE (ref) == POINTER_TYPE);
tree ret = TREE_TYPE (ref);
- if (!in_lto_p)
+ if (!in_lto_p && !TYPE_STRUCTURAL_EQUALITY_P (ret))
ret = TYPE_CANONICAL (ret);
else
ret = get_odr_type (ret)->type;
@@ -2042,7 +2042,7 @@ get_odr_type (tree type, bool insert)
int base_id = -1;
type = TYPE_MAIN_VARIANT (type);
- if (!in_lto_p)
+ if (!in_lto_p && !TYPE_STRUCTURAL_EQUALITY_P (type))
type = TYPE_CANONICAL (type);
gcc_checking_assert (can_be_name_hashed_p (type)
--- gcc/testsuite/g++.target/i386/pr90303.C (nonexistent)
+++ gcc/testsuite/g++.target/i386/pr90303.C (revision 270835)
@@ -0,0 +1,8 @@
+// PR tree-optimization/90303
+// { dg-do compile { target ia32 } }
+// { dg-additional-options "-O2" }
+
+struct A { virtual void foo (); };
+template <class> class B : A {};
+typedef void (__attribute__((fastcall)) F) ();
+B<F> e;

11
SOURCES/nvptx-tools-build.patch Normal file
View File

@ -0,0 +1,11 @@
--- nvptx-tools/nvptx-as.c.jj 2017-01-20 12:40:18.000000000 +0100
+++ nvptx-tools/nvptx-as.c 2017-01-20 12:43:53.864271442 +0100
@@ -939,7 +939,7 @@ fork_execute (const char *prog, char *co
fatal_error ("%s: %m", errmsg);
}
else
- fatal_error (errmsg);
+ fatal_error ("%s", errmsg);
}
do_wait (prog, pex);
}

32
SOURCES/nvptx-tools-glibc.patch Normal file
View File

@ -0,0 +1,32 @@
--- nvptx-tools/configure.ac.jj 2017-01-13 12:48:31.000000000 +0100
+++ nvptx-tools/configure.ac 2017-05-03 10:26:57.076092259 +0200
@@ -66,6 +66,8 @@ CPPFLAGS=$save_CPPFLAGS
LDFLAGS=$save_LDFLAGS
LIBS=$save_LIBS
+AC_CHECK_DECLS(getopt)
+
AC_CONFIG_SUBDIRS([libiberty])
AC_CONFIG_FILES([Makefile dejagnu.exp])
AC_OUTPUT
--- nvptx-tools/configure.jj 2017-01-13 12:48:54.000000000 +0100
+++ nvptx-tools/configure 2017-05-03 10:27:13.503876809 +0200
@@ -3963,6 +3963,18 @@ CPPFLAGS=$save_CPPFLAGS
LDFLAGS=$save_LDFLAGS
LIBS=$save_LIBS
+ac_fn_c_check_decl "$LINENO" "getopt" "ac_cv_have_decl_getopt" "$ac_includes_default"
+if test "x$ac_cv_have_decl_getopt" = x""yes; then :
+ ac_have_decl=1
+else
+ ac_have_decl=0
+fi
+
+cat >>confdefs.h <<_ACEOF
+#define HAVE_DECL_GETOPT $ac_have_decl
+_ACEOF
+
+
subdirs="$subdirs libiberty"

947
SOURCES/nvptx-tools-no-ptxas.patch Normal file
View File

@ -0,0 +1,947 @@
--- nvptx-tools/configure.ac
+++ nvptx-tools/configure.ac
@@ -51,6 +51,7 @@ LIBS="$LIBS -lcuda"
AC_CHECK_FUNCS([[cuGetErrorName] [cuGetErrorString]])
AC_CHECK_DECLS([[cuGetErrorName], [cuGetErrorString]],
[], [], [[#include <cuda.h>]])
+AC_CHECK_HEADERS(unistd.h sys/stat.h)
AC_MSG_CHECKING([for extra programs to build requiring -lcuda])
NVPTX_RUN=
--- nvptx-tools/include/libiberty.h
+++ nvptx-tools/include/libiberty.h
@@ -390,6 +390,17 @@ extern void hex_init (void);
/* Save files used for communication between processes. */
#define PEX_SAVE_TEMPS 0x4
+/* Max number of alloca bytes per call before we must switch to malloc.
+
+ ?? Swiped from gnulib's regex_internal.h header. Is this actually
+ the case? This number seems arbitrary, though sane.
+
+ The OS usually guarantees only one guard page at the bottom of the stack,
+ and a page size can be as small as 4096 bytes. So we cannot safely
+ allocate anything larger than 4096 bytes. Also care for the possibility
+ of a few compiler-allocated temporary stack slots. */
+#define MAX_ALLOCA_SIZE 4032
+
/* Prepare to execute one or more programs, with standard output of
each program fed to standard input of the next.
FLAGS As above.
--- nvptx-tools/nvptx-as.c
+++ nvptx-tools/nvptx-as.c
@@ -30,6 +30,9 @@
#include <string.h>
#include <wait.h>
#include <unistd.h>
+#ifdef HAVE_SYS_STAT_H
+#include <sys/stat.h>
+#endif
#include <errno.h>
#define obstack_chunk_alloc malloc
#define obstack_chunk_free free
@@ -42,6 +45,38 @@
#include "version.h"
+#ifndef R_OK
+#define R_OK 4
+#define W_OK 2
+#define X_OK 1
+#endif
+
+#ifndef DIR_SEPARATOR
+# define DIR_SEPARATOR '/'
+#endif
+
+#if defined (_WIN32) || defined (__MSDOS__) \
+ || defined (__DJGPP__) || defined (__OS2__)
+# define HAVE_DOS_BASED_FILE_SYSTEM
+# define HAVE_HOST_EXECUTABLE_SUFFIX
+# define HOST_EXECUTABLE_SUFFIX ".exe"
+# ifndef DIR_SEPARATOR_2
+# define DIR_SEPARATOR_2 '\\'
+# endif
+# define PATH_SEPARATOR ';'
+#else
+# define PATH_SEPARATOR ':'
+#endif
+
+#ifndef DIR_SEPARATOR_2
+# define IS_DIR_SEPARATOR(ch) ((ch) == DIR_SEPARATOR)
+#else
+# define IS_DIR_SEPARATOR(ch) \
+ (((ch) == DIR_SEPARATOR) || ((ch) == DIR_SEPARATOR_2))
+#endif
+
+#define DIR_UP ".."
+
static const char *outname = NULL;
static void __attribute__ ((format (printf, 1, 2)))
@@ -816,7 +851,7 @@ traverse (void **slot, void *data)
}
static void
-process (FILE *in, FILE *out)
+process (FILE *in, FILE *out, int verify, const char *outname)
{
symbol_table = htab_create (500, hash_string_hash, hash_string_eq,
NULL);
@@ -824,6 +859,18 @@ process (FILE *in, FILE *out)
const char *input = read_file (in);
Token *tok = tokenize (input);
+ /* By default, when ptxas is not in PATH, do minimalistic verification,
+ just require that the first non-comment directive is .version. */
+ if (verify < 0)
+ {
+ size_t i;
+ for (i = 0; tok[i].kind == K_comment; i++)
+ ;
+ if (tok[i].kind != K_dotted || !is_keyword (&tok[i], "version"))
+ fatal_error ("missing .version directive at start of file '%s'",
+ outname);
+ }
+
do
tok = parse_file (tok);
while (tok->kind);
@@ -897,9 +944,83 @@ fork_execute (const char *prog, char *const *argv)
do_wait (prog, pex);
}
+/* Determine if progname is available in PATH. */
+static bool
+program_available (const char *progname)
+{
+ char *temp = getenv ("PATH");
+ if (temp)
+ {
+ char *startp, *endp, *nstore, *alloc_ptr = NULL;
+ size_t prefixlen = strlen (temp) + 1;
+ size_t len;
+ if (prefixlen < 2)
+ prefixlen = 2;
+
+ len = prefixlen + strlen (progname) + 1;
+#ifdef HAVE_HOST_EXECUTABLE_SUFFIX
+ len += strlen (HOST_EXECUTABLE_SUFFIX);
+#endif
+ if (len < MAX_ALLOCA_SIZE)
+ nstore = (char *) alloca (len);
+ else
+ alloc_ptr = nstore = (char *) malloc (len);
+
+ startp = endp = temp;
+ while (1)
+ {
+ if (*endp == PATH_SEPARATOR || *endp == 0)
+ {
+ if (endp == startp)
+ {
+ nstore[0] = '.';
+ nstore[1] = DIR_SEPARATOR;
+ nstore[2] = '\0';
+ }
+ else
+ {
+ memcpy (nstore, startp, endp - startp);
+ if (! IS_DIR_SEPARATOR (endp[-1]))
+ {
+ nstore[endp - startp] = DIR_SEPARATOR;
+ nstore[endp - startp + 1] = 0;
+ }
+ else
+ nstore[endp - startp] = 0;
+ }
+ strcat (nstore, progname);
+ if (! access (nstore, X_OK)
+#ifdef HAVE_HOST_EXECUTABLE_SUFFIX
+ || ! access (strcat (nstore, HOST_EXECUTABLE_SUFFIX), X_OK)
+#endif
+ )
+ {
+#if defined (HAVE_SYS_STAT_H) && defined (S_ISREG)
+ struct stat st;
+ if (stat (nstore, &st) >= 0 && S_ISREG (st.st_mode))
+#endif
+ {
+ free (alloc_ptr);
+ return true;
+ }
+ }
+
+ if (*endp == 0)
+ break;
+ endp = startp = endp + 1;
+ }
+ else
+ endp++;
+ }
+ free (alloc_ptr);
+ }
+ return false;
+}
+
static struct option long_options[] = {
{"traditional-format", no_argument, 0, 0 },
{"save-temps", no_argument, 0, 0 },
+ {"verify", no_argument, 0, 0 },
{"no-verify", no_argument, 0, 0 },
{"help", no_argument, 0, 'h' },
{"version", no_argument, 0, 'V' },
@@ -912,7 +1033,7 @@ main (int argc, char **argv)
FILE *in = stdin;
FILE *out = stdout;
bool verbose __attribute__((unused)) = false;
- bool verify = true;
+ int verify = -1;
const char *smver = "sm_30";
int o;
@@ -923,7 +1044,9 @@ main (int argc, char **argv)
{
case 0:
if (option_index == 2)
- verify = false;
+ verify = 1;
+ else if (option_index == 3)
+ verify = 0;
break;
case 'v':
verbose = true;
@@ -948,7 +1071,8 @@ Usage: nvptx-none-as [option...] [asmfile]\n\
Options:\n\
-o FILE Write output to FILE\n\
-v Be verbose\n\
+ --verify Do verify output is acceptable to ptxas\n\
--no-verify Do not verify output is acceptable to ptxas\n\
--help Print this help and exit\n\
--version Print version number and exit\n\
\n\
@@ -983,11 +1108,17 @@ This program has absolutely no warranty.\n",
if (!in)
fatal_error ("cannot open input ptx file");
- process (in, out);
- if (outname)
+ if (outname == NULL)
+ verify = 0;
+ else if (verify == -1)
+ if (program_available ("ptxas"))
+ verify = 1;
+
+ process (in, out, verify, outname);
+ if (outname)
fclose (out);
- if (verify && outname)
+ if (verify > 0)
{
struct obstack argv_obstack;
obstack_init (&argv_obstack);
--- nvptx-tools/configure
+++ nvptx-tools/configure
@@ -168,7 +168,8 @@ test x\$exitcode = x0 || exit 1"
as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO
as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO
eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" &&
- test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1"
+ test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1
+test \$(( 1 + 1 )) = 2 || exit 1"
if (eval "$as_required") 2>/dev/null; then :
as_have_required=yes
else
@@ -552,11 +553,50 @@ PACKAGE_URL=
ac_unique_file="nvptx-tools"
ac_unique_file="nvptx-as.c"
+# Factoring default headers for most tests.
+ac_includes_default="\
+#include <stdio.h>
+#ifdef HAVE_SYS_TYPES_H
+# include <sys/types.h>
+#endif
+#ifdef HAVE_SYS_STAT_H
+# include <sys/stat.h>
+#endif
+#ifdef STDC_HEADERS
+# include <stdlib.h>
+# include <stddef.h>
+#else
+# ifdef HAVE_STDLIB_H
+# include <stdlib.h>
+# endif
+#endif
+#ifdef HAVE_STRING_H
+# if !defined STDC_HEADERS && defined HAVE_MEMORY_H
+# include <memory.h>
+# endif
+# include <string.h>
+#endif
+#ifdef HAVE_STRINGS_H
+# include <strings.h>
+#endif
+#ifdef HAVE_INTTYPES_H
+# include <inttypes.h>
+#endif
+#ifdef HAVE_STDINT_H
+# include <stdint.h>
+#endif
+#ifdef HAVE_UNISTD_H
+# include <unistd.h>
+#endif"
+
enable_option_checking=no
ac_subst_vars='LTLIBOBJS
LIBOBJS
subdirs
NVPTX_RUN
+EGREP
+GREP
+CPP
CUDA_DRIVER_LDFLAGS
CUDA_DRIVER_CPPFLAGS
AR
@@ -635,7 +675,8 @@ LIBS
CPPFLAGS
CXX
CXXFLAGS
-CCC'
+CCC
+CPP'
ac_subdirs_all='libiberty'
# Initialize some variables set by options.
@@ -1267,6 +1308,7 @@ Some influential environment variables:
you have headers in a nonstandard directory <include dir>
CXX C++ compiler command
CXXFLAGS C++ compiler flags
+ CPP C preprocessor
Use these variables to override the choices made by `configure' or to help
it to find libraries and programs with nonstandard names/locations.
@@ -1575,6 +1617,203 @@ $as_echo "$ac_res" >&6; }
eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}
} # ac_fn_c_check_decl
+
+# ac_fn_c_try_cpp LINENO
+# ----------------------
+# Try to preprocess conftest.$ac_ext, and return whether this succeeded.
+ac_fn_c_try_cpp ()
+{
+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ if { { ac_try="$ac_cpp conftest.$ac_ext"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+ (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err
+ ac_status=$?
+ if test -s conftest.err; then
+ grep -v '^ *+' conftest.err >conftest.er1
+ cat conftest.er1 >&5
+ mv -f conftest.er1 conftest.err
+ fi
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; } >/dev/null && {
+ test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" ||
+ test ! -s conftest.err
+ }; then :
+ ac_retval=0
+else
+ $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ ac_retval=1
+fi
+ eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}
+ return $ac_retval
+
+} # ac_fn_c_try_cpp
+
+# ac_fn_c_check_header_mongrel LINENO HEADER VAR INCLUDES
+# -------------------------------------------------------
+# Tests whether HEADER exists, giving a warning if it cannot be compiled using
+# the include files in INCLUDES and setting the cache variable VAR
+# accordingly.
+ac_fn_c_check_header_mongrel ()
+{
+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then :
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
+$as_echo_n "checking for $2... " >&6; }
+if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then :
+ $as_echo_n "(cached) " >&6
+fi
+eval ac_res=\$$3
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+else
+ # Is the header compilable?
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 usability" >&5
+$as_echo_n "checking $2 usability... " >&6; }
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$4
+#include <$2>
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ ac_header_compiler=yes
+else
+ ac_header_compiler=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_compiler" >&5
+$as_echo "$ac_header_compiler" >&6; }
+
+# Is the header present?
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 presence" >&5
+$as_echo_n "checking $2 presence... " >&6; }
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <$2>
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+ ac_header_preproc=yes
+else
+ ac_header_preproc=no
+fi
+rm -f conftest.err conftest.$ac_ext
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_preproc" >&5
+$as_echo "$ac_header_preproc" >&6; }
+
+# So? What about this header?
+case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in #((
+ yes:no: )
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&5
+$as_echo "$as_me: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5
+$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;}
+ ;;
+ no:yes:* )
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: present but cannot be compiled" >&5
+$as_echo "$as_me: WARNING: $2: present but cannot be compiled" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: check for missing prerequisite headers?" >&5
+$as_echo "$as_me: WARNING: $2: check for missing prerequisite headers?" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: see the Autoconf documentation" >&5
+$as_echo "$as_me: WARNING: $2: see the Autoconf documentation" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&5
+$as_echo "$as_me: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5
+$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;}
+ ;;
+esac
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
+$as_echo_n "checking for $2... " >&6; }
+if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then :
+ $as_echo_n "(cached) " >&6
+else
+ eval "$3=\$ac_header_compiler"
+fi
+eval ac_res=\$$3
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+fi
+ eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}
+
+} # ac_fn_c_check_header_mongrel
+
+# ac_fn_c_try_run LINENO
+# ----------------------
+# Try to link conftest.$ac_ext, and return whether this succeeded. Assumes
+# that executables *can* be run.
+ac_fn_c_try_run ()
+{
+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ if { { ac_try="$ac_link"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+ (eval "$ac_link") 2>&5
+ ac_status=$?
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; } && { ac_try='./conftest$ac_exeext'
+ { { case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+ (eval "$ac_try") 2>&5
+ ac_status=$?
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; }; }; then :
+ ac_retval=0
+else
+ $as_echo "$as_me: program exited with status $ac_status" >&5
+ $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ ac_retval=$ac_status
+fi
+ rm -rf conftest.dSYM conftest_ipa8_conftest.oo
+ eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}
+ return $ac_retval
+
+} # ac_fn_c_try_run
+
+# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES
+# -------------------------------------------------------
+# Tests whether HEADER exists and can be compiled using the include files in
+# INCLUDES, setting the cache variable VAR accordingly.
+ac_fn_c_check_header_compile ()
+{
+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
+$as_echo_n "checking for $2... " >&6; }
+if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$4
+#include <$2>
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ eval "$3=yes"
+else
+ eval "$3=no"
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+eval ac_res=\$$3
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+ eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}
+
+} # ac_fn_c_check_header_compile
cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
@@ -3284,6 +3523,418 @@ cat >>confdefs.h <<_ACEOF
#define HAVE_DECL_CUGETERRORSTRING $ac_have_decl
_ACEOF
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5
+$as_echo_n "checking how to run the C preprocessor... " >&6; }
+# On Suns, sometimes $CPP names a directory.
+if test -n "$CPP" && test -d "$CPP"; then
+ CPP=
+fi
+if test -z "$CPP"; then
+ if test "${ac_cv_prog_CPP+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ # Double quotes because CPP needs to be expanded
+ for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp"
+ do
+ ac_preproc_ok=false
+for ac_c_preproc_warn_flag in '' yes
+do
+ # Use a header file that comes with gcc, so configuring glibc
+ # with a fresh cross-compiler works.
+ # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+ # <limits.h> exists even on freestanding compilers.
+ # On the NeXT, cc -E runs the code through the compiler's parser,
+ # not just through cpp. "Syntax error" is here to catch this case.
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+ Syntax error
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+
+else
+ # Broken: fails on valid input.
+continue
+fi
+rm -f conftest.err conftest.$ac_ext
+
+ # OK, works on sane cases. Now check whether nonexistent headers
+ # can be detected and how.
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <ac_nonexistent.h>
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+ # Broken: success on invalid input.
+continue
+else
+ # Passes both tests.
+ac_preproc_ok=:
+break
+fi
+rm -f conftest.err conftest.$ac_ext
+
+done
+# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
+rm -f conftest.err conftest.$ac_ext
+if $ac_preproc_ok; then :
+ break
+fi
+
+ done
+ ac_cv_prog_CPP=$CPP
+
+fi
+ CPP=$ac_cv_prog_CPP
+else
+ ac_cv_prog_CPP=$CPP
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5
+$as_echo "$CPP" >&6; }
+ac_preproc_ok=false
+for ac_c_preproc_warn_flag in '' yes
+do
+ # Use a header file that comes with gcc, so configuring glibc
+ # with a fresh cross-compiler works.
+ # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+ # <limits.h> exists even on freestanding compilers.
+ # On the NeXT, cc -E runs the code through the compiler's parser,
+ # not just through cpp. "Syntax error" is here to catch this case.
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+ Syntax error
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+
+else
+ # Broken: fails on valid input.
+continue
+fi
+rm -f conftest.err conftest.$ac_ext
+
+ # OK, works on sane cases. Now check whether nonexistent headers
+ # can be detected and how.
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <ac_nonexistent.h>
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+ # Broken: success on invalid input.
+continue
+else
+ # Passes both tests.
+ac_preproc_ok=:
+break
+fi
+rm -f conftest.err conftest.$ac_ext
+
+done
+# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
+rm -f conftest.err conftest.$ac_ext
+if $ac_preproc_ok; then :
+
+else
+ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error "C preprocessor \"$CPP\" fails sanity check
+See \`config.log' for more details." "$LINENO" 5; }
+fi
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5
+$as_echo_n "checking for grep that handles long lines and -e... " >&6; }
+if test "${ac_cv_path_GREP+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ if test -z "$GREP"; then
+ ac_path_GREP_found=false
+ # Loop through the user's path and test for each of PROGNAME-LIST
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_prog in grep ggrep; do
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext"
+ { test -f "$ac_path_GREP" && $as_test_x "$ac_path_GREP"; } || continue
+# Check for GNU ac_path_GREP and select it if it is found.
+ # Check for GNU $ac_path_GREP
+case `"$ac_path_GREP" --version 2>&1` in
+*GNU*)
+ ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;;
+*)
+ ac_count=0
+ $as_echo_n 0123456789 >"conftest.in"
+ while :
+ do
+ cat "conftest.in" "conftest.in" >"conftest.tmp"
+ mv "conftest.tmp" "conftest.in"
+ cp "conftest.in" "conftest.nl"
+ $as_echo 'GREP' >> "conftest.nl"
+ "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break
+ diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break
+ as_fn_arith $ac_count + 1 && ac_count=$as_val
+ if test $ac_count -gt ${ac_path_GREP_max-0}; then
+ # Best one so far, save it but keep looking for a better one
+ ac_cv_path_GREP="$ac_path_GREP"
+ ac_path_GREP_max=$ac_count
+ fi
+ # 10*(2^10) chars as input seems more than enough
+ test $ac_count -gt 10 && break
+ done
+ rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
+esac
+
+ $ac_path_GREP_found && break 3
+ done
+ done
+ done
+IFS=$as_save_IFS
+ if test -z "$ac_cv_path_GREP"; then
+ as_fn_error "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5
+ fi
+else
+ ac_cv_path_GREP=$GREP
+fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5
+$as_echo "$ac_cv_path_GREP" >&6; }
+ GREP="$ac_cv_path_GREP"
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5
+$as_echo_n "checking for egrep... " >&6; }
+if test "${ac_cv_path_EGREP+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ if echo a | $GREP -E '(a|b)' >/dev/null 2>&1
+ then ac_cv_path_EGREP="$GREP -E"
+ else
+ if test -z "$EGREP"; then
+ ac_path_EGREP_found=false
+ # Loop through the user's path and test for each of PROGNAME-LIST
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_prog in egrep; do
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext"
+ { test -f "$ac_path_EGREP" && $as_test_x "$ac_path_EGREP"; } || continue
+# Check for GNU ac_path_EGREP and select it if it is found.
+ # Check for GNU $ac_path_EGREP
+case `"$ac_path_EGREP" --version 2>&1` in
+*GNU*)
+ ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;;
+*)
+ ac_count=0
+ $as_echo_n 0123456789 >"conftest.in"
+ while :
+ do
+ cat "conftest.in" "conftest.in" >"conftest.tmp"
+ mv "conftest.tmp" "conftest.in"
+ cp "conftest.in" "conftest.nl"
+ $as_echo 'EGREP' >> "conftest.nl"
+ "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break
+ diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break
+ as_fn_arith $ac_count + 1 && ac_count=$as_val
+ if test $ac_count -gt ${ac_path_EGREP_max-0}; then
+ # Best one so far, save it but keep looking for a better one
+ ac_cv_path_EGREP="$ac_path_EGREP"
+ ac_path_EGREP_max=$ac_count
+ fi
+ # 10*(2^10) chars as input seems more than enough
+ test $ac_count -gt 10 && break
+ done
+ rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
+esac
+
+ $ac_path_EGREP_found && break 3
+ done
+ done
+ done
+IFS=$as_save_IFS
+ if test -z "$ac_cv_path_EGREP"; then
+ as_fn_error "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5
+ fi
+else
+ ac_cv_path_EGREP=$EGREP
+fi
+
+ fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5
+$as_echo "$ac_cv_path_EGREP" >&6; }
+ EGREP="$ac_cv_path_EGREP"
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5
+$as_echo_n "checking for ANSI C header files... " >&6; }
+if test "${ac_cv_header_stdc+set}" = set; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <stdlib.h>
+#include <stdarg.h>
+#include <string.h>
+#include <float.h>
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ ac_cv_header_stdc=yes
+else
+ ac_cv_header_stdc=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+if test $ac_cv_header_stdc = yes; then
+ # SunOS 4.x string.h does not declare mem*, contrary to ANSI.
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <string.h>
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ $EGREP "memchr" >/dev/null 2>&1; then :
+
+else
+ ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+ # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <stdlib.h>
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ $EGREP "free" >/dev/null 2>&1; then :
+
+else
+ ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+ # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.
+ if test "$cross_compiling" = yes; then :
+ :
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <ctype.h>
+#include <stdlib.h>
+#if ((' ' & 0x0FF) == 0x020)
+# define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
+# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
+#else
+# define ISLOWER(c) \
+ (('a' <= (c) && (c) <= 'i') \
+ || ('j' <= (c) && (c) <= 'r') \
+ || ('s' <= (c) && (c) <= 'z'))
+# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c))
+#endif
+
+#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))
+int
+main ()
+{
+ int i;
+ for (i = 0; i < 256; i++)
+ if (XOR (islower (i), ISLOWER (i))
+ || toupper (i) != TOUPPER (i))
+ return 2;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+
+else
+ ac_cv_header_stdc=no
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5
+$as_echo "$ac_cv_header_stdc" >&6; }
+if test $ac_cv_header_stdc = yes; then
+
+$as_echo "#define STDC_HEADERS 1" >>confdefs.h
+
+fi
+
+# On IRIX 5.3, sys/types and inttypes.h are conflicting.
+for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \
+ inttypes.h stdint.h unistd.h
+do :
+ as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`
+ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default
+"
+eval as_val=\$$as_ac_Header
+ if test "x$as_val" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+
+done
+
+
+for ac_header in unistd.h sys/stat.h
+do :
+ as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`
+ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default"
+eval as_val=\$$as_ac_Header
+ if test "x$as_val" = x""yes; then :
+ cat >>confdefs.h <<_ACEOF
+#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+
+done
+
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for extra programs to build requiring -lcuda" >&5
$as_echo_n "checking for extra programs to build requiring -lcuda... " >&6; }

293
SPECS/gcc.spec
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 20190503
%global SVNREV 270850
%global gcc_version 9.1.1
%global DATE 20191120
%global SVNREV 278493
%global gcc_version 9.2.1
%global gcc_major 9
# 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 1
%global gcc_release 2
%global nvptx_tools_gitrev c28050f60193b3b95a18866a96f03334e874e78f
%global nvptx_newlib_gitrev aadc8eb0ec43b7cd0dd2dfb484bae63c8b05ef24
%global mpc_version 0.8.1
@ -94,7 +94,7 @@
%global attr_ifunc 0
%endif
%ifarch x86_64 ppc64le
%global build_offload_nvptx 0
%global build_offload_nvptx 1
%else
%global build_offload_nvptx 0
%endif
@ -113,7 +113,7 @@
Summary: GCC version 9
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
@ -125,6 +125,21 @@ Source0: gcc-%{version}-%{DATE}.tar.xz
Source1: ftp://gcc.gnu.org/pub/gcc/infrastructure/isl-%{isl_version}.tar.bz2
Source2: http://www.multiprecision.org/mpc/download/mpc-%{mpc_version}.tar.gz
Source3: ftp://ftp.stack.nl/pub/users/dimitri/doxygen-%{doxygen_version}.src.tar.gz
# The source for nvptx-tools package was pulled from upstream's vcs. Use the
# following commands to generate the tarball:
# git clone https://github.com/MentorEmbedded/nvptx-tools.git
# cd nvptx-tools
# git archive origin/master --prefix=nvptx-tools-%%{nvptx_tools_gitrev}/ | xz -9e > ../nvptx-tools-%%{nvptx_tools_gitrev}.tar.xz
# cd ..; rm -rf nvptx-tools
Source4: nvptx-tools-%{nvptx_tools_gitrev}.tar.xz
# The source for nvptx-newlib package was pulled from upstream's vcs. Use the
# following commands to generate the tarball:
# git clone https://github.com/MentorEmbedded/nvptx-newlib.git
# cd nvptx-newlib
# git archive origin/master --prefix=nvptx-newlib-%%{nvptx_newlib_gitrev}/ | xz -9 > ../nvptx-newlib-%%{nvptx_newlib_gitrev}.tar.xz
# cd ..; rm -rf nvptx-newlib
Source5: nvptx-newlib-%{nvptx_newlib_gitrev}.tar.xz
%global isl_version 0.16.1
URL: http://gcc.gnu.org
# Need binutils with -pie support >= 2.14.90.0.4-4
# Need binutils which can omit dot symbols and overlap .opd on ppc64 >= 2.15.91.0.2-4
@ -135,16 +150,17 @@ URL: http://gcc.gnu.org
# Need binutils which support --build-id >= 2.17.50.0.17-3
# Need binutils which support %%gnu_unique_object >= 2.19.51.0.14
# Need binutils which support .cfi_sections >= 2.19.51.0.14-33
# Need binutils which support new PowerPC relocs >= 2.31
BuildRequires: binutils >= 2.19.51.0.14-33
# While gcc doesn't include statically linked binaries, during testing
# -static is used several times.
BuildRequires: glibc-static
%if 0%{?scl:1}
BuildRequires: %{?scl_prefix}binutils >= 2.22.52.0.1
BuildRequires: %{?scl_prefix}binutils >= 2.31
# For testing
%if 0%{?rhel} > 7
%if 0%{?rhel} >= 6
# FIXME gcc-toolset-9-gdb isn't yet in the buildroot.
BuildRequires: gdb >= 7.4.50
BuildRequires: gdb
%else
BuildRequires: %{?scl_prefix}gdb >= 7.4.50
%endif
@ -273,7 +289,8 @@ Patch8: gcc9-foffload-default.patch
Patch9: gcc9-Wno-format-security.patch
Patch10: gcc9-rh1574936.patch
Patch11: gcc9-d-shared-libphobos.patch
Patch12: gcc9-pr90303.patch
Patch12: gcc9-fixes.patch
Patch13: gcc9-add-sve-tests.patch
Patch1000: gcc9-libstdc++-compat.patch
Patch1001: gcc9-alt-compat-test.patch
@ -284,32 +301,26 @@ Patch2001: doxygen-1.7.1-config.patch
Patch2002: doxygen-1.7.5-timestamp.patch
Patch2003: doxygen-1.8.0-rh856725.patch
Patch3001: 0001-Allow-repeated-compatible-type-specifications.patch
Patch3002: 0002-Pad-character-to-int-conversions-with-spaces-instead.patch
Patch3003: 0003-Add-std-extra-legacy.patch
Patch3004: 0004-Allow-conversion-between-Hollerith-constants-and-CHA.patch
Patch3005: 0005-Allow-comparisons-between-INTEGER-and-REAL.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-Convert-LOGICAL-to-INTEGER-for-arithmetic-ops-and-vi.patch
Patch3010: 0010-Allow-mixed-string-length-and-array-specification-in.patch
Patch3011: 0011-Allow-character-to-int-conversions-in-DATA-statement.patch
Patch3012: 0012-Allow-old-style-initializers-in-derived-types.patch
Patch3013: 0013-Allow-per-variable-kind-specification.patch
Patch3014: 0014-Allow-non-logical-expressions-in-IF-statements.patch
Patch3016: 0016-Allow-calls-to-intrinsics-with-smaller-types-than-sp.patch
Patch3017: 0017-Add-the-SEQUENCE-attribute-by-default-if-it-s-not-pr.patch
Patch3018: 0018-Fill-in-missing-array-dimensions-using-the-lower-bou.patch
Patch3019: 0019-Add-tests-for-AUTOMATIC-keyword.patch
Patch3022: 0022-Default-values-for-certain-field-descriptors-in-form.patch
Patch3023: gcc8-fortranlines.patch
Patch3025: gcc8-fortran-equivalence.patch
Patch3026: gcc8-fortran-fdec-include.patch
Patch3027: gcc8-fortran-fdec-include-doc.patch
Patch3028: gcc8-fortran-fpad-source.patch
Patch3029: gcc8-fortran-pr87919.patch
Patch3030: gcc8-fortran-pr87919-2.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
Patch4000: nvptx-tools-no-ptxas.patch
Patch4001: nvptx-tools-build.patch
Patch4002: nvptx-tools-glibc.patch
%if 0%{?rhel} > 7
%global nonsharedver 80
@ -469,10 +480,10 @@ for __float128 math support and for Fortran REAL*16 support.
Summary: GCC 9 __float128 support
Group: Development/Libraries
%if 0%{!?scl:1}
Requires: %{?scl_prefix}libquadmath = %{version}-%{release}
Requires: %{?scl_prefix}libquadmath%{_isa} = %{version}-%{release}
%else
%if 0%{?rhel} >= 7
Requires: libquadmath
Requires: libquadmath%{_isa}
%endif
%endif
Requires: %{?scl_prefix}gcc%{!?scl:5} = %{version}-%{release}
@ -493,7 +504,7 @@ which is a GCC transactional memory support runtime library.
%package -n %{?scl_prefix}libitm-devel
Summary: The GNU Transactional Memory support
Requires: libitm >= 4.7.0-1
Requires: libitm%{_isa} >= 4.7.0-1
Requires: %{?scl_prefix}gcc%{!?scl:5} = %{version}-%{release}
%description -n %{?scl_prefix}libitm-devel
@ -527,21 +538,11 @@ by hardware.
%package -n %{?scl_prefix}libatomic-devel
Summary: The GNU Atomic static library
Requires: libatomic >= 4.8.0
Requires: libatomic%{_isa} >= 4.8.0
%description -n %{?scl_prefix}libatomic-devel
This package contains GNU Atomic static libraries.
%package -n libasan
Summary: The Address Sanitizer runtime library from GCC 9
Group: System Environment/Libraries
Requires(post): /sbin/install-info
Requires(preun): /sbin/install-info
%description -n libasan
This package contains the Address Sanitizer library from GCC 9
which is used for -fsanitize=address instrumented programs.
%package -n libasan5
Summary: The Address Sanitizer runtime library from GCC 9
Group: System Environment/Libraries
@ -554,10 +555,11 @@ 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 >= 9.1.1
%if 0%{?rhel} > 7
Requires: libasan%{_isa} >= 8.3.1
Obsoletes: libasan5
%else
Requires: libasan5 >= 9.1.1
Requires: libasan5%{_isa} >= 8.3.1
%endif
%description -n %{?scl_prefix}libasan-devel
@ -574,7 +576,7 @@ which is used for -fsanitize=thread instrumented programs.
%package -n %{?scl_prefix}libtsan-devel
Summary: The Thread Sanitizer static library
Requires: libtsan >= 5.1.1
Requires: libtsan%{_isa} >= 5.1.1
%description -n %{?scl_prefix}libtsan-devel
This package contains Thread Sanitizer static runtime library.
@ -590,10 +592,11 @@ which is used for -fsanitize=undefined instrumented programs.
%package -n %{?scl_prefix}libubsan-devel
Summary: The Undefined Behavior Sanitizer static library
%if 0%{?rhel} > 8
Requires: libubsan >= 9.1.1
%if 0%{?rhel} > 7
Requires: libubsan%{_isa} >= 8.3.1
Obsoletes: libubsan1
%else
Requires: libubsan1 >= 9.1.1
Requires: libubsan1%{_isa} >= 8.3.1
%endif
%description -n %{?scl_prefix}libubsan-devel
@ -610,17 +613,27 @@ which is used for -fsanitize=leak instrumented programs.
%package -n %{?scl_prefix}liblsan-devel
Summary: The Leak Sanitizer static library
Requires: liblsan >= 5.1.1
Requires: liblsan%{_isa} >= 5.1.1
%description -n %{?scl_prefix}liblsan-devel
This package contains Leak Sanitizer static runtime library.
%package -n %{?scl_prefix}offload-nvptx
Summary: Offloading compiler to NVPTX
Requires: gcc >= 8.3.1
Requires: libgomp-offload-nvptx >= 8.3.1
%description -n %{?scl_prefix}offload-nvptx
The gcc-offload-nvptx package provides offloading support for
NVidia PTX. OpenMP and OpenACC programs linked with -fopenmp will
by default add PTX code into the binaries, which can be offloaded
to NVidia PTX capable devices if available.
%prep
%if 0%{?rhel} >= 7
%setup -q -n gcc-%{version}-%{DATE} -a 1
%setup -q -n gcc-%{version}-%{DATE} -a 1 -a 4 -a 5
%else
%setup -q -n gcc-%{version}-%{DATE} -a 1 -a 2 -a 3
%setup -q -n gcc-%{version}-%{DATE} -a 1 -a 2 -a 3 -a 4 -a 5
%endif
%patch0 -p0 -b .hack~
%patch1 -p0 -b .i386-libgomp~
@ -640,7 +653,8 @@ This package contains Leak Sanitizer static runtime library.
%patch10 -p0 -b .rh1574936~
%endif
%patch11 -p0 -b .d-shared-libphobos~
%patch12 -p0 -b .pr90303~
%patch12 -p0 -b .fixes~
%patch13 -p0 -b .add-sve-tests~
%patch1000 -p0 -b .libstdc++-compat~
%ifarch %{ix86} x86_64
@ -665,11 +679,9 @@ cd ..
%endif
%endif
%if 0
%if 0%{?rhel} <= 7
%patch3003 -p1 -b .fortran03~
%patch3001 -p1 -b .fortran01~
%patch3002 -p1 -b .fortran02~
%patch3003 -p1 -b .fortran03~
%patch3004 -p1 -b .fortran04~
%patch3005 -p1 -b .fortran05~
%patch3006 -p1 -b .fortran06~
@ -681,20 +693,14 @@ cd ..
%patch3012 -p1 -b .fortran12~
%patch3013 -p1 -b .fortran13~
%patch3014 -p1 -b .fortran14~
%patch3015 -p1 -b .fortran15~
%patch3016 -p1 -b .fortran16~
%patch3017 -p1 -b .fortran17~
%patch3018 -p1 -b .fortran18~
%patch3019 -p1 -b .fortran19~
%patch3022 -p1 -b .fortran22~
%patch3023 -p1 -b .fortran23~
%patch3025 -p1 -b .fortran25~
%patch3026 -p1 -b .fortran26~
%patch3027 -p1 -b .fortran27~
%patch3028 -p1 -b .fortran28~
%patch3029 -p1 -b .fortran29~
%patch3030 -p1 -b .fortran30~
%endif
%endif
cd nvptx-tools-%{nvptx_tools_gitrev}
%patch4000 -p1 -b .nvptx-tools-no-ptxas~
%patch4001 -p1 -b .nvptx-tools-build~
%patch4002 -p1 -b .nvptx-tools-glibc~
cd ..
echo 'Red Hat %{version}-%{gcc_release}' > gcc/DEV-PHASE
@ -739,6 +745,41 @@ rm -f gcc/testsuite/go.test/test/chan/goroutines.go
# Undo the broken autoconf change in recent Fedora versions
export CONFIG_SITE=NONE
%if %{build_offload_nvptx}
mkdir obji
IROOT=`pwd`/obji
cd nvptx-tools-%{nvptx_tools_gitrev}
rm -rf obj-%{gcc_target_platform}
mkdir obj-%{gcc_target_platform}
cd obj-%{gcc_target_platform}
CC="$CC" CXX="$CXX" CFLAGS="%{optflags}" CXXFLAGS="%{optflags}" \
../configure --prefix=%{_prefix}
make %{?_smp_mflags}
make install prefix=${IROOT}%{_prefix}
cd ../..
ln -sf nvptx-newlib-%{nvptx_newlib_gitrev}/newlib newlib
rm -rf obj-offload-nvptx-none
mkdir obj-offload-nvptx-none
cd obj-offload-nvptx-none
CC="$CC" CXX="$CXX" CFLAGS="$OPT_FLAGS" \
CXXFLAGS="`echo " $OPT_FLAGS " | sed 's/ -Wall / /g;s/ -fexceptions / /g' \
| sed 's/ -Wformat-security / -Wformat -Wformat-security /'`" \
XCFLAGS="$OPT_FLAGS" TCFLAGS="$OPT_FLAGS" \
../configure --disable-bootstrap --disable-sjlj-exceptions \
--enable-newlib-io-long-long --with-build-time-tools=${IROOT}%{_prefix}/nvptx-none/bin \
--target nvptx-none --enable-as-accelerator-for=%{gcc_target_platform} \
--enable-languages=c,c++,fortran,lto \
--prefix=%{_prefix} --mandir=%{_mandir} --infodir=%{_infodir} \
--with-bugurl=http://bugzilla.redhat.com/bugzilla \
--enable-checking=release --with-system-zlib \
--with-gcc-major-version-only --without-isl
make %{?_smp_mflags}
cd ..
rm -f newlib
%endif
rm -fr obj-%{gcc_target_platform}
mkdir obj-%{gcc_target_platform}
cd obj-%{gcc_target_platform}
@ -791,10 +832,7 @@ ln -sf libisl.so.15 libisl.so
cd ../..
%endif
# Disable for now.
%if 0%{?rhel} == 6
%{?scl:PATH=%{_bindir}${PATH:+:${PATH}}}
%endif
CC=gcc
CXX=g++
@ -841,6 +879,10 @@ CONFIGURE_OPTS="\
--with-isl=`pwd`/isl-install \
%else
--without-isl \
%if %{build_offload_nvptx}
--enable-offload-targets=nvptx-none \
--without-cuda-driver \
%endif
%endif
--disable-libmpx \
%if 0%{?rhel} < 7
@ -1054,6 +1096,32 @@ cd ..
%install
rm -rf %{buildroot}
%if %{build_offload_nvptx}
cd nvptx-tools-%{nvptx_tools_gitrev}
cd obj-%{gcc_target_platform}
make install prefix=%{buildroot}%{_prefix}
cd ../..
ln -sf nvptx-newlib-%{nvptx_newlib_gitrev}/newlib newlib
cd obj-offload-nvptx-none
make prefix=%{buildroot}%{_prefix} mandir=%{buildroot}%{_mandir} \
infodir=%{buildroot}%{_infodir} install
rm -rf %{buildroot}%{_prefix}/libexec/gcc/nvptx-none/%{gcc_major}/install-tools
rm -rf %{buildroot}%{_prefix}/libexec/gcc/%{gcc_target_platform}/%{gcc_major}/accel/nvptx-none/{install-tools,plugin,cc1,cc1plus,f951}
rm -rf %{buildroot}%{_infodir} %{buildroot}%{_mandir}/man7 %{buildroot}%{_prefix}/share/locale
rm -rf %{buildroot}%{_prefix}/lib/gcc/nvptx-none/%{gcc_major}/{install-tools,plugin}
rm -rf %{buildroot}%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/accel/nvptx-none/{install-tools,plugin,include-fixed}
rm -rf %{buildroot}%{_prefix}/%{_lib}/libc[cp]1*
mv -f %{buildroot}%{_prefix}/nvptx-none/lib/*.{a,spec} %{buildroot}%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/accel/nvptx-none/
mv -f %{buildroot}%{_prefix}/nvptx-none/lib/mgomp/*.{a,spec} %{buildroot}%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/accel/nvptx-none/mgomp/
mv -f %{buildroot}%{_prefix}/lib/gcc/nvptx-none/%{gcc_major}/*.a %{buildroot}%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/accel/nvptx-none/
mv -f %{buildroot}%{_prefix}/lib/gcc/nvptx-none/%{gcc_major}/mgomp/*.a %{buildroot}%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/accel/nvptx-none/mgomp/
find %{buildroot}%{_prefix}/lib/gcc/nvptx-none %{buildroot}%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/accel/nvptx-none \
%{buildroot}%{_prefix}/nvptx-none/lib -name \*.la | xargs rm
cd ..
rm -f newlib
%endif
%if %{build_libstdcxx_docs}
%if 0%{?rhel} < 7
export PATH=`pwd`/obj-%{gcc_target_platform}/doxygen-install/bin/${PATH:+:${PATH}}
@ -1876,10 +1944,6 @@ fi
%postun -n libatomic -p /sbin/ldconfig
%post -n libasan -p /sbin/ldconfig
%postun -n libasan -p /sbin/ldconfig
%post -n libasan5 -p /sbin/ldconfig
%postun -n libasan5 -p /sbin/ldconfig
@ -2412,8 +2476,11 @@ fi
%endif
%if %{build_libasan}
# GTS 9 libasan5 would clash with the system RHEL 8 libasan.
%if 0%{?rhel} < 8
%files -n libasan5
%{?scl:%{_root_prefix}}%{!?scl:%{_prefix}}/%{_lib}/libasan.so.5*
%endif
%files -n %{?scl_prefix}libasan-devel
%dir %{_prefix}/lib/gcc
@ -2438,8 +2505,11 @@ fi
%endif
%if %{build_libtsan}
# Use the system libtsan.
%if 0%{?rhel} < 8
%files -n libtsan
%{?scl:%{_root_prefix}}%{!?scl:%{_prefix}}/%{_lib}/libtsan.so.0*
%endif
%files -n %{?scl_prefix}libtsan-devel
%dir %{_prefix}/lib/gcc
@ -2452,8 +2522,11 @@ fi
%endif
%if %{build_libubsan}
# GTS 9 libubsan1 would clash with the system RHEL 8 libubsan.
%if 0%{?rhel} < 8
%files -n libubsan1
%{?scl:%{_root_prefix}}%{!?scl:%{_prefix}}/%{_lib}/libubsan.so.1*
%endif
%files -n %{?scl_prefix}libubsan-devel
%dir %{_prefix}/lib/gcc
@ -2465,8 +2538,11 @@ fi
%endif
%if %{build_liblsan}
# Use the system liblsan.
%if 0%{?rhel} < 8
%files -n liblsan
%{?scl:%{_root_prefix}}%{!?scl:%{_prefix}}/%{_lib}/liblsan.so.0*
%endif
%files -n %{?scl_prefix}liblsan-devel
%dir %{_prefix}/lib/gcc
@ -2517,6 +2593,61 @@ fi
%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/plugin/libcp1plugin.so*
%doc rpm.doc/changelogs/libcc1/ChangeLog*
%if %{build_offload_nvptx}
%files -n %{?scl_prefix}offload-nvptx
%{_prefix}/bin/nvptx-none-*
%{_prefix}/bin/%{gcc_target_platform}-accel-nvptx-none-gcc
%dir %{_prefix}/lib/gcc
%dir %{_prefix}/lib/gcc/%{gcc_target_platform}
%dir %{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}
%dir %{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/accel
%dir %{_prefix}/libexec/gcc
%dir %{_prefix}/libexec/gcc/%{gcc_target_platform}
%dir %{_prefix}/libexec/gcc/%{gcc_target_platform}/%{gcc_major}
%dir %{_prefix}/libexec/gcc/%{gcc_target_platform}/%{gcc_major}/accel
%{_prefix}/lib/gcc/nvptx-none
%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/accel/nvptx-none
%{_prefix}/libexec/gcc/%{gcc_target_platform}/%{gcc_major}/accel/nvptx-none
%dir %{_prefix}/nvptx-none
%{_prefix}/nvptx-none/bin
%{_prefix}/nvptx-none/include
%endif
%changelog
* Wed Nov 27 2019 Marek Polacek <polacek@redhat.com> 9.2.1-2.2
- fix offload-nvptx requires
* Mon Nov 25 2019 Marek Polacek <polacek@redhat.com> 9.2.1-2.1
- add offload-nvptx (#1698607)
* Thu Nov 21 2019 Marek Polacek <polacek@redhat.com> 9.2.1-2
- update from Fedora gcc-9.2.1-2 (#1747158)
- fix ABI change in deque iterators (PR libstdc++/92267)
- fix up sink select_best_block (PR tree-optimization/91355)
- revert PR tree-optimization/91790 fix
- allow MODE_PARTIAL_INT modes for integer constant input operands
(PR other/92090)
- fix adjust_unroll_factor (PR middle-end/90796)
- fixes for SVE Vector PCS on AArch64: emit .variant_pcs for
aarch64_vector_pcs symbol references (#1726641)
* Tue Sep 24 2019 Marek Polacek <polacek@redhat.com> 9.1.1-2.4
- drop libtsan and liblsan (#1729402)
* Tue Aug 27 2019 Marek Polacek <polacek@redhat.com> 9.1.1-2.3
- require binutils >= 2.31 so that gcc supports -mpltseq (#1744988)
* Mon Jul 22 2019 Marek Polacek <polacek@redhat.com> 9.1.1-2.2
- small fixes for the Fortran patches (#1722881)
* Sun Jul 21 2019 Marek Polacek <polacek@redhat.com> 9.1.1-2.1
- add Obsoletes for libasan5 and libubsan1 on RHEL 8 (#1722892)
* Fri Jul 19 2019 Marek Polacek <polacek@redhat.com> 9.1.1-2
- update from Fedora 9.1.1-2 (#1728745)
- apply Fortran patches (#1722881)
- do not include libasan5 and libubsan1 on RHEL 8 and use the system
version (#1722892)
* Tue Jun 4 2019 Marek Polacek <polacek@redhat.com> 9.1.1-1
- new package