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

Compare commits

merge into: rpms:c10s
Branches Tags
rpms:c8
rpms:c10s
rpms:c8s
rpms:c8-beta
rpms:imports/c10s/gcc-toolset-9-gcc-9.2.1-2.3.el10
rpms:imports/c8-beta/gcc-toolset-9-gcc-9.2.1-2.3.el8
rpms:imports/c8-beta/gcc-toolset-9-gcc-9.2.1-2.2.el8
rpms:imports/c8-beta/gcc-toolset-9-gcc-9.1.1-1.el8
rpms:imports/c8s/gcc-toolset-9-gcc-9.2.1-2.3.el8
rpms:imports/c8s/gcc-toolset-9-gcc-9.2.1-2.2.el8
rpms:imports/c8/gcc-toolset-9-gcc-9.2.1-2.3.el8
rpms:imports/c8/gcc-toolset-9-gcc-9.2.1-2.2.el8
rpms:imports/c8/gcc-toolset-9-gcc-9.1.1-2.4.el8
...
pull from: rpms:c8
Branches Tags
rpms:c10s
rpms:c8s
rpms:c8-beta
rpms:c8
rpms:imports/c10s/gcc-toolset-9-gcc-9.2.1-2.3.el10
rpms:imports/c8-beta/gcc-toolset-9-gcc-9.2.1-2.3.el8
rpms:imports/c8-beta/gcc-toolset-9-gcc-9.2.1-2.2.el8
rpms:imports/c8-beta/gcc-toolset-9-gcc-9.1.1-1.el8
rpms:imports/c8s/gcc-toolset-9-gcc-9.2.1-2.3.el8
rpms:imports/c8s/gcc-toolset-9-gcc-9.2.1-2.2.el8
rpms:imports/c8/gcc-toolset-9-gcc-9.2.1-2.3.el8
rpms:imports/c8/gcc-toolset-9-gcc-9.2.1-2.2.el8
rpms:imports/c8/gcc-toolset-9-gcc-9.1.1-2.4.el8

No commits in common. "c10s" and "c8" have entirely different histories.
c10s ... c8

46 changed files with 7630 additions and 10 deletions
Show Stats Expand all files Collapse all files

6
.gcc-toolset-9-gcc.metadata Normal file
View File

@ -0,0 +1,6 @@
7f4348418dc3efefd357b32a2b5c8010211ab284 SOURCES/doxygen-1.8.0.src.tar.gz
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

6
.gitignore vendored Normal file
View File

@ -0,0 +1,6 @@
SOURCES/doxygen-1.8.0.src.tar.gz
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

3
README.md
View File

@ -1,3 +0,0 @@
# Package Not Available
This package is not available on CentOS Stream 10.
It may be available on another branch.

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

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

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

150
SOURCES/0006-Allow-blank-format-items-in-format-strings.patch Normal file
View File

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

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

@ -0,0 +1,78 @@
From d15e5e207e2a6b46edee2f2b5d3e4c1cc7cdb80f Mon Sep 17 00:00:00 2001
From: Jim MacArthur <jim.macarthur@codethink.co.uk>
Date: Mon, 5 Oct 2015 13:45:15 +0100
Subject: [PATCH 07/16] Allow more than one character as argument to ICHAR
Use -fdec to enable..
---
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 a04f0d66655..0ba4d0a031f 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -2603,7 +2603,7 @@ gfc_check_ichar_iachar (gfc_expr *c, gfc_expr *kind)
else
return true;
- if (i != 1)
+ if (i != 1 && !flag_dec)
{
gfc_error ("Argument of %s at %L must be of length one",
gfc_current_intrinsic, &c->where);
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 7d7e3f22f73..7aff256c6b3 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -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 && !flag_dec)
{
gfc_error ("Argument of IACHAR at %L must be of length one", &e->where);
return &gfc_bad_expr;
@@ -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 && !flag_dec)
{
gfc_error ("Argument of ICHAR at %L must be of length one", &e->where);
return &gfc_bad_expr;
diff --git a/gcc/testsuite/gfortran.dg/dec_ichar_with_string_1.f b/gcc/testsuite/gfortran.dg/dec_ichar_with_string_1.f
new file mode 100644
index 00000000000..85efccecc0f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_ichar_with_string_1.f
@@ -0,0 +1,21 @@
+! { dg-do run }
+! { dg-options "-fdec" }
+!
+! Test ICHAR and IACHAR with more than one character as argument
+!
+! Test case contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+ PROGRAM ichar_more_than_one_character
+ CHARACTER*4 st/'Test'/
+ INTEGER i
+
+ i = ICHAR(st)
+ if (i.NE.84) STOP 1
+ i = IACHAR(st)
+ if (i.NE.84) STOP 2
+ i = ICHAR('Test')
+ if (i.NE.84) STOP 3
+ i = IACHAR('Test')
+ if (i.NE.84) STOP 4
+ END
--
2.11.0

158
SOURCES/0008-Allow-non-integer-substring-indexes.patch Normal file
View File

@ -0,0 +1,158 @@
From 96563a652406d3c8471d75e6527ba634fa013400 Mon Sep 17 00:00:00 2001
From: Jim MacArthur <jim.macarthur@codethink.co.uk>
Date: Mon, 5 Oct 2015 14:05:03 +0100
Subject: [PATCH 08/16] Allow non-integer substring indexes
Use -fdec-non-integer-index compiler flag to enable. Also enabled by -fdec.
---
gcc/fortran/lang.opt | 4 ++++
gcc/fortran/options.c | 1 +
gcc/fortran/resolve.c | 20 ++++++++++++++++++++
.../dec_not_integer_substring_indexes_1.f | 18 ++++++++++++++++++
.../dec_not_integer_substring_indexes_2.f | 18 ++++++++++++++++++
.../dec_not_integer_substring_indexes_3.f | 18 ++++++++++++++++++
6 files changed, 79 insertions(+)
create mode 100644 gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_1.f
create mode 100644 gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_2.f
create mode 100644 gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_3.f
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 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 c8b6333874b..04679d3a15d 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -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 (flag_dec_non_integer_index && ref->u.ss.start->ts.type != BT_INTEGER
+ && gfc_numeric_ts (&ref->u.ss.start->ts))
+ {
+ gfc_typespec t;
+ t.type = BT_INTEGER;
+ t.kind = ref->u.ss.start->ts.kind;
+ gfc_convert_type_warn (ref->u.ss.start, &t, 2, 1);
+ }
+
if (ref->u.ss.start->ts.type != BT_INTEGER)
{
gfc_error ("Substring start index at %L must be of type INTEGER",
@@ -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 (flag_dec_non_integer_index && ref->u.ss.end->ts.type != BT_INTEGER
+ && gfc_numeric_ts (&ref->u.ss.end->ts))
+ {
+ gfc_typespec t;
+ t.type = BT_INTEGER;
+ t.kind = ref->u.ss.end->ts.kind;
+ gfc_convert_type_warn (ref->u.ss.end, &t, 2, 1);
+ }
+
if (ref->u.ss.end->ts.type != BT_INTEGER)
{
gfc_error ("Substring end index at %L must be of type INTEGER",
diff --git a/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_1.f b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_1.f
new file mode 100644
index 00000000000..0be28abaa4b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_1.f
@@ -0,0 +1,18 @@
+! { dg-do run }
+! { dg-options "-fdec" }
+!
+! Test not integer substring indexes
+!
+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+ PROGRAM not_integer_substring_indexes
+ CHARACTER*5 st/'Tests'/
+ REAL ir/1.0/
+ REAL ir2/4.0/
+
+ if (st(ir:4).ne.'Test') stop 1
+ if (st(1:ir2).ne.'Test') stop 2
+ if (st(1.0:4).ne.'Test') stop 3
+ if (st(1:4.0).ne.'Test') stop 4
+ if (st(2.5:4).ne.'est') stop 5
+ END
diff --git a/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_2.f b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_2.f
new file mode 100644
index 00000000000..3cf05296d0c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_2.f
@@ -0,0 +1,18 @@
+! { dg-do run }
+! { dg-options "-fdec-non-integer-index" }
+!
+! Test not integer substring indexes
+!
+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+ PROGRAM not_integer_substring_indexes
+ CHARACTER*5 st/'Tests'/
+ REAL ir/1.0/
+ REAL ir2/4.0/
+
+ if (st(ir:4).ne.'Test') stop 1
+ if (st(1:ir2).ne.'Test') stop 2
+ if (st(1.0:4).ne.'Test') stop 3
+ if (st(1:4.0).ne.'Test') stop 4
+ if (st(2.5:4).ne.'est') stop 5
+ END
diff --git a/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_3.f b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_3.f
new file mode 100644
index 00000000000..703de995897
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_3.f
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! { dg-options "-fdec -fno-dec-non-integer-index" }
+!
+! Test not integer substring indexes
+!
+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
+!
+ PROGRAM not_integer_substring_indexes
+ CHARACTER*5 st/'Tests'/
+ REAL ir/1.0/
+ REAL ir2/4.0/
+
+ if (st(ir:4).ne.'Test') stop 1 ! { dg-error "Substring start index" }
+ if (st(1:ir2).ne.'Test') stop 2 ! { dg-error "Substring end index" }
+ if (st(1.0:4).ne.'Test') stop 3 ! { dg-error "Substring start index" }
+ if (st(1:4.0).ne.'Test') stop 4 ! { dg-error "Substring end index" }
+ if (st(2.5:4).ne.'est') stop 5 ! { dg-error "Substring start index" }
+ END
--
2.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

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

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

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

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

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

95
SOURCES/doxygen-1.7.1-config.patch Normal file
View File

@ -0,0 +1,95 @@
diff -up doxygen-1.7.1/addon/doxywizard/Makefile.in.config doxygen-1.7.1/addon/doxywizard/Makefile.in
--- doxygen-1.7.1/addon/doxywizard/Makefile.in.config 2010-05-23 16:51:31.000000000 +0200
+++ doxygen-1.7.1/addon/doxywizard/Makefile.in 2010-07-19 13:38:33.000000000 +0200
@@ -10,8 +10,6 @@
# See the GNU General Public License for more details.
#
-QMAKE=qmake $(MKSPECS)
-
all: Makefile.doxywizard
$(MAKE) -f Makefile.doxywizard
@@ -29,11 +27,11 @@ distclean: Makefile.doxywizard
$(RM) Makefile.doxywizard
install:
- $(INSTTOOL) -d $(INSTALL)/bin
- $(INSTTOOL) -m 755 ../../bin/doxywizard $(INSTALL)/bin
- $(INSTTOOL) -d $(INSTALL)/$(MAN1DIR)
+ $(INSTTOOL) -d $(DESTDIR)$(INSTALL)/bin
+ $(INSTTOOL) -m 755 ../../bin/doxywizard $(DESTDIR)$(INSTALL)/bin
+ $(INSTTOOL) -d $(DESTDIR)$(INSTALL)/$(MAN1DIR)
cat ../../doc/doxywizard.1 | sed -e "s/DATE/$(DATE)/g" -e "s/VERSION/$(VERSION)/g" > doxywizard.1
- $(INSTTOOL) -m 644 doxywizard.1 $(INSTALL)/$(MAN1DIR)/doxywizard.1
+ $(INSTTOOL) -m 644 doxywizard.1 $(DESTDIR)$(INSTALL)/$(MAN1DIR)/doxywizard.1
rm doxywizard.1
FORCE:
diff -up doxygen-1.7.1/configure.config doxygen-1.7.1/configure
--- doxygen-1.7.1/configure.config 2010-06-25 11:46:38.000000000 +0200
+++ doxygen-1.7.1/configure 2010-07-19 12:03:53.000000000 +0200
@@ -268,9 +268,10 @@ if test "$f_wizard" = YES; then
if test -z "$QTDIR"; then
echo " QTDIR environment variable not set!"
echo -n " Checking for Qt..."
- for d in /usr/{lib,share,qt}/{qt-4,qt4,qt,qt*,4} /usr; do
+ for d in /usr/{lib64,lib,share,qt}/{qt-4,qt4,qt,qt*,4} /usr; do
if test -x "$d/bin/qmake"; then
QTDIR=$d
+ QMAKE=$d/bin/qmake
fi
done
else
@@ -485,6 +486,8 @@ INSTTOOL = $f_insttool
DOXYDOCS = ..
DOCDIR = $f_docdir
QTDIR = $QTDIR
+QMAKE = $QMAKE
+MAN1DIR = share/man/man1
EOF
if test "$f_dot" != NO; then
diff -up doxygen-1.7.1/Makefile.in.config doxygen-1.7.1/Makefile.in
--- doxygen-1.7.1/Makefile.in.config 2009-08-20 21:41:13.000000000 +0200
+++ doxygen-1.7.1/Makefile.in 2010-07-19 12:03:53.000000000 +0200
@@ -44,8 +44,6 @@ distclean: clean
DATE=$(shell date "+%B %Y")
-MAN1DIR = man/man1
-
install: doxywizard_install
$(INSTTOOL) -d $(DESTDIR)/$(INSTALL)/bin
$(INSTTOOL) -m 755 bin/doxygen $(DESTDIR)/$(INSTALL)/bin
diff -up doxygen-1.7.1/tmake/lib/linux-g++/tmake.conf.config doxygen-1.7.1/tmake/lib/linux-g++/tmake.conf
--- doxygen-1.7.1/tmake/lib/linux-g++/tmake.conf.config 2008-12-06 14:16:20.000000000 +0100
+++ doxygen-1.7.1/tmake/lib/linux-g++/tmake.conf 2010-07-19 12:03:53.000000000 +0200
@@ -11,7 +11,7 @@ TMAKE_CC = gcc
TMAKE_CFLAGS = -pipe
TMAKE_CFLAGS_WARN_ON = -Wall -W -fno-exceptions
TMAKE_CFLAGS_WARN_OFF =
-TMAKE_CFLAGS_RELEASE = -O2
+TMAKE_CFLAGS_RELEASE = $(RPM_OPT_FLAGS)
TMAKE_CFLAGS_DEBUG = -g
TMAKE_CFLAGS_SHLIB = -fPIC
TMAKE_CFLAGS_YACC = -Wno-unused -Wno-parentheses
@@ -27,12 +27,12 @@ TMAKE_CXXFLAGS_YACC = $$TMAKE_CFLAGS_YAC
TMAKE_INCDIR =
TMAKE_LIBDIR =
-TMAKE_INCDIR_X11 = /usr/X11R6/include
-TMAKE_LIBDIR_X11 = /usr/X11R6/lib
-TMAKE_INCDIR_QT = $(QTDIR)/include
-TMAKE_LIBDIR_QT = $(QTDIR)/lib
-TMAKE_INCDIR_OPENGL = /usr/X11R6/include
-TMAKE_LIBDIR_OPENGL = /usr/X11R6/lib
+TMAKE_INCDIR_X11 =
+TMAKE_LIBDIR_X11 =
+TMAKE_INCDIR_QT =
+TMAKE_LIBDIR_QT =
+TMAKE_INCDIR_OPENGL =
+TMAKE_LIBDIR_OPENGL =
TMAKE_LINK = g++
TMAKE_LINK_SHLIB = g++

63
SOURCES/doxygen-1.7.5-timestamp.patch Normal file
View File

@ -0,0 +1,63 @@
diff -up doxygen-1.7.5/src/configoptions.cpp.timestamp doxygen-1.7.5/src/configoptions.cpp
--- doxygen-1.7.5/src/configoptions.cpp.timestamp 2011-08-03 15:54:50.000000000 +0200
+++ doxygen-1.7.5/src/configoptions.cpp 2011-08-23 12:55:56.000000000 +0200
@@ -1173,6 +1173,14 @@ void addConfigOptions(Config *cfg)
cs->setWidgetType(ConfigString::File);
cs->addDependency("GENERATE_HTML");
//----
+ cb = cfg->addBool(
+ "HTML_TIMESTAMP",
+ "If the HTML_TIMESTAMP tag is set to YES then the generated HTML\n"
+ "documentation will contain the timesstamp.",
+ FALSE
+ );
+ cb->addDependency("GENERATE_HTML");
+ //----
cs = cfg->addString(
"HTML_STYLESHEET",
"The HTML_STYLESHEET tag can be used to specify a user-defined cascading\n"
diff -up doxygen-1.7.5/src/config.xml.timestamp doxygen-1.7.5/src/config.xml
--- doxygen-1.7.5/src/config.xml.timestamp 2011-08-03 15:54:48.000000000 +0200
+++ doxygen-1.7.5/src/config.xml 2011-08-23 12:55:56.000000000 +0200
@@ -819,6 +819,11 @@ The HTML_FOOTER tag can be used to speci
each generated HTML page. If it is left blank doxygen will generate a
standard footer.
' defval='' depends='GENERATE_HTML'/>
+ <option type='bool' id='HTML_TIMESTAMP' docs='
+If the HTML_TIMESTAMP tag is set to YES then the generated HTML
+documentation will contain the timesstamp.
+' defval='' depends='GENERATE_HTML'/>
+
<option type='string' id='HTML_STYLESHEET' format='file' docs='
The HTML_STYLESHEET tag can be used to specify a user-defined cascading
style sheet that is used by each HTML page. It can be used to
diff -up doxygen-1.7.5/src/htmlgen.cpp.timestamp doxygen-1.7.5/src/htmlgen.cpp
--- doxygen-1.7.5/src/htmlgen.cpp.timestamp 2011-08-01 22:10:17.000000000 +0200
+++ doxygen-1.7.5/src/htmlgen.cpp 2011-08-23 13:01:16.000000000 +0200
@@ -88,7 +88,7 @@ static const char svgpan_script[]=
static QCString g_header;
static QCString g_footer;
-
+static bool timestamp=false;
//------------------------- Pictures for the Tabs ------------------------
// active
@@ -1072,6 +1072,8 @@ void HtmlGenerator::init()
{
g_footer = defaultHtmlFooter;
}
+ if (Config_getBool("HTML_TIMESTAMP"))
+ timestamp=true;
createSubDirs(d);
QCString fileName=dname+"/tabs.css";
@@ -1285,7 +1287,7 @@ QCString HtmlGenerator::writeLogoAsStrin
if (timeStamp)
{
result += theTranslator->trGeneratedAt(
- dateToString(TRUE),
+ dateToString(timestamp),
Config_getString("PROJECT_NAME")
);
}

15
SOURCES/doxygen-1.8.0-rh856725.patch Normal file
View File

@ -0,0 +1,15 @@
--- doxygen-1.8.0/src/configgen.py 2012-01-29 10:12:54.000000000 -0500
+++ doxygen-1.8.0/src/configgen.py 2012-08-07 17:38:54.751696536 -0400
@@ -34,8 +34,10 @@
if type=='bool':
if len(adefval)>0:
enabled = adefval
- else:
- enabled = "TRUE" if defval=='1' else "FALSE"
+ elif defval=='1':
+ enabled = "TRUE"
+ else:
+ enabled = "FALSE"
print " cb = cfg->addBool("
print " \"%s\"," % (name)
print " \"%s\"," % (docC)

0
gcc9-Wno-format-security.patch → SOURCES/gcc9-Wno-format-security.patch
View File

0
gcc9-add-sve-tests.patch → SOURCES/gcc9-add-sve-tests.patch
View File

0
gcc9-alt-compat-test.patch → SOURCES/gcc9-alt-compat-test.patch
View File

0
gcc9-d-shared-libphobos.patch → SOURCES/gcc9-d-shared-libphobos.patch
View File

0
gcc9-fixes.patch → SOURCES/gcc9-fixes.patch
View File

0
gcc9-foffload-default.patch → SOURCES/gcc9-foffload-default.patch
View File

0
gcc9-hack.patch → SOURCES/gcc9-hack.patch
View File

0
gcc9-i386-libgomp.patch → SOURCES/gcc9-i386-libgomp.patch
View File

0
gcc9-isl-dl.patch → SOURCES/gcc9-isl-dl.patch
View File

0
gcc9-isl-dl2.patch → SOURCES/gcc9-isl-dl2.patch
View File

0
gcc9-libgfortran-compat.patch → SOURCES/gcc9-libgfortran-compat.patch
View File

0
gcc9-libgomp-omp_h-multilib.patch → SOURCES/gcc9-libgomp-omp_h-multilib.patch
View File

0
gcc9-libstdc++-compat.patch → SOURCES/gcc9-libstdc++-compat.patch
View File

0
gcc9-libstdc++-docs.patch → SOURCES/gcc9-libstdc++-docs.patch
View File

0
gcc9-libtool-no-rpath.patch → SOURCES/gcc9-libtool-no-rpath.patch
View File

0
gcc9-no-add-needed.patch → SOURCES/gcc9-no-add-needed.patch
View File

0
gcc9-rh1574936.patch → SOURCES/gcc9-rh1574936.patch
View File

0
gcc9-sparc-config-detection.patch → SOURCES/gcc9-sparc-config-detection.patch
View File

0
nvptx-tools-build.patch → SOURCES/nvptx-tools-build.patch
View File

0
nvptx-tools-glibc.patch → SOURCES/nvptx-tools-glibc.patch
View File

0
nvptx-tools-no-ptxas.patch → SOURCES/nvptx-tools-no-ptxas.patch
View File

0
gcc.spec → SPECS/gcc.spec
View File

1
dead.package
View File

@ -1 +0,0 @@
gcc-toolset-9-gcc package is retired on branch c10s for CS-2551

6
sources
View File

@ -1,6 +0,0 @@
SHA512 (doxygen-1.8.0.src.tar.gz) = 21ebcbcc22e279a75b4b4495da0f8ceb175d615c2c7cd253b4ed8f049599d6d5ed61da442c750202db9b82869426b40201e5a1ecc1273175d1ee904cce4125a6
SHA512 (gcc-9.2.1-20191120.tar.xz) = cbd156d19afc4d4e752df3aee159906899f229342c314dcb16699e29bb43c0ac63b35ced11fcc50c4017c20e4e0e5609d941d88abcfe16e3903c3e7da6050acd
SHA512 (isl-0.16.1.tar.bz2) = c188667a84dc5bdddb4ab7c35f89c91bf15a8171f4fcaf41301cf285fb7328846d9a367c096012fec4cc69d244f0bc9e95d84c09ec097394cd4093076f2a041b
SHA512 (mpc-0.8.1.tar.gz) = 14cb9ae3d33caed24d5ae648eed28b2e00ad047a8baeff25981129af88245b4def2948573d7a00d65c5bd34e53524aa6a7351b76703c9f888b41830c1a1daae2
SHA512 (nvptx-newlib-aadc8eb0ec43b7cd0dd2dfb484bae63c8b05ef24.tar.xz) = 94f7089365296f7dfa485107b4143bebc850a81586f3460fd896bbbb6ba099a00217d4042133424fd2183b352132f4fd367e6a60599bdae2a26dfd48a77d0e04
SHA512 (nvptx-tools-c28050f60193b3b95a18866a96f03334e874e78f.tar.xz) = a688cb12cf805950a5abbb13b52f45c81dbee98e310b7ed57ae20e76dbfa5964a16270148374a6426d177db71909d28360490f091c86a5d19d4faa5127beeee1