From 06b0a95731c93b21523ebe2c53954ca25583f2b5 Mon Sep 17 00:00:00 2001 From: CentOS Sources Date: Tue, 21 Jan 2020 17:25:40 -0500 Subject: [PATCH] import gcc-toolset-9-gcc-9.2.1-2.2.el8 --- .gcc-toolset-9-gcc.metadata | 4 +- .gitignore | 4 +- ...eated-compatible-type-specifications.patch | 81 - ...or-i-f-and-g-format-specifiers-in-fo.patch | 873 +++++++ .../0002-Allow-duplicate-declarations.patch | 219 ++ ...-int-conversions-with-spaces-instead.patch | 106 - SOURCES/0003-Add-std-extra-legacy.patch | 54 - ...to-INTEGER-for-arithmetic-ops-and-vi.patch | 298 +++ ...literals-in-assignments-and-data-sta.patch | 860 +++++++ ...-between-Hollerith-constants-and-CHA.patch | 318 --- ...comparisons-between-INTEGER-and-REAL.patch | 1143 --------- SOURCES/0005-dec-comparisons.patch | 658 +++++ ...blank-format-items-in-format-strings.patch | 136 +- ...n-one-character-as-argument-to-ICHAR.patch | 55 +- ...-Allow-non-integer-substring-indexes.patch | 141 +- ...-style-initializers-in-derived-types.patch | 185 ++ ...to-INTEGER-for-arithmetic-ops-and-vi.patch | 111 - ...ng-length-and-array-specification-in.patch | 158 -- ...gth-and-kind-to-be-specified-on-a-pe.patch | 587 +++++ ...to-int-conversions-in-DATA-statement.patch | 52 - ...logical-expressions-in-IF-statements.patch | 378 +++ ...-style-initializers-in-derived-types.patch | 94 - ...ype-promotion-in-calls-to-intrinsics.patch | 2151 +++++++++++++++++ ...-attribute-by-default-if-it-s-not-pr.patch | 262 ++ ...llow-per-variable-kind-specification.patch | 129 - ...logical-expressions-in-IF-statements.patch | 143 -- ...array-dimensions-using-the-lower-bou.patch | 181 ++ ...0015-Allow-automatics-in-equivalence.patch | 358 +++ ...ntrinsics-with-smaller-types-than-sp.patch | 277 --- ...warning-with-Wno-overwrite-recursive.patch | 49 + ...-attribute-by-default-if-it-s-not-pr.patch | 68 - ...array-dimensions-using-the-lower-bou.patch | 62 - ...0019-Add-tests-for-AUTOMATIC-keyword.patch | 35 - ...or-certain-field-descriptors-in-form.patch | 516 ---- SOURCES/gcc8-fortran-equivalence.patch | 202 -- SOURCES/gcc8-fortran-fdec-include-doc.patch | 30 - SOURCES/gcc8-fortran-fdec-include.patch | 687 ------ SOURCES/gcc8-fortran-fpad-source.patch | 144 -- SOURCES/gcc8-fortran-pr87919-2.patch | 87 - SOURCES/gcc8-fortran-pr87919.patch | 419 ---- SOURCES/gcc8-fortranlines.patch | 36 - SOURCES/gcc9-add-sve-tests.patch | 159 ++ SOURCES/gcc9-fixes.patch | 481 ++++ SOURCES/gcc9-libstdc++-compat.patch | 14 +- SOURCES/gcc9-pr90303.patch | 39 - SOURCES/nvptx-tools-build.patch | 11 + SOURCES/nvptx-tools-glibc.patch | 32 + SOURCES/nvptx-tools-no-ptxas.patch | 947 ++++++++ SPECS/gcc.spec | 293 ++- 49 files changed, 9158 insertions(+), 5169 deletions(-) delete mode 100644 SOURCES/0001-Allow-repeated-compatible-type-specifications.patch create mode 100644 SOURCES/0001-Default-widths-for-i-f-and-g-format-specifiers-in-fo.patch create mode 100644 SOURCES/0002-Allow-duplicate-declarations.patch delete mode 100644 SOURCES/0002-Pad-character-to-int-conversions-with-spaces-instead.patch delete mode 100644 SOURCES/0003-Add-std-extra-legacy.patch create mode 100644 SOURCES/0003-Convert-LOGICAL-to-INTEGER-for-arithmetic-ops-and-vi.patch create mode 100644 SOURCES/0004-Allow-CHARACTER-literals-in-assignments-and-data-sta.patch delete mode 100644 SOURCES/0004-Allow-conversion-between-Hollerith-constants-and-CHA.patch delete mode 100644 SOURCES/0005-Allow-comparisons-between-INTEGER-and-REAL.patch create mode 100644 SOURCES/0005-dec-comparisons.patch create mode 100644 SOURCES/0009-Allow-old-style-initializers-in-derived-types.patch delete mode 100644 SOURCES/0009-Convert-LOGICAL-to-INTEGER-for-arithmetic-ops-and-vi.patch delete mode 100644 SOURCES/0010-Allow-mixed-string-length-and-array-specification-in.patch create mode 100644 SOURCES/0010-Allow-string-length-and-kind-to-be-specified-on-a-pe.patch delete mode 100644 SOURCES/0011-Allow-character-to-int-conversions-in-DATA-statement.patch create mode 100644 SOURCES/0011-Allow-non-logical-expressions-in-IF-statements.patch delete mode 100644 SOURCES/0012-Allow-old-style-initializers-in-derived-types.patch create mode 100644 SOURCES/0012-Support-type-promotion-in-calls-to-intrinsics.patch create mode 100644 SOURCES/0013-Add-the-SEQUENCE-attribute-by-default-if-it-s-not-pr.patch delete mode 100644 SOURCES/0013-Allow-per-variable-kind-specification.patch delete mode 100644 SOURCES/0014-Allow-non-logical-expressions-in-IF-statements.patch create mode 100644 SOURCES/0014-Fill-in-missing-array-dimensions-using-the-lower-bou.patch create mode 100644 SOURCES/0015-Allow-automatics-in-equivalence.patch delete mode 100644 SOURCES/0016-Allow-calls-to-intrinsics-with-smaller-types-than-sp.patch create mode 100644 SOURCES/0016-Suppress-warning-with-Wno-overwrite-recursive.patch delete mode 100644 SOURCES/0017-Add-the-SEQUENCE-attribute-by-default-if-it-s-not-pr.patch delete mode 100644 SOURCES/0018-Fill-in-missing-array-dimensions-using-the-lower-bou.patch delete mode 100644 SOURCES/0019-Add-tests-for-AUTOMATIC-keyword.patch delete mode 100644 SOURCES/0022-Default-values-for-certain-field-descriptors-in-form.patch delete mode 100644 SOURCES/gcc8-fortran-equivalence.patch delete mode 100644 SOURCES/gcc8-fortran-fdec-include-doc.patch delete mode 100644 SOURCES/gcc8-fortran-fdec-include.patch delete mode 100644 SOURCES/gcc8-fortran-fpad-source.patch delete mode 100644 SOURCES/gcc8-fortran-pr87919-2.patch delete mode 100644 SOURCES/gcc8-fortran-pr87919.patch delete mode 100644 SOURCES/gcc8-fortranlines.patch create mode 100644 SOURCES/gcc9-add-sve-tests.patch create mode 100644 SOURCES/gcc9-fixes.patch delete mode 100644 SOURCES/gcc9-pr90303.patch create mode 100644 SOURCES/nvptx-tools-build.patch create mode 100644 SOURCES/nvptx-tools-glibc.patch create mode 100644 SOURCES/nvptx-tools-no-ptxas.patch diff --git a/.gcc-toolset-9-gcc.metadata b/.gcc-toolset-9-gcc.metadata index e02f06c..5b96d56 100644 --- a/.gcc-toolset-9-gcc.metadata +++ b/.gcc-toolset-9-gcc.metadata @@ -1,4 +1,6 @@ 7f4348418dc3efefd357b32a2b5c8010211ab284 SOURCES/doxygen-1.8.0.src.tar.gz -574d80f9840124e0ad45b84e8a59b29419726ce8 SOURCES/gcc-9.1.1-20190503.tar.xz +f98fd29e9c3faf986b48404be3ae4201e6a1b492 SOURCES/gcc-9.2.1-20191120.tar.xz c5a2b201bf05229647e73203c0bf2d9679d4d21f SOURCES/isl-0.16.1.tar.bz2 5ef03ca7aee134fe7dfecb6c9d048799f0810278 SOURCES/mpc-0.8.1.tar.gz +3bdb3cc01fa7690a0e20ea5cfffcbe690f7665eb SOURCES/nvptx-newlib-aadc8eb0ec43b7cd0dd2dfb484bae63c8b05ef24.tar.xz +ce8eb83be0ac37fb5d5388df455a980fe37b4f13 SOURCES/nvptx-tools-c28050f60193b3b95a18866a96f03334e874e78f.tar.xz diff --git a/.gitignore b/.gitignore index 217feb2..a5401a6 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,6 @@ SOURCES/doxygen-1.8.0.src.tar.gz -SOURCES/gcc-9.1.1-20190503.tar.xz +SOURCES/gcc-9.2.1-20191120.tar.xz SOURCES/isl-0.16.1.tar.bz2 SOURCES/mpc-0.8.1.tar.gz +SOURCES/nvptx-newlib-aadc8eb0ec43b7cd0dd2dfb484bae63c8b05ef24.tar.xz +SOURCES/nvptx-tools-c28050f60193b3b95a18866a96f03334e874e78f.tar.xz diff --git a/SOURCES/0001-Allow-repeated-compatible-type-specifications.patch b/SOURCES/0001-Allow-repeated-compatible-type-specifications.patch deleted file mode 100644 index 4dc58b5..0000000 --- a/SOURCES/0001-Allow-repeated-compatible-type-specifications.patch +++ /dev/null @@ -1,81 +0,0 @@ -From f96f2f273741ea19311c6e7a6f556c09b6ff9415 Mon Sep 17 00:00:00 2001 -From: Mark Doffman -Date: Tue, 23 Jun 2015 22:59:08 +0000 -Subject: [PATCH 01/23] Allow repeated compatible type specifications. - -Add a check to see if a repeated type specification is compatible -with the previous specification. Only create an error on incompatible -type specifications for the same symbol. - -Some fixes by Jim MacArthur ---- - - 0001-Allow-repeated-compatible-type-specifications.patch - - 0015-Allow-redefinition-of-types-for-procedures.patch - - 0021-Correct-internal-fault-in-select_type_9.f90.patch - - -diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c -index ec43e63..67ad504 100644 ---- a/gcc/fortran/symbol.c -+++ b/gcc/fortran/symbol.c -@@ -1877,6 +1877,8 @@ gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where) - if (sym->attr.result && type == BT_UNKNOWN && sym->ns->proc_name) - type = sym->ns->proc_name->ts.type; - -+ flavor = sym->attr.flavor; -+ - if (type != BT_UNKNOWN && !(sym->attr.function && sym->attr.implicit_type) - && !(gfc_state_stack->previous && gfc_state_stack->previous->previous - && gfc_state_stack->previous->previous->state == COMP_SUBMODULE) -@@ -1886,6 +1888,20 @@ gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where) - gfc_error ("Symbol %qs at %L conflicts with symbol from module %qs, " - "use-associated at %L", sym->name, where, sym->module, - &sym->declared_at); -+ else if (gfc_option.allow_std & GFC_STD_EXTRA_LEGACY) -+ { -+ /* Ignore temporaries and class/procedure names */ -+ if (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS || sym->ts.type == BT_PROCEDURE) -+ return false; -+ -+ if (gfc_compare_types (&sym->ts, ts) -+ && (flavor == FL_UNKNOWN || flavor == FL_VARIABLE || flavor == FL_PROCEDURE)) -+ { -+ return gfc_notify_std (GFC_STD_LEGACY, -+ "Symbol '%qs' at %L already has basic type of %s", sym->name, -+ where, gfc_basic_typename (type)); -+ } -+ } - else - gfc_error ("Symbol %qs at %L already has basic type of %s", sym->name, - where, gfc_basic_typename (type)); -@@ -1899,8 +1915,6 @@ gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where) - return false; - } - -- flavor = sym->attr.flavor; -- - if (flavor == FL_PROGRAM || flavor == FL_BLOCK_DATA || flavor == FL_MODULE - || flavor == FL_LABEL - || (flavor == FL_PROCEDURE && sym->attr.subroutine) -diff --git a/gcc/testsuite/gfortran.dg/duplicate_type_4.f90 b/gcc/testsuite/gfortran.dg/duplicate_type_4.f90 -new file mode 100644 -index 0000000..cdd29ea ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/duplicate_type_4.f90 -@@ -0,0 +1,13 @@ -+! { dg-do compile } -+! { dg-options "-std=f95" } -+ -+! PR fortran/30239 -+! Check for errors when a symbol gets declared a type twice, even if it -+! is the same. -+ -+INTEGER FUNCTION foo () -+ IMPLICIT NONE -+ INTEGER :: x -+ INTEGER :: x ! { dg-error "basic type of" } -+ x = 42 -+END FUNCTION foo diff --git a/SOURCES/0001-Default-widths-for-i-f-and-g-format-specifiers-in-fo.patch b/SOURCES/0001-Default-widths-for-i-f-and-g-format-specifiers-in-fo.patch new file mode 100644 index 0000000..8d6247d --- /dev/null +++ b/SOURCES/0001-Default-widths-for-i-f-and-g-format-specifiers-in-fo.patch @@ -0,0 +1,873 @@ +From f3e3034684c7ac44a14c70d6a248d8acee303176 Mon Sep 17 00:00:00 2001 +From: law +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 : + +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 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 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 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 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 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 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 + diff --git a/SOURCES/0002-Allow-duplicate-declarations.patch b/SOURCES/0002-Allow-duplicate-declarations.patch new file mode 100644 index 0000000..42f4fd3 --- /dev/null +++ b/SOURCES/0002-Allow-duplicate-declarations.patch @@ -0,0 +1,219 @@ +From dd2c3c5e8e8370d6e08a87b7122b8fbe4ddf7dde Mon Sep 17 00:00:00 2001 +From: Mark Doffman +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 +Addition of -fdec-duplicates by Mark Eggleston +--- + 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 ++! ++ ++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 ++! ++ ++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 ++! ++ ++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 ++! ++ ++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 ++! ++ ++integer function foo () ++ implicit none ++ integer :: x ++ integer :: x ! { dg-error "basic type of" } ++ x = 42 ++end function foo +-- +2.11.0 + diff --git a/SOURCES/0002-Pad-character-to-int-conversions-with-spaces-instead.patch b/SOURCES/0002-Pad-character-to-int-conversions-with-spaces-instead.patch deleted file mode 100644 index c0b375c..0000000 --- a/SOURCES/0002-Pad-character-to-int-conversions-with-spaces-instead.patch +++ /dev/null @@ -1,106 +0,0 @@ -From 40d6590b03a9f92c19b7097b1cae296276d6ce22 Mon Sep 17 00:00:00 2001 -From: Jim MacArthur -Date: Mon, 28 Sep 2015 16:06:30 +0100 -Subject: [PATCH 02/23] Pad character-to-int conversions with spaces instead of - zeros. - -The pad character is 'undefined' or 'processor dependent' depending on which -standard you read. This makes it 0x20 which matches the Oracle Fortran -compiler. One of the tests tests this undefined behaviour, so I had to modify -it. - - 0002-Pad-character-to-int-conversions-with-spaces-instead.patch - -diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt -index 4808c27..93908f8 100644 ---- a/gcc/fortran/lang.opt -+++ b/gcc/fortran/lang.opt -@@ -428,6 +428,10 @@ fdec - Fortran Var(flag_dec) - Enable all DEC language extensions. - -+fdec-pad-with-spaces -+Fortran Var(flag_dec_pad_with_spaces) -+For character to integer conversions, use spaces for the pad rather than NUL. -+ - fdec-intrinsic-ints - Fortran Var(flag_dec_intrinsic_ints) - Enable kind-specific variants of integer intrinsic functions. -diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c -index d12ae5f..09da1d2 100644 ---- a/gcc/fortran/simplify.c -+++ b/gcc/fortran/simplify.c -@@ -6623,7 +6623,7 @@ gfc_simplify_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size) - /* Allocate the buffer to store the binary version of the source. */ - buffer_size = MAX (source_size, result_size); - buffer = (unsigned char*)alloca (buffer_size); -- memset (buffer, 0, buffer_size); -+ memset (buffer, (flag_dec_pad_with_spaces ? 0x20 : 0x0), buffer_size); - - /* Now write source to the buffer. */ - gfc_target_encode_expr (source, buffer, buffer_size); ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/c_ptr_tests_20.f90 -@@ -0,0 +1,62 @@ -+! { dg-do compile } -+! { dg-options "-fdump-tree-optimized -O -fdec-pad-with-spaces" } -+! -+! PR fortran/46974 -+ -+program test -+ use ISO_C_BINDING -+ implicit none -+ type(c_ptr) :: m -+ integer(c_intptr_t) :: a -+ integer(transfer(transfer(4_c_intptr_t, c_null_ptr),1_c_intptr_t)) :: b -+ a = transfer (transfer("ABCE", m), 1_c_intptr_t) -+ print '(z8)', a -+ if ( int(z'45434241') /= a & -+ .and. int(z'41424345') /= a & -+ .and. int(z'4142434520202020',kind=8) /= a & -+ .and. int(z'2020202045434241',kind=8) /= a ) & -+ call i_do_not_exist() -+end program test -+ -+! Examples contributed by Steve Kargl and James Van Buskirk -+ -+subroutine bug1 -+ use ISO_C_BINDING -+ implicit none -+ type(c_ptr) :: m -+ type mytype -+ integer a, b, c -+ end type mytype -+ type(mytype) x -+ print *, transfer(32512, x) ! Works. -+ print *, transfer(32512, m) ! Caused ICE. -+end subroutine bug1 -+ -+subroutine bug6 -+ use ISO_C_BINDING -+ implicit none -+ interface -+ function fun() -+ use ISO_C_BINDING -+ implicit none -+ type(C_FUNPTR) fun -+ end function fun -+ end interface -+ type(C_PTR) array(2) -+ type(C_FUNPTR) result -+ integer(C_INTPTR_T), parameter :: const(*) = [32512,32520] -+ -+ result = fun() -+ array = transfer([integer(C_INTPTR_T)::32512,32520],array) -+! write(*,*) transfer(result,const) -+! write(*,*) transfer(array,const) -+end subroutine bug6 -+ -+function fun() -+ use ISO_C_BINDING -+ implicit none -+ type(C_FUNPTR) fun -+ fun = transfer(32512_C_INTPTR_T,fun) -+end function fun -+ -+! { dg-final { scan-tree-dump-times "i_do_not_exist" 0 "optimized" } } diff --git a/SOURCES/0003-Add-std-extra-legacy.patch b/SOURCES/0003-Add-std-extra-legacy.patch deleted file mode 100644 index 193d3aa..0000000 --- a/SOURCES/0003-Add-std-extra-legacy.patch +++ /dev/null @@ -1,54 +0,0 @@ -From d1bb76287ec58fdde7ced70088559136555bd7bd Mon Sep 17 00:00:00 2001 -From: Jim MacArthur -Date: Fri, 11 Dec 2015 17:04:09 +0000 -Subject: [PATCH 03/23] Add -std=extra-legacy - - - 0003-Add-std-extra-legacy.patch - - 0023-Add-a-full-stop-to-the-std-extra-legacy-help-text.patch - -diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt -index 4421ce4..4808c27 100644 ---- a/gcc/fortran/lang.opt -+++ b/gcc/fortran/lang.opt -@@ -790,6 +790,10 @@ std=legacy - Fortran - Accept extensions to support legacy code. - -+std=extra-legacy -+Fortran -+Accept even more legacy extensions, including things disallowed in f90. -+ - undef - Fortran - ; Documented in C -diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h -index c5ff992..dcc923b 100644 ---- a/gcc/fortran/libgfortran.h -+++ b/gcc/fortran/libgfortran.h -@@ -22,6 +22,7 @@ along with GCC; see the file COPYING3. - Note that no features were obsoleted nor deleted in F2003. - Please remember to keep those definitions in sync with - gfortran.texi. */ -+#define GFC_STD_EXTRA_LEGACY (1<<13) /* Even more backward compatibility. */ - #define GFC_STD_F2018_DEL (1<<12) /* Deleted in F2018. */ - #define GFC_STD_F2018_OBS (1<<11) /* Obsolescent in F2018. */ - #define GFC_STD_F2018 (1<<10) /* New in F2018. */ -diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c -index 1af76aa..9ebf8e3 100644 ---- a/gcc/fortran/options.c -+++ b/gcc/fortran/options.c -@@ -733,6 +733,12 @@ gfc_handle_option (size_t scode, const char *arg, int value, - gfc_option.warn_std = 0; - break; - -+ case OPT_std_extra_legacy: -+ set_default_std_flags (); -+ gfc_option.warn_std = 0; -+ gfc_option.allow_std |= GFC_STD_EXTRA_LEGACY; -+ break; -+ - case OPT_fshort_enums: - /* Handled in language-independent code. */ - break; diff --git a/SOURCES/0003-Convert-LOGICAL-to-INTEGER-for-arithmetic-ops-and-vi.patch b/SOURCES/0003-Convert-LOGICAL-to-INTEGER-for-arithmetic-ops-and-vi.patch new file mode 100644 index 0000000..abec1ac --- /dev/null +++ b/SOURCES/0003-Convert-LOGICAL-to-INTEGER-for-arithmetic-ops-and-vi.patch @@ -0,0 +1,298 @@ +From 6a3faecd0b1eed41e865bdab721cc3a60492845d Mon Sep 17 00:00:00 2001 +From: Jim MacArthur +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 ++! Modified for -flogical-as-integer by Mark Eggleston ++! ++! ++ 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 ++! ++! ++ 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 + diff --git a/SOURCES/0004-Allow-CHARACTER-literals-in-assignments-and-data-sta.patch b/SOURCES/0004-Allow-CHARACTER-literals-in-assignments-and-data-sta.patch new file mode 100644 index 0000000..66a63b7 --- /dev/null +++ b/SOURCES/0004-Allow-CHARACTER-literals-in-assignments-and-data-sta.patch @@ -0,0 +1,860 @@ +From c1d6c81730ffda61eff8fccf4d0c7efa3ae6fd8d Mon Sep 17 00:00:00 2001 +From: Jim MacArthur +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 ++! ++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 ++! ++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 ++! ++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 ++! ++ ++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 ++! ++ ++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 ++! ++ ++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 ++! ++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 + diff --git a/SOURCES/0004-Allow-conversion-between-Hollerith-constants-and-CHA.patch b/SOURCES/0004-Allow-conversion-between-Hollerith-constants-and-CHA.patch deleted file mode 100644 index 6b99600..0000000 --- a/SOURCES/0004-Allow-conversion-between-Hollerith-constants-and-CHA.patch +++ /dev/null @@ -1,318 +0,0 @@ -From 7420e95a0ebb2401d67ad405670fb6a8d33f02da Mon Sep 17 00:00:00 2001 -From: Jim MacArthur -Date: Thu, 4 Feb 2016 17:18:30 +0000 -Subject: [PATCH 04/23] Allow conversion between Hollerith constants and - CHARACTER and INTEGER - -Warnings are raised when this happens. - -This feature is enabled with the `-std=extra-legacy` compiler flag. - - 0004-Allow-conversion-between-Hollerith-constants-and-CHA.patch - -diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c -index 8fa305c..fc1be48 100644 ---- a/gcc/fortran/arith.c -+++ b/gcc/fortran/arith.c -@@ -2562,6 +2562,34 @@ hollerith2representation (gfc_expr *resu - } - - -+/* Helper function to set the representation in a character conversion. -+ This assumes that the ts.type and ts.kind of the result have already -+ been set. */ -+ -+static void -+character2representation (gfc_expr *result, gfc_expr *src) -+{ -+ size_t src_len, result_len; -+ size_t i; -+ src_len = src->value.character.length; -+ gfc_target_expr_size (result, &result_len); -+ -+ if (src_len > result_len) -+ gfc_warning (0, "The character constant at %L is too long to convert to %s", -+ &src->where, gfc_typename(&result->ts)); -+ -+ result->representation.string = XCNEWVEC (char, result_len + 1); -+ -+ for (i = 0; i < MIN (result_len, src_len); i++) -+ result->representation.string[i] = (char) src->value.character.string[i]; -+ -+ if (src_len < result_len) -+ memset (&result->representation.string[src_len], ' ', result_len - src_len); -+ -+ result->representation.string[result_len] = '\0'; /* For debugger */ -+ result->representation.length = result_len; -+} -+ - /* Convert Hollerith to integer. The constant will be padded or truncated. */ - - gfc_expr * -@@ -2577,6 +2605,19 @@ gfc_hollerith2int (gfc_expr *src, int ki - return result; - } - -+/* Convert character to integer. The constant will be padded or truncated. */ -+ -+gfc_expr * -+gfc_character2int (gfc_expr *src, int kind) -+{ -+ gfc_expr *result; -+ result = gfc_get_constant_expr (BT_INTEGER, kind, &src->where); -+ -+ character2representation (result, src); -+ gfc_interpret_integer (kind, (unsigned char *) result->representation.string, -+ result->representation.length, result->value.integer); -+ return result; -+} - - /* Convert Hollerith to real. The constant will be padded or truncated. */ - -diff --git a/gcc/fortran/arith.h b/gcc/fortran/arith.h -index 85aca5b..1f56aea 100644 ---- a/gcc/fortran/arith.h -+++ b/gcc/fortran/arith.h -@@ -83,6 +83,7 @@ gfc_expr *gfc_hollerith2complex (gfc_expr *, int); - gfc_expr *gfc_hollerith2character (gfc_expr *, int); - gfc_expr *gfc_hollerith2logical (gfc_expr *, int); - gfc_expr *gfc_character2character (gfc_expr *, int); -+gfc_expr *gfc_character2int (gfc_expr *, int); - - #endif /* GFC_ARITH_H */ - -diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c -index f304154..ed3d440 100644 ---- a/gcc/fortran/check.c -+++ b/gcc/fortran/check.c -@@ -2643,9 +2643,14 @@ gfc_check_index (gfc_expr *string, gfc_expr *substring, gfc_expr *back, - } - - -+/* This is the check function for the argument to the INT intrinsic */ - bool - gfc_check_int (gfc_expr *x, gfc_expr *kind) - { -+ if ((gfc_option.allow_std & GFC_STD_EXTRA_LEGACY) -+ && x->ts.type == BT_CHARACTER) -+ return true; -+ - if (!numeric_check (x, 0)) - return false; - -diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c -index 2f60fe8..371f5b8 100644 ---- a/gcc/fortran/intrinsic.c -+++ b/gcc/fortran/intrinsic.c -@@ -3928,6 +3928,17 @@ add_conversions (void) - add_conv (BT_LOGICAL, gfc_logical_kinds[j].kind, - BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY); - } -+ -+ /* Oracle allows character values to be converted to integers, -+ similar to Hollerith-Integer conversion - the first characters will -+ be turned into ascii values. */ -+ if (gfc_option.allow_std & GFC_STD_EXTRA_LEGACY) -+ { -+ /* Character-Integer conversions. */ -+ for (i = 0; gfc_integer_kinds[i].kind != 0; i++) -+ add_conv (BT_CHARACTER, gfc_default_character_kind, -+ BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY); -+ } - } - - -@@ -5008,6 +5019,15 @@ gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag) - gfc_typename (&from_ts), gfc_typename (ts), - &expr->where); - } -+ else if ((gfc_option.allow_std & GFC_STD_EXTRA_LEGACY) -+ && from_ts.type == BT_CHARACTER -+ && ts->type == BT_INTEGER) -+ { -+ if (warn_conversion_extra || warn_conversion) -+ gfc_warning_now (0, "Conversion from %s to %s at %L", -+ gfc_typename (&from_ts), gfc_typename (ts), -+ &expr->where); -+ } - else - gcc_unreachable (); - } -diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c -index d09cfa6..07c8c9a 100644 ---- a/gcc/fortran/resolve.c -+++ b/gcc/fortran/resolve.c -@@ -3803,6 +3803,30 @@ lookup_uop_fuzzy (const char *op, gfc_symtree *uop) - return gfc_closest_fuzzy_match (op, candidates); - } - -+/* Return true if TYPE is character based, false otherwise. */ -+ -+static int -+is_character_based (bt type) -+{ -+ return type == BT_CHARACTER || type == BT_HOLLERITH; -+} -+ -+/* If E is a logical, convert it to an integer and issue a warning -+ for the conversion. */ -+ -+static void -+convert_logical_to_integer (gfc_expr *e) -+{ -+ if (e->ts.type == BT_LOGICAL) -+ { -+ /* Convert to INTEGER */ -+ gfc_typespec t; -+ t.type = BT_INTEGER; -+ t.kind = 1; -+ gfc_convert_type_warn (e, &t, 2, 1); -+ } -+} -+ - - /* Resolve an operator expression node. This can involve replacing the - operation with a user defined function call. */ -@@ -3976,6 +4000,38 @@ resolve_operator (gfc_expr *e) - case INTRINSIC_EQ_OS: - case INTRINSIC_NE: - case INTRINSIC_NE_OS: -+ -+ if (gfc_option.allow_std & GFC_STD_EXTRA_LEGACY) -+ { -+ convert_logical_to_integer (op1); -+ convert_logical_to_integer (op2); -+ } -+ -+ /* If you're comparing hollerith contants to character expresisons, -+ convert the hollerith constant */ -+ if ((gfc_option.allow_std & GFC_STD_EXTRA_LEGACY) -+ && is_character_based (op1->ts.type) -+ && is_character_based (op2->ts.type)) -+ { -+ gfc_typespec ts; -+ ts.type = BT_CHARACTER; -+ ts.kind = op1->ts.kind; -+ if (op1->ts.type == BT_HOLLERITH) -+ { -+ gfc_convert_type_warn (op1, &ts, 2, 1); -+ gfc_warning (0, "Promoting argument for comparison from HOLLERITH " -+ "to CHARACTER at %L", &op1->where); -+ } -+ ts.type = BT_CHARACTER; -+ ts.kind = op2->ts.kind; -+ if (op2->ts.type == BT_HOLLERITH) -+ { -+ gfc_convert_type_warn (op2, &ts, 2, 1); -+ gfc_warning (0, "Promoting argument for comparison from HOLLERITH " -+ "to CHARACTER at %L", &op2->where); -+ } -+ } -+ - if (op1->ts.type == BT_CHARACTER && op2->ts.type == BT_CHARACTER - && op1->ts.kind == op2->ts.kind) - { -@@ -3984,6 +4040,29 @@ resolve_operator (gfc_expr *e) - break; - } - -+ /* Numeric to hollerith comparisons */ -+ if ((gfc_option.allow_std & GFC_STD_EXTRA_LEGACY) -+ && gfc_numeric_ts (&op1->ts) -+ && (op2->ts.type == BT_HOLLERITH || op2->ts.type == BT_CHARACTER)) -+ { -+ gfc_warning (0, "Promoting argument for comparison from character type to INTEGER at %L", &op2->where); -+ gfc_typespec ts; -+ ts.type = BT_INTEGER; -+ ts.kind = 4; -+ gfc_convert_type_warn (op2, &ts, 2, 1); -+ } -+ -+ if ((gfc_option.allow_std & GFC_STD_EXTRA_LEGACY) -+ && gfc_numeric_ts (&op2->ts) -+ && (op1->ts.type == BT_HOLLERITH || op1->ts.type == BT_CHARACTER)) -+ { -+ gfc_warning (0, "Promoting argument for comparison from character type to INTEGER at %L", &op1->where); -+ gfc_typespec ts; -+ ts.type = BT_INTEGER; -+ ts.kind = 4; -+ gfc_convert_type_warn (op1, &ts, 2, 1); -+ } -+ - if (gfc_numeric_ts (&op1->ts) && gfc_numeric_ts (&op2->ts)) - { - gfc_type_convert_binary (e, 1); -@@ -4188,7 +4267,6 @@ bad_op: - return false; - } - -- - /************** Array resolution subroutines **************/ - - enum compare_result -diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c -index 3c85c52..e03384c 100644 ---- a/gcc/fortran/simplify.c -+++ b/gcc/fortran/simplify.c -@@ -7987,10 +7987,19 @@ gfc_convert_constant (gfc_expr *e, bt type, int kind) - break; - - case BT_CHARACTER: -- if (type == BT_CHARACTER) -- f = gfc_character2character; -- else -- goto oops; -+ switch (type) -+ { -+ case BT_CHARACTER: -+ f = gfc_character2character; -+ break; -+ -+ case BT_INTEGER: -+ f = gfc_character2int; -+ break; -+ -+ default: -+ goto oops; -+ } - break; - - default: -diff --git a/gcc/testsuite/gfortran.dg/hollerith-character-comparison.f90 b/gcc/testsuite/gfortran.dg/hollerith-character-comparison.f90 -new file mode 100644 -index 0000000..9c462b9 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/hollerith-character-comparison.f90 -@@ -0,0 +1,15 @@ -+ ! { dg-options "-std=extra-legacy" } -+ -+ program convert -+ REAL*4 a -+ INTEGER*4 b -+ b = 1000 -+ print *, 4HJMAC.eq.4HJMAC ! { dg-warning "Promoting argument for comparison from HOLLERITH to CHARACTER at" } -+ print *, 4HJMAC.eq."JMAC" ! { dg-warning "Promoting argument for comparison from HOLLERITH to CHARACTER at" } -+ print *, 4HJMAC.eq."JMAN" ! { dg-warning "Promoting argument for comparison from HOLLERITH to CHARACTER at" } -+ print *, "JMAC".eq.4HJMAN ! { dg-warning "Promoting argument for comparison from HOLLERITH to CHARACTER at" } -+ print *, "AAAA".eq.5HAAAAA ! { dg-warning "Promoting argument for comparison from HOLLERITH to CHARACTER at" } -+ print *, "BBBBB".eq.5HBBBB ! { dg-warning "Promoting argument for comparison from HOLLERITH to CHARACTER at" } -+ -+ end program -+ -diff --git a/gcc/testsuite/gfortran.dg/hollerith-int-comparison.f90 b/gcc/testsuite/gfortran.dg/hollerith-int-comparison.f90 -new file mode 100644 -index 0000000..f44c1f8 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/hollerith-int-comparison.f90 -@@ -0,0 +1,11 @@ -+ ! { dg-options "-std=extra-legacy" } -+ -+ program convert -+ INTEGER*4 b -+ b = 5HRIVET ! { dg-warning "Legacy Extension: Hollerith constant|Conversion from HOLLERITH to INTEGER|too long to convert" } -+ print *, 4HJMAC.eq.400 ! { dg-warning "Legacy Extension: Hollerith constant|Promoting argument for comparison from character|Conversion from HOLLERITH to INTEGER" } -+ print *, 4HRIVE.eq.1163282770 ! { dg-warning "Legacy Extension: Hollerith constant|Promoting argument for comparison from character|Conversion from HOLLERITH to INTEGER" } -+ print *, b -+ print *, 1163282770.eq.4HRIVE ! { dg-warning "Legacy Extension: Hollerith constant|Promoting argument for comparison from character|Conversion from HOLLERITH to INTEGER" } -+ end program -+ diff --git a/SOURCES/0005-Allow-comparisons-between-INTEGER-and-REAL.patch b/SOURCES/0005-Allow-comparisons-between-INTEGER-and-REAL.patch deleted file mode 100644 index b1e447d..0000000 --- a/SOURCES/0005-Allow-comparisons-between-INTEGER-and-REAL.patch +++ /dev/null @@ -1,1143 +0,0 @@ -commit a2ddfaea2bbe8ea26c37c1d31db71c56855e10ce -Author: Francisco Redondo Marchena -Date: Mon Apr 9 15:10:02 2018 +0100 - - Add support for type promotion in intrinsic arguments - - This feature is supported by the DEC compiler and can be enabled - using the -fdec flag. - - Signed-off-by: Ben Brewer - - Tests written by: Francisco Redondo Marchena - Jeff Law - -diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c -index fd0b00a..423d2cb 100644 ---- a/gcc/fortran/check.c -+++ b/gcc/fortran/check.c -@@ -932,12 +932,40 @@ gfc_check_allocated (gfc_expr *array) - } - - -+/* Check function where both arguments must be real or integer -+ and warn if they are different types. */ -+ -+bool -+check_int_real_promotion (gfc_expr *a, gfc_expr *b) -+{ -+ gfc_expr *i; -+ -+ if (!int_or_real_check (a, 0)) -+ return false; -+ -+ if (!int_or_real_check (b, 1)) -+ return false; -+ -+ if (a->ts.type != b->ts.type) -+ { -+ i = (a->ts.type != BT_REAL ? a : b); -+ gfc_warning_now (OPT_Wconversion, "Conversion from INTEGER to REAL " -+ "at %L might lose precision", &i->where); -+ } -+ -+ return true; -+} -+ -+ - /* Common check function where the first argument must be real or - integer and the second argument must be the same as the first. */ - - bool - gfc_check_a_p (gfc_expr *a, gfc_expr *p) - { -+ if (flag_dec) -+ return check_int_real_promotion (a, p); -+ - if (!int_or_real_check (a, 0)) - return false; - -@@ -3140,6 +3168,41 @@ check_rest (bt type, int kind, gfc_actual_arglist *arglist) - } - - -+/* Check function where all arguments of an argument list must be real -+ or integer. */ -+ -+static bool -+check_rest_int_real (gfc_actual_arglist *arglist) -+{ -+ gfc_actual_arglist *arg, *tmp; -+ gfc_expr *x; -+ int m, n; -+ -+ if (!min_max_args (arglist)) -+ return false; -+ -+ for (arg = arglist, n=1; arg; arg = arg->next, n++) -+ { -+ x = arg->expr; -+ if (x->ts.type != BT_INTEGER && x->ts.type != BT_REAL) -+ { -+ gfc_error ("% argument of %qs intrinsic at %L must be " -+ "INTEGER or REAL", n, gfc_current_intrinsic, &x->where); -+ return false; -+ } -+ -+ for (tmp = arglist, m=1; tmp != arg; tmp = tmp->next, m++) -+ if (!gfc_check_conformance (tmp->expr, x, -+ "arguments 'a%d' and 'a%d' for " -+ "intrinsic '%s'", m, n, -+ gfc_current_intrinsic)) -+ return false; -+ } -+ -+ return true; -+} -+ -+ - bool - gfc_check_min_max (gfc_actual_arglist *arg) - { -@@ -3164,7 +3227,10 @@ gfc_check_min_max (gfc_actual_arglist *arg) - return false; - } - -- return check_rest (x->ts.type, x->ts.kind, arg); -+ if (flag_dec && x->ts.type != BT_CHARACTER) -+ return check_rest_int_real (arg); -+ else -+ return check_rest (x->ts.type, x->ts.kind, arg); - } - - -@@ -4426,6 +4492,9 @@ gfc_check_shift (gfc_expr *i, gfc_expr *shift) - bool - gfc_check_sign (gfc_expr *a, gfc_expr *b) - { -+ if (flag_dec) -+ return check_int_real_promotion (a, b); -+ - if (!int_or_real_check (a, 0)) - return false; - -diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c -index f15b8f2..0932180 100644 ---- a/gcc/fortran/iresolve.c -+++ b/gcc/fortran/iresolve.c -@@ -892,19 +892,22 @@ gfc_resolve_dble (gfc_expr *f, gfc_expr *a) - void - gfc_resolve_dim (gfc_expr *f, gfc_expr *a, gfc_expr *p) - { -- f->ts.type = a->ts.type; - if (p != NULL) -- f->ts.kind = gfc_kind_max (a,p); -- else -- f->ts.kind = a->ts.kind; -- -- if (p != NULL && a->ts.kind != p->ts.kind) - { -- if (a->ts.kind == gfc_kind_max (a,p)) -- gfc_convert_type (p, &a->ts, 2); -+ f->ts.kind = gfc_kind_max (a,p); -+ if (a->ts.type == BT_REAL || p->ts.type == BT_REAL) -+ f->ts.type = BT_REAL; - else -- gfc_convert_type (a, &p->ts, 2); -+ f->ts.type = BT_INTEGER; -+ -+ if (a->ts.kind != f->ts.kind || a->ts.type != f->ts.type) -+ gfc_convert_type (a, &f->ts, 2); -+ -+ if (p->ts.kind != f->ts.kind || p->ts.type != f->ts.type) -+ gfc_convert_type (p, &f->ts, 2); - } -+ else -+ f->ts = a->ts; - - f->value.function.name - = gfc_get_string ("__dim_%c%d", gfc_type_letter (f->ts.type), f->ts.kind); -@@ -1659,14 +1662,17 @@ gfc_resolve_minmax (const char *name, gfc_expr *f, gfc_actual_arglist *args) - /* Find the largest type kind. */ - for (a = args->next; a; a = a->next) - { -+ if (a->expr-> ts.type == BT_REAL) -+ f->ts.type = BT_REAL; -+ - if (a->expr->ts.kind > f->ts.kind) - f->ts.kind = a->expr->ts.kind; - } - -- /* Convert all parameters to the required kind. */ -+ /* Convert all parameters to the required type and/or kind. */ - for (a = args; a; a = a->next) - { -- if (a->expr->ts.kind != f->ts.kind) -+ if (a->expr->ts.type != f->ts.type || a->expr->ts.kind != f->ts.kind) - gfc_convert_type (a->expr, &f->ts, 2); - } - -@@ -2050,19 +2056,22 @@ gfc_resolve_minval (gfc_expr *f, gfc_expr *array, gfc_expr *dim, - void - gfc_resolve_mod (gfc_expr *f, gfc_expr *a, gfc_expr *p) - { -- f->ts.type = a->ts.type; - if (p != NULL) -- f->ts.kind = gfc_kind_max (a,p); -- else -- f->ts.kind = a->ts.kind; -- -- if (p != NULL && a->ts.kind != p->ts.kind) - { -- if (a->ts.kind == gfc_kind_max (a,p)) -- gfc_convert_type (p, &a->ts, 2); -+ f->ts.kind = gfc_kind_max (a,p); -+ if (a->ts.type == BT_REAL || p->ts.type == BT_REAL) -+ f->ts.type = BT_REAL; - else -- gfc_convert_type (a, &p->ts, 2); -+ f->ts.type = BT_INTEGER; -+ -+ if (a->ts.kind != f->ts.kind || a->ts.type != f->ts.type) -+ gfc_convert_type (a, &f->ts, 2); -+ -+ if (p->ts.kind != f->ts.kind || p->ts.type != f->ts.type) -+ gfc_convert_type (p, &f->ts, 2); - } -+ else -+ f->ts = a->ts; - - f->value.function.name - = gfc_get_string ("__mod_%c%d", gfc_type_letter (f->ts.type), f->ts.kind); -@@ -2072,19 +2081,22 @@ gfc_resolve_mod (gfc_expr *f, gfc_expr *a, gfc_expr *p) - void - gfc_resolve_modulo (gfc_expr *f, gfc_expr *a, gfc_expr *p) - { -- f->ts.type = a->ts.type; - if (p != NULL) -- f->ts.kind = gfc_kind_max (a,p); -- else -- f->ts.kind = a->ts.kind; -- -- if (p != NULL && a->ts.kind != p->ts.kind) - { -- if (a->ts.kind == gfc_kind_max (a,p)) -- gfc_convert_type (p, &a->ts, 2); -+ f->ts.kind = gfc_kind_max (a,p); -+ if (a->ts.type == BT_REAL || p->ts.type == BT_REAL) -+ f->ts.type = BT_REAL; - else -- gfc_convert_type (a, &p->ts, 2); -+ f->ts.type = BT_INTEGER; -+ -+ if (a->ts.kind != f->ts.kind || a->ts.type != f->ts.type) -+ gfc_convert_type (a, &f->ts, 2); -+ -+ if (p->ts.kind != f->ts.kind || p->ts.type != f->ts.type) -+ gfc_convert_type (p, &f->ts, 2); - } -+ else -+ f->ts = a->ts; - - f->value.function.name - = gfc_get_string ("__modulo_%c%d", gfc_type_letter (f->ts.type), -@@ -2455,9 +2467,26 @@ gfc_resolve_shift (gfc_expr *f, gfc_expr *i, gfc_expr *shift ATTRIBUTE_UNUSED) - - - void --gfc_resolve_sign (gfc_expr *f, gfc_expr *a, gfc_expr *b ATTRIBUTE_UNUSED) -+gfc_resolve_sign (gfc_expr *f, gfc_expr *a, gfc_expr *b) - { -- f->ts = a->ts; -+ if (b != NULL) -+ { -+ f->ts.kind = gfc_kind_max (a, b); -+ if (a->ts.type == BT_REAL || b->ts.type == BT_REAL) -+ f->ts.type = BT_REAL; -+ else -+ f->ts.type = BT_INTEGER; -+ -+ if (a->ts.kind != f->ts.kind || a->ts.type != f->ts.type) -+ gfc_convert_type (a, &f->ts, 2); -+ -+ if (b->ts.kind != f->ts.kind || b->ts.type != f->ts.type) -+ gfc_convert_type (b, &f->ts, 2); -+ } -+ else -+ { -+ f->ts = a->ts; -+ } - f->value.function.name - = gfc_get_string ("__sign_%c%d", gfc_type_letter (a->ts.type), a->ts.kind); - } -diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c -index 7603f30..2de9a29 100644 ---- a/gcc/fortran/simplify.c -+++ b/gcc/fortran/simplify.c -@@ -2254,39 +2254,78 @@ gfc_simplify_digits (gfc_expr *x) - } - - -+/* Simplify function which sets the floating-point value of ar from -+ the value of a independently if a is integer of real. */ -+ -+static void -+simplify_int_real_promotion (const gfc_expr *a, const gfc_expr *b, mpfr_t *ar) -+{ -+ if (a->ts.type == BT_REAL) -+ { -+ mpfr_init2 (*ar, (a->ts.kind * 8)); -+ mpfr_set (*ar, a->value.real, GFC_RND_MODE); -+ } -+ else -+ { -+ mpfr_init2 (*ar, (b->ts.kind * 8)); -+ mpfr_set_z (*ar, a->value.integer, GFC_RND_MODE); -+ } -+} -+ -+ -+/* Simplify function which promotes a and b arguments from integer to real if required in -+ ar and br floating-point values. This function returns true if a or b are reals and false -+ otherwise. */ -+ -+static bool -+simplify_int_real_promotion2 (const gfc_expr *a, const gfc_expr *b, mpfr_t *ar, mpfr_t *br) -+{ -+ if (a->ts.type != BT_REAL && b->ts.type != BT_REAL) -+ return false; -+ -+ simplify_int_real_promotion (a, b, ar); -+ simplify_int_real_promotion (b, a, br); -+ -+ return true; -+} -+ -+ - gfc_expr * - gfc_simplify_dim (gfc_expr *x, gfc_expr *y) - { - gfc_expr *result; - int kind; - -+ mpfr_t xr; -+ mpfr_t yr; -+ - if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT) - return NULL; - -- kind = x->ts.kind > y->ts.kind ? x->ts.kind : y->ts.kind; -- result = gfc_get_constant_expr (x->ts.type, kind, &x->where); -- -- switch (x->ts.type) -+ if ((x->ts.type != BT_REAL && x->ts.type != BT_INTEGER) -+ || (y->ts.type != BT_REAL && y->ts.type != BT_INTEGER)) - { -- case BT_INTEGER: -- if (mpz_cmp (x->value.integer, y->value.integer) > 0) -- mpz_sub (result->value.integer, x->value.integer, y->value.integer); -- else -- mpz_set_ui (result->value.integer, 0); -- -- break; -- -- case BT_REAL: -- if (mpfr_cmp (x->value.real, y->value.real) > 0) -- mpfr_sub (result->value.real, x->value.real, y->value.real, -- GFC_RND_MODE); -- else -- mpfr_set_ui (result->value.real, 0, GFC_RND_MODE); -+ gfc_internal_error ("gfc_simplify_dim(): Bad arguments"); -+ return NULL; -+ } - -- break; -+ kind = x->ts.kind > y->ts.kind ? x->ts.kind : y->ts.kind; - -- default: -- gfc_internal_error ("gfc_simplify_dim(): Bad type"); -+ if (simplify_int_real_promotion2 (x, y, &xr, &yr)) -+ { -+ result = gfc_get_constant_expr (BT_REAL, kind, &x->where); -+ if (mpfr_cmp (xr, yr) > 0) -+ mpfr_sub (result->value.real, xr, yr, GFC_RND_MODE); -+ else -+ mpfr_set_ui (result->value.real, 0, GFC_RND_MODE); -+ } -+ else -+ { -+ result = gfc_get_constant_expr (BT_INTEGER, kind, &x->where); -+ if (mpz_cmp (x->value.integer, y->value.integer) > 0) -+ mpz_sub (result->value.integer, x->value.integer, y->value.integer); -+ else -+ mpz_set_ui (result->value.integer, 0); - } - - return range_check (result, "DIM"); -@@ -4881,13 +4920,87 @@ min_max_choose (gfc_expr *arg, gfc_expr *extremum, int sign) - { - int ret; - -+ mpfr_t *arp; -+ mpfr_t *erp; -+ mpfr_t ar; -+ mpfr_t er; -+ -+ if (arg->ts.type != extremum->ts.type) -+ { -+ if (arg->ts.type == BT_REAL) -+ { -+ arp = &arg->value.real; -+ } -+ else -+ { -+ mpfr_init2 (ar, (arg->ts.kind * 8)); -+ mpfr_set_z (ar, arg->value.integer, GFC_RND_MODE); -+ arp = &ar; -+ } -+ -+ if (extremum->ts.type == BT_REAL) -+ { -+ erp = &extremum->value.real; -+ } -+ else -+ { -+ mpfr_init2 (er, (extremum->ts.kind * 8)); -+ mpfr_set_z (er, extremum->value.integer, GFC_RND_MODE); -+ erp = &er; -+ } -+ -+ if (mpfr_nan_p (*erp)) -+ { -+ ret = 1; -+ extremum->ts.type = arg->ts.type; -+ extremum->ts.kind = arg->ts.kind; -+ if (arg->ts.type == BT_INTEGER) -+ { -+ mpz_init2 (extremum->value.integer, (arg->ts.kind * 8)); -+ mpz_set (extremum->value.integer, arg->value.integer); -+ } -+ else -+ { -+ mpfr_init2 (extremum->value.real, (arg->ts.kind * 8)); -+ mpfr_set (extremum->value.real, *arp, GFC_RND_MODE); -+ } -+ } -+ else if (mpfr_nan_p (*arp)) -+ ret = -1; -+ else -+ { -+ ret = mpfr_cmp (*arp, *erp) * sign; -+ if (ret > 0) -+ { -+ extremum->ts.type = arg->ts.type; -+ extremum->ts.kind = arg->ts.kind; -+ if (arg->ts.type == BT_INTEGER) -+ { -+ mpz_init2 (extremum->value.integer, (arg->ts.kind * 8)); -+ mpz_set (extremum->value.integer, arg->value.integer); -+ } -+ else -+ { -+ mpfr_init2 (extremum->value.real, (arg->ts.kind * 8)); -+ mpfr_set (extremum->value.real, *arp, GFC_RND_MODE); -+ } -+ } -+ } -+ -+ return ret; -+ } -+ - switch (arg->ts.type) - { - case BT_INTEGER: - ret = mpz_cmp (arg->value.integer, - extremum->value.integer) * sign; - if (ret > 0) -- mpz_set (extremum->value.integer, arg->value.integer); -+ { -+ if (arg->ts.kind > extremum->ts.kind) -+ extremum->ts.kind = arg->ts.kind; -+ mpz_set (extremum->value.integer, arg->value.integer); -+ } - break; - - case BT_REAL: -@@ -5457,7 +5570,9 @@ gfc_simplify_mod (gfc_expr *a, gfc_expr *p) - gfc_expr *result; - int kind; - -- /* First check p. */ -+ mpfr_t ar; -+ mpfr_t pr; -+ - if (p->expr_type != EXPR_CONSTANT) - return NULL; - -@@ -5468,18 +5583,18 @@ gfc_simplify_mod (gfc_expr *a, gfc_expr *p) - if (mpz_cmp_ui (p->value.integer, 0) == 0) - { - gfc_error ("Argument %qs of MOD at %L shall not be zero", -- "P", &p->where); -+ "P", &p->where); - return &gfc_bad_expr; - } -- break; -+ break; - case BT_REAL: - if (mpfr_cmp_ui (p->value.real, 0) == 0) - { - gfc_error ("Argument %qs of MOD at %L shall not be zero", -- "P", &p->where); -+ "P", &p->where); - return &gfc_bad_expr; -- } -- break; -+ } -+ break; - default: - gfc_internal_error ("gfc_simplify_mod(): Bad arguments"); - } -@@ -5487,16 +5602,24 @@ gfc_simplify_mod (gfc_expr *a, gfc_expr *p) - if (a->expr_type != EXPR_CONSTANT) - return NULL; - -+ if (a->ts.type != BT_REAL && a->ts.type != BT_INTEGER) -+ { -+ gfc_internal_error ("gfc_simplify_mod(): Bad arguments"); -+ return NULL; -+ } -+ - kind = a->ts.kind > p->ts.kind ? a->ts.kind : p->ts.kind; -- result = gfc_get_constant_expr (a->ts.type, kind, &a->where); - -- if (a->ts.type == BT_INTEGER) -- mpz_tdiv_r (result->value.integer, a->value.integer, p->value.integer); -- else -+ if (simplify_int_real_promotion2 (a, p, &ar, &pr)) - { -+ result = gfc_get_constant_expr (BT_REAL, kind, &a->where); - gfc_set_model_kind (kind); -- mpfr_fmod (result->value.real, a->value.real, p->value.real, -- GFC_RND_MODE); -+ mpfr_fmod (result->value.real, ar, pr, GFC_RND_MODE); -+ } -+ else -+ { -+ result = gfc_get_constant_expr (BT_INTEGER, kind, &a->where); -+ mpz_tdiv_r (result->value.integer, a->value.integer, p->value.integer); - } - - return range_check (result, "MOD"); -@@ -5509,7 +5632,9 @@ gfc_simplify_modulo (gfc_expr *a, gfc_expr *p) - gfc_expr *result; - int kind; - -- /* First check p. */ -+ mpfr_t ar; -+ mpfr_t pr; -+ - if (p->expr_type != EXPR_CONSTANT) - return NULL; - -@@ -5520,44 +5645,50 @@ gfc_simplify_modulo (gfc_expr *a, gfc_expr *p) - if (mpz_cmp_ui (p->value.integer, 0) == 0) - { - gfc_error ("Argument %qs of MODULO at %L shall not be zero", -- "P", &p->where); -+ "P", &p->where); - return &gfc_bad_expr; - } -- break; -+ break; - case BT_REAL: - if (mpfr_cmp_ui (p->value.real, 0) == 0) - { - gfc_error ("Argument %qs of MODULO at %L shall not be zero", -- "P", &p->where); -+ "P", &p->where); - return &gfc_bad_expr; -- } -- break; -+ } -+ break; - default: - gfc_internal_error ("gfc_simplify_modulo(): Bad arguments"); - } - -+ if (a->ts.type != BT_REAL && a->ts.type != BT_INTEGER) -+ { -+ gfc_internal_error ("gfc_simplify_modulo(): Bad arguments"); -+ return NULL; -+ } -+ - if (a->expr_type != EXPR_CONSTANT) - return NULL; - - kind = a->ts.kind > p->ts.kind ? a->ts.kind : p->ts.kind; -- result = gfc_get_constant_expr (a->ts.type, kind, &a->where); - -- if (a->ts.type == BT_INTEGER) -- mpz_fdiv_r (result->value.integer, a->value.integer, p->value.integer); -- else -+ if (simplify_int_real_promotion2 (a, p, &ar, &pr)) - { -+ result = gfc_get_constant_expr (BT_REAL, kind, &a->where); - gfc_set_model_kind (kind); -- mpfr_fmod (result->value.real, a->value.real, p->value.real, -- GFC_RND_MODE); -+ mpfr_fmod (result->value.real, ar, pr, GFC_RND_MODE); - if (mpfr_cmp_ui (result->value.real, 0) != 0) -- { -- if (mpfr_signbit (a->value.real) != mpfr_signbit (p->value.real)) -- mpfr_add (result->value.real, result->value.real, p->value.real, -- GFC_RND_MODE); -- } -- else -- mpfr_copysign (result->value.real, result->value.real, -- p->value.real, GFC_RND_MODE); -+ { -+ if (mpfr_signbit (ar) != mpfr_signbit (pr)) -+ mpfr_add (result->value.real, result->value.real, pr, GFC_RND_MODE); -+ } -+ else -+ mpfr_copysign (result->value.real, result->value.real, pr, GFC_RND_MODE); -+ } -+ else -+ { -+ result = gfc_get_constant_expr (BT_INTEGER, kind, &a->where); -+ mpz_fdiv_r (result->value.integer, a->value.integer, p->value.integer); - } - - return range_check (result, "MODULO"); -@@ -6976,27 +7107,40 @@ gfc_expr * - gfc_simplify_sign (gfc_expr *x, gfc_expr *y) - { - gfc_expr *result; -+ bool neg; - - if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT) - return NULL; - - result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where); - -+ switch (y->ts.type) -+ { -+ case BT_INTEGER: -+ neg = (mpz_sgn (y->value.integer) < 0); -+ break; -+ -+ case BT_REAL: -+ neg = (mpfr_sgn (y->value.real) < 0); -+ break; -+ -+ default: -+ gfc_internal_error ("Bad type in gfc_simplify_sign"); -+ } -+ - switch (x->ts.type) - { - case BT_INTEGER: - mpz_abs (result->value.integer, x->value.integer); -- if (mpz_sgn (y->value.integer) < 0) -+ if (neg) - mpz_neg (result->value.integer, result->value.integer); - break; - - case BT_REAL: -- if (flag_sign_zero) -- mpfr_copysign (result->value.real, x->value.real, y->value.real, -- GFC_RND_MODE); -+ if (flag_sign_zero && y->ts.type == BT_REAL) -+ mpfr_copysign (result->value.real, x->value.real, y->value.real, GFC_RND_MODE); - else -- mpfr_setsign (result->value.real, x->value.real, -- mpfr_sgn (y->value.real) < 0 ? 1 : 0, GFC_RND_MODE); -+ mpfr_setsign (result->value.real, x->value.real, neg, GFC_RND_MODE); - break; - - default: -diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion.f -new file mode 100644 -index 0000000..d77a46e ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion.f -@@ -0,0 +1,14 @@ -+! { dg-do compile } -+! { dg-options "-fdec" } -+! -+! Test promotion between integers and reals for mod and modulo where -+! A is a constant array and P is zero. -+! -+! Compilation errors are expected -+! -+ program promotion_int_real_array_const -+ real a(2) = mod([12, 34], 0.0)*4 ! { dg-error "shall not be zero" } -+ a = mod([12.0, 34.0], 0)*4 ! { dg-error "shall not be zero" } -+ real b(2) = modulo([12, 34], 0.0)*4 ! { dg-error "shall not be zero" } -+ b = modulo([12.0, 34.0], 0)*4 ! { dg-error "shall not be zero" } -+ end program -diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion.f -new file mode 100644 -index 0000000..2784b34 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion.f -@@ -0,0 +1,86 @@ -+! { dg-do compile } -+! { dg-options "-fdec -finit-real=snan" } -+! -+! Test promotion between integers and reals in intrinsic operations. -+! These operations are: mod, modulo, dim, sign, min, max, minloc and -+! maxloc. -+! -+ PROGRAM promotion_int_real_const -+ ! array_nan 4th position value is NAN -+ REAL array_nan(4) -+ DATA array_nan(1)/-4.0/ -+ DATA array_nan(2)/3.0/ -+ DATA array_nan(3)/-2/ -+ -+ INTEGER m_i/0/ -+ REAL m_r/0.0/ -+ -+ INTEGER md_i/0/ -+ REAL md_r/0.0/ -+ -+ INTEGER d_i/0/ -+ REAL d_r/0.0/ -+ -+ INTEGER s_i/0/ -+ REAL s_r/0.0/ -+ -+ INTEGER mn_i/0/ -+ REAL mn_r/0.0/ -+ -+ INTEGER mx_i/0/ -+ REAL mx_r/0.0/ -+ -+ m_i = MOD(4, 3) -+ if (m_i .ne. 1) STOP 1 -+ m_r = MOD(4.0, 3.0) -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 2 -+ m_r = MOD(4, 3.0) -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 3 -+ m_r = MOD(4.0, 3) -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 4 -+ -+ md_i = MODULO(4, 3) -+ if (md_i .ne. 1) STOP 5 -+ md_r = MODULO(4.0, 3.0) -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 6 -+ md_r = MODULO(4, 3.0) -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 7 -+ md_r = MODULO(4.0, 3) -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 8 -+ -+ d_i = DIM(4, 3) -+ if (d_i .ne. 1) STOP 9 -+ d_r = DIM(4.0, 3.0) -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 10 -+ d_r = DIM(4.0, 3) -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 11 -+ d_r = DIM(3, 4.0) -+ if (abs(d_r) > 1.0D-6) STOP 12 -+ -+ s_i = SIGN(-4, 3) -+ if (s_i .ne. 4) STOP 13 -+ s_r = SIGN(4.0, -3.0) -+ if (abs(s_r - (-4.0)) > 1.0D-6) STOP 14 -+ s_r = SIGN(4.0, -3) -+ if (abs(s_r - (-4.0)) > 1.0D-6) STOP 15 -+ s_r = SIGN(-4, 3.0) -+ if (abs(s_r - 4.0) > 1.0D-6) STOP 16 -+ -+ mx_i = MAX(-4, -3, 2, 1) -+ if (mx_i .ne. 2) STOP 17 -+ mx_r = MAX(-4.0, -3.0, 2.0, 1.0) -+ if (abs(mx_r - 2.0) > 1.0D-6) STOP 18 -+ mx_r = MAX(-4, -3.0, 2.0, 1) -+ if (abs(mx_r - 2.0) > 1.0D-6) STOP 19 -+ mx_i = MAXLOC(array_nan, 1) -+ if (mx_i .ne. 2) STOP 20 -+ -+ mn_i = MIN(-4, -3, 2, 1) -+ if (mn_i .ne. -4) STOP 21 -+ mn_r = MIN(-4.0, -3.0, 2.0, 1.0) -+ if (abs(mn_r - (-4.0)) > 1.0D-6) STOP 22 -+ mn_r = MIN(-4, -3.0, 2.0, 1) -+ if (abs(mn_r - (-4.0)) > 1.0D-6) STOP 23 -+ mn_i = MINLOC(array_nan, 1) -+ if (mn_i .ne. 1) STOP 24 -+ END PROGRAM -diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion-2.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion-2.f -new file mode 100644 -index 0000000..354c773 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion-2.f -@@ -0,0 +1,114 @@ -+! { dg-do compile } -+! { dg-options "-fdec" } -+! -+! Test promotion between integers and reals in intrinsic operations. -+! These operations are: mod, modulo, dim, sign, min, max, minloc and -+! maxloc. -+! -+ PROGRAM promotion_int_real -+ REAL l/0.0/ -+ LOGICAL a_l -+ LOGICAL*4 a2_l -+ LOGICAL b_l -+ LOGICAL*8 b2_l -+ LOGICAL x_l -+ LOGICAL y_l -+ CHARACTER a_c -+ CHARACTER*4 a2_c -+ CHARACTER b_c -+ CHARACTER*8 b2_c -+ CHARACTER x_c -+ CHARACTER y_c -+ -+ INTEGER m_i/0/ -+ REAL m_r/0.0/ -+ -+ INTEGER md_i/0/ -+ REAL md_r/0.0/ -+ -+ INTEGER d_i/0/ -+ REAL d_r/0.0/ -+ -+ INTEGER s_i/0/ -+ REAL s_r/0.0/ -+ -+ INTEGER mn_i/0/ -+ REAL mn_r/0.0/ -+ -+ INTEGER mx_i/0/ -+ REAL mx_r/0.0/ -+ -+ m_i = MOD(a_l, b_l) ! { dg-error "" } -+ if (m_i .ne. 1) STOP 1 -+ m_i = MOD(a2_l, b2_l) ! { dg-error "" } -+ if (m_i .ne. 1) STOP 2 -+ m_r = MOD(a_c, b_c) ! { dg-error "" } -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 3 -+ m_r = MOD(a2_c, b2_c) ! { dg-error "" } -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 4 -+ m_r = MOD(a_l, b_c) ! { dg-error "" } -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 5 -+ m_r = MOD(a_c, b_l) ! { dg-error "" } -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 6 -+ -+ md_i = MODULO(a_l, b_l) ! { dg-error "" } -+ if (md_i .ne. 1) STOP 7 -+ md_i = MODULO(a2_l, b2_l) ! { dg-error "" } -+ if (md_i .ne. 1) STOP 8 -+ md_r = MODULO(a_c, b_c) ! { dg-error "" } -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 9 -+ md_r = MODULO(a2_c, b2_c) ! { dg-error "" } -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 10 -+ md_r = MODULO(a_l, b_c) ! { dg-error "" } -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 11 -+ md_r = MODULO(a_c, b_l) ! { dg-error "" } -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 12 -+ -+ d_i = DIM(a_l, b_l) ! { dg-error "" } -+ if (d_i .ne. 1) STOP 13 -+ d_i = DIM(a2_l, b2_l) ! { dg-error "" } -+ if (d_i .ne. 1) STOP 14 -+ d_r = DIM(a_c, b_c) ! { dg-error "" } -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 15 -+ d_r = DIM(a2_c, b2_c) ! { dg-error "" } -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 16 -+ d_r = DIM(a_c, b_l) ! { dg-error "" } -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 17 -+ d_r = DIM(b_l, a_c) ! { dg-error "" } -+ if (abs(d_r) > 1.0D-6) STOP 18 -+ -+ s_i = SIGN(-a_l, b_l) ! { dg-error "" } -+ if (s_i .ne. 4) STOP 19 -+ s_i = SIGN(-a2_l, b2_l) ! { dg-error "" } -+ if (s_i .ne. 4) STOP 20 -+ s_r = SIGN(a_c, -b_c) ! { dg-error "" } -+ if (abs(s_r - (-a_c)) > 1.0D-6) STOP 21 ! { dg-error "" } -+ s_r = SIGN(a2_c, -b2_c) ! { dg-error "" } -+ if (abs(s_r - (-a2_c)) > 1.0D-6) STOP 22 ! { dg-error "" } -+ s_r = SIGN(a_c, -b_l) ! { dg-error "" } -+ if (abs(s_r - (-a_c)) > 1.0D-6) STOP 23 ! { dg-error "" } -+ s_r = SIGN(-a_l, b_c) ! { dg-error "" } -+ if (abs(s_r - a_c) > 1.0D-6) STOP 24 ! { dg-error "" } -+ -+ mx_i = MAX(-a_l, -b_l, x_l, y_l) ! { dg-error "" } -+ if (mx_i .ne. x_l) STOP 25 ! { dg-error "" } -+ mx_i = MAX(-a2_l, -b2_l, x_l, y_l) ! { dg-error "" } -+ if (mx_i .ne. x_l) STOP 26 ! { dg-error "" } -+ mx_r = MAX(-a_c, -b_c, x_c, y_c) ! { dg-error "" } -+ if (abs(mx_r - x_c) > 1.0D-6) STOP 27 ! { dg-error "" } -+ mx_r = MAX(-a_c, -b_c, x_c, y_c) ! { dg-error "" } -+ if (abs(mx_r - x_c) > 1.0D-6) STOP 28 ! { dg-error "" } -+ mx_r = MAX(-a_l, -b_c, x_c, y_l) ! { dg-error "" } -+ if (abs(mx_r - x_c) > 1.0D-6) STOP 29 ! { dg-error "" } -+ -+ mn_i = MIN(-a_l, -b_l, x_l, y_l) ! { dg-error "" } -+ if (mn_i .ne. -a_l) STOP 31 ! { dg-error "" } -+ mn_i = MIN(-a2_l, -b2_l, x_l, y_l) ! { dg-error "" } -+ if (mn_i .ne. -a2_l) STOP 32 ! { dg-error "" } -+ mn_r = MIN(-a_c, -b_c, x_c, y_c) ! { dg-error "" } -+ if (abs(mn_r - (-a_c)) > 1.0D-6) STOP 33 ! { dg-error "" } -+ mn_r = MIN(-a2_c, -b2_c, x_c, y_c) ! { dg-error "" } -+ if (abs(mn_r - (-a2_c)) > 1.0D-6) STOP 34 ! { dg-error "" } -+ mn_r = MIN(-a_l, -b_c, x_c, y_l) ! { dg-error "" } -+ if (abs(mn_r - (-a_c)) > 1.0D-6) STOP 35 ! { dg-error "" } -+ END PROGRAM -diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion-3.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion-3.f -new file mode 100644 -index 0000000..92d1b45 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion-3.f -@@ -0,0 +1,114 @@ -+! { dg-do compile } -+! { dg-options "-fdec" } -+! -+! Test promotion between integers and reals in intrinsic operations. -+! These operations are: mod, modulo, dim, sign, min, max, minloc and -+! maxloc. -+! -+ PROGRAM promotion_int_real -+ REAL l/0.0/ -+ INTEGER a_i/4/ -+ INTEGER*4 a2_i/4/ -+ CHARACTER b_c -+ CHARACTER*8 b2_c -+ INTEGER x_i/2/ -+ CHARACTER y_c -+ REAL a_r/4.0/ -+ REAL*4 a2_r/4.0/ -+ LOGICAL b_l -+ LOGICAL*8 b2_l -+ REAL x_r/2.0/ -+ LOGICAL y_l -+ -+ INTEGER m_i/0/ -+ REAL m_r/0.0/ -+ -+ INTEGER md_i/0/ -+ REAL md_r/0.0/ -+ -+ INTEGER d_i/0/ -+ REAL d_r/0.0/ -+ -+ INTEGER s_i/0/ -+ REAL s_r/0.0/ -+ -+ INTEGER mn_i/0/ -+ REAL mn_r/0.0/ -+ -+ INTEGER mx_i/0/ -+ REAL mx_r/0.0/ -+ -+ m_i = MOD(a_i, b_c) ! { dg-error "" } -+ if (m_i .ne. 1) STOP 1 -+ m_i = MOD(a2_i, b2_c) ! { dg-error "" } -+ if (m_i .ne. 1) STOP 2 -+ m_r = MOD(a_r, b_l) ! { dg-error "" } -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 3 -+ m_r = MOD(a2_r, b2_l) ! { dg-error "" } -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 4 -+ m_r = MOD(a_i, b_l) ! { dg-error "" } -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 5 -+ m_r = MOD(a_r, b_c) ! { dg-error "" } -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 6 -+ -+ md_i = MODULO(a_i, b_c) ! { dg-error "" } -+ if (md_i .ne. 1) STOP 7 -+ md_i = MODULO(a2_i, b2_c) ! { dg-error "" } -+ if (md_i .ne. 1) STOP 8 -+ md_r = MODULO(a_r, b_l) ! { dg-error "" } -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 9 -+ md_r = MODULO(a2_r, b2_l) ! { dg-error "" } -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 10 -+ md_r = MODULO(a_i, b_l) ! { dg-error "" } -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 11 -+ md_r = MODULO(a_r, b_c) ! { dg-error "" } -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 12 -+ -+ d_i = DIM(a_i, b_c) ! { dg-error "" } -+ if (d_i .ne. 1) STOP 13 -+ d_i = DIM(a2_i, b2_c) ! { dg-error "" } -+ if (d_i .ne. 1) STOP 14 -+ d_r = DIM(a_r, b_l) ! { dg-error "" } -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 15 -+ d_r = DIM(a2_r, b2_l) ! { dg-error "" } -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 16 -+ d_r = DIM(a_r, b_c) ! { dg-error "" } -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 17 -+ d_r = DIM(b_c, a_r) ! { dg-error "" } -+ if (abs(d_r) > 1.0D-6) STOP 18 -+ -+ s_i = SIGN(-a_i, b_c) ! { dg-error "" } -+ if (s_i .ne. 4) STOP 19 -+ s_i = SIGN(-a2_i, b2_c) ! { dg-error "" } -+ if (s_i .ne. 4) STOP 20 -+ s_r = SIGN(a_r, -b_l) ! { dg-error "" } -+ if (abs(s_r - (-a_r)) > 1.0D-6) STOP 21 -+ s_r = SIGN(a2_r, -b2_l) ! { dg-error "" } -+ if (abs(s_r - (-a2_r)) > 1.0D-6) STOP 22 -+ s_r = SIGN(a_r, -b_c) ! { dg-error "" } -+ if (abs(s_r - (-a_r)) > 1.0D-6) STOP 23 -+ s_r = SIGN(-a_i, b_l) ! { dg-error "" } -+ if (abs(s_r - a_r) > 1.0D-6) STOP 24 -+ -+ mx_i = MAX(-a_i, -b_c, x_i, y_c) ! { dg-error "" } -+ if (mx_i .ne. x_i) STOP 25 -+ mx_i = MAX(-a2_i, -b2_c, x_i, y_c) ! { dg-error "" } -+ if (mx_i .ne. x_i) STOP 26 -+ mx_r = MAX(-a_r, -b_l, x_r, y_l) ! { dg-error "" } -+ if (abs(mx_r - x_r) > 1.0D-6) STOP 27 -+ mx_r = MAX(-a_r, -b_l, x_r, y_l) ! { dg-error "" } -+ if (abs(mx_r - x_r) > 1.0D-6) STOP 28 -+ mx_r = MAX(-a_i, -b_l, x_r, y_c) ! { dg-error "" } -+ if (abs(mx_r - x_r) > 1.0D-6) STOP 29 -+ -+ mn_i = MIN(-a_i, -b_c, x_i, y_c) ! { dg-error "" } -+ if (mn_i .ne. -a_i) STOP 31 -+ mn_i = MIN(-a2_i, -b2_c, x_i, y_c) ! { dg-error "" } -+ if (mn_i .ne. -a2_i) STOP 32 -+ mn_r = MIN(-a_r, -b_l, x_r, y_l) ! { dg-error "" } -+ if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 33 -+ mn_r = MIN(-a2_r, -b2_l, x_r, y_l) ! { dg-error "" } -+ if (abs(mn_r - (-a2_r)) > 1.0D-6) STOP 34 -+ mn_r = MIN(-a_i, -b_l, x_r, y_c) ! { dg-error "" } -+ if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 35 -+ END PROGRAM -diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion.f -new file mode 100644 -index 0000000..785331e ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion.f -@@ -0,0 +1,126 @@ -+! { dg-do compile } -+! { dg-options "-fdec" } -+! -+! Test promotion between integers and reals in intrinsic operations. -+! These operations are: mod, modulo, dim, sign, min, max, minloc and -+! maxloc. -+! -+ PROGRAM promotion_int_real -+ REAL l/0.0/ -+ INTEGER a_i/4/ -+ INTEGER*4 a2_i/4/ -+ INTEGER b_i/3/ -+ INTEGER*8 b2_i/3/ -+ INTEGER x_i/2/ -+ INTEGER y_i/1/ -+ REAL a_r/4.0/ -+ REAL*4 a2_r/4.0/ -+ REAL b_r/3.0/ -+ REAL*8 b2_r/3.0/ -+ REAL x_r/2.0/ -+ REAL y_r/1.0/ -+ -+ REAL array_nan(4) -+ DATA array_nan(1)/-4.0/ -+ DATA array_nan(2)/3.0/ -+ DATA array_nan(3)/-2/ -+ -+ INTEGER m_i/0/ -+ REAL m_r/0.0/ -+ -+ INTEGER md_i/0/ -+ REAL md_r/0.0/ -+ -+ INTEGER d_i/0/ -+ REAL d_r/0.0/ -+ -+ INTEGER s_i/0/ -+ REAL s_r/0.0/ -+ -+ INTEGER mn_i/0/ -+ REAL mn_r/0.0/ -+ -+ INTEGER mx_i/0/ -+ REAL mx_r/0.0/ -+ -+ ! array_nan 4th position value is NAN -+ array_nan(4) = 0/l -+ -+ m_i = MOD(a_i, b_i) -+ if (m_i .ne. 1) STOP 1 -+ m_i = MOD(a2_i, b2_i) -+ if (m_i .ne. 1) STOP 2 -+ m_r = MOD(a_r, b_r) -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 3 -+ m_r = MOD(a2_r, b2_r) -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 4 -+ m_r = MOD(a_i, b_r) -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 5 -+ m_r = MOD(a_r, b_i) -+ if (abs(m_r - 1.0) > 1.0D-6) STOP 6 -+ -+ md_i = MODULO(a_i, b_i) -+ if (md_i .ne. 1) STOP 7 -+ md_i = MODULO(a2_i, b2_i) -+ if (md_i .ne. 1) STOP 8 -+ md_r = MODULO(a_r, b_r) -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 9 -+ md_r = MODULO(a2_r, b2_r) -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 10 -+ md_r = MODULO(a_i, b_r) -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 11 -+ md_r = MODULO(a_r, b_i) -+ if (abs(md_r - 1.0) > 1.0D-6) STOP 12 -+ -+ d_i = DIM(a_i, b_i) -+ if (d_i .ne. 1) STOP 13 -+ d_i = DIM(a2_i, b2_i) -+ if (d_i .ne. 1) STOP 14 -+ d_r = DIM(a_r, b_r) -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 15 -+ d_r = DIM(a2_r, b2_r) -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 16 -+ d_r = DIM(a_r, b_i) -+ if (abs(d_r - 1.0) > 1.0D-6) STOP 17 -+ d_r = DIM(b_i, a_r) -+ if (abs(d_r) > 1.0D-6) STOP 18 -+ -+ s_i = SIGN(-a_i, b_i) -+ if (s_i .ne. 4) STOP 19 -+ s_i = SIGN(-a2_i, b2_i) -+ if (s_i .ne. 4) STOP 20 -+ s_r = SIGN(a_r, -b_r) -+ if (abs(s_r - (-a_r)) > 1.0D-6) STOP 21 -+ s_r = SIGN(a2_r, -b2_r) -+ if (abs(s_r - (-a2_r)) > 1.0D-6) STOP 22 -+ s_r = SIGN(a_r, -b_i) -+ if (abs(s_r - (-a_r)) > 1.0D-6) STOP 23 -+ s_r = SIGN(-a_i, b_r) -+ if (abs(s_r - a_r) > 1.0D-6) STOP 24 -+ -+ mx_i = MAX(-a_i, -b_i, x_i, y_i) -+ if (mx_i .ne. x_i) STOP 25 -+ mx_i = MAX(-a2_i, -b2_i, x_i, y_i) -+ if (mx_i .ne. x_i) STOP 26 -+ mx_r = MAX(-a_r, -b_r, x_r, y_r) -+ if (abs(mx_r - x_r) > 1.0D-6) STOP 27 -+ mx_r = MAX(-a_r, -b_r, x_r, y_r) -+ if (abs(mx_r - x_r) > 1.0D-6) STOP 28 -+ mx_r = MAX(-a_i, -b_r, x_r, y_i) -+ if (abs(mx_r - x_r) > 1.0D-6) STOP 29 -+ mx_i = MAXLOC(array_nan, 1) -+ if (mx_i .ne. 2) STOP 30 -+ -+ mn_i = MIN(-a_i, -b_i, x_i, y_i) -+ if (mn_i .ne. -a_i) STOP 31 -+ mn_i = MIN(-a2_i, -b2_i, x_i, y_i) -+ if (mn_i .ne. -a2_i) STOP 32 -+ mn_r = MIN(-a_r, -b_r, x_r, y_r) -+ if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 33 -+ mn_r = MIN(-a2_r, -b2_r, x_r, y_r) -+ if (abs(mn_r - (-a2_r)) > 1.0D-6) STOP 34 -+ mn_r = MIN(-a_i, -b_r, x_r, y_i) -+ if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 35 -+ mn_i = MINLOC(array_nan, 1) -+ if (mn_i .ne. 1) STOP 36 -+ END PROGRAM diff --git a/SOURCES/0005-dec-comparisons.patch b/SOURCES/0005-dec-comparisons.patch new file mode 100644 index 0000000..0110209 --- /dev/null +++ b/SOURCES/0005-dec-comparisons.patch @@ -0,0 +1,658 @@ +From 6946d3e3e6a1d839772f4c59a5ab08901111800c Mon Sep 17 00:00:00 2001 +From: Mark Eggleston +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 ++! ++ ++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 ++! ++ ++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 ++! ++ ++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 ++! ++ ++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 ++! ++ ++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 ++! ++ ++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 ++! ++ ++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 ++! ++ ++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 ++! ++ ++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 ++! ++ ++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 ++! ++ ++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 ++! ++ ++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 ++! ++! 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 + diff --git a/SOURCES/0006-Allow-blank-format-items-in-format-strings.patch b/SOURCES/0006-Allow-blank-format-items-in-format-strings.patch index 8f855c5..e3ad8d0 100644 --- a/SOURCES/0006-Allow-blank-format-items-in-format-strings.patch +++ b/SOURCES/0006-Allow-blank-format-items-in-format-strings.patch @@ -1,42 +1,39 @@ -From f50b0452c10d514860e08e1ea091b17aa97d6a90 Mon Sep 17 00:00:00 2001 +From 8a5920d930429f91b269d9265323bf2507a6b8e5 Mon Sep 17 00:00:00 2001 From: Jim MacArthur Date: Thu, 4 Feb 2016 16:59:41 +0000 -Subject: [PATCH 06/23] Allow blank format items in format strings +Subject: [PATCH 06/16] Allow blank format items in format strings This has to be written in a slightly verbose manner because GCC 7 defaults to building with -Werror=implicit-fallthrough which prevents us from just falling through to the default: case. -This feature is enabled by the `-std=extra-legacy` compiler flag. +Test written by: Francisco Redondo Marchena + +Use -fdec-blank-format-item to enable. Also enabled by -fdec. --- - 0006-Allow-blank-format-items-in-format-strings.patch - -commit 8e205f3940a364318d0cd2197a9897142632b336 -Author: Jim MacArthur -Date: Thu Feb 4 16:59:41 2016 +0000 - - Allow blank format items in format strings - - This has to be written in a slightly verbose manner because GCC 7 - defaults to building with -Werror=implicit-fallthrough which prevents - us from just falling through to the default: case. - - This feature is enabled by the `-std=extra-legacy` compiler flag. - - Test written by: Francisco Redondo Marchena + gcc/fortran/io.c | 10 ++++++++++ + gcc/fortran/lang.opt | 4 ++++ + gcc/fortran/options.c | 1 + + gcc/testsuite/gfortran.dg/dec_format_empty_item_1.f | 19 +++++++++++++++++++ + gcc/testsuite/gfortran.dg/dec_format_empty_item_2.f | 19 +++++++++++++++++++ + gcc/testsuite/gfortran.dg/dec_format_empty_item_3.f | 19 +++++++++++++++++++ + 6 files changed, 72 insertions(+) + create mode 100644 gcc/testsuite/gfortran.dg/dec_format_empty_item_1.f + create mode 100644 gcc/testsuite/gfortran.dg/dec_format_empty_item_2.f + create mode 100644 gcc/testsuite/gfortran.dg/dec_format_empty_item_3.f diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c -index 0bec4ee39b2..d93dcfadd61 100644 +index 57117579627..5b355952840 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c -@@ -752,6 +752,16 @@ format_item_1: +@@ -756,6 +756,16 @@ format_item_1: error = unexpected_end; goto syntax; + case FMT_RPAREN: + /* Oracle allows a blank format item. */ -+ if (gfc_option.allow_std & GFC_STD_EXTRA_LEGACY) -+ goto finished; ++ if (flag_dec_blank_format_item) ++ goto finished; + else + { + error = unexpected_element; @@ -46,17 +43,47 @@ index 0bec4ee39b2..d93dcfadd61 100644 default: error = unexpected_element; goto syntax; -diff --git a/gcc/testsuite/gfortran.dg/dec_format_empty_item.f b/gcc/testsuite/gfortran.dg/dec_format_empty_item.f +diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt +index a957b90707f..3d8aaeaaf44 100644 +--- a/gcc/fortran/lang.opt ++++ b/gcc/fortran/lang.opt +@@ -440,6 +440,10 @@ fdec + Fortran Var(flag_dec) + Enable all DEC language extensions. + ++fdec-blank-format-item ++Fortran Var(flag_dec_blank_format_item) ++Enable the use of blank format items in format strings. ++ + fdec-duplicates + Fortran Var(flag_dec_duplicates) + Allow varibles to be duplicated in the type specification matches. +diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c +index b652be70f3d..a8c2cf71c3b 100644 +--- a/gcc/fortran/options.c ++++ b/gcc/fortran/options.c +@@ -78,6 +78,7 @@ set_dec_flags (int value) + SET_BITFLAG (flag_dec_duplicates, value, value); + SET_BITFLAG (flag_dec_char_conversions, value, value); + SET_BITFLAG (flag_dec_comparisons, value, value); ++ SET_BITFLAG (flag_dec_blank_format_item, value, value); + } + + /* Finalize DEC flags. */ +diff --git a/gcc/testsuite/gfortran.dg/dec_format_empty_item_1.f b/gcc/testsuite/gfortran.dg/dec_format_empty_item_1.f new file mode 100644 -index 00000000000..e817001e38a +index 00000000000..ed27c18944b --- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_format_empty_item.f -@@ -0,0 +1,16 @@ -+! { dg-do compile } -+! { dg-options "-std=extra-legacy" } ++++ b/gcc/testsuite/gfortran.dg/dec_format_empty_item_1.f +@@ -0,0 +1,19 @@ ++! { dg-do run } ++! { dg-options "-fdec" } +! +! Test blank/empty format items in format string +! ++! Test case contributed by Jim MacArthur ++! Modified by Mark Eggleston ++! + PROGRAM blank_format_items + INTEGER A/0/ + @@ -68,3 +95,56 @@ index 00000000000..e817001e38a + PRINT 10, A +10 FORMAT( I5,) + END +diff --git a/gcc/testsuite/gfortran.dg/dec_format_empty_item_2.f b/gcc/testsuite/gfortran.dg/dec_format_empty_item_2.f +new file mode 100644 +index 00000000000..2793cb16225 +--- /dev/null ++++ b/gcc/testsuite/gfortran.dg/dec_format_empty_item_2.f +@@ -0,0 +1,19 @@ ++! { dg-do run } ++! { dg-options "-fdec-blank-format-item" } ++! ++! Test blank/empty format items in format string ++! ++! Test case contributed by Jim MacArthur ++! Modified by Mark Eggleston ++! ++ 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 ++! Modified by Mark Eggleston ++! ++ 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 + diff --git a/SOURCES/0007-Allow-more-than-one-character-as-argument-to-ICHAR.patch b/SOURCES/0007-Allow-more-than-one-character-as-argument-to-ICHAR.patch index f77dd34..a70ca2b 100644 --- a/SOURCES/0007-Allow-more-than-one-character-as-argument-to-ICHAR.patch +++ b/SOURCES/0007-Allow-more-than-one-character-as-argument-to-ICHAR.patch @@ -1,67 +1,65 @@ -From d75972937274489189a151a47da9b9aadfdefe8d Mon Sep 17 00:00:00 2001 +From d15e5e207e2a6b46edee2f2b5d3e4c1cc7cdb80f Mon Sep 17 00:00:00 2001 From: Jim MacArthur Date: Mon, 5 Oct 2015 13:45:15 +0100 -Subject: [PATCH 07/23] Allow more than one character as argument to ICHAR +Subject: [PATCH 07/16] Allow more than one character as argument to ICHAR -This feature is enabled by the `-std=extra-legacy` compiler flag. +Use -fdec to enable.. --- - -commit 44861a8907c8d849193287231a464d34fcce522d -Author: Jim MacArthur -Date: Mon Oct 5 13:45:15 2015 +0100 - - Allow more than one character as argument to ICHAR - - This feature is enabled by the `-std=extra-legacy` compiler flag. - - Test written by: Francisco Redondo Marchena + gcc/fortran/check.c | 2 +- + gcc/fortran/simplify.c | 4 ++-- + gcc/testsuite/gfortran.dg/dec_ichar_with_string_1.f | 21 +++++++++++++++++++++ + 3 files changed, 24 insertions(+), 3 deletions(-) + create mode 100644 gcc/testsuite/gfortran.dg/dec_ichar_with_string_1.f diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c -index 4f2d21610b9..38a90519c81 100644 +index a04f0d66655..0ba4d0a031f 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c -@@ -2472,7 +2472,7 @@ gfc_check_ichar_iachar (gfc_expr *c, gfc_expr *kind) +@@ -2603,7 +2603,7 @@ gfc_check_ichar_iachar (gfc_expr *c, gfc_expr *kind) else return true; - if (i != 1) -+ if (i != 1 && !(gfc_option.allow_std & GFC_STD_EXTRA_LEGACY)) ++ if (i != 1 && !flag_dec) { gfc_error ("Argument of %s at %L must be of length one", gfc_current_intrinsic, &c->where); diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c -index 80c96371ad9..6e05bb444ed 100644 +index 7d7e3f22f73..7aff256c6b3 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c -@@ -2774,7 +2774,7 @@ gfc_simplify_iachar (gfc_expr *e, gfc_expr *kind) +@@ -3229,7 +3229,7 @@ gfc_simplify_iachar (gfc_expr *e, gfc_expr *kind) if (e->expr_type != EXPR_CONSTANT) return NULL; - if (e->value.character.length != 1) -+ if (e->value.character.length != 1 && !(gfc_option.allow_std & GFC_STD_EXTRA_LEGACY)) ++ if (e->value.character.length != 1 && !flag_dec) { gfc_error ("Argument of IACHAR at %L must be of length one", &e->where); return &gfc_bad_expr; -@@ -2972,7 +2972,7 @@ gfc_simplify_ichar (gfc_expr *e, gfc_expr *kind) +@@ -3427,7 +3427,7 @@ gfc_simplify_ichar (gfc_expr *e, gfc_expr *kind) if (e->expr_type != EXPR_CONSTANT) return NULL; - if (e->value.character.length != 1) -+ if (e->value.character.length != 1 && !(gfc_option.allow_std & GFC_STD_EXTRA_LEGACY)) ++ if (e->value.character.length != 1 && !flag_dec) { gfc_error ("Argument of ICHAR at %L must be of length one", &e->where); return &gfc_bad_expr; -diff --git a/gcc/testsuite/gfortran.dg/dec_ichar_with_string.f b/gcc/testsuite/gfortran.dg/dec_ichar_with_string.f +diff --git a/gcc/testsuite/gfortran.dg/dec_ichar_with_string_1.f b/gcc/testsuite/gfortran.dg/dec_ichar_with_string_1.f new file mode 100644 -index 00000000000..c97746d4a4e +index 00000000000..85efccecc0f --- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_ichar_with_string.f -@@ -0,0 +1,18 @@ -+! { dg-do compile } -+! { dg-options "-std=extra-legacy" } ++++ b/gcc/testsuite/gfortran.dg/dec_ichar_with_string_1.f +@@ -0,0 +1,21 @@ ++! { dg-do run } ++! { dg-options "-fdec" } +! +! Test ICHAR and IACHAR with more than one character as argument +! ++! Test case contributed by Jim MacArthur ++! Modified by Mark Eggleston ++! + PROGRAM ichar_more_than_one_character + CHARACTER*4 st/'Test'/ + INTEGER i @@ -75,3 +73,6 @@ index 00000000000..c97746d4a4e + i = IACHAR('Test') + if (i.NE.84) STOP 4 + END +-- +2.11.0 + diff --git a/SOURCES/0008-Allow-non-integer-substring-indexes.patch b/SOURCES/0008-Allow-non-integer-substring-indexes.patch index c27f19b..b165df8 100644 --- a/SOURCES/0008-Allow-non-integer-substring-indexes.patch +++ b/SOURCES/0008-Allow-non-integer-substring-indexes.patch @@ -1,32 +1,58 @@ -From a6e02ad7b8b66823629a9703af4662b8b4037e2b Mon Sep 17 00:00:00 2001 +From 96563a652406d3c8471d75e6527ba634fa013400 Mon Sep 17 00:00:00 2001 From: Jim MacArthur Date: Mon, 5 Oct 2015 14:05:03 +0100 -Subject: [PATCH 08/23] Allow non-integer substring indexes +Subject: [PATCH 08/16] Allow non-integer substring indexes -This feature is enabled by the `-std=extra-legacy` compiler flag. +Use -fdec-non-integer-index compiler flag to enable. Also enabled by -fdec. --- + gcc/fortran/lang.opt | 4 ++++ + gcc/fortran/options.c | 1 + + gcc/fortran/resolve.c | 20 ++++++++++++++++++++ + .../dec_not_integer_substring_indexes_1.f | 18 ++++++++++++++++++ + .../dec_not_integer_substring_indexes_2.f | 18 ++++++++++++++++++ + .../dec_not_integer_substring_indexes_3.f | 18 ++++++++++++++++++ + 6 files changed, 79 insertions(+) + create mode 100644 gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_1.f + create mode 100644 gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_2.f + create mode 100644 gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_3.f -commit 9f05bda69f21d7a7c17b58ff0b6392bfd1a06bae -Author: Jim MacArthur -Date: Mon Oct 5 14:05:03 2015 +0100 - - Allow non-integer substring indexes - - This feature is enabled by the `-std=extra-legacy` compiler flag. - - Test written by: Francisco Redondo Marchena - +diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt +index 3d8aaeaaf44..772cf5e81f1 100644 +--- a/gcc/fortran/lang.opt ++++ b/gcc/fortran/lang.opt +@@ -474,6 +474,10 @@ fdec-math + Fortran Var(flag_dec_math) + Enable legacy math intrinsics for compatibility. + ++fdec-non-integer-index ++Fortran Var(flag_dec_non_integer_index) ++Enable support for non-integer substring indexes. ++ + fdec-structure + Fortran Var(flag_dec_structure) + Enable support for DEC STRUCTURE/RECORD. +diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c +index a8c2cf71c3b..e0ef03e6cc5 100644 +--- a/gcc/fortran/options.c ++++ b/gcc/fortran/options.c +@@ -79,6 +79,7 @@ set_dec_flags (int value) + SET_BITFLAG (flag_dec_char_conversions, value, value); + SET_BITFLAG (flag_dec_comparisons, value, value); + SET_BITFLAG (flag_dec_blank_format_item, value, value); ++ SET_BITFLAG (flag_dec_non_integer_index, value, value); + } + + /* Finalize DEC flags. */ diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c -index 84a4827a1b7..667cc5073e3 100644 +index c8b6333874b..04679d3a15d 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c -@@ -4680,6 +4680,17 @@ resolve_substring (gfc_ref *ref) +@@ -4992,6 +4992,16 @@ resolve_substring (gfc_ref *ref, bool *equal_length) if (!gfc_resolve_expr (ref->u.ss.start)) return false; + /* In legacy mode, allow non-integer string indexes by converting */ -+ if ((gfc_option.allow_std & GFC_STD_EXTRA_LEGACY) -+ && ref->u.ss.start->ts.type != BT_INTEGER ++ if (flag_dec_non_integer_index && ref->u.ss.start->ts.type != BT_INTEGER + && gfc_numeric_ts (&ref->u.ss.start->ts)) + { + gfc_typespec t; @@ -38,13 +64,12 @@ index 84a4827a1b7..667cc5073e3 100644 if (ref->u.ss.start->ts.type != BT_INTEGER) { gfc_error ("Substring start index at %L must be of type INTEGER", -@@ -4709,6 +4720,17 @@ resolve_substring (gfc_ref *ref) +@@ -5021,6 +5031,16 @@ resolve_substring (gfc_ref *ref, bool *equal_length) if (!gfc_resolve_expr (ref->u.ss.end)) return false; + /* Non-integer string index endings, as for start */ -+ if ((gfc_option.allow_std & GFC_STD_EXTRA_LEGACY) -+ && ref->u.ss.end->ts.type != BT_INTEGER ++ if (flag_dec_non_integer_index && ref->u.ss.end->ts.type != BT_INTEGER + && gfc_numeric_ts (&ref->u.ss.end->ts)) + { + gfc_typespec t; @@ -56,26 +81,78 @@ index 84a4827a1b7..667cc5073e3 100644 if (ref->u.ss.end->ts.type != BT_INTEGER) { gfc_error ("Substring end index at %L must be of type INTEGER", -diff --git a/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes.f b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes.f +diff --git a/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_1.f b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_1.f new file mode 100644 -index 00000000000..8f5c8eb3c0e +index 00000000000..0be28abaa4b --- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes.f -@@ -0,0 +1,17 @@ -+! { dg-do compile } -+! { dg-options "-std=extra-legacy" } ++++ b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_1.f +@@ -0,0 +1,18 @@ ++! { dg-do run } ++! { dg-options "-fdec" } +! +! Test not integer substring indexes +! ++! Test case contributed by Mark Eggleston ++! + PROGRAM not_integer_substring_indexes + CHARACTER*5 st/'Tests'/ -+ CHARACTER*4 st2 + REAL ir/1.0/ + REAL ir2/4.0/ + -+ st2 = st(ir:4) -+ st2 = st(1:ir2) -+ st2 = st(1.0:4) -+ st2 = st(1:4.0) -+ st2 = st(1.5:4) ++ if (st(ir:4).ne.'Test') stop 1 ++ if (st(1:ir2).ne.'Test') stop 2 ++ if (st(1.0:4).ne.'Test') stop 3 ++ if (st(1:4.0).ne.'Test') stop 4 ++ if (st(2.5:4).ne.'est') stop 5 + END +diff --git a/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_2.f b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_2.f +new file mode 100644 +index 00000000000..3cf05296d0c +--- /dev/null ++++ b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_2.f +@@ -0,0 +1,18 @@ ++! { dg-do run } ++! { dg-options "-fdec-non-integer-index" } ++! ++! Test not integer substring indexes ++! ++! Test case contributed by Mark Eggleston ++! ++ 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 ++! ++ 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 + diff --git a/SOURCES/0009-Allow-old-style-initializers-in-derived-types.patch b/SOURCES/0009-Allow-old-style-initializers-in-derived-types.patch new file mode 100644 index 0000000..d9a3a9e --- /dev/null +++ b/SOURCES/0009-Allow-old-style-initializers-in-derived-types.patch @@ -0,0 +1,185 @@ +From 772fea9acdac79164f3496f54ef4f63dd2562a0c Mon Sep 17 00:00:00 2001 +From: Jim MacArthur +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 ++! Modified by Mark Eggleston ++! ++ 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 ++! Modified by Mark Eggleston ++! ++ 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 ++! Modified by Mark Eggleston ++! ++ ++ 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 + diff --git a/SOURCES/0009-Convert-LOGICAL-to-INTEGER-for-arithmetic-ops-and-vi.patch b/SOURCES/0009-Convert-LOGICAL-to-INTEGER-for-arithmetic-ops-and-vi.patch deleted file mode 100644 index 2747d91..0000000 --- a/SOURCES/0009-Convert-LOGICAL-to-INTEGER-for-arithmetic-ops-and-vi.patch +++ /dev/null @@ -1,111 +0,0 @@ -From 00f13a60974cb4145799593398cc61894326c222 Mon Sep 17 00:00:00 2001 -From: Jim MacArthur -Date: Wed, 7 Oct 2015 16:31:18 -0400 -Subject: [PATCH 09/23] Convert LOGICAL to INTEGER for arithmetic ops, and vice - versa - -We allow converting LOGICAL types to INTEGER when doing arithmetic -operations, and converting INTEGER types to LOGICAL for use in -boolean operations. - -This feature is enabled with the `-std=extra-legacy` compiler flag. - -commit f40dbd54915de8155aad94bfa19c22f11b8a8eae -Author: Jim MacArthur -Date: Wed Oct 7 16:31:18 2015 -0400 - - Convert LOGICAL to INTEGER for arithmetic ops, and vice versa - - We allow converting LOGICAL types to INTEGER when doing arithmetic - operations, and converting INTEGER types to LOGICAL for use in - boolean operations. - - This feature is enabled with the `-std=extra-legacy` compiler flag. - - Test written by: Francisco Redondo Marchena - -diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c -index 667cc5073e3..33b441aa1bc 100644 ---- a/gcc/fortran/resolve.c -+++ b/gcc/fortran/resolve.c -@@ -3623,6 +3623,22 @@ is_character_based (bt type) - return type == BT_CHARACTER || type == BT_HOLLERITH; - } - -+/* If E is a logical, convert it to an integer and issue a warning -+ for the conversion. */ -+ -+static void -+convert_integer_to_logical (gfc_expr *e) -+{ -+ if (e->ts.type == BT_INTEGER) -+ { -+ /* Convert to LOGICAL */ -+ gfc_typespec t; -+ t.type = BT_LOGICAL; -+ t.kind = 1; -+ gfc_convert_type_warn (e, &t, 2, 1); -+ } -+} -+ - /* If E is a logical, convert it to an integer and issue a warning - for the conversion. */ - -@@ -3733,6 +3749,12 @@ resolve_operator (gfc_expr *e) - case INTRINSIC_OR: - case INTRINSIC_EQV: - case INTRINSIC_NEQV: -+ if (gfc_option.allow_std & GFC_STD_EXTRA_LEGACY) -+ { -+ convert_integer_to_logical (op1); -+ convert_integer_to_logical (op2); -+ } -+ - if (op1->ts.type == BT_LOGICAL && op2->ts.type == BT_LOGICAL) - { - e->ts.type = BT_LOGICAL; -@@ -3774,6 +3796,11 @@ resolve_operator (gfc_expr *e) - break; - } - -+ if (gfc_option.allow_std & GFC_STD_EXTRA_LEGACY) -+ { -+ convert_integer_to_logical (op1); -+ } -+ - if (op1->ts.type == BT_LOGICAL) - { - e->ts.type = BT_LOGICAL; -diff --git a/gcc/testsuite/gfortran.dg/dec_logical_to_integer_and_vice_versa.f b/gcc/testsuite/gfortran.dg/dec_logical_to_integer_and_vice_versa.f -new file mode 100644 -index 00000000000..7b9ec0d0cd2 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_logical_to_integer_and_vice_versa.f -@@ -0,0 +1,27 @@ -+! { dg-do compile } -+! { dg-options "-std=extra-legacy" } -+! -+! Test convertion between logical and integer for logical operators -+! -+ PROGRAM logical_integer_conversion -+ LOGICAL lpos /.true./ -+ INTEGER ineg/0/ -+ INTEGER ires -+ LOGICAL lres -+ -+ ! Test Logicals converted to Integers -+ if ((lpos.AND.ineg).EQ.1) STOP 3 -+ if ((ineg.AND.lpos).NE.0) STOP 4 -+ ires = (.true..AND.0) -+ if (ires.NE.0) STOP 5 -+ ires = (1.AND..false.) -+ if (ires.EQ.1) STOP 6 -+ -+ ! Test Integers converted to Logicals -+ if (lpos.EQ.ineg) STOP 7 -+ if (ineg.EQ.lpos) STOP 8 -+ lres = (.true..EQ.0) -+ if (lres) STOP 9 -+ lres = (1.EQ..false.) -+ if (lres) STOP 10 -+ END diff --git a/SOURCES/0010-Allow-mixed-string-length-and-array-specification-in.patch b/SOURCES/0010-Allow-mixed-string-length-and-array-specification-in.patch deleted file mode 100644 index a5194c2..0000000 --- a/SOURCES/0010-Allow-mixed-string-length-and-array-specification-in.patch +++ /dev/null @@ -1,158 +0,0 @@ -From e4c3d25a9133224535b3142ed31e8a8be1ad356b Mon Sep 17 00:00:00 2001 -From: Jim MacArthur -Date: Wed, 7 Oct 2015 17:04:06 -0400 -Subject: [PATCH 10/23] Allow mixed string length and array specification in - character declarations. - ---- - - 0010-Allow-mixed-string-length-and-array-specification-in.patch - -commit 05124ea7df2ee14620d5c24ffe972db3dcab4f4e -Author: Jim MacArthur -Date: Wed Oct 7 17:04:06 2015 -0400 - - Allow mixed string length and array specification in character declarations. - - Test written by: Francisco Redondo Marchena - -diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c -index 6d3d28af127..c90f9de5a78 100644 ---- a/gcc/fortran/decl.c -+++ b/gcc/fortran/decl.c -@@ -2264,6 +2264,35 @@ check_function_name (char *name) - } - - -+static match -+match_character_length_clause (gfc_charlen **cl, bool *cl_deferred, int elem) -+{ -+ gfc_expr* char_len; -+ char_len = NULL; -+ -+ match m = match_char_length (&char_len, cl_deferred, false); -+ if (m == MATCH_YES) -+ { -+ *cl = gfc_new_charlen (gfc_current_ns, NULL); -+ (*cl)->length = char_len; -+ } -+ else if (m == MATCH_NO) -+ { -+ if (elem > 1 -+ && (current_ts.u.cl->length == NULL -+ || current_ts.u.cl->length->expr_type != EXPR_CONSTANT)) -+ { -+ *cl = gfc_new_charlen (gfc_current_ns, NULL); -+ (*cl)->length = gfc_copy_expr (current_ts.u.cl->length); -+ } -+ else -+ *cl = current_ts.u.cl; -+ -+ *cl_deferred = current_ts.deferred; -+ } -+ return m; -+} -+ - /* Match a variable name with an optional initializer. When this - subroutine is called, a variable is expected to be parsed next. - Depending on what is happening at the moment, updates either the -@@ -2274,7 +2303,7 @@ variable_decl (int elem) - { - char name[GFC_MAX_SYMBOL_LEN + 1]; - static unsigned int fill_id = 0; -- gfc_expr *initializer, *char_len; -+ gfc_expr *initializer; - gfc_array_spec *as; - gfc_array_spec *cp_as; /* Extra copy for Cray Pointees. */ - gfc_charlen *cl; -@@ -2283,6 +2312,7 @@ variable_decl (int elem) - match m; - bool t; - gfc_symbol *sym; -+ match cl_match; - - initializer = NULL; - as = NULL; -@@ -2335,6 +2365,20 @@ variable_decl (int elem) - - var_locus = gfc_current_locus; - -+ -+ cl = NULL; -+ cl_deferred = false; -+ cl_match = MATCH_NO; -+ -+ /* Check for a character length clause before an array clause */ -+ if ((gfc_option.allow_std & GFC_STD_EXTRA_LEGACY) -+ && current_ts.type == BT_CHARACTER) -+ { -+ cl_match = match_character_length_clause (&cl, &cl_deferred, elem); -+ if (cl_match == MATCH_ERROR) -+ goto cleanup; -+ } -+ - /* Now we could see the optional array spec. or character length. */ - m = gfc_match_array_spec (&as, true, true); - if (m == MATCH_ERROR) -@@ -2453,40 +2497,12 @@ variable_decl (int elem) - } - } - -- char_len = NULL; -- cl = NULL; -- cl_deferred = false; -- -- if (current_ts.type == BT_CHARACTER) -+ /* Second chance for a character length clause */ -+ if (cl_match == MATCH_NO && current_ts.type == BT_CHARACTER) - { -- switch (match_char_length (&char_len, &cl_deferred, false)) -- { -- case MATCH_YES: -- cl = gfc_new_charlen (gfc_current_ns, NULL); -- -- cl->length = char_len; -- break; -- -- /* Non-constant lengths need to be copied after the first -- element. Also copy assumed lengths. */ -- case MATCH_NO: -- if (elem > 1 -- && (current_ts.u.cl->length == NULL -- || current_ts.u.cl->length->expr_type != EXPR_CONSTANT)) -- { -- cl = gfc_new_charlen (gfc_current_ns, NULL); -- cl->length = gfc_copy_expr (current_ts.u.cl->length); -- } -- else -- cl = current_ts.u.cl; -- -- cl_deferred = current_ts.deferred; -- -- break; -- -- case MATCH_ERROR: -- goto cleanup; -- } -+ m = match_character_length_clause( &cl, &cl_deferred, elem ); -+ if (m == MATCH_ERROR) -+ goto cleanup; - } - - /* The dummy arguments and result of the abreviated form of MODULE -diff --git a/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration.f b/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration.f -new file mode 100644 -index 00000000000..69b110edb25 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration.f -@@ -0,0 +1,10 @@ -+! { dg-do compile } -+! { dg-options "-std=extra-legacy" } -+! -+! Test character declaration with mixed string length and array specification -+! -+ PROGRAM character_declaration -+ CHARACTER ASPEC_SLENGTH*2 (5) /'01','02','03','04','05'/ -+ CHARACTER SLENGTH_ASPEC(5)*2 /'01','02','03','04','05'/ -+ if (ASPEC_SLENGTH(3).NE.SLENGTH_ASPEC(3)) STOP 1 -+ END diff --git a/SOURCES/0010-Allow-string-length-and-kind-to-be-specified-on-a-pe.patch b/SOURCES/0010-Allow-string-length-and-kind-to-be-specified-on-a-pe.patch new file mode 100644 index 0000000..e4bde41 --- /dev/null +++ b/SOURCES/0010-Allow-string-length-and-kind-to-be-specified-on-a-pe.patch @@ -0,0 +1,587 @@ +From 08e63b85674f146b5f242906d7d5f063b2abd31c Mon Sep 17 00:00:00 2001 +From: Jim MacArthur +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 + +Now rejects invalid kind parameters and prints error messages: + + INTEGER X*3 + +caused an internal compiler error. + +Contributed by Mark Eggleston +--- + 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 ++! Modified by Mark Eggleston ++! ++ 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 ++! Modified by Mark Eggleston ++! ++ 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 ++! Modified by Mark Eggleston ++! ++ 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 ++! ++ 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 ++! ++ 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 ++! ++ 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 ++! ++ 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 ++! ++ 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 ++! ++ 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 ++! ++ 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 ++! ++ 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 + diff --git a/SOURCES/0011-Allow-character-to-int-conversions-in-DATA-statement.patch b/SOURCES/0011-Allow-character-to-int-conversions-in-DATA-statement.patch deleted file mode 100644 index 1130a94..0000000 --- a/SOURCES/0011-Allow-character-to-int-conversions-in-DATA-statement.patch +++ /dev/null @@ -1,52 +0,0 @@ -From ced1b6638459f33dc9f22a0cd959f97c05a62e22 Mon Sep 17 00:00:00 2001 -From: Jim MacArthur -Date: Wed, 7 Oct 2015 18:23:31 -0400 -Subject: [PATCH 11/23] Allow character-to-int conversions in DATA statements - -This feature is enabled by the `-std=extra-legacy` compiler flag. ---- - - 0011-Allow-character-to-int-conversions-in-DATA-statement.patch - -commit 11b148af8967669bcebd91ea6fdae28e9ec8e97c -Author: Jim MacArthur -Date: Wed Oct 7 18:23:31 2015 -0400 - - Allow character-to-int conversions in DATA statements - - This feature is enabled by the `-std=extra-legacy` compiler flag. - - Test written by: Francisco Redondo Marchena - -diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c -index f347c753702..9982b8d0e85 100644 ---- a/gcc/fortran/expr.c -+++ b/gcc/fortran/expr.c -@@ -3294,6 +3294,10 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform, - || rvalue->ts.type == BT_HOLLERITH) - return true; - -+ if ((gfc_option.allow_std & GFC_STD_EXTRA_LEGACY) -+ && gfc_numeric_ts (&lvalue->ts) && rvalue->ts.type == BT_CHARACTER) -+ return true; -+ - if (lvalue->ts.type == BT_LOGICAL && rvalue->ts.type == BT_LOGICAL) - return true; - -diff --git a/gcc/testsuite/gfortran.dg/dec_char_to_int_conversion_in_data.f b/gcc/testsuite/gfortran.dg/dec_char_to_int_conversion_in_data.f -new file mode 100644 -index 00000000000..e0e4f735243 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_char_to_int_conversion_in_data.f -@@ -0,0 +1,11 @@ -+! { dg-do compile } -+! { dg-options "-std=extra-legacy" } -+! -+! Test character to int conversion in DATA types -+! -+ PROGRAM char_int_data_type -+ INTEGER*1 ai(2) -+ -+ DATA ai/'1',1/ -+ if(ai(1).NE.49) STOP 1 -+ END diff --git a/SOURCES/0011-Allow-non-logical-expressions-in-IF-statements.patch b/SOURCES/0011-Allow-non-logical-expressions-in-IF-statements.patch new file mode 100644 index 0000000..7152a0b --- /dev/null +++ b/SOURCES/0011-Allow-non-logical-expressions-in-IF-statements.patch @@ -0,0 +1,378 @@ +From f6197d0e59059a172f68a697e25cd585ad158937 Mon Sep 17 00:00:00 2001 +From: Jim MacArthur +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 ++! and Jeff Law ++! Modified by Mark Eggleston ++! ++ 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 ++! and Jeff Law ++! Modified by Mark Eggleston ++! ++ 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 ++! and Jeff Law ++! Modified by Mark Eggleston ++! ++ 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 ++! and Jeff Law ++! Modified by Mark Eggleston ++! ++ 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 ++! and Jeff Law ++! Modified by Mark Eggleston ++! ++ 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 ++! and Jeff Law ++! Modified by Mark Eggleston ++! ++ 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 + diff --git a/SOURCES/0012-Allow-old-style-initializers-in-derived-types.patch b/SOURCES/0012-Allow-old-style-initializers-in-derived-types.patch deleted file mode 100644 index a91db5b..0000000 --- a/SOURCES/0012-Allow-old-style-initializers-in-derived-types.patch +++ /dev/null @@ -1,94 +0,0 @@ -From 5d5a6c9d8c5a8db252d972ec32dd70d2510404fb Mon Sep 17 00:00:00 2001 -From: Jim MacArthur -Date: Thu, 4 Feb 2016 16:00:30 +0000 -Subject: [PATCH 12/23] Allow old-style initializers in derived types - -This allows simple declarations in derived types and structures, such as: - LOGICAL*1 NIL /0/ -Only single value expressions are allowed at the moment. - -This feature is enabled by the `-std=extra-legacy` compiler flag. ---- - -commit a9ee9b2c45580d0e52670cec4d3d68095dabc178 -Author: Jim MacArthur -Date: Thu Feb 4 16:00:30 2016 +0000 - - Allow old-style initializers in derived types - - This allows simple declarations in derived types and structures, such as: - LOGICAL*1 NIL /0/ - Only single value expressions are allowed at the moment. - - This feature is enabled by the `-std=extra-legacy` compiler flag. - - Test written by: Francisco Redondo Marchena - -diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c -index c90f9de5a78..3ad9c2c8b40 100644 ---- a/gcc/fortran/decl.c -+++ b/gcc/fortran/decl.c -@@ -2437,12 +2437,30 @@ variable_decl (int elem) - but not components of derived types. */ - else if (gfc_current_state () == COMP_DERIVED) - { -- gfc_error ("Invalid old style initialization for derived type " -- "component at %C"); -- m = MATCH_ERROR; -- goto cleanup; -- } -+ if (gfc_option.allow_std & GFC_STD_EXTRA_LEGACY) -+ { -+ /* Attempt to match an old-style initializer which is a simple -+ integer or character expression; this will not work with -+ multiple values. */ -+ m = gfc_match_init_expr (&initializer); -+ if (m == MATCH_ERROR) -+ goto cleanup; -+ else if (m == MATCH_YES) -+ { -+ m = gfc_match ("/"); -+ if (m != MATCH_YES) -+ goto cleanup; -+ } -+ } -+ else - -+ { -+ gfc_error ("Invalid old style initialization for derived type " -+ "component at %C"); -+ m = MATCH_ERROR; -+ goto cleanup; -+ } -+ } - /* For structure components, read the initializer as a special - expression and let the rest of this function apply the initializer - as usual. */ -diff --git a/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style.f b/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style.f -new file mode 100644 -index 00000000000..eac7de987e8 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style.f -@@ -0,0 +1,22 @@ -+! { dg-do compile } -+! { dg-options "-std=extra-legacy" } -+! -+! Test old style initializers in derived types -+! -+ PROGRAM spec_in_var -+ TYPE STRUCT1 -+ INTEGER*4 ID /8/ -+ INTEGER*4 TYPE /5/ -+ INTEGER*8 DEFVAL /0/ -+ CHARACTER*(5) NAME /'tests'/ -+ LOGICAL*1 NIL /0/ -+ END TYPE STRUCT1 -+ -+ TYPE (STRUCT1) SINST -+ -+ if(SINST%ID.NE.8) STOP 1 -+ if(SINST%TYPE.NE.5) STOP 2 -+ if(SINST%DEFVAL.NE.0) STOP 3 -+ if(SINST%NAME.NE.'tests') STOP 4 -+ if(SINST%NIL) STOP 5 -+ END diff --git a/SOURCES/0012-Support-type-promotion-in-calls-to-intrinsics.patch b/SOURCES/0012-Support-type-promotion-in-calls-to-intrinsics.patch new file mode 100644 index 0000000..3b67735 --- /dev/null +++ b/SOURCES/0012-Support-type-promotion-in-calls-to-intrinsics.patch @@ -0,0 +1,2151 @@ +From 79bc3c8c15122dd929703f5ca7e468ffd46c3c3e Mon Sep 17 00:00:00 2001 +From: Francisco Redondo Marchena +Date: Mon, 9 Apr 2018 15:10:02 +0100 +Subject: [PATCH 12/16] Support type promotion in calls to intrinsics + +Use -fdec-promotion or -fdec to enable this feature. + +Merged 2 commits: worked on by Ben Brewer , +Francisco Redondo Marchena + +Re-worked by Mark Eggleston +--- + gcc/fortran/check.c | 71 +++++- + gcc/fortran/intrinsic.c | 5 + + gcc/fortran/iresolve.c | 91 ++++--- + gcc/fortran/lang.opt | 4 + + gcc/fortran/options.c | 1 + + gcc/fortran/simplify.c | 266 ++++++++++++++++----- + ...ec_intrinsic_int_real_array_const_promotion_1.f | 18 ++ + ...ec_intrinsic_int_real_array_const_promotion_2.f | 18 ++ + ...ec_intrinsic_int_real_array_const_promotion_3.f | 18 ++ + .../dec_intrinsic_int_real_const_promotion_1.f | 90 +++++++ + .../dec_intrinsic_int_real_const_promotion_2.f | 90 +++++++ + .../dec_intrinsic_int_real_const_promotion_3.f | 92 +++++++ + .../dec_intrinsic_int_real_promotion_1.f | 130 ++++++++++ + .../dec_intrinsic_int_real_promotion_2.f | 130 ++++++++++ + .../dec_intrinsic_int_real_promotion_3.f | 130 ++++++++++ + .../dec_intrinsic_int_real_promotion_4.f | 118 +++++++++ + .../dec_intrinsic_int_real_promotion_5.f | 118 +++++++++ + .../dec_intrinsic_int_real_promotion_6.f | 118 +++++++++ + .../dec_intrinsic_int_real_promotion_7.f | 118 +++++++++ + gcc/testsuite/gfortran.dg/dec_kind_promotion-1.f | 40 ++++ + gcc/testsuite/gfortran.dg/dec_kind_promotion-2.f | 40 ++++ + gcc/testsuite/gfortran.dg/dec_kind_promotion-3.f | 40 ++++ + 22 files changed, 1655 insertions(+), 91 deletions(-) + create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_1.f + create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_2.f + create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_3.f + create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion_1.f + create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion_2.f + create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion_3.f + create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_1.f + create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_2.f + create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_3.f + create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_4.f + create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_5.f + create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_6.f + create mode 100644 gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_7.f + create mode 100644 gcc/testsuite/gfortran.dg/dec_kind_promotion-1.f + create mode 100644 gcc/testsuite/gfortran.dg/dec_kind_promotion-2.f + create mode 100644 gcc/testsuite/gfortran.dg/dec_kind_promotion-3.f + +diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c +index 0ba4d0a031f..89416ba368d 100644 +--- a/gcc/fortran/check.c ++++ b/gcc/fortran/check.c +@@ -947,12 +947,40 @@ gfc_check_allocated (gfc_expr *array) + } + + ++/* Check function where both arguments must be real or integer ++ and warn if they are different types. */ ++ ++bool ++check_int_real_promotion (gfc_expr *a, gfc_expr *b) ++{ ++ gfc_expr *i; ++ ++ if (!int_or_real_check (a, 0)) ++ return false; ++ ++ if (!int_or_real_check (b, 1)) ++ return false; ++ ++ if (a->ts.type != b->ts.type) ++ { ++ i = (a->ts.type != BT_REAL ? a : b); ++ gfc_warning_now (OPT_Wconversion, "Conversion from INTEGER to REAL " ++ "at %L might lose precision", &i->where); ++ } ++ ++ return true; ++} ++ ++ + /* Common check function where the first argument must be real or + integer and the second argument must be the same as the first. */ + + bool + gfc_check_a_p (gfc_expr *a, gfc_expr *p) + { ++ if (flag_dec_promotion) ++ return check_int_real_promotion (a, p); ++ + if (!int_or_real_check (a, 0)) + return false; + +@@ -3126,6 +3154,41 @@ check_rest (bt type, int kind, gfc_actual_arglist *arglist) + } + + ++/* Check function where all arguments of an argument list must be real ++ or integer. */ ++ ++static bool ++check_rest_int_real (gfc_actual_arglist *arglist) ++{ ++ gfc_actual_arglist *arg, *tmp; ++ gfc_expr *x; ++ int m, n; ++ ++ if (!min_max_args (arglist)) ++ return false; ++ ++ for (arg = arglist, n=1; arg; arg = arg->next, n++) ++ { ++ x = arg->expr; ++ if (x->ts.type != BT_INTEGER && x->ts.type != BT_REAL) ++ { ++ gfc_error ("% argument of %qs intrinsic at %L must be " ++ "INTEGER or REAL", n, gfc_current_intrinsic, &x->where); ++ return false; ++ } ++ ++ for (tmp = arglist, m=1; tmp != arg; tmp = tmp->next, m++) ++ if (!gfc_check_conformance (tmp->expr, x, ++ "arguments 'a%d' and 'a%d' for " ++ "intrinsic '%s'", m, n, ++ gfc_current_intrinsic)) ++ return false; ++ } ++ ++ return true; ++} ++ ++ + bool + gfc_check_min_max (gfc_actual_arglist *arg) + { +@@ -3150,7 +3213,10 @@ gfc_check_min_max (gfc_actual_arglist *arg) + return false; + } + +- return check_rest (x->ts.type, x->ts.kind, arg); ++ if (flag_dec_promotion && x->ts.type != BT_CHARACTER) ++ return check_rest_int_real (arg); ++ else ++ return check_rest (x->ts.type, x->ts.kind, arg); + } + + +@@ -4488,6 +4554,9 @@ gfc_check_shift (gfc_expr *i, gfc_expr *shift) + bool + gfc_check_sign (gfc_expr *a, gfc_expr *b) + { ++ if (flag_dec_promotion) ++ return check_int_real_promotion (a, b); ++ + if (!int_or_real_check (a, 0)) + return false; + +diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c +index 6d47ae3105f..a4b23bc244a 100644 +--- a/gcc/fortran/intrinsic.c ++++ b/gcc/fortran/intrinsic.c +@@ -4329,6 +4329,11 @@ check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym, + if (ts.kind == 0) + ts.kind = actual->expr->ts.kind; + ++ /* If kind promotion is allowed don't check for kind if it is smaller */ ++ if (flag_dec_promotion && ts.type == BT_INTEGER) ++ if (actual->expr->ts.kind < ts.kind) ++ ts.kind = actual->expr->ts.kind; ++ + if (!gfc_compare_types (&ts, &actual->expr->ts)) + { + if (error_flag) +diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c +index 53338dda0a7..92d50c3deb9 100644 +--- a/gcc/fortran/iresolve.c ++++ b/gcc/fortran/iresolve.c +@@ -893,19 +893,22 @@ gfc_resolve_dble (gfc_expr *f, gfc_expr *a) + void + gfc_resolve_dim (gfc_expr *f, gfc_expr *a, gfc_expr *p) + { +- f->ts.type = a->ts.type; + if (p != NULL) +- f->ts.kind = gfc_kind_max (a,p); +- else +- f->ts.kind = a->ts.kind; +- +- if (p != NULL && a->ts.kind != p->ts.kind) + { +- if (a->ts.kind == gfc_kind_max (a,p)) +- gfc_convert_type (p, &a->ts, 2); ++ f->ts.kind = gfc_kind_max (a,p); ++ if (a->ts.type == BT_REAL || p->ts.type == BT_REAL) ++ f->ts.type = BT_REAL; + else +- gfc_convert_type (a, &p->ts, 2); ++ f->ts.type = BT_INTEGER; ++ ++ if (a->ts.kind != f->ts.kind || a->ts.type != f->ts.type) ++ gfc_convert_type (a, &f->ts, 2); ++ ++ if (p->ts.kind != f->ts.kind || p->ts.type != f->ts.type) ++ gfc_convert_type (p, &f->ts, 2); + } ++ else ++ f->ts = a->ts; + + f->value.function.name + = gfc_get_string ("__dim_%c%d", gfc_type_letter (f->ts.type), f->ts.kind); +@@ -1669,14 +1672,17 @@ gfc_resolve_minmax (const char *name, gfc_expr *f, gfc_actual_arglist *args) + /* Find the largest type kind. */ + for (a = args->next; a; a = a->next) + { ++ if (a->expr-> ts.type == BT_REAL) ++ f->ts.type = BT_REAL; ++ + if (a->expr->ts.kind > f->ts.kind) + f->ts.kind = a->expr->ts.kind; + } + +- /* Convert all parameters to the required kind. */ ++ /* Convert all parameters to the required type and/or kind. */ + for (a = args; a; a = a->next) + { +- if (a->expr->ts.kind != f->ts.kind) ++ if (a->expr->ts.type != f->ts.type || a->expr->ts.kind != f->ts.kind) + gfc_convert_type (a->expr, &f->ts, 2); + } + +@@ -2169,19 +2175,22 @@ gfc_resolve_minval (gfc_expr *f, gfc_expr *array, gfc_expr *dim, + void + gfc_resolve_mod (gfc_expr *f, gfc_expr *a, gfc_expr *p) + { +- f->ts.type = a->ts.type; + if (p != NULL) +- f->ts.kind = gfc_kind_max (a,p); +- else +- f->ts.kind = a->ts.kind; +- +- if (p != NULL && a->ts.kind != p->ts.kind) + { +- if (a->ts.kind == gfc_kind_max (a,p)) +- gfc_convert_type (p, &a->ts, 2); ++ f->ts.kind = gfc_kind_max (a,p); ++ if (a->ts.type == BT_REAL || p->ts.type == BT_REAL) ++ f->ts.type = BT_REAL; + else +- gfc_convert_type (a, &p->ts, 2); ++ f->ts.type = BT_INTEGER; ++ ++ if (a->ts.kind != f->ts.kind || a->ts.type != f->ts.type) ++ gfc_convert_type (a, &f->ts, 2); ++ ++ if (p->ts.kind != f->ts.kind || p->ts.type != f->ts.type) ++ gfc_convert_type (p, &f->ts, 2); + } ++ else ++ f->ts = a->ts; + + f->value.function.name + = gfc_get_string ("__mod_%c%d", gfc_type_letter (f->ts.type), f->ts.kind); +@@ -2191,19 +2200,22 @@ gfc_resolve_mod (gfc_expr *f, gfc_expr *a, gfc_expr *p) + void + gfc_resolve_modulo (gfc_expr *f, gfc_expr *a, gfc_expr *p) + { +- f->ts.type = a->ts.type; + if (p != NULL) +- f->ts.kind = gfc_kind_max (a,p); +- else +- f->ts.kind = a->ts.kind; +- +- if (p != NULL && a->ts.kind != p->ts.kind) + { +- if (a->ts.kind == gfc_kind_max (a,p)) +- gfc_convert_type (p, &a->ts, 2); ++ f->ts.kind = gfc_kind_max (a,p); ++ if (a->ts.type == BT_REAL || p->ts.type == BT_REAL) ++ f->ts.type = BT_REAL; + else +- gfc_convert_type (a, &p->ts, 2); ++ f->ts.type = BT_INTEGER; ++ ++ if (a->ts.kind != f->ts.kind || a->ts.type != f->ts.type) ++ gfc_convert_type (a, &f->ts, 2); ++ ++ if (p->ts.kind != f->ts.kind || p->ts.type != f->ts.type) ++ gfc_convert_type (p, &f->ts, 2); + } ++ else ++ f->ts = a->ts; + + f->value.function.name + = gfc_get_string ("__modulo_%c%d", gfc_type_letter (f->ts.type), +@@ -2578,9 +2590,26 @@ gfc_resolve_shift (gfc_expr *f, gfc_expr *i, gfc_expr *shift ATTRIBUTE_UNUSED) + + + void +-gfc_resolve_sign (gfc_expr *f, gfc_expr *a, gfc_expr *b ATTRIBUTE_UNUSED) ++gfc_resolve_sign (gfc_expr *f, gfc_expr *a, gfc_expr *b) + { +- f->ts = a->ts; ++ if (b != NULL) ++ { ++ f->ts.kind = gfc_kind_max (a, b); ++ if (a->ts.type == BT_REAL || b->ts.type == BT_REAL) ++ f->ts.type = BT_REAL; ++ else ++ f->ts.type = BT_INTEGER; ++ ++ if (a->ts.kind != f->ts.kind || a->ts.type != f->ts.type) ++ gfc_convert_type (a, &f->ts, 2); ++ ++ if (b->ts.kind != f->ts.kind || b->ts.type != f->ts.type) ++ gfc_convert_type (b, &f->ts, 2); ++ } ++ else ++ { ++ f->ts = a->ts; ++ } + f->value.function.name + = gfc_get_string ("__sign_%c%d", gfc_type_letter (a->ts.type), a->ts.kind); + } +diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt +index fa2851ae837..2a8f5f661a8 100644 +--- a/gcc/fortran/lang.opt ++++ b/gcc/fortran/lang.opt +@@ -490,6 +490,10 @@ fdec-old-init + Fortran Var(flag_dec_old_init) + Enable support for old style initializers in derived types. + ++fdec-promotion ++Fortran Var(flag_dec_promotion) ++Add support for type promotion in intrinsic arguments. ++ + fdec-structure + Fortran Var(flag_dec_structure) + Enable support for DEC STRUCTURE/RECORD. +diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c +index 7b04a681f7b..7a2583a2076 100644 +--- a/gcc/fortran/options.c ++++ b/gcc/fortran/options.c +@@ -83,6 +83,7 @@ set_dec_flags (int value) + SET_BITFLAG (flag_dec_old_init, value, value); + SET_BITFLAG (flag_dec_override_kind, value, value); + SET_BITFLAG (flag_dec_non_logical_if, value, value); ++ SET_BITFLAG (flag_dec_promotion, value, value); + } + + /* Finalize DEC flags. */ +diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c +index 7aff256c6b3..cb5f93e293d 100644 +--- a/gcc/fortran/simplify.c ++++ b/gcc/fortran/simplify.c +@@ -2256,39 +2256,79 @@ gfc_simplify_digits (gfc_expr *x) + } + + ++/* Simplify function which sets the floating-point value of ar from ++ the value of a independently if a is integer of real. */ ++ ++static void ++simplify_int_real_promotion (const gfc_expr *a, const gfc_expr *b, mpfr_t *ar) ++{ ++ if (a->ts.type == BT_REAL) ++ { ++ mpfr_init2 (*ar, (a->ts.kind * 8)); ++ mpfr_set (*ar, a->value.real, GFC_RND_MODE); ++ } ++ else ++ { ++ mpfr_init2 (*ar, (b->ts.kind * 8)); ++ mpfr_set_z (*ar, a->value.integer, GFC_RND_MODE); ++ } ++} ++ ++ ++/* Simplify function which promotes a and b arguments from integer to real if ++ required in ar and br floating-point values. This function returns true if ++ a or b are reals and false otherwise. */ ++ ++static bool ++simplify_int_real_promotion2 (const gfc_expr *a, const gfc_expr *b, mpfr_t *ar, ++ mpfr_t *br) ++{ ++ if (a->ts.type != BT_REAL && b->ts.type != BT_REAL) ++ return false; ++ ++ simplify_int_real_promotion (a, b, ar); ++ simplify_int_real_promotion (b, a, br); ++ ++ return true; ++} ++ ++ + gfc_expr * + gfc_simplify_dim (gfc_expr *x, gfc_expr *y) + { + gfc_expr *result; + int kind; + ++ mpfr_t xr; ++ mpfr_t yr; ++ + if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT) + return NULL; + +- kind = x->ts.kind > y->ts.kind ? x->ts.kind : y->ts.kind; +- result = gfc_get_constant_expr (x->ts.type, kind, &x->where); +- +- switch (x->ts.type) ++ if ((x->ts.type != BT_REAL && x->ts.type != BT_INTEGER) ++ || (y->ts.type != BT_REAL && y->ts.type != BT_INTEGER)) + { +- case BT_INTEGER: +- if (mpz_cmp (x->value.integer, y->value.integer) > 0) +- mpz_sub (result->value.integer, x->value.integer, y->value.integer); +- else +- mpz_set_ui (result->value.integer, 0); +- +- break; +- +- case BT_REAL: +- if (mpfr_cmp (x->value.real, y->value.real) > 0) +- mpfr_sub (result->value.real, x->value.real, y->value.real, +- GFC_RND_MODE); +- else +- mpfr_set_ui (result->value.real, 0, GFC_RND_MODE); ++ gfc_internal_error ("gfc_simplify_dim(): Bad arguments"); ++ return NULL; ++ } + +- break; ++ kind = x->ts.kind > y->ts.kind ? x->ts.kind : y->ts.kind; + +- default: +- gfc_internal_error ("gfc_simplify_dim(): Bad type"); ++ if (simplify_int_real_promotion2 (x, y, &xr, &yr)) ++ { ++ result = gfc_get_constant_expr (BT_REAL, kind, &x->where); ++ if (mpfr_cmp (xr, yr) > 0) ++ mpfr_sub (result->value.real, xr, yr, GFC_RND_MODE); ++ else ++ mpfr_set_ui (result->value.real, 0, GFC_RND_MODE); ++ } ++ else ++ { ++ result = gfc_get_constant_expr (BT_INTEGER, kind, &x->where); ++ if (mpz_cmp (x->value.integer, y->value.integer) > 0) ++ mpz_sub (result->value.integer, x->value.integer, y->value.integer); ++ else ++ mpz_set_ui (result->value.integer, 0); + } + + return range_check (result, "DIM"); +@@ -4886,13 +4926,87 @@ min_max_choose (gfc_expr *arg, gfc_expr *extremum, int sign, bool back_val) + { + int ret; + ++ mpfr_t *arp; ++ mpfr_t *erp; ++ mpfr_t ar; ++ mpfr_t er; ++ ++ if (arg->ts.type != extremum->ts.type) ++ { ++ if (arg->ts.type == BT_REAL) ++ { ++ arp = &arg->value.real; ++ } ++ else ++ { ++ mpfr_init2 (ar, (arg->ts.kind * 8)); ++ mpfr_set_z (ar, arg->value.integer, GFC_RND_MODE); ++ arp = &ar; ++ } ++ ++ if (extremum->ts.type == BT_REAL) ++ { ++ erp = &extremum->value.real; ++ } ++ else ++ { ++ mpfr_init2 (er, (extremum->ts.kind * 8)); ++ mpfr_set_z (er, extremum->value.integer, GFC_RND_MODE); ++ erp = &er; ++ } ++ ++ if (mpfr_nan_p (*erp)) ++ { ++ ret = 1; ++ extremum->ts.type = arg->ts.type; ++ extremum->ts.kind = arg->ts.kind; ++ if (arg->ts.type == BT_INTEGER) ++ { ++ mpz_init2 (extremum->value.integer, (arg->ts.kind * 8)); ++ mpz_set (extremum->value.integer, arg->value.integer); ++ } ++ else ++ { ++ mpfr_init2 (extremum->value.real, (arg->ts.kind * 8)); ++ mpfr_set (extremum->value.real, *arp, GFC_RND_MODE); ++ } ++ } ++ else if (mpfr_nan_p (*arp)) ++ ret = -1; ++ else ++ { ++ ret = mpfr_cmp (*arp, *erp) * sign; ++ if (ret > 0) ++ { ++ extremum->ts.type = arg->ts.type; ++ extremum->ts.kind = arg->ts.kind; ++ if (arg->ts.type == BT_INTEGER) ++ { ++ mpz_init2 (extremum->value.integer, (arg->ts.kind * 8)); ++ mpz_set (extremum->value.integer, arg->value.integer); ++ } ++ else ++ { ++ mpfr_init2 (extremum->value.real, (arg->ts.kind * 8)); ++ mpfr_set (extremum->value.real, *arp, GFC_RND_MODE); ++ } ++ } ++ } ++ ++ return ret; ++ } ++ + switch (arg->ts.type) + { + case BT_INTEGER: + ret = mpz_cmp (arg->value.integer, + extremum->value.integer) * sign; + if (ret > 0) +- mpz_set (extremum->value.integer, arg->value.integer); ++ { ++ if (arg->ts.kind > extremum->ts.kind) ++ extremum->ts.kind = arg->ts.kind; ++ mpz_set (extremum->value.integer, arg->value.integer); ++ } + break; + + case BT_REAL: +@@ -5841,7 +5955,9 @@ gfc_simplify_mod (gfc_expr *a, gfc_expr *p) + gfc_expr *result; + int kind; + +- /* First check p. */ ++ mpfr_t ar; ++ mpfr_t pr; ++ + if (p->expr_type != EXPR_CONSTANT) + return NULL; + +@@ -5852,18 +5968,18 @@ gfc_simplify_mod (gfc_expr *a, gfc_expr *p) + if (mpz_cmp_ui (p->value.integer, 0) == 0) + { + gfc_error ("Argument %qs of MOD at %L shall not be zero", +- "P", &p->where); ++ "P", &p->where); + return &gfc_bad_expr; + } +- break; ++ break; + case BT_REAL: + if (mpfr_cmp_ui (p->value.real, 0) == 0) + { + gfc_error ("Argument %qs of MOD at %L shall not be zero", +- "P", &p->where); ++ "P", &p->where); + return &gfc_bad_expr; +- } +- break; ++ } ++ break; + default: + gfc_internal_error ("gfc_simplify_mod(): Bad arguments"); + } +@@ -5871,16 +5987,24 @@ gfc_simplify_mod (gfc_expr *a, gfc_expr *p) + if (a->expr_type != EXPR_CONSTANT) + return NULL; + ++ if (a->ts.type != BT_REAL && a->ts.type != BT_INTEGER) ++ { ++ gfc_internal_error ("gfc_simplify_mod(): Bad arguments"); ++ return NULL; ++ } ++ + kind = a->ts.kind > p->ts.kind ? a->ts.kind : p->ts.kind; +- result = gfc_get_constant_expr (a->ts.type, kind, &a->where); + +- if (a->ts.type == BT_INTEGER) +- mpz_tdiv_r (result->value.integer, a->value.integer, p->value.integer); +- else ++ if (simplify_int_real_promotion2 (a, p, &ar, &pr)) + { ++ result = gfc_get_constant_expr (BT_REAL, kind, &a->where); + gfc_set_model_kind (kind); +- mpfr_fmod (result->value.real, a->value.real, p->value.real, +- GFC_RND_MODE); ++ mpfr_fmod (result->value.real, ar, pr, GFC_RND_MODE); ++ } ++ else ++ { ++ result = gfc_get_constant_expr (BT_INTEGER, kind, &a->where); ++ mpz_tdiv_r (result->value.integer, a->value.integer, p->value.integer); + } + + return range_check (result, "MOD"); +@@ -5893,7 +6017,9 @@ gfc_simplify_modulo (gfc_expr *a, gfc_expr *p) + gfc_expr *result; + int kind; + +- /* First check p. */ ++ mpfr_t ar; ++ mpfr_t pr; ++ + if (p->expr_type != EXPR_CONSTANT) + return NULL; + +@@ -5904,44 +6030,52 @@ gfc_simplify_modulo (gfc_expr *a, gfc_expr *p) + if (mpz_cmp_ui (p->value.integer, 0) == 0) + { + gfc_error ("Argument %qs of MODULO at %L shall not be zero", +- "P", &p->where); ++ "P", &p->where); + return &gfc_bad_expr; + } +- break; ++ break; + case BT_REAL: + if (mpfr_cmp_ui (p->value.real, 0) == 0) + { + gfc_error ("Argument %qs of MODULO at %L shall not be zero", +- "P", &p->where); ++ "P", &p->where); + return &gfc_bad_expr; +- } +- break; ++ } ++ break; + default: + gfc_internal_error ("gfc_simplify_modulo(): Bad arguments"); + } + ++ if (a->ts.type != BT_REAL && a->ts.type != BT_INTEGER) ++ { ++ gfc_internal_error ("gfc_simplify_modulo(): Bad arguments"); ++ return NULL; ++ } ++ + if (a->expr_type != EXPR_CONSTANT) + return NULL; + + kind = a->ts.kind > p->ts.kind ? a->ts.kind : p->ts.kind; +- result = gfc_get_constant_expr (a->ts.type, kind, &a->where); + +- if (a->ts.type == BT_INTEGER) +- mpz_fdiv_r (result->value.integer, a->value.integer, p->value.integer); +- else ++ if (simplify_int_real_promotion2 (a, p, &ar, &pr)) + { ++ result = gfc_get_constant_expr (BT_REAL, kind, &a->where); + gfc_set_model_kind (kind); +- mpfr_fmod (result->value.real, a->value.real, p->value.real, +- GFC_RND_MODE); ++ mpfr_fmod (result->value.real, ar, pr, GFC_RND_MODE); + if (mpfr_cmp_ui (result->value.real, 0) != 0) +- { +- if (mpfr_signbit (a->value.real) != mpfr_signbit (p->value.real)) +- mpfr_add (result->value.real, result->value.real, p->value.real, +- GFC_RND_MODE); +- } +- else +- mpfr_copysign (result->value.real, result->value.real, +- p->value.real, GFC_RND_MODE); ++ { ++ if (mpfr_signbit (ar) != mpfr_signbit (pr)) ++ mpfr_add (result->value.real, result->value.real, pr, ++ GFC_RND_MODE); ++ } ++ else ++ mpfr_copysign (result->value.real, result->value.real, pr, ++ GFC_RND_MODE); ++ } ++ else ++ { ++ result = gfc_get_constant_expr (BT_INTEGER, kind, &a->where); ++ mpz_fdiv_r (result->value.integer, a->value.integer, p->value.integer); + } + + return range_check (result, "MODULO"); +@@ -7442,27 +7576,41 @@ gfc_expr * + gfc_simplify_sign (gfc_expr *x, gfc_expr *y) + { + gfc_expr *result; ++ bool neg; + + if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT) + return NULL; + + result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where); + ++ switch (y->ts.type) ++ { ++ case BT_INTEGER: ++ neg = (mpz_sgn (y->value.integer) < 0); ++ break; ++ ++ case BT_REAL: ++ neg = (mpfr_sgn (y->value.real) < 0); ++ break; ++ ++ default: ++ gfc_internal_error ("Bad type in gfc_simplify_sign"); ++ } ++ + switch (x->ts.type) + { + case BT_INTEGER: + mpz_abs (result->value.integer, x->value.integer); +- if (mpz_sgn (y->value.integer) < 0) ++ if (neg) + mpz_neg (result->value.integer, result->value.integer); + break; + + case BT_REAL: +- if (flag_sign_zero) ++ if (flag_sign_zero && y->ts.type == BT_REAL) + mpfr_copysign (result->value.real, x->value.real, y->value.real, +- GFC_RND_MODE); ++ GFC_RND_MODE); + else +- mpfr_setsign (result->value.real, x->value.real, +- mpfr_sgn (y->value.real) < 0 ? 1 : 0, GFC_RND_MODE); ++ mpfr_setsign (result->value.real, x->value.real, neg, GFC_RND_MODE); + break; + + default: +diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_1.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_1.f +new file mode 100644 +index 00000000000..25763852139 +--- /dev/null ++++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_1.f +@@ -0,0 +1,18 @@ ++! { dg-do compile } ++! { dg-options "-fdec" } ++! ++! Test promotion between integers and reals for mod and modulo where ++! A is a constant array and P is zero. ++! ++! Compilation errors are expected ++! ++! Contributed by Francisco Redondo Marchena ++! and Jeff Law ++! Modified by Mark Eggleston ++! ++ program promotion_int_real_array_const ++ real a(2) = mod([12, 34], 0.0)*4 ! { dg-error "shall not be zero" } ++ a = mod([12.0, 34.0], 0)*4 ! { dg-error "shall not be zero" } ++ real b(2) = modulo([12, 34], 0.0)*4 ! { dg-error "shall not be zero" } ++ b = modulo([12.0, 34.0], 0)*4 ! { dg-error "shall not be zero" } ++ end program +diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_2.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_2.f +new file mode 100644 +index 00000000000..b78a46054f4 +--- /dev/null ++++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_2.f +@@ -0,0 +1,18 @@ ++! { dg-do compile } ++! { dg-options "-fdec-promotion" } ++! ++! Test promotion between integers and reals for mod and modulo where ++! A is a constant array and P is zero. ++! ++! Compilation errors are expected ++! ++! Contributed by Francisco Redondo Marchena ++! and Jeff Law ++! Modified by Mark Eggleston ++! ++ program promotion_int_real_array_const ++ real a(2) = mod([12, 34], 0.0)*4 ! { dg-error "shall not be zero" } ++ a = mod([12.0, 34.0], 0)*4 ! { dg-error "shall not be zero" } ++ real b(2) = modulo([12, 34], 0.0)*4 ! { dg-error "shall not be zero" } ++ b = modulo([12.0, 34.0], 0)*4 ! { dg-error "shall not be zero" } ++ end program +diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_3.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_3.f +new file mode 100644 +index 00000000000..318ab5db97e +--- /dev/null ++++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_array_const_promotion_3.f +@@ -0,0 +1,18 @@ ++! { dg-do compile } ++! { dg-options "-fdec -fno-dec-promotion" } ++! ++! Test promotion between integers and reals for mod and modulo where ++! A is a constant array and P is zero. ++! ++! Compilation errors are expected ++! ++! Contributed by Francisco Redondo Marchena ++! and Jeff Law ++! Modified by Mark Eggleston ++! ++ program promotion_int_real_array_const ++ real a(2) = mod([12, 34], 0.0)*4 ! { dg-error "'a' and 'p' arguments of 'mod'" } ++ a = mod([12.0, 34.0], 0)*4 ! { dg-error "'a' and 'p' arguments of 'mod'" } ++ real b(2) = modulo([12, 34], 0.0)*4 ! { dg-error "'a' and 'p' arguments of 'modulo'" } ++ b = modulo([12.0, 34.0], 0)*4 ! { dg-error "'a' and 'p' arguments of 'modulo'" } ++ end program +diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion_1.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion_1.f +new file mode 100644 +index 00000000000..27eb2582bb2 +--- /dev/null ++++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion_1.f +@@ -0,0 +1,90 @@ ++! { dg-do run } ++! { dg-options "-fdec -finit-real=snan" } ++! ++! Test promotion between integers and reals in intrinsic operations. ++! These operations are: mod, modulo, dim, sign, min, max, minloc and ++! maxloc. ++! ++! Contributed by Francisco Redondo Marchena ++! and Jeff Law ++! Modified by Mark Eggleston ++! ++ PROGRAM promotion_int_real_const ++ ! array_nan 4th position value is NAN ++ REAL array_nan(4) ++ DATA array_nan(1)/-4.0/ ++ DATA array_nan(2)/3.0/ ++ DATA array_nan(3)/-2/ ++ ++ INTEGER m_i/0/ ++ REAL m_r/0.0/ ++ ++ INTEGER md_i/0/ ++ REAL md_r/0.0/ ++ ++ INTEGER d_i/0/ ++ REAL d_r/0.0/ ++ ++ INTEGER s_i/0/ ++ REAL s_r/0.0/ ++ ++ INTEGER mn_i/0/ ++ REAL mn_r/0.0/ ++ ++ INTEGER mx_i/0/ ++ REAL mx_r/0.0/ ++ ++ m_i = MOD(4, 3) ++ if (m_i .ne. 1) STOP 1 ++ m_r = MOD(4.0, 3.0) ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 2 ++ m_r = MOD(4, 3.0) ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 3 ++ m_r = MOD(4.0, 3) ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 4 ++ ++ md_i = MODULO(4, 3) ++ if (md_i .ne. 1) STOP 5 ++ md_r = MODULO(4.0, 3.0) ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 6 ++ md_r = MODULO(4, 3.0) ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 7 ++ md_r = MODULO(4.0, 3) ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 8 ++ ++ d_i = DIM(4, 3) ++ if (d_i .ne. 1) STOP 9 ++ d_r = DIM(4.0, 3.0) ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 10 ++ d_r = DIM(4.0, 3) ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 11 ++ d_r = DIM(3, 4.0) ++ if (abs(d_r) > 1.0D-6) STOP 12 ++ ++ s_i = SIGN(-4, 3) ++ if (s_i .ne. 4) STOP 13 ++ s_r = SIGN(4.0, -3.0) ++ if (abs(s_r - (-4.0)) > 1.0D-6) STOP 14 ++ s_r = SIGN(4.0, -3) ++ if (abs(s_r - (-4.0)) > 1.0D-6) STOP 15 ++ s_r = SIGN(-4, 3.0) ++ if (abs(s_r - 4.0) > 1.0D-6) STOP 16 ++ ++ mx_i = MAX(-4, -3, 2, 1) ++ if (mx_i .ne. 2) STOP 17 ++ mx_r = MAX(-4.0, -3.0, 2.0, 1.0) ++ if (abs(mx_r - 2.0) > 1.0D-6) STOP 18 ++ mx_r = MAX(-4, -3.0, 2.0, 1) ++ if (abs(mx_r - 2.0) > 1.0D-6) STOP 19 ++ mx_i = MAXLOC(array_nan, 1) ++ if (mx_i .ne. 2) STOP 20 ++ ++ mn_i = MIN(-4, -3, 2, 1) ++ if (mn_i .ne. -4) STOP 21 ++ mn_r = MIN(-4.0, -3.0, 2.0, 1.0) ++ if (abs(mn_r - (-4.0)) > 1.0D-6) STOP 22 ++ mn_r = MIN(-4, -3.0, 2.0, 1) ++ if (abs(mn_r - (-4.0)) > 1.0D-6) STOP 23 ++ mn_i = MINLOC(array_nan, 1) ++ if (mn_i .ne. 1) STOP 24 ++ END PROGRAM +diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion_2.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion_2.f +new file mode 100644 +index 00000000000..bdd017b7280 +--- /dev/null ++++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion_2.f +@@ -0,0 +1,90 @@ ++! { dg-do run } ++! { dg-options "-fdec-promotion -finit-real=snan" } ++! ++! Test promotion between integers and reals in intrinsic operations. ++! These operations are: mod, modulo, dim, sign, min, max, minloc and ++! maxloc. ++! ++! Contributed by Francisco Redondo Marchena ++! and Jeff Law ++! Modified by Mark Eggleston ++! ++ PROGRAM promotion_int_real_const ++ ! array_nan 4th position value is NAN ++ REAL array_nan(4) ++ DATA array_nan(1)/-4.0/ ++ DATA array_nan(2)/3.0/ ++ DATA array_nan(3)/-2/ ++ ++ INTEGER m_i/0/ ++ REAL m_r/0.0/ ++ ++ INTEGER md_i/0/ ++ REAL md_r/0.0/ ++ ++ INTEGER d_i/0/ ++ REAL d_r/0.0/ ++ ++ INTEGER s_i/0/ ++ REAL s_r/0.0/ ++ ++ INTEGER mn_i/0/ ++ REAL mn_r/0.0/ ++ ++ INTEGER mx_i/0/ ++ REAL mx_r/0.0/ ++ ++ m_i = MOD(4, 3) ++ if (m_i .ne. 1) STOP 1 ++ m_r = MOD(4.0, 3.0) ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 2 ++ m_r = MOD(4, 3.0) ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 3 ++ m_r = MOD(4.0, 3) ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 4 ++ ++ md_i = MODULO(4, 3) ++ if (md_i .ne. 1) STOP 5 ++ md_r = MODULO(4.0, 3.0) ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 6 ++ md_r = MODULO(4, 3.0) ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 7 ++ md_r = MODULO(4.0, 3) ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 8 ++ ++ d_i = DIM(4, 3) ++ if (d_i .ne. 1) STOP 9 ++ d_r = DIM(4.0, 3.0) ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 10 ++ d_r = DIM(4.0, 3) ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 11 ++ d_r = DIM(3, 4.0) ++ if (abs(d_r) > 1.0D-6) STOP 12 ++ ++ s_i = SIGN(-4, 3) ++ if (s_i .ne. 4) STOP 13 ++ s_r = SIGN(4.0, -3.0) ++ if (abs(s_r - (-4.0)) > 1.0D-6) STOP 14 ++ s_r = SIGN(4.0, -3) ++ if (abs(s_r - (-4.0)) > 1.0D-6) STOP 15 ++ s_r = SIGN(-4, 3.0) ++ if (abs(s_r - 4.0) > 1.0D-6) STOP 16 ++ ++ mx_i = MAX(-4, -3, 2, 1) ++ if (mx_i .ne. 2) STOP 17 ++ mx_r = MAX(-4.0, -3.0, 2.0, 1.0) ++ if (abs(mx_r - 2.0) > 1.0D-6) STOP 18 ++ mx_r = MAX(-4, -3.0, 2.0, 1) ++ if (abs(mx_r - 2.0) > 1.0D-6) STOP 19 ++ mx_i = MAXLOC(array_nan, 1) ++ if (mx_i .ne. 2) STOP 20 ++ ++ mn_i = MIN(-4, -3, 2, 1) ++ if (mn_i .ne. -4) STOP 21 ++ mn_r = MIN(-4.0, -3.0, 2.0, 1.0) ++ if (abs(mn_r - (-4.0)) > 1.0D-6) STOP 22 ++ mn_r = MIN(-4, -3.0, 2.0, 1) ++ if (abs(mn_r - (-4.0)) > 1.0D-6) STOP 23 ++ mn_i = MINLOC(array_nan, 1) ++ if (mn_i .ne. 1) STOP 24 ++ END PROGRAM +diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion_3.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion_3.f +new file mode 100644 +index 00000000000..ce90a5667d6 +--- /dev/null ++++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_const_promotion_3.f +@@ -0,0 +1,92 @@ ++! { dg-do compile } ++! { dg-options "-fdec -fno-dec-promotion -finit-real=snan" } ++! ++! Test that there is no promotion between integers and reals in ++! intrinsic operations. ++! ++! These operations are: mod, modulo, dim, sign, min, max, minloc and ++! maxloc. ++! ++! Contributed by Francisco Redondo Marchena ++! and Jeff Law ++! Modified by Mark Eggleston ++! ++ PROGRAM promotion_int_real_const ++ ! array_nan 4th position value is NAN ++ REAL array_nan(4) ++ DATA array_nan(1)/-4.0/ ++ DATA array_nan(2)/3.0/ ++ DATA array_nan(3)/-2/ ++ ++ INTEGER m_i/0/ ++ REAL m_r/0.0/ ++ ++ INTEGER md_i/0/ ++ REAL md_r/0.0/ ++ ++ INTEGER d_i/0/ ++ REAL d_r/0.0/ ++ ++ INTEGER s_i/0/ ++ REAL s_r/0.0/ ++ ++ INTEGER mn_i/0/ ++ REAL mn_r/0.0/ ++ ++ INTEGER mx_i/0/ ++ REAL mx_r/0.0/ ++ ++ m_i = MOD(4, 3) ++ if (m_i .ne. 1) STOP 1 ++ m_r = MOD(4.0, 3.0) ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 2 ++ m_r = MOD(4, 3.0) ! { dg-error "'a' and 'p' arguments" } ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 3 ++ m_r = MOD(4.0, 3) ! { dg-error "'a' and 'p' arguments" } ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 4 ++ ++ md_i = MODULO(4, 3) ++ if (md_i .ne. 1) STOP 5 ++ md_r = MODULO(4.0, 3.0) ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 6 ++ md_r = MODULO(4, 3.0) ! { dg-error "'a' and 'p' arguments" } ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 7 ++ md_r = MODULO(4.0, 3) ! { dg-error "'a' and 'p' arguments" } ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 8 ++ ++ d_i = DIM(4, 3) ++ if (d_i .ne. 1) STOP 9 ++ d_r = DIM(4.0, 3.0) ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 10 ++ d_r = DIM(4.0, 3) ! { dg-error "'x' and 'y' arguments" } ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 11 ++ d_r = DIM(3, 4.0) ! { dg-error "'x' and 'y' arguments" } ++ if (abs(d_r) > 1.0D-6) STOP 12 ++ ++ s_i = SIGN(-4, 3) ++ if (s_i .ne. 4) STOP 13 ++ s_r = SIGN(4.0, -3.0) ++ if (abs(s_r - (-4.0)) > 1.0D-6) STOP 14 ++ s_r = SIGN(4.0, -3) ! { dg-error "'b' argument" } ++ if (abs(s_r - (-4.0)) > 1.0D-6) STOP 15 ++ s_r = SIGN(-4, 3.0) ! { dg-error "'b' argument" } ++ if (abs(s_r - 4.0) > 1.0D-6) STOP 16 ++ ++ mx_i = MAX(-4, -3, 2, 1) ++ if (mx_i .ne. 2) STOP 17 ++ mx_r = MAX(-4.0, -3.0, 2.0, 1.0) ++ if (abs(mx_r - 2.0) > 1.0D-6) STOP 18 ++ mx_r = MAX(-4, -3.0, 2.0, 1) ! { dg-error "'a2' argument" } ++ if (abs(mx_r - 2.0) > 1.0D-6) STOP 19 ++ mx_i = MAXLOC(array_nan, 1) ++ if (mx_i .ne. 2) STOP 20 ++ ++ mn_i = MIN(-4, -3, 2, 1) ++ if (mn_i .ne. -4) STOP 21 ++ mn_r = MIN(-4.0, -3.0, 2.0, 1.0) ++ if (abs(mn_r - (-4.0)) > 1.0D-6) STOP 22 ++ mn_r = MIN(-4, -3.0, 2.0, 1) ! { dg-error "'a2' argument" } ++ if (abs(mn_r - (-4.0)) > 1.0D-6) STOP 23 ++ mn_i = MINLOC(array_nan, 1) ++ if (mn_i .ne. 1) STOP 24 ++ END PROGRAM +diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_1.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_1.f +new file mode 100644 +index 00000000000..5c2cd931a4b +--- /dev/null ++++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_1.f +@@ -0,0 +1,130 @@ ++! { dg-do run } ++! { dg-options "-fdec" } ++! ++! Test promotion between integers and reals in intrinsic operations. ++! These operations are: mod, modulo, dim, sign, min, max, minloc and ++! maxloc. ++! ++! Contributed by Francisco Redondo Marchena ++! and Jeff Law ++! Modified by Mark Eggleston ++! ++ PROGRAM promotion_int_real ++ REAL l/0.0/ ++ INTEGER a_i/4/ ++ INTEGER*4 a2_i/4/ ++ INTEGER b_i/3/ ++ INTEGER*8 b2_i/3/ ++ INTEGER x_i/2/ ++ INTEGER y_i/1/ ++ REAL a_r/4.0/ ++ REAL*4 a2_r/4.0/ ++ REAL b_r/3.0/ ++ REAL*8 b2_r/3.0/ ++ REAL x_r/2.0/ ++ REAL y_r/1.0/ ++ ++ REAL array_nan(4) ++ DATA array_nan(1)/-4.0/ ++ DATA array_nan(2)/3.0/ ++ DATA array_nan(3)/-2/ ++ ++ INTEGER m_i/0/ ++ REAL m_r/0.0/ ++ ++ INTEGER md_i/0/ ++ REAL md_r/0.0/ ++ ++ INTEGER d_i/0/ ++ REAL d_r/0.0/ ++ ++ INTEGER s_i/0/ ++ REAL s_r/0.0/ ++ ++ INTEGER mn_i/0/ ++ REAL mn_r/0.0/ ++ ++ INTEGER mx_i/0/ ++ REAL mx_r/0.0/ ++ ++ ! array_nan 4th position value is NAN ++ array_nan(4) = 0/l ++ ++ m_i = MOD(a_i, b_i) ++ if (m_i .ne. 1) STOP 1 ++ m_i = MOD(a2_i, b2_i) ++ if (m_i .ne. 1) STOP 2 ++ m_r = MOD(a_r, b_r) ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 3 ++ m_r = MOD(a2_r, b2_r) ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 4 ++ m_r = MOD(a_i, b_r) ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 5 ++ m_r = MOD(a_r, b_i) ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 6 ++ ++ md_i = MODULO(a_i, b_i) ++ if (md_i .ne. 1) STOP 7 ++ md_i = MODULO(a2_i, b2_i) ++ if (md_i .ne. 1) STOP 8 ++ md_r = MODULO(a_r, b_r) ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 9 ++ md_r = MODULO(a2_r, b2_r) ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 10 ++ md_r = MODULO(a_i, b_r) ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 11 ++ md_r = MODULO(a_r, b_i) ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 12 ++ ++ d_i = DIM(a_i, b_i) ++ if (d_i .ne. 1) STOP 13 ++ d_i = DIM(a2_i, b2_i) ++ if (d_i .ne. 1) STOP 14 ++ d_r = DIM(a_r, b_r) ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 15 ++ d_r = DIM(a2_r, b2_r) ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 16 ++ d_r = DIM(a_r, b_i) ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 17 ++ d_r = DIM(b_i, a_r) ++ if (abs(d_r) > 1.0D-6) STOP 18 ++ ++ s_i = SIGN(-a_i, b_i) ++ if (s_i .ne. 4) STOP 19 ++ s_i = SIGN(-a2_i, b2_i) ++ if (s_i .ne. 4) STOP 20 ++ s_r = SIGN(a_r, -b_r) ++ if (abs(s_r - (-a_r)) > 1.0D-6) STOP 21 ++ s_r = SIGN(a2_r, -b2_r) ++ if (abs(s_r - (-a2_r)) > 1.0D-6) STOP 22 ++ s_r = SIGN(a_r, -b_i) ++ if (abs(s_r - (-a_r)) > 1.0D-6) STOP 23 ++ s_r = SIGN(-a_i, b_r) ++ if (abs(s_r - a_r) > 1.0D-6) STOP 24 ++ ++ mx_i = MAX(-a_i, -b_i, x_i, y_i) ++ if (mx_i .ne. x_i) STOP 25 ++ mx_i = MAX(-a2_i, -b2_i, x_i, y_i) ++ if (mx_i .ne. x_i) STOP 26 ++ mx_r = MAX(-a_r, -b_r, x_r, y_r) ++ if (abs(mx_r - x_r) > 1.0D-6) STOP 27 ++ mx_r = MAX(-a_r, -b_r, x_r, y_r) ++ if (abs(mx_r - x_r) > 1.0D-6) STOP 28 ++ mx_r = MAX(-a_i, -b_r, x_r, y_i) ++ if (abs(mx_r - x_r) > 1.0D-6) STOP 29 ++ mx_i = MAXLOC(array_nan, 1) ++ if (mx_i .ne. 2) STOP 30 ++ ++ mn_i = MIN(-a_i, -b_i, x_i, y_i) ++ if (mn_i .ne. -a_i) STOP 31 ++ mn_i = MIN(-a2_i, -b2_i, x_i, y_i) ++ if (mn_i .ne. -a2_i) STOP 32 ++ mn_r = MIN(-a_r, -b_r, x_r, y_r) ++ if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 33 ++ mn_r = MIN(-a2_r, -b2_r, x_r, y_r) ++ if (abs(mn_r - (-a2_r)) > 1.0D-6) STOP 34 ++ mn_r = MIN(-a_i, -b_r, x_r, y_i) ++ if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 35 ++ mn_i = MINLOC(array_nan, 1) ++ if (mn_i .ne. 1) STOP 36 ++ END PROGRAM +diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_2.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_2.f +new file mode 100644 +index 00000000000..d64d468f7d1 +--- /dev/null ++++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_2.f +@@ -0,0 +1,130 @@ ++! { dg-do run } ++! { dg-options "-fdec-promotion" } ++! ++! Test promotion between integers and reals in intrinsic operations. ++! These operations are: mod, modulo, dim, sign, min, max, minloc and ++! maxloc. ++! ++! Contributed by Francisco Redondo Marchena ++! and Jeff Law ++! Modified by Mark Eggleston ++! ++ PROGRAM promotion_int_real ++ REAL l/0.0/ ++ INTEGER a_i/4/ ++ INTEGER*4 a2_i/4/ ++ INTEGER b_i/3/ ++ INTEGER*8 b2_i/3/ ++ INTEGER x_i/2/ ++ INTEGER y_i/1/ ++ REAL a_r/4.0/ ++ REAL*4 a2_r/4.0/ ++ REAL b_r/3.0/ ++ REAL*8 b2_r/3.0/ ++ REAL x_r/2.0/ ++ REAL y_r/1.0/ ++ ++ REAL array_nan(4) ++ DATA array_nan(1)/-4.0/ ++ DATA array_nan(2)/3.0/ ++ DATA array_nan(3)/-2/ ++ ++ INTEGER m_i/0/ ++ REAL m_r/0.0/ ++ ++ INTEGER md_i/0/ ++ REAL md_r/0.0/ ++ ++ INTEGER d_i/0/ ++ REAL d_r/0.0/ ++ ++ INTEGER s_i/0/ ++ REAL s_r/0.0/ ++ ++ INTEGER mn_i/0/ ++ REAL mn_r/0.0/ ++ ++ INTEGER mx_i/0/ ++ REAL mx_r/0.0/ ++ ++ ! array_nan 4th position value is NAN ++ array_nan(4) = 0/l ++ ++ m_i = MOD(a_i, b_i) ++ if (m_i .ne. 1) STOP 1 ++ m_i = MOD(a2_i, b2_i) ++ if (m_i .ne. 1) STOP 2 ++ m_r = MOD(a_r, b_r) ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 3 ++ m_r = MOD(a2_r, b2_r) ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 4 ++ m_r = MOD(a_i, b_r) ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 5 ++ m_r = MOD(a_r, b_i) ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 6 ++ ++ md_i = MODULO(a_i, b_i) ++ if (md_i .ne. 1) STOP 7 ++ md_i = MODULO(a2_i, b2_i) ++ if (md_i .ne. 1) STOP 8 ++ md_r = MODULO(a_r, b_r) ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 9 ++ md_r = MODULO(a2_r, b2_r) ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 10 ++ md_r = MODULO(a_i, b_r) ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 11 ++ md_r = MODULO(a_r, b_i) ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 12 ++ ++ d_i = DIM(a_i, b_i) ++ if (d_i .ne. 1) STOP 13 ++ d_i = DIM(a2_i, b2_i) ++ if (d_i .ne. 1) STOP 14 ++ d_r = DIM(a_r, b_r) ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 15 ++ d_r = DIM(a2_r, b2_r) ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 16 ++ d_r = DIM(a_r, b_i) ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 17 ++ d_r = DIM(b_i, a_r) ++ if (abs(d_r) > 1.0D-6) STOP 18 ++ ++ s_i = SIGN(-a_i, b_i) ++ if (s_i .ne. 4) STOP 19 ++ s_i = SIGN(-a2_i, b2_i) ++ if (s_i .ne. 4) STOP 20 ++ s_r = SIGN(a_r, -b_r) ++ if (abs(s_r - (-a_r)) > 1.0D-6) STOP 21 ++ s_r = SIGN(a2_r, -b2_r) ++ if (abs(s_r - (-a2_r)) > 1.0D-6) STOP 22 ++ s_r = SIGN(a_r, -b_i) ++ if (abs(s_r - (-a_r)) > 1.0D-6) STOP 23 ++ s_r = SIGN(-a_i, b_r) ++ if (abs(s_r - a_r) > 1.0D-6) STOP 24 ++ ++ mx_i = MAX(-a_i, -b_i, x_i, y_i) ++ if (mx_i .ne. x_i) STOP 25 ++ mx_i = MAX(-a2_i, -b2_i, x_i, y_i) ++ if (mx_i .ne. x_i) STOP 26 ++ mx_r = MAX(-a_r, -b_r, x_r, y_r) ++ if (abs(mx_r - x_r) > 1.0D-6) STOP 27 ++ mx_r = MAX(-a_r, -b_r, x_r, y_r) ++ if (abs(mx_r - x_r) > 1.0D-6) STOP 28 ++ mx_r = MAX(-a_i, -b_r, x_r, y_i) ++ if (abs(mx_r - x_r) > 1.0D-6) STOP 29 ++ mx_i = MAXLOC(array_nan, 1) ++ if (mx_i .ne. 2) STOP 30 ++ ++ mn_i = MIN(-a_i, -b_i, x_i, y_i) ++ if (mn_i .ne. -a_i) STOP 31 ++ mn_i = MIN(-a2_i, -b2_i, x_i, y_i) ++ if (mn_i .ne. -a2_i) STOP 32 ++ mn_r = MIN(-a_r, -b_r, x_r, y_r) ++ if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 33 ++ mn_r = MIN(-a2_r, -b2_r, x_r, y_r) ++ if (abs(mn_r - (-a2_r)) > 1.0D-6) STOP 34 ++ mn_r = MIN(-a_i, -b_r, x_r, y_i) ++ if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 35 ++ mn_i = MINLOC(array_nan, 1) ++ if (mn_i .ne. 1) STOP 36 ++ END PROGRAM +diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_3.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_3.f +new file mode 100644 +index 00000000000..0708b666633 +--- /dev/null ++++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_3.f +@@ -0,0 +1,130 @@ ++! { dg-do compile } ++! { dg-options "-fdec -fno-dec-promotion" } ++! ++! Test promotion between integers and reals in intrinsic operations. ++! These operations are: mod, modulo, dim, sign, min, max, minloc and ++! maxloc. ++! ++! Contributed by Francisco Redondo Marchena ++! and Jeff Law ++! Modified by Mark Eggleston ++! ++ PROGRAM promotion_int_real ++ REAL l/0.0/ ++ INTEGER a_i/4/ ++ INTEGER*4 a2_i/4/ ++ INTEGER b_i/3/ ++ INTEGER*8 b2_i/3/ ++ INTEGER x_i/2/ ++ INTEGER y_i/1/ ++ REAL a_r/4.0/ ++ REAL*4 a2_r/4.0/ ++ REAL b_r/3.0/ ++ REAL*8 b2_r/3.0/ ++ REAL x_r/2.0/ ++ REAL y_r/1.0/ ++ ++ REAL array_nan(4) ++ DATA array_nan(1)/-4.0/ ++ DATA array_nan(2)/3.0/ ++ DATA array_nan(3)/-2/ ++ ++ INTEGER m_i/0/ ++ REAL m_r/0.0/ ++ ++ INTEGER md_i/0/ ++ REAL md_r/0.0/ ++ ++ INTEGER d_i/0/ ++ REAL d_r/0.0/ ++ ++ INTEGER s_i/0/ ++ REAL s_r/0.0/ ++ ++ INTEGER mn_i/0/ ++ REAL mn_r/0.0/ ++ ++ INTEGER mx_i/0/ ++ REAL mx_r/0.0/ ++ ++ ! array_nan 4th position value is NAN ++ array_nan(4) = 0/l ++ ++ m_i = MOD(a_i, b_i) ++ if (m_i .ne. 1) STOP 1 ++ m_i = MOD(a2_i, b2_i) ++ if (m_i .ne. 1) STOP 2 ++ m_r = MOD(a_r, b_r) ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 3 ++ m_r = MOD(a2_r, b2_r) ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 4 ++ m_r = MOD(a_i, b_r) ! { dg-error "'a' and 'p' arguments" } ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 5 ++ m_r = MOD(a_r, b_i) ! { dg-error "'a' and 'p' arguments" } ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 6 ++ ++ md_i = MODULO(a_i, b_i) ++ if (md_i .ne. 1) STOP 7 ++ md_i = MODULO(a2_i, b2_i) ++ if (md_i .ne. 1) STOP 8 ++ md_r = MODULO(a_r, b_r) ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 9 ++ md_r = MODULO(a2_r, b2_r) ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 10 ++ md_r = MODULO(a_i, b_r) ! { dg-error "'a' and 'p' arguments" } ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 11 ++ md_r = MODULO(a_r, b_i) ! { dg-error "'a' and 'p' arguments" } ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 12 ++ ++ d_i = DIM(a_i, b_i) ++ if (d_i .ne. 1) STOP 13 ++ d_i = DIM(a2_i, b2_i) ++ if (d_i .ne. 1) STOP 14 ++ d_r = DIM(a_r, b_r) ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 15 ++ d_r = DIM(a2_r, b2_r) ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 16 ++ d_r = DIM(a_r, b_i) ! { dg-error "'x' and 'y' arguments" } ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 17 ++ d_r = DIM(b_i, a_r) ! { dg-error "'x' and 'y' arguments" } ++ if (abs(d_r) > 1.0D-6) STOP 18 ++ ++ s_i = SIGN(-a_i, b_i) ++ if (s_i .ne. 4) STOP 19 ++ s_i = SIGN(-a2_i, b2_i) ! { dg-error "'b' argument" } ++ if (s_i .ne. 4) STOP 20 ++ s_r = SIGN(a_r, -b_r) ++ if (abs(s_r - (-a_r)) > 1.0D-6) STOP 21 ++ s_r = SIGN(a2_r, -b2_r) ! { dg-error "'b' argument" } ++ if (abs(s_r - (-a2_r)) > 1.0D-6) STOP 22 ++ s_r = SIGN(a_r, -b_i) ! { dg-error "'b' argument" } ++ if (abs(s_r - (-a_r)) > 1.0D-6) STOP 23 ++ s_r = SIGN(-a_i, b_r) ! { dg-error "'b' argument" } ++ if (abs(s_r - a_r) > 1.0D-6) STOP 24 ++ ++ mx_i = MAX(-a_i, -b_i, x_i, y_i) ++ if (mx_i .ne. x_i) STOP 25 ++ mx_i = MAX(-a2_i, -b2_i, x_i, y_i) ++ if (mx_i .ne. x_i) STOP 26 ++ mx_r = MAX(-a_r, -b_r, x_r, y_r) ++ if (abs(mx_r - x_r) > 1.0D-6) STOP 27 ++ mx_r = MAX(-a_r, -b_r, x_r, y_r) ++ if (abs(mx_r - x_r) > 1.0D-6) STOP 28 ++ mx_r = MAX(-a_i, -b_r, x_r, y_i) ! { dg-error "'a2' argument" } ++ if (abs(mx_r - x_r) > 1.0D-6) STOP 29 ++ mx_i = MAXLOC(array_nan, 1) ++ if (mx_i .ne. 2) STOP 30 ++ ++ mn_i = MIN(-a_i, -b_i, x_i, y_i) ++ if (mn_i .ne. -a_i) STOP 31 ++ mn_i = MIN(-a2_i, -b2_i, x_i, y_i) ++ if (mn_i .ne. -a2_i) STOP 32 ++ mn_r = MIN(-a_r, -b_r, x_r, y_r) ++ if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 33 ++ mn_r = MIN(-a2_r, -b2_r, x_r, y_r) ++ if (abs(mn_r - (-a2_r)) > 1.0D-6) STOP 34 ++ mn_r = MIN(-a_i, -b_r, x_r, y_i) ! { dg-error "'a2' argument" } ++ if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 35 ++ mn_i = MINLOC(array_nan, 1) ++ if (mn_i .ne. 1) STOP 36 ++ END PROGRAM +diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_4.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_4.f +new file mode 100644 +index 00000000000..efa4f236410 +--- /dev/null ++++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_4.f +@@ -0,0 +1,118 @@ ++! { dg-do compile } ++! { dg-options "-fdec" } ++! ++! Test promotion between integers and reals in intrinsic operations. ++! These operations are: mod, modulo, dim, sign, min, max, minloc and ++! maxloc. ++! ++! Contributed by Francisco Redondo Marchena ++! and Jeff Law ++! Modified by Mark Eggleston ++! ++ PROGRAM promotion_int_real ++ REAL l/0.0/ ++ LOGICAL a_l ++ LOGICAL*4 a2_l ++ LOGICAL b_l ++ LOGICAL*8 b2_l ++ LOGICAL x_l ++ LOGICAL y_l ++ CHARACTER a_c ++ CHARACTER*4 a2_c ++ CHARACTER b_c ++ CHARACTER*8 b2_c ++ CHARACTER x_c ++ CHARACTER y_c ++ ++ INTEGER m_i/0/ ++ REAL m_r/0.0/ ++ ++ INTEGER md_i/0/ ++ REAL md_r/0.0/ ++ ++ INTEGER d_i/0/ ++ REAL d_r/0.0/ ++ ++ INTEGER s_i/0/ ++ REAL s_r/0.0/ ++ ++ INTEGER mn_i/0/ ++ REAL mn_r/0.0/ ++ ++ INTEGER mx_i/0/ ++ REAL mx_r/0.0/ ++ ++ m_i = MOD(a_l, b_l) ! { dg-error "" } ++ if (m_i .ne. 1) STOP 1 ++ m_i = MOD(a2_l, b2_l) ! { dg-error "" } ++ if (m_i .ne. 1) STOP 2 ++ m_r = MOD(a_c, b_c) ! { dg-error "" } ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 3 ++ m_r = MOD(a2_c, b2_c) ! { dg-error "" } ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 4 ++ m_r = MOD(a_l, b_c) ! { dg-error "" } ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 5 ++ m_r = MOD(a_c, b_l) ! { dg-error "" } ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 6 ++ ++ md_i = MODULO(a_l, b_l) ! { dg-error "" } ++ if (md_i .ne. 1) STOP 7 ++ md_i = MODULO(a2_l, b2_l) ! { dg-error "" } ++ if (md_i .ne. 1) STOP 8 ++ md_r = MODULO(a_c, b_c) ! { dg-error "" } ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 9 ++ md_r = MODULO(a2_c, b2_c) ! { dg-error "" } ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 10 ++ md_r = MODULO(a_l, b_c) ! { dg-error "" } ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 11 ++ md_r = MODULO(a_c, b_l) ! { dg-error "" } ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 12 ++ ++ d_i = DIM(a_l, b_l) ! { dg-error "" } ++ if (d_i .ne. 1) STOP 13 ++ d_i = DIM(a2_l, b2_l) ! { dg-error "" } ++ if (d_i .ne. 1) STOP 14 ++ d_r = DIM(a_c, b_c) ! { dg-error "" } ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 15 ++ d_r = DIM(a2_c, b2_c) ! { dg-error "" } ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 16 ++ d_r = DIM(a_c, b_l) ! { dg-error "" } ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 17 ++ d_r = DIM(b_l, a_c) ! { dg-error "" } ++ if (abs(d_r) > 1.0D-6) STOP 18 ++ ++ s_i = SIGN(-a_l, b_l) ! { dg-error "" } ++ if (s_i .ne. 4) STOP 19 ++ s_i = SIGN(-a2_l, b2_l) ! { dg-error "" } ++ if (s_i .ne. 4) STOP 20 ++ s_r = SIGN(a_c, -b_c) ! { dg-error "" } ++ if (abs(s_r - (-a_c)) > 1.0D-6) STOP 21 ! { dg-error "" } ++ s_r = SIGN(a2_c, -b2_c) ! { dg-error "" } ++ if (abs(s_r - (-a2_c)) > 1.0D-6) STOP 22 ! { dg-error "" } ++ s_r = SIGN(a_c, -b_l) ! { dg-error "" } ++ if (abs(s_r - (-a_c)) > 1.0D-6) STOP 23 ! { dg-error "" } ++ s_r = SIGN(-a_l, b_c) ! { dg-error "" } ++ if (abs(s_r - a_c) > 1.0D-6) STOP 24 ! { dg-error "" } ++ ++ mx_i = MAX(-a_l, -b_l, x_l, y_l) ! { dg-error "" } ++ if (mx_i .ne. x_l) STOP 25 ! { dg-error "" } ++ mx_i = MAX(-a2_l, -b2_l, x_l, y_l) ! { dg-error "" } ++ if (mx_i .ne. x_l) STOP 26 ! { dg-error "" } ++ mx_r = MAX(-a_c, -b_c, x_c, y_c) ! { dg-error "" } ++ if (abs(mx_r - x_c) > 1.0D-6) STOP 27 ! { dg-error "" } ++ mx_r = MAX(-a_c, -b_c, x_c, y_c) ! { dg-error "" } ++ if (abs(mx_r - x_c) > 1.0D-6) STOP 28 ! { dg-error "" } ++ mx_r = MAX(-a_l, -b_c, x_c, y_l) ! { dg-error "" } ++ if (abs(mx_r - x_c) > 1.0D-6) STOP 29 ! { dg-error "" } ++ ++ mn_i = MIN(-a_l, -b_l, x_l, y_l) ! { dg-error "" } ++ if (mn_i .ne. -a_l) STOP 31 ! { dg-error "" } ++ mn_i = MIN(-a2_l, -b2_l, x_l, y_l) ! { dg-error "" } ++ if (mn_i .ne. -a2_l) STOP 32 ! { dg-error "" } ++ mn_r = MIN(-a_c, -b_c, x_c, y_c) ! { dg-error "" } ++ if (abs(mn_r - (-a_c)) > 1.0D-6) STOP 33 ! { dg-error "" } ++ mn_r = MIN(-a2_c, -b2_c, x_c, y_c) ! { dg-error "" } ++ if (abs(mn_r - (-a2_c)) > 1.0D-6) STOP 34 ! { dg-error "" } ++ mn_r = MIN(-a_l, -b_c, x_c, y_l) ! { dg-error "" } ++ if (abs(mn_r - (-a_c)) > 1.0D-6) STOP 35 ! { dg-error "" } ++ END PROGRAM +diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_5.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_5.f +new file mode 100644 +index 00000000000..d023af5086d +--- /dev/null ++++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_5.f +@@ -0,0 +1,118 @@ ++! { dg-do compile } ++! { dg-options "-fdec-promotion" } ++! ++! Test promotion between integers and reals in intrinsic operations. ++! These operations are: mod, modulo, dim, sign, min, max, minloc and ++! maxloc. ++! ++! Contributed by Francisco Redondo Marchena ++! and Jeff Law ++! Modified by Mark Eggleston ++! ++ PROGRAM promotion_int_real ++ REAL l/0.0/ ++ LOGICAL a_l ++ LOGICAL*4 a2_l ++ LOGICAL b_l ++ LOGICAL*8 b2_l ++ LOGICAL x_l ++ LOGICAL y_l ++ CHARACTER a_c ++ CHARACTER*4 a2_c ++ CHARACTER b_c ++ CHARACTER*8 b2_c ++ CHARACTER x_c ++ CHARACTER y_c ++ ++ INTEGER m_i/0/ ++ REAL m_r/0.0/ ++ ++ INTEGER md_i/0/ ++ REAL md_r/0.0/ ++ ++ INTEGER d_i/0/ ++ REAL d_r/0.0/ ++ ++ INTEGER s_i/0/ ++ REAL s_r/0.0/ ++ ++ INTEGER mn_i/0/ ++ REAL mn_r/0.0/ ++ ++ INTEGER mx_i/0/ ++ REAL mx_r/0.0/ ++ ++ m_i = MOD(a_l, b_l) ! { dg-error "" } ++ if (m_i .ne. 1) STOP 1 ++ m_i = MOD(a2_l, b2_l) ! { dg-error "" } ++ if (m_i .ne. 1) STOP 2 ++ m_r = MOD(a_c, b_c) ! { dg-error "" } ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 3 ++ m_r = MOD(a2_c, b2_c) ! { dg-error "" } ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 4 ++ m_r = MOD(a_l, b_c) ! { dg-error "" } ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 5 ++ m_r = MOD(a_c, b_l) ! { dg-error "" } ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 6 ++ ++ md_i = MODULO(a_l, b_l) ! { dg-error "" } ++ if (md_i .ne. 1) STOP 7 ++ md_i = MODULO(a2_l, b2_l) ! { dg-error "" } ++ if (md_i .ne. 1) STOP 8 ++ md_r = MODULO(a_c, b_c) ! { dg-error "" } ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 9 ++ md_r = MODULO(a2_c, b2_c) ! { dg-error "" } ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 10 ++ md_r = MODULO(a_l, b_c) ! { dg-error "" } ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 11 ++ md_r = MODULO(a_c, b_l) ! { dg-error "" } ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 12 ++ ++ d_i = DIM(a_l, b_l) ! { dg-error "" } ++ if (d_i .ne. 1) STOP 13 ++ d_i = DIM(a2_l, b2_l) ! { dg-error "" } ++ if (d_i .ne. 1) STOP 14 ++ d_r = DIM(a_c, b_c) ! { dg-error "" } ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 15 ++ d_r = DIM(a2_c, b2_c) ! { dg-error "" } ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 16 ++ d_r = DIM(a_c, b_l) ! { dg-error "" } ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 17 ++ d_r = DIM(b_l, a_c) ! { dg-error "" } ++ if (abs(d_r) > 1.0D-6) STOP 18 ++ ++ s_i = SIGN(-a_l, b_l) ! { dg-error "" } ++ if (s_i .ne. 4) STOP 19 ++ s_i = SIGN(-a2_l, b2_l) ! { dg-error "" } ++ if (s_i .ne. 4) STOP 20 ++ s_r = SIGN(a_c, -b_c) ! { dg-error "" } ++ if (abs(s_r - (-a_c)) > 1.0D-6) STOP 21 ! { dg-error "" } ++ s_r = SIGN(a2_c, -b2_c) ! { dg-error "" } ++ if (abs(s_r - (-a2_c)) > 1.0D-6) STOP 22 ! { dg-error "" } ++ s_r = SIGN(a_c, -b_l) ! { dg-error "" } ++ if (abs(s_r - (-a_c)) > 1.0D-6) STOP 23 ! { dg-error "" } ++ s_r = SIGN(-a_l, b_c) ! { dg-error "" } ++ if (abs(s_r - a_c) > 1.0D-6) STOP 24 ! { dg-error "" } ++ ++ mx_i = MAX(-a_l, -b_l, x_l, y_l) ! { dg-error "" } ++ if (mx_i .ne. x_l) STOP 25 ! { dg-error "" } ++ mx_i = MAX(-a2_l, -b2_l, x_l, y_l) ! { dg-error "" } ++ if (mx_i .ne. x_l) STOP 26 ! { dg-error "" } ++ mx_r = MAX(-a_c, -b_c, x_c, y_c) ! { dg-error "" } ++ if (abs(mx_r - x_c) > 1.0D-6) STOP 27 ! { dg-error "" } ++ mx_r = MAX(-a_c, -b_c, x_c, y_c) ! { dg-error "" } ++ if (abs(mx_r - x_c) > 1.0D-6) STOP 28 ! { dg-error "" } ++ mx_r = MAX(-a_l, -b_c, x_c, y_l) ! { dg-error "" } ++ if (abs(mx_r - x_c) > 1.0D-6) STOP 29 ! { dg-error "" } ++ ++ mn_i = MIN(-a_l, -b_l, x_l, y_l) ! { dg-error "" } ++ if (mn_i .ne. -a_l) STOP 31 ! { dg-error "" } ++ mn_i = MIN(-a2_l, -b2_l, x_l, y_l) ! { dg-error "" } ++ if (mn_i .ne. -a2_l) STOP 32 ! { dg-error "" } ++ mn_r = MIN(-a_c, -b_c, x_c, y_c) ! { dg-error "" } ++ if (abs(mn_r - (-a_c)) > 1.0D-6) STOP 33 ! { dg-error "" } ++ mn_r = MIN(-a2_c, -b2_c, x_c, y_c) ! { dg-error "" } ++ if (abs(mn_r - (-a2_c)) > 1.0D-6) STOP 34 ! { dg-error "" } ++ mn_r = MIN(-a_l, -b_c, x_c, y_l) ! { dg-error "" } ++ if (abs(mn_r - (-a_c)) > 1.0D-6) STOP 35 ! { dg-error "" } ++ END PROGRAM +diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_6.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_6.f +new file mode 100644 +index 00000000000..00f8fb88f1b +--- /dev/null ++++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_6.f +@@ -0,0 +1,118 @@ ++! { dg-do compile } ++! { dg-options "-fdec" } ++! ++! Test promotion between integers and reals in intrinsic operations. ++! These operations are: mod, modulo, dim, sign, min, max, minloc and ++! maxloc. ++! ++! Contributed by Francisco Redondo Marchena ++! and Jeff Law ++! Modified by Mark Eggleston ++! ++ PROGRAM promotion_int_real ++ REAL l/0.0/ ++ INTEGER a_i/4/ ++ INTEGER*4 a2_i/4/ ++ CHARACTER b_c ++ CHARACTER*8 b2_c ++ INTEGER x_i/2/ ++ CHARACTER y_c ++ REAL a_r/4.0/ ++ REAL*4 a2_r/4.0/ ++ LOGICAL b_l ++ LOGICAL*8 b2_l ++ REAL x_r/2.0/ ++ LOGICAL y_l ++ ++ INTEGER m_i/0/ ++ REAL m_r/0.0/ ++ ++ INTEGER md_i/0/ ++ REAL md_r/0.0/ ++ ++ INTEGER d_i/0/ ++ REAL d_r/0.0/ ++ ++ INTEGER s_i/0/ ++ REAL s_r/0.0/ ++ ++ INTEGER mn_i/0/ ++ REAL mn_r/0.0/ ++ ++ INTEGER mx_i/0/ ++ REAL mx_r/0.0/ ++ ++ m_i = MOD(a_i, b_c) ! { dg-error "" } ++ if (m_i .ne. 1) STOP 1 ++ m_i = MOD(a2_i, b2_c) ! { dg-error "" } ++ if (m_i .ne. 1) STOP 2 ++ m_r = MOD(a_r, b_l) ! { dg-error "" } ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 3 ++ m_r = MOD(a2_r, b2_l) ! { dg-error "" } ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 4 ++ m_r = MOD(a_i, b_l) ! { dg-error "" } ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 5 ++ m_r = MOD(a_r, b_c) ! { dg-error "" } ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 6 ++ ++ md_i = MODULO(a_i, b_c) ! { dg-error "" } ++ if (md_i .ne. 1) STOP 7 ++ md_i = MODULO(a2_i, b2_c) ! { dg-error "" } ++ if (md_i .ne. 1) STOP 8 ++ md_r = MODULO(a_r, b_l) ! { dg-error "" } ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 9 ++ md_r = MODULO(a2_r, b2_l) ! { dg-error "" } ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 10 ++ md_r = MODULO(a_i, b_l) ! { dg-error "" } ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 11 ++ md_r = MODULO(a_r, b_c) ! { dg-error "" } ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 12 ++ ++ d_i = DIM(a_i, b_c) ! { dg-error "" } ++ if (d_i .ne. 1) STOP 13 ++ d_i = DIM(a2_i, b2_c) ! { dg-error "" } ++ if (d_i .ne. 1) STOP 14 ++ d_r = DIM(a_r, b_l) ! { dg-error "" } ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 15 ++ d_r = DIM(a2_r, b2_l) ! { dg-error "" } ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 16 ++ d_r = DIM(a_r, b_c) ! { dg-error "" } ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 17 ++ d_r = DIM(b_c, a_r) ! { dg-error "" } ++ if (abs(d_r) > 1.0D-6) STOP 18 ++ ++ s_i = SIGN(-a_i, b_c) ! { dg-error "" } ++ if (s_i .ne. 4) STOP 19 ++ s_i = SIGN(-a2_i, b2_c) ! { dg-error "" } ++ if (s_i .ne. 4) STOP 20 ++ s_r = SIGN(a_r, -b_l) ! { dg-error "" } ++ if (abs(s_r - (-a_r)) > 1.0D-6) STOP 21 ++ s_r = SIGN(a2_r, -b2_l) ! { dg-error "" } ++ if (abs(s_r - (-a2_r)) > 1.0D-6) STOP 22 ++ s_r = SIGN(a_r, -b_c) ! { dg-error "" } ++ if (abs(s_r - (-a_r)) > 1.0D-6) STOP 23 ++ s_r = SIGN(-a_i, b_l) ! { dg-error "" } ++ if (abs(s_r - a_r) > 1.0D-6) STOP 24 ++ ++ mx_i = MAX(-a_i, -b_c, x_i, y_c) ! { dg-error "" } ++ if (mx_i .ne. x_i) STOP 25 ++ mx_i = MAX(-a2_i, -b2_c, x_i, y_c) ! { dg-error "" } ++ if (mx_i .ne. x_i) STOP 26 ++ mx_r = MAX(-a_r, -b_l, x_r, y_l) ! { dg-error "" } ++ if (abs(mx_r - x_r) > 1.0D-6) STOP 27 ++ mx_r = MAX(-a_r, -b_l, x_r, y_l) ! { dg-error "" } ++ if (abs(mx_r - x_r) > 1.0D-6) STOP 28 ++ mx_r = MAX(-a_i, -b_l, x_r, y_c) ! { dg-error "" } ++ if (abs(mx_r - x_r) > 1.0D-6) STOP 29 ++ ++ mn_i = MIN(-a_i, -b_c, x_i, y_c) ! { dg-error "" } ++ if (mn_i .ne. -a_i) STOP 31 ++ mn_i = MIN(-a2_i, -b2_c, x_i, y_c) ! { dg-error "" } ++ if (mn_i .ne. -a2_i) STOP 32 ++ mn_r = MIN(-a_r, -b_l, x_r, y_l) ! { dg-error "" } ++ if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 33 ++ mn_r = MIN(-a2_r, -b2_l, x_r, y_l) ! { dg-error "" } ++ if (abs(mn_r - (-a2_r)) > 1.0D-6) STOP 34 ++ mn_r = MIN(-a_i, -b_l, x_r, y_c) ! { dg-error "" } ++ if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 35 ++ END PROGRAM +diff --git a/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_7.f b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_7.f +new file mode 100644 +index 00000000000..1d4150d81c0 +--- /dev/null ++++ b/gcc/testsuite/gfortran.dg/dec_intrinsic_int_real_promotion_7.f +@@ -0,0 +1,118 @@ ++! { dg-do compile } ++! { dg-options "-fdec-promotion" } ++! ++! Test promotion between integers and reals in intrinsic operations. ++! These operations are: mod, modulo, dim, sign, min, max, minloc and ++! maxloc. ++! ++! Contributed by Francisco Redondo Marchena ++! and Jeff Law ++! Modified by Mark Eggleston ++! ++ PROGRAM promotion_int_real ++ REAL l/0.0/ ++ INTEGER a_i/4/ ++ INTEGER*4 a2_i/4/ ++ CHARACTER b_c ++ CHARACTER*8 b2_c ++ INTEGER x_i/2/ ++ CHARACTER y_c ++ REAL a_r/4.0/ ++ REAL*4 a2_r/4.0/ ++ LOGICAL b_l ++ LOGICAL*8 b2_l ++ REAL x_r/2.0/ ++ LOGICAL y_l ++ ++ INTEGER m_i/0/ ++ REAL m_r/0.0/ ++ ++ INTEGER md_i/0/ ++ REAL md_r/0.0/ ++ ++ INTEGER d_i/0/ ++ REAL d_r/0.0/ ++ ++ INTEGER s_i/0/ ++ REAL s_r/0.0/ ++ ++ INTEGER mn_i/0/ ++ REAL mn_r/0.0/ ++ ++ INTEGER mx_i/0/ ++ REAL mx_r/0.0/ ++ ++ m_i = MOD(a_i, b_c) ! { dg-error "" } ++ if (m_i .ne. 1) STOP 1 ++ m_i = MOD(a2_i, b2_c) ! { dg-error "" } ++ if (m_i .ne. 1) STOP 2 ++ m_r = MOD(a_r, b_l) ! { dg-error "" } ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 3 ++ m_r = MOD(a2_r, b2_l) ! { dg-error "" } ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 4 ++ m_r = MOD(a_i, b_l) ! { dg-error "" } ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 5 ++ m_r = MOD(a_r, b_c) ! { dg-error "" } ++ if (abs(m_r - 1.0) > 1.0D-6) STOP 6 ++ ++ md_i = MODULO(a_i, b_c) ! { dg-error "" } ++ if (md_i .ne. 1) STOP 7 ++ md_i = MODULO(a2_i, b2_c) ! { dg-error "" } ++ if (md_i .ne. 1) STOP 8 ++ md_r = MODULO(a_r, b_l) ! { dg-error "" } ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 9 ++ md_r = MODULO(a2_r, b2_l) ! { dg-error "" } ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 10 ++ md_r = MODULO(a_i, b_l) ! { dg-error "" } ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 11 ++ md_r = MODULO(a_r, b_c) ! { dg-error "" } ++ if (abs(md_r - 1.0) > 1.0D-6) STOP 12 ++ ++ d_i = DIM(a_i, b_c) ! { dg-error "" } ++ if (d_i .ne. 1) STOP 13 ++ d_i = DIM(a2_i, b2_c) ! { dg-error "" } ++ if (d_i .ne. 1) STOP 14 ++ d_r = DIM(a_r, b_l) ! { dg-error "" } ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 15 ++ d_r = DIM(a2_r, b2_l) ! { dg-error "" } ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 16 ++ d_r = DIM(a_r, b_c) ! { dg-error "" } ++ if (abs(d_r - 1.0) > 1.0D-6) STOP 17 ++ d_r = DIM(b_c, a_r) ! { dg-error "" } ++ if (abs(d_r) > 1.0D-6) STOP 18 ++ ++ s_i = SIGN(-a_i, b_c) ! { dg-error "" } ++ if (s_i .ne. 4) STOP 19 ++ s_i = SIGN(-a2_i, b2_c) ! { dg-error "" } ++ if (s_i .ne. 4) STOP 20 ++ s_r = SIGN(a_r, -b_l) ! { dg-error "" } ++ if (abs(s_r - (-a_r)) > 1.0D-6) STOP 21 ++ s_r = SIGN(a2_r, -b2_l) ! { dg-error "" } ++ if (abs(s_r - (-a2_r)) > 1.0D-6) STOP 22 ++ s_r = SIGN(a_r, -b_c) ! { dg-error "" } ++ if (abs(s_r - (-a_r)) > 1.0D-6) STOP 23 ++ s_r = SIGN(-a_i, b_l) ! { dg-error "" } ++ if (abs(s_r - a_r) > 1.0D-6) STOP 24 ++ ++ mx_i = MAX(-a_i, -b_c, x_i, y_c) ! { dg-error "" } ++ if (mx_i .ne. x_i) STOP 25 ++ mx_i = MAX(-a2_i, -b2_c, x_i, y_c) ! { dg-error "" } ++ if (mx_i .ne. x_i) STOP 26 ++ mx_r = MAX(-a_r, -b_l, x_r, y_l) ! { dg-error "" } ++ if (abs(mx_r - x_r) > 1.0D-6) STOP 27 ++ mx_r = MAX(-a_r, -b_l, x_r, y_l) ! { dg-error "" } ++ if (abs(mx_r - x_r) > 1.0D-6) STOP 28 ++ mx_r = MAX(-a_i, -b_l, x_r, y_c) ! { dg-error "" } ++ if (abs(mx_r - x_r) > 1.0D-6) STOP 29 ++ ++ mn_i = MIN(-a_i, -b_c, x_i, y_c) ! { dg-error "" } ++ if (mn_i .ne. -a_i) STOP 31 ++ mn_i = MIN(-a2_i, -b2_c, x_i, y_c) ! { dg-error "" } ++ if (mn_i .ne. -a2_i) STOP 32 ++ mn_r = MIN(-a_r, -b_l, x_r, y_l) ! { dg-error "" } ++ if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 33 ++ mn_r = MIN(-a2_r, -b2_l, x_r, y_l) ! { dg-error "" } ++ if (abs(mn_r - (-a2_r)) > 1.0D-6) STOP 34 ++ mn_r = MIN(-a_i, -b_l, x_r, y_c) ! { dg-error "" } ++ if (abs(mn_r - (-a_r)) > 1.0D-6) STOP 35 ++ END PROGRAM +diff --git a/gcc/testsuite/gfortran.dg/dec_kind_promotion-1.f b/gcc/testsuite/gfortran.dg/dec_kind_promotion-1.f +new file mode 100644 +index 00000000000..435bf98350c +--- /dev/null ++++ b/gcc/testsuite/gfortran.dg/dec_kind_promotion-1.f +@@ -0,0 +1,40 @@ ++!{ dg-do run } ++!{ dg-options "-fdec" } ++! ++! integer types of a smaller kind than expected should be ++! accepted by type specific intrinsic functions ++! ++! Contributed by Mark Eggleston ++! ++ program test_small_type_promtion ++ implicit none ++ integer(1) :: a = 1 ++ integer :: i ++ if (iiabs(-9_1).ne.9) stop 1 ++ if (iabs(-9_1).ne.9) stop 2 ++ if (iabs(-9_2).ne.9) stop 3 ++ if (jiabs(-9_1).ne.9) stop 4 ++ if (jiabs(-9_2).ne.9) stop 5 ++ if (iishft(1_1, 2).ne.4) stop 6 ++ if (jishft(1_1, 2).ne.4) stop 7 ++ if (jishft(1_2, 2).ne.4) stop 8 ++ if (kishft(1_1, 2).ne.4) stop 9 ++ if (kishft(1_2, 2).ne.4) stop 10 ++ if (kishft(1_4, 2).ne.4) stop 11 ++ if (imod(17_1, 3).ne.2) stop 12 ++ if (jmod(17_1, 3).ne.2) stop 13 ++ if (jmod(17_2, 3).ne.2) stop 14 ++ if (kmod(17_1, 3).ne.2) stop 15 ++ if (kmod(17_2, 3).ne.2) stop 16 ++ if (kmod(17_4, 3).ne.2) stop 17 ++ if (inot(5_1).ne.-6) stop 18 ++ if (jnot(5_1).ne.-6) stop 19 ++ if (jnot(5_2).ne.-6) stop 20 ++ if (knot(5_1).ne.-6) stop 21 ++ if (knot(5_2).ne.-6) stop 22 ++ if (knot(5_4).ne.-6) stop 23 ++ if (isign(-77_1, 1).ne.77) stop 24 ++ if (isign(-77_1, -1).ne.-77) stop 25 ++ if (isign(-77_2, 1).ne.77) stop 26 ++ if (isign(-77_2, -1).ne.-77) stop 27 ++ end program +diff --git a/gcc/testsuite/gfortran.dg/dec_kind_promotion-2.f b/gcc/testsuite/gfortran.dg/dec_kind_promotion-2.f +new file mode 100644 +index 00000000000..7b1697ca665 +--- /dev/null ++++ b/gcc/testsuite/gfortran.dg/dec_kind_promotion-2.f +@@ -0,0 +1,40 @@ ++!{ dg-do run } ++!{ dg-options "-fdec-intrinsic-ints -fdec-promotion" } ++! ++! integer types of a smaller kind than expected should be ++! accepted by type specific intrinsic functions ++! ++! Contributed by Mark Eggleston ++! ++ program test_small_type_promtion ++ implicit none ++ integer(1) :: a = 1 ++ integer :: i ++ if (iiabs(-9_1).ne.9) stop 1 ++ if (iabs(-9_1).ne.9) stop 2 ++ if (iabs(-9_2).ne.9) stop 3 ++ if (jiabs(-9_1).ne.9) stop 4 ++ if (jiabs(-9_2).ne.9) stop 5 ++ if (iishft(1_1, 2).ne.4) stop 6 ++ if (jishft(1_1, 2).ne.4) stop 7 ++ if (jishft(1_2, 2).ne.4) stop 8 ++ if (kishft(1_1, 2).ne.4) stop 9 ++ if (kishft(1_2, 2).ne.4) stop 10 ++ if (kishft(1_4, 2).ne.4) stop 11 ++ if (imod(17_1, 3).ne.2) stop 12 ++ if (jmod(17_1, 3).ne.2) stop 13 ++ if (jmod(17_2, 3).ne.2) stop 14 ++ if (kmod(17_1, 3).ne.2) stop 15 ++ if (kmod(17_2, 3).ne.2) stop 16 ++ if (kmod(17_4, 3).ne.2) stop 17 ++ if (inot(5_1).ne.-6) stop 18 ++ if (jnot(5_1).ne.-6) stop 19 ++ if (jnot(5_2).ne.-6) stop 20 ++ if (knot(5_1).ne.-6) stop 21 ++ if (knot(5_2).ne.-6) stop 22 ++ if (knot(5_4).ne.-6) stop 23 ++ if (isign(-77_1, 1).ne.77) stop 24 ++ if (isign(-77_1, -1).ne.-77) stop 25 ++ if (isign(-77_2, 1).ne.77) stop 26 ++ if (isign(-77_2, -1).ne.-77) stop 27 ++ end program +diff --git a/gcc/testsuite/gfortran.dg/dec_kind_promotion-3.f b/gcc/testsuite/gfortran.dg/dec_kind_promotion-3.f +new file mode 100644 +index 00000000000..b9d550a5a48 +--- /dev/null ++++ b/gcc/testsuite/gfortran.dg/dec_kind_promotion-3.f +@@ -0,0 +1,40 @@ ++!{ dg-do compile } ++!{ dg-options "-fdec -fno-dec-promotion" } ++! ++! integer types of a smaller kind than expected should be ++! accepted by type specific intrinsic functions ++! ++! Contributed by Mark Eggleston ++! ++ program test_small_type_promtion ++ implicit none ++ integer(1) :: a = 1 ++ integer :: i ++ if (iiabs(-9_1).ne.9) stop 1 ++ if (iabs(-9_1).ne.9) stop 2 ! { dg-error "Type of argument" } ++ if (iabs(-9_2).ne.9) stop 3 ! { dg-error "Type of argument" } ++ if (jiabs(-9_1).ne.9) stop 4 ++ if (jiabs(-9_2).ne.9) stop 5 ++ if (iishft(1_1, 2).ne.4) stop 6 ++ if (jishft(1_1, 2).ne.4) stop 7 ++ if (jishft(1_2, 2).ne.4) stop 8 ++ if (kishft(1_1, 2).ne.4) stop 9 ++ if (kishft(1_2, 2).ne.4) stop 10 ++ if (kishft(1_4, 2).ne.4) stop 11 ++ if (imod(17_1, 3).ne.2) stop 12 ++ if (jmod(17_1, 3).ne.2) stop 13 ++ if (jmod(17_2, 3).ne.2) stop 14 ++ if (kmod(17_1, 3).ne.2) stop 15 ++ if (kmod(17_2, 3).ne.2) stop 16 ++ if (kmod(17_4, 3).ne.2) stop 17 ++ if (inot(5_1).ne.-6) stop 18 ++ if (jnot(5_1).ne.-6) stop 19 ++ if (jnot(5_2).ne.-6) stop 20 ++ if (knot(5_1).ne.-6) stop 21 ++ if (knot(5_2).ne.-6) stop 22 ++ if (knot(5_4).ne.-6) stop 23 ++ if (isign(-77_1, 1).ne.77) stop 24 ! { dg-error "Type of argument" } ++ if (isign(-77_1, -1).ne.-77) stop 25 ! { dg-error "Type of argument" } ++ if (isign(-77_2, 1).ne.77) stop 26 ! { dg-error "Type of argument" } ++ if (isign(-77_2, -1).ne.-77) stop 27 ! { dg-error "Type of argument" } ++ end program +-- +2.11.0 + diff --git a/SOURCES/0013-Add-the-SEQUENCE-attribute-by-default-if-it-s-not-pr.patch b/SOURCES/0013-Add-the-SEQUENCE-attribute-by-default-if-it-s-not-pr.patch new file mode 100644 index 0000000..8c88c18 --- /dev/null +++ b/SOURCES/0013-Add-the-SEQUENCE-attribute-by-default-if-it-s-not-pr.patch @@ -0,0 +1,262 @@ +From aafd9c215d41b4a846c6724bc25025b124c65ec4 Mon Sep 17 00:00:00 2001 +From: Jim MacArthur +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 ++! Modified by Mark Eggleston ++! ++ 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 ++! Modified by Mark Eggleston ++! ++ 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 ++! Modified by Mark Eggleston ++! ++ 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 + diff --git a/SOURCES/0013-Allow-per-variable-kind-specification.patch b/SOURCES/0013-Allow-per-variable-kind-specification.patch deleted file mode 100644 index 2dd665b..0000000 --- a/SOURCES/0013-Allow-per-variable-kind-specification.patch +++ /dev/null @@ -1,129 +0,0 @@ -From 72d3915eadd1121d8b2f0be04fafc17e9232be81 Mon Sep 17 00:00:00 2001 -From: Jim MacArthur -Date: Thu, 5 Nov 2015 18:57:53 +0000 -Subject: [PATCH 13/23] Allow per-variable kind specification. - - INTEGER*4 x*2, y*8 - -The per-variable sizes override the kind specified in the type. -At the moment, you can follow this with an array specification, so -INTEGER x*2(10) is OK, but not the other way round. - -This feature is enabled by the `-std=extra-legacy` compiler flag. ---- - - 0013-Allow-per-variable-kind-specification.patch - - Allow per-variable kind specification. - - INTEGER*4 x*2, y*8 - - The per-variable sizes override the kind specified in the type. - At the moment, you can follow this with an array specification, so - INTEGER x*2(10) is OK, but not the other way round. - - This feature is enabled by the `-std=extra-legacy` compiler flag. - - Test written by: Francisco Redondo Marchena - -diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c -index 3ad9c2c8b40..faa08d9c4bb 100644 ---- a/gcc/fortran/decl.c -+++ b/gcc/fortran/decl.c -@@ -1019,6 +1019,24 @@ syntax: - return MATCH_ERROR; - } - -+/* This matches the nonstandard kind given after a variable name, like: -+ INTEGER x*2, y*4 -+ The per-variable kind will override any kind given in the type -+ declaration. -+*/ -+ -+static match -+match_per_symbol_kind (int *length) -+{ -+ match m; -+ -+ m = gfc_match_char ('*'); -+ if (m != MATCH_YES) -+ return m; -+ -+ m = gfc_match_small_literal_int (length, NULL); -+ return m; -+} - - /* Special subroutine for finding a symbol. Check if the name is found - in the current name space. If not, and we're compiling a function or -@@ -2193,10 +2211,13 @@ variable_decl (int elem) - bool t; - gfc_symbol *sym; - match cl_match; -+ match kind_match; -+ int overridden_kind; - - initializer = NULL; - as = NULL; - cp_as = NULL; -+ kind_match = MATCH_NO; - - /* When we get here, we've just matched a list of attributes and - maybe a type and a double colon. The next thing we expect to see -@@ -2213,12 +2234,20 @@ variable_decl (int elem) - cl_match = MATCH_NO; - - /* Check for a character length clause before an array clause */ -- if ((gfc_option.allow_std & GFC_STD_EXTRA_LEGACY) -- && current_ts.type == BT_CHARACTER) -+ if (gfc_option.allow_std & GFC_STD_EXTRA_LEGACY) - { -- cl_match = match_character_length_clause (&cl, &cl_deferred, elem); -- if (cl_match == MATCH_ERROR) -- goto cleanup; -+ if (current_ts.type == BT_CHARACTER) -+ { -+ cl_match = match_character_length_clause (&cl, &cl_deferred, elem); -+ if (cl_match == MATCH_ERROR) -+ goto cleanup; -+ } -+ else -+ { -+ kind_match = match_per_symbol_kind (&overridden_kind); -+ if (kind_match == MATCH_ERROR) -+ goto cleanup; -+ } - } - - /* Now we could see the optional array spec. or character length. */ -@@ -2412,6 +2441,13 @@ variable_decl (int elem) - goto cleanup; - } - -+ if (kind_match == MATCH_YES) -+ { -+ gfc_find_symbol (name, gfc_current_ns, 1, &sym); -+ /* sym *must* be found at this point */ -+ sym->ts.kind = overridden_kind; -+ } -+ - if (!check_function_name (name)) - { - m = MATCH_ERROR; -diff --git a/gcc/testsuite/gfortran.dg/dec_spec_in_variable.f b/gcc/testsuite/gfortran.dg/dec_spec_in_variable.f -new file mode 100644 -index 00000000000..0341a176aca ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_spec_in_variable.f -@@ -0,0 +1,12 @@ -+! { dg-do compile } -+! { dg-options "-std=extra-legacy" } -+! -+! Test kind specification in variable not in type -+! -+ PROGRAM spec_in_var -+ INTEGER ai*1/1/ -+ REAL ar*4/1.0/ -+ -+ if(ai.NE.1) STOP 1 -+ if(abs(ar - 1.0) > 1.0D-6) STOP 2 -+ END diff --git a/SOURCES/0014-Allow-non-logical-expressions-in-IF-statements.patch b/SOURCES/0014-Allow-non-logical-expressions-in-IF-statements.patch deleted file mode 100644 index 04fda43..0000000 --- a/SOURCES/0014-Allow-non-logical-expressions-in-IF-statements.patch +++ /dev/null @@ -1,143 +0,0 @@ -From 99c791361468b61976d6054e1ec1c81fe43e6559 Mon Sep 17 00:00:00 2001 -From: Jim MacArthur -Date: Wed, 11 Nov 2015 15:37:00 +0000 -Subject: [PATCH 14/23] Allow non-logical expressions in IF statements - -This feature is enabled by the `-std=extra-legacy` compiler flag. ---- - - 0014-Allow-non-logical-expressions-in-IF-statements.patch - - Allow non-logical expressions in IF statements - - This feature is enabled by the `-std=extra-legacy` compiler flag. - - Signed-off-by: Ben Brewer - Signed-off-by: Francisco Redondo Marchena - -diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c -index 33b441aa1bc..f979915e856 100644 ---- a/gcc/fortran/resolve.c -+++ b/gcc/fortran/resolve.c -@@ -9919,10 +9919,23 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) - switch (b->op) - { - case EXEC_IF: -- if (t && b->expr1 != NULL -- && (b->expr1->ts.type != BT_LOGICAL || b->expr1->rank != 0)) -- gfc_error ("IF clause at %L requires a scalar LOGICAL expression", -- &b->expr1->where); -+ if (t && b->expr1 != NULL) -+ { -+ if (gfc_option.allow_std & GFC_STD_EXTRA_LEGACY && b->expr1->ts.type != BT_LOGICAL) -+ { -+ gfc_expr* cast; -+ cast = gfc_ne (b->expr1, gfc_get_int_expr (1, &gfc_current_locus, 0), INTRINSIC_NE); -+ if (cast == NULL) -+ gfc_internal_error ("gfc_resolve_blocks(): Failed to cast to LOGICAL in IF"); -+ b->expr1 = cast; -+ gfc_warning (0, "Non-LOGICAL type in IF statement condition %L" -+ " will be true if it evaluates to nonzero", &b->expr1->where); -+ } -+ -+ if ((b->expr1->ts.type != BT_LOGICAL || b->expr1->rank != 0)) -+ gfc_error ("IF clause at %L requires a scalar LOGICAL expression", -+ &b->expr1->where); -+ } - break; - - case EXEC_WHERE: -@@ -11182,11 +11195,23 @@ start: - break; - - case EXEC_IF: -- if (t && code->expr1 != NULL -- && (code->expr1->ts.type != BT_LOGICAL -- || code->expr1->rank != 0)) -- gfc_error ("IF clause at %L requires a scalar LOGICAL expression", -- &code->expr1->where); -+ if (t && code->expr1 != NULL) -+ { -+ if (gfc_option.allow_std & GFC_STD_EXTRA_LEGACY && code->expr1->ts.type != BT_LOGICAL) -+ { -+ gfc_expr* cast; -+ cast = gfc_ne (code->expr1, gfc_get_int_expr (1, &gfc_current_locus, 0), INTRINSIC_NE); -+ if (cast == NULL) -+ gfc_internal_error ("gfc_resolve_code(): Failed to cast to LOGICAL in IF"); -+ code->expr1 = cast; -+ gfc_warning (0, "Non-LOGICAL type in IF statement condition %L" -+ " will be true if it evaluates to nonzero", &code->expr1->where); -+ } -+ -+ if ((code->expr1->ts.type != BT_LOGICAL || code->expr1->rank != 0)) -+ gfc_error ("IF clause at %L requires a scalar LOGICAL expression", -+ &code->expr1->where); -+ } - break; - - case EXEC_CALL: -diff --git a/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks.f b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks.f -new file mode 100644 -index 00000000000..ad23fcfc9af ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks.f -@@ -0,0 +1,21 @@ -+! { dg-do compile } -+! { dg-options "-std=extra-legacy" } -+! -+! Allow logical expressions in if statements and blocks -+! -+ PROGRAM logical_exp_if_st_bl -+ INTEGER ipos/1/ -+ INTEGER ineg/0/ -+ -+ ! Test non logical variables -+ if (ineg) STOP 1 ! { dg-warning "if it evaluates to nonzero" } -+ if (0) STOP 2 ! { dg-warning "if it evaluates to nonzero" } -+ -+ ! Test non logical expressions in if statements -+ if (MOD(ipos, 1)) STOP 3 ! { dg-warning "if it evaluates to nonzero" } -+ -+ ! Test non logical expressions in if blocks -+ if (MOD(2 * ipos, 2)) then ! { dg-warning "if it evaluates to nonzero" } -+ STOP 4 -+ endif -+ END -commit cf72338b9468fad669b60600bcce7918a8d4591e -Author: Jeff Law -Date: Tue Jun 5 15:45:41 2018 -0600 - - Additional test for - - 0014-Allow-non-logical-expressions-in-IF-statements.patch - "Allow non-logical expressions in IF statements" - -diff --git a/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks-2.f b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks-2.f -new file mode 100644 -index 00000000000..7da6aaceec7 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks-2.f -@@ -0,0 +1,23 @@ -+! { dg-do compile } -+! { dg-options "-std=extra-legacy" } -+ -+ function othersub1() -+ integer*4 othersub1 -+ othersub1 = 1 -+ end -+ function othersub2() -+ integer*4 othersub2 -+ othersub2 = 2 -+ end -+ program MAIN -+ integer*4 othersub1 -+ integer*4 othersub2 -+c the if (integer) works here -+ if (othersub2()) then ! { dg-warning "" } -+ write (*,*), 'othersub2 is true' -+c but fails in the "else if" -+ else if (othersub1()) then ! { dg-warning "" } -+ write (*,*), 'othersub2 is false, othersub1 is true' -+ endif -+ end -+ diff --git a/SOURCES/0014-Fill-in-missing-array-dimensions-using-the-lower-bou.patch b/SOURCES/0014-Fill-in-missing-array-dimensions-using-the-lower-bou.patch new file mode 100644 index 0000000..f808856 --- /dev/null +++ b/SOURCES/0014-Fill-in-missing-array-dimensions-using-the-lower-bou.patch @@ -0,0 +1,181 @@ +From 60b2e0b9ad2057f256591f56d5433e9ca54bf56f Mon Sep 17 00:00:00 2001 +From: Jim MacArthur +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 ++! Updated by Mark Eggleston ++! ++ ++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 ++! Updated by Mark Eggleston ++! ++ ++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 ++! Updated by Mark Eggleston ++! ++ ++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 + diff --git a/SOURCES/0015-Allow-automatics-in-equivalence.patch b/SOURCES/0015-Allow-automatics-in-equivalence.patch new file mode 100644 index 0000000..8f12dcf --- /dev/null +++ b/SOURCES/0015-Allow-automatics-in-equivalence.patch @@ -0,0 +1,358 @@ +From e6f385f8258148890a097878a618b694be663db6 Mon Sep 17 00:00:00 2001 +From: Mark Eggleston +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 . +--- + 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 ++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 ++ ++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 ++ ++! 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 + diff --git a/SOURCES/0016-Allow-calls-to-intrinsics-with-smaller-types-than-sp.patch b/SOURCES/0016-Allow-calls-to-intrinsics-with-smaller-types-than-sp.patch deleted file mode 100644 index 6c4a55e..0000000 --- a/SOURCES/0016-Allow-calls-to-intrinsics-with-smaller-types-than-sp.patch +++ /dev/null @@ -1,277 +0,0 @@ -From 109b1eeba24e5091bf3bdb6caedf7101a9dcaa6a Mon Sep 17 00:00:00 2001 -From: Jim MacArthur -Date: Wed, 18 Nov 2015 11:50:41 +0000 -Subject: [PATCH 16/23] Allow calls to intrinsics with smaller types than - specified - -This feature is enabled by the `-std=extra-legacy` compiler flag. ---- - - 0016-Allow-calls-to-intrinsics-with-smaller-types-than-sp.patch - -diff -Nrup a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h ---- a/gcc/fortran/gfortran.h 2018-06-05 11:59:14.269337049 -0600 -+++ b/gcc/fortran/gfortran.h 2018-06-05 11:59:52.830081690 -0600 -@@ -656,6 +656,13 @@ enum gfc_param_spec_type - SPEC_DEFERRED - }; - -+enum match_type -+{ -+ MATCH_EXACT, -+ MATCH_PROMOTABLE, -+ MATCH_INVALID -+}; -+ - /************************* Structures *****************************/ - - /* Used for keeping things in balanced binary trees. */ -@@ -3251,7 +3253,7 @@ bool gfc_add_interface (gfc_symbol *); - gfc_interface *gfc_current_interface_head (void); - void gfc_set_current_interface_head (gfc_interface *); - gfc_symtree* gfc_find_sym_in_symtree (gfc_symbol*); --bool gfc_arglist_matches_symbol (gfc_actual_arglist**, gfc_symbol*); -+bool gfc_arglist_matches_symbol (gfc_actual_arglist**, gfc_symbol*, enum match_type mtype); - bool gfc_check_operator_interface (gfc_symbol*, gfc_intrinsic_op, locus); - bool gfc_has_vector_subscript (gfc_expr*); - gfc_intrinsic_op gfc_equivalent_op (gfc_intrinsic_op); -diff -Nrup a/gcc/fortran/interface.c b/gcc/fortran/interface.c ---- a/gcc/fortran/interface.c 2018-03-03 06:51:39.000000000 -0700 -+++ b/gcc/fortran/interface.c 2018-06-05 12:01:11.218559539 -0600 -@@ -682,7 +682,7 @@ gfc_compare_derived_types (gfc_symbol *d - /* Compare two typespecs, recursively if necessary. */ - - bool --gfc_compare_types (gfc_typespec *ts1, gfc_typespec *ts2) -+gfc_compare_types_generic (gfc_typespec *ts1, gfc_typespec *ts2, enum match_type mtype) - { - /* See if one of the typespecs is a BT_VOID, which is what is being used - to allow the funcs like c_f_pointer to accept any pointer type. -@@ -721,12 +721,23 @@ gfc_compare_types (gfc_typespec *ts1, gf - return compare_union_types (ts1->u.derived, ts2->u.derived); - - if (ts1->type != BT_DERIVED && ts1->type != BT_CLASS) -- return (ts1->kind == ts2->kind); -+ { -+ if (mtype == MATCH_PROMOTABLE) -+ return (ts1->kind >= ts2->kind); -+ else -+ return (ts1->kind == ts2->kind); -+ } -+ - - /* Compare derived types. */ - return gfc_type_compatible (ts1, ts2); - } - -+bool -+gfc_compare_types (gfc_typespec *ts1, gfc_typespec *ts2) -+{ -+ return gfc_compare_types_generic (ts1, ts2, MATCH_EXACT); -+} - - static bool - compare_type (gfc_symbol *s1, gfc_symbol *s2) -@@ -743,7 +754,9 @@ compare_type (gfc_symbol *s1, gfc_symbol - return compare_type (s1, s2); - } - -- -+/* Given two symbols that are formal arguments, compare their ranks -+ and types. Returns nonzero if they have the same rank and type, -+ zero otherwise. */ - static bool - compare_rank (gfc_symbol *s1, gfc_symbol *s2) - { -@@ -2150,7 +2163,7 @@ argument_rank_mismatch (const char *name - - static bool - compare_parameter (gfc_symbol *formal, gfc_expr *actual, -- int ranks_must_agree, int is_elemental, locus *where) -+ int ranks_must_agree, int is_elemental, locus *where, enum match_type mtype) - { - gfc_ref *ref; - bool rank_check, is_pointer; -@@ -2242,7 +2255,7 @@ compare_parameter (gfc_symbol *formal, g - && actual->ts.type != BT_HOLLERITH - && formal->ts.type != BT_ASSUMED - && !(formal->attr.ext_attr & (1 << EXT_ATTR_NO_ARG_CHECK)) -- && !gfc_compare_types (&formal->ts, &actual->ts) -+ && !gfc_compare_types_generic (&formal->ts, &actual->ts, mtype) - && !(formal->ts.type == BT_DERIVED && actual->ts.type == BT_CLASS - && gfc_compare_derived_types (formal->ts.u.derived, - CLASS_DATA (actual)->ts.u.derived))) -@@ -2792,7 +2805,8 @@ is_procptr_result (gfc_expr *expr) - static bool - compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, - int ranks_must_agree, int is_elemental, -- bool in_statement_function, locus *where) -+ bool in_statement_function, locus *where, -+ enum match_type mtype) - { - gfc_actual_arglist **new_arg, *a, *actual; - gfc_formal_arglist *f; -@@ -2918,7 +2932,7 @@ compare_actual_formal (gfc_actual_arglis - } - - if (!compare_parameter (f->sym, a->expr, ranks_must_agree, -- is_elemental, where)) -+ is_elemental, where, mtype)) - return false; - - /* TS 29113, 6.3p2. */ -@@ -3666,7 +3680,7 @@ gfc_procedure_use (gfc_symbol *sym, gfc_ - /* For a statement function, check that types and type parameters of actual - arguments and dummy arguments match. */ - if (!compare_actual_formal (ap, dummy_args, 0, sym->attr.elemental, -- sym->attr.proc == PROC_ST_FUNCTION, where)) -+ sym->attr.proc == PROC_ST_FUNCTION, where, MATCH_PROMOTABLE)) - return false; - - if (!check_intents (dummy_args, *ap)) -@@ -3715,7 +3730,7 @@ gfc_ppc_use (gfc_component *comp, gfc_ac - } - - if (!compare_actual_formal (ap, comp->ts.interface->formal, 0, -- comp->attr.elemental, false, where)) -+ comp->attr.elemental, false, where, MATCH_EXACT)) - return; - - check_intents (comp->ts.interface->formal, *ap); -@@ -3729,7 +3744,7 @@ gfc_ppc_use (gfc_component *comp, gfc_ac - GENERIC resolution. */ - - bool --gfc_arglist_matches_symbol (gfc_actual_arglist** args, gfc_symbol* sym) -+gfc_arglist_matches_symbol (gfc_actual_arglist** args, gfc_symbol* sym, enum match_type mtype) - { - gfc_formal_arglist *dummy_args; - bool r; -@@ -3740,7 +3755,7 @@ gfc_arglist_matches_symbol (gfc_actual_a - dummy_args = gfc_sym_get_dummy_args (sym); - - r = !sym->attr.elemental; -- if (compare_actual_formal (args, dummy_args, r, !r, false, NULL)) -+ if (compare_actual_formal (args, dummy_args, r, !r, false, NULL, mtype)) - { - check_intents (dummy_args, *args); - if (warn_aliasing) -@@ -3766,7 +3781,8 @@ gfc_search_interface (gfc_interface *int - locus null_expr_loc; - gfc_actual_arglist *a; - bool has_null_arg = false; -- -+ enum match_type mtypes[] = { MATCH_EXACT, MATCH_PROMOTABLE }; -+ int i; - for (a = *ap; a; a = a->next) - if (a->expr && a->expr->expr_type == EXPR_NULL - && a->expr->ts.type == BT_UNKNOWN) -@@ -3776,38 +3792,43 @@ gfc_search_interface (gfc_interface *int - break; - } - -- for (; intr; intr = intr->next) -+ for (i=0; i<2; i++) - { -+ for (; intr; intr = intr->next) -+ { -+ if (intr->sym->attr.flavor == FL_DERIVED) -+ continue; - if (gfc_fl_struct (intr->sym->attr.flavor)) - continue; -- if (sub_flag && intr->sym->attr.function) -- continue; -- if (!sub_flag && intr->sym->attr.subroutine) -+ if (sub_flag && intr->sym->attr.function) -+ continue; -+ if (!sub_flag && intr->sym->attr.subroutine) - continue; - -- if (gfc_arglist_matches_symbol (ap, intr->sym)) -- { -- if (has_null_arg && null_sym) -- { -- gfc_error ("MOLD= required in NULL() argument at %L: Ambiguity " -- "between specific functions %s and %s", -- &null_expr_loc, null_sym->name, intr->sym->name); -- return NULL; -- } -- else if (has_null_arg) -+ if (gfc_arglist_matches_symbol (ap, intr->sym, mtypes[i])) - { -- null_sym = intr->sym; -- continue; -- } -+ if (has_null_arg && null_sym) -+ { -+ gfc_error ("MOLD= required in NULL() argument at %L: Ambiguity " -+ "between specific functions %s and %s", -+ &null_expr_loc, null_sym->name, intr->sym->name); -+ return NULL; -+ } -+ else if (has_null_arg) -+ { -+ null_sym = intr->sym; -+ continue; -+ } - -- /* Satisfy 12.4.4.1 such that an elemental match has lower -- weight than a non-elemental match. */ -- if (intr->sym->attr.elemental) -- { -- elem_sym = intr->sym; -- continue; -+ /* Satisfy 12.4.4.1 such that an elemental match has lower -+ weight than a non-elemental match. */ -+ if (intr->sym->attr.elemental) -+ { -+ elem_sym = intr->sym; -+ continue; -+ } -+ return intr->sym; - } -- return intr->sym; - } - } - -@@ -3942,7 +3963,7 @@ matching_typebound_op (gfc_expr** tb_bas - - /* Check if this arglist matches the formal. */ - argcopy = gfc_copy_actual_arglist (args); -- matches = gfc_arglist_matches_symbol (&argcopy, target); -+ matches = gfc_arglist_matches_symbol (&argcopy, target, MATCH_EXACT); - gfc_free_actual_arglist (argcopy); - - /* Return if we found a match. */ -diff -Nrup a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c ---- a/gcc/fortran/intrinsic.c 2018-06-05 11:59:14.278336990 -0600 -+++ b/gcc/fortran/intrinsic.c 2018-06-05 11:59:52.831081683 -0600 -@@ -4229,6 +4229,16 @@ check_arglist (gfc_actual_arglist **ap, - if (ts.kind == 0) - ts.kind = actual->expr->ts.kind; - -+ /* ts.kind is the argument spec. actual is what was passed. */ -+ -+ if (actual->expr->ts.kind < ts.kind -+ && ts.type == BT_INTEGER) -+ { -+ /* If it was OK to overwrite ts.kind in the previous case, it -+ should be fine here... */ -+ ts.kind = actual->expr->ts.kind; -+ } -+ - if (!gfc_compare_types (&ts, &actual->expr->ts)) - { - if (error_flag) -diff -Nrup a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c ---- a/gcc/fortran/resolve.c 2018-06-05 11:59:14.291336904 -0600 -+++ b/gcc/fortran/resolve.c 2018-06-05 11:59:52.833081670 -0600 -@@ -6055,7 +6055,7 @@ resolve_typebound_generic_call (gfc_expr - && gfc_sym_get_dummy_args (target) == NULL); - - /* Check if this arglist matches the formal. */ -- matches = gfc_arglist_matches_symbol (&args, target); -+ matches = gfc_arglist_matches_symbol (&args, target, MATCH_EXACT); - - /* Clean up and break out of the loop if we've found it. */ - gfc_free_actual_arglist (args); diff --git a/SOURCES/0016-Suppress-warning-with-Wno-overwrite-recursive.patch b/SOURCES/0016-Suppress-warning-with-Wno-overwrite-recursive.patch new file mode 100644 index 0000000..7a283ba --- /dev/null +++ b/SOURCES/0016-Suppress-warning-with-Wno-overwrite-recursive.patch @@ -0,0 +1,49 @@ +From 9bf3b68e118a749ab87f52649fd56aca059470e8 Mon Sep 17 00:00:00 2001 +From: Mark Eggleston +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 + diff --git a/SOURCES/0017-Add-the-SEQUENCE-attribute-by-default-if-it-s-not-pr.patch b/SOURCES/0017-Add-the-SEQUENCE-attribute-by-default-if-it-s-not-pr.patch deleted file mode 100644 index 13ab77f..0000000 --- a/SOURCES/0017-Add-the-SEQUENCE-attribute-by-default-if-it-s-not-pr.patch +++ /dev/null @@ -1,68 +0,0 @@ -From fdda38024c7151ca632cb338085af80ceb63ec4d Mon Sep 17 00:00:00 2001 -From: Jim MacArthur -Date: Wed, 18 Nov 2015 15:08:56 +0000 -Subject: [PATCH 17/23] Add the SEQUENCE attribute by default if it's not - present. - -This feature is enabled by the `-std=extra-legacy` compiler flag. - - - 0017-Add-the-SEQUENCE-attribute-by-default-if-it-s-not-pr.patch - -commit 1635277d719de05fbd37a2887273ce893bf43198 -Author: Jim MacArthur -Date: Wed Nov 18 15:08:56 2015 +0000 - - Add the SEQUENCE attribute by default if it's not present. - - This feature is enabled by the `-std=extra-legacy` compiler flag. - - Test written by: Francisco Redondo Marchena - -diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c -index 2e60984b3bd..022b9230ec9 100644 ---- a/gcc/fortran/resolve.c -+++ b/gcc/fortran/resolve.c -@@ -963,9 +963,16 @@ resolve_common_vars (gfc_common_head *common_block, bool named_common) - - if (!(csym->ts.u.derived->attr.sequence - || csym->ts.u.derived->attr.is_bind_c)) -- gfc_error_now ("Derived type variable %qs in COMMON at %L " -- "has neither the SEQUENCE nor the BIND(C) " -- "attribute", csym->name, &csym->declared_at); -+ { -+ if (gfc_option.allow_std & GFC_STD_EXTRA_LEGACY) -+ /* Assume sequence. */ -+ csym->ts.u.derived->attr.sequence = 1; -+ else -+ gfc_error_now ("Derived type variable '%s' in COMMON at %L " -+ "has neither the SEQUENCE nor the BIND(C) " -+ "attribute", csym->name, &csym->declared_at); -+ } -+ - if (csym->ts.u.derived->attr.alloc_comp) - gfc_error_now ("Derived type variable %qs in COMMON at %L " - "has an ultimate component that is " -diff --git a/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default.f b/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default.f -new file mode 100644 -index 00000000000..c0851c8bc77 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default.f -@@ -0,0 +1,17 @@ -+! { dg-do compile } -+! { dg-options "-std=extra-legacy" } -+! -+! Test add default SEQUENCE attribute to COMMON blocks -+! -+ PROGRAM sequence_att_common -+ TYPE STRUCT1 -+ INTEGER*4 ID -+ INTEGER*4 TYPE -+ INTEGER*8 DEFVAL -+ CHARACTER*(4) NAME -+ LOGICAL*1 NIL -+ END TYPE STRUCT1 -+ -+ TYPE (STRUCT1) SINST -+ COMMON /BLOCK1/ SINST -+ END diff --git a/SOURCES/0018-Fill-in-missing-array-dimensions-using-the-lower-bou.patch b/SOURCES/0018-Fill-in-missing-array-dimensions-using-the-lower-bou.patch deleted file mode 100644 index 85ec1ad..0000000 --- a/SOURCES/0018-Fill-in-missing-array-dimensions-using-the-lower-bou.patch +++ /dev/null @@ -1,62 +0,0 @@ -From b8527b8f03c4c50869c4f9a063f5c7686e58e5e9 Mon Sep 17 00:00:00 2001 -From: Jim MacArthur -Date: Fri, 26 Aug 2016 17:46:05 +0100 -Subject: [PATCH 18/23] Fill in missing array dimensions using the lower bound - -This feature is enabled by the `-fstd=extra-legacy` compiler flag ---- - - - 0018-Fill-in-missing-array-dimensions-using-the-lower-bou.patch - -diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c -index a831f70..ac35357 100644 ---- a/gcc/fortran/resolve.c -+++ b/gcc/fortran/resolve.c -@@ -4396,6 +4396,27 @@ compare_spec_to_ref (gfc_array_ref *ar) - if (ar->type == AR_FULL) - return true; - -+ if ((gfc_option.allow_std & GFC_STD_EXTRA_LEGACY) -+ && as->rank > ar->dimen) -+ { -+ /* Add in the missing dimensions, assuming they are the lower bound -+ of that dimension if not specified. */ -+ int j; -+ gfc_warning (0, "Using the lower bound for unspecified dimensions " -+ "in array reference at %L", &ar->where); -+ /* Other parts of the code iterate ar->start and ar->end from 0 to -+ ar->dimen, so it is safe to assume slots from ar->dimen upwards -+ are unused (i.e. there are no gaps; the specified indexes are -+ contiguous and start at zero */ -+ for(j = ar->dimen; j <= as->rank; j++) -+ { -+ ar->start[j] = gfc_copy_expr (as->lower[j]); -+ ar->end[j] = gfc_copy_expr (as->lower[j]); -+ ar->dimen_type[j] = DIMEN_ELEMENT; -+ } -+ ar->dimen = as->rank; -+ } -+ - if (as->rank != ar->dimen) - { - gfc_error ("Rank mismatch in array reference at %L (%d/%d)", -diff --git a/gcc/testsuite/gfortran.dg/array_6.f90 b/gcc/testsuite/gfortran.dg/array_6.f90 -new file mode 100644 -index 0000000..20752a1 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/array_6.f90 -@@ -0,0 +1,13 @@ -+! { dg-do compile } -+! { dg-options "-std=extra-legacy" }! -+! Checks that under-specified arrays (referencing arrays with fewer -+! dimensions than the array spec) generates a warning. -+! -+! Contributed by Jim MacArthur -+! -+ -+program under_specified_array -+ INTEGER chsbrd(8,8) -+ chsbrd(3,1) = 5 -+ print *, chsbrd(3) ! { dg-warning "Using the lower bound for unspecified dimensions in array reference" } -+end program diff --git a/SOURCES/0019-Add-tests-for-AUTOMATIC-keyword.patch b/SOURCES/0019-Add-tests-for-AUTOMATIC-keyword.patch deleted file mode 100644 index 2e24b14..0000000 --- a/SOURCES/0019-Add-tests-for-AUTOMATIC-keyword.patch +++ /dev/null @@ -1,35 +0,0 @@ -From 52e49e5edaf2c4de5974b42dd359c0f57546c640 Mon Sep 17 00:00:00 2001 -From: Mark Doffman -Date: Thu, 5 Jun 2014 20:47:51 +0000 -Subject: [PATCH 19/23] Add tests for AUTOMATIC keyword - -These tests were written by Mark Doffman for his own implementation of -the AUTOMATIC keyword. Since then, Fritz Reese's implementation was -merged upstream so we no longer carry Mark's patches but the tests -may add some useful extra test coverage. Or they might not. ---- - gcc/testsuite/gfortran.dg/automatic_1.f90 | 31 ++++++++++++++++++++++++++ - gcc/testsuite/gfortran.dg/automatic_common.f90 | 6 +++++ - gcc/testsuite/gfortran.dg/automatic_repeat.f90 | 8 +++++++ - gcc/testsuite/gfortran.dg/automatic_save.f90 | 8 +++++++ - 4 files changed, 53 insertions(+) - create mode 100644 gcc/testsuite/gfortran.dg/automatic_1.f90 - create mode 100644 gcc/testsuite/gfortran.dg/automatic_common.f90 - create mode 100644 gcc/testsuite/gfortran.dg/automatic_repeat.f90 - create mode 100644 gcc/testsuite/gfortran.dg/automatic_save.f90 - -diff --git a/gcc/testsuite/gfortran.dg/automatic_common.f90 b/gcc/testsuite/gfortran.dg/automatic_common.f90 -new file mode 100644 -index 0000000..5ec016f ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/automatic_common.f90 -@@ -0,0 +1,6 @@ -+! { dg-do compile } -+! { dg-options "-fdec-static" } -+! A common variable may not have the AUTOMATIC attribute. -+INTEGER, AUTOMATIC :: X -+COMMON /COM/ X ! { dg-error "conflicts with AUTOMATIC attribute" } -+END --- -2.9.5 - diff --git a/SOURCES/0022-Default-values-for-certain-field-descriptors-in-form.patch b/SOURCES/0022-Default-values-for-certain-field-descriptors-in-form.patch deleted file mode 100644 index b070abe..0000000 --- a/SOURCES/0022-Default-values-for-certain-field-descriptors-in-form.patch +++ /dev/null @@ -1,516 +0,0 @@ -diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c -index d93dcfa..f47565c 100644 ---- a/gcc/fortran/io.c -+++ b/gcc/fortran/io.c -@@ -909,6 +909,13 @@ data_desc: - - if (u != FMT_POSINT) - { -+ if (flag_dec) -+ { -+ /* Assume a default width based on the variable size. */ -+ saved_token = u; -+ break; -+ } -+ - format_locus.nextc += format_string_pos; - gfc_error ("Positive width required in format " - "specifier %s at %L", token_to_string (t), -@@ -1030,6 +1037,13 @@ data_desc: - goto fail; - if (t != FMT_ZERO && t != FMT_POSINT) - { -+ if (flag_dec) -+ { -+ /* Assume the default width is expected here and continue lexing. */ -+ value = 0; /* It doesn't matter what we set the value to here. */ -+ saved_token = t; -+ break; -+ } - error = nonneg_required; - goto syntax; - } -@@ -1099,8 +1113,17 @@ data_desc: - goto fail; - if (t != FMT_ZERO && t != FMT_POSINT) - { -- error = nonneg_required; -- goto syntax; -+ if (flag_dec) -+ { -+ /* Assume the default width is expected here and continue lexing. */ -+ value = 0; /* It doesn't matter what we set the value to here. */ -+ saved_token = t; -+ } -+ else -+ { -+ error = nonneg_required; -+ goto syntax; -+ } - } - else if (is_input && t == FMT_ZERO) - { -diff --git a/gcc/testsuite/gfortran.dg/fmt_f_default_field_width.f90 b/gcc/testsuite/gfortran.dg/fmt_f_default_field_width.f90 -new file mode 100644 -index 0000000..b087b8f ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/fmt_f_default_field_width.f90 -@@ -0,0 +1,43 @@ -+! { dg-do run } -+! { dg-options -fdec } -+! -+! Test case for the default field widths enabled by the -fdec-format-defaults flag. -+! -+! This feature is not part of any Fortran standard, but it is supported by the -+! Oracle Fortran compiler and others. -+! -+! libgfortran uses printf() internally to implement FORMAT. If you print float -+! values to a higher precision than the type can actually store, the results -+! are implementation dependent: some platforms print zeros, others print random -+! numbers. Don't depend on this behaviour in tests because they will not be -+! portable. -+ -+ character(50) :: buffer -+ -+ real*4 :: real_4 -+ real*8 :: real_8 -+ real*16 :: real_16 -+ integer :: len -+ -+ real_4 = 4.18 -+ write(buffer, '(A, F, A)') ':',real_4,':' -+ print *,buffer -+ if (buffer.ne.": 4.1799998:") call abort -+ -+ real_4 = 0.00000018 -+ write(buffer, '(A, F, A)') ':',real_4,':' -+ print *,buffer -+ if (buffer.ne.": 0.0000002:") call abort -+ -+ real_8 = 4.18 -+ write(buffer, '(A, F, A)') ':',real_8,':' -+ print *,buffer -+ len = len_trim(buffer) -+ if (len /= 27) call abort -+ -+ real_16 = 4.18 -+ write(buffer, '(A, F, A)') ':',real_16,':' -+ print *,buffer -+ len = len_trim(buffer) -+ if (len /= 44) call abort -+end -diff --git a/gcc/testsuite/gfortran.dg/fmt_g_default_field_width.f90 b/gcc/testsuite/gfortran.dg/fmt_g_default_field_width.f90 -new file mode 100644 -index 0000000..3d3a476 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/fmt_g_default_field_width.f90 -@@ -0,0 +1,48 @@ -+! { dg-do run } -+! { dg-options -fdec } -+! -+! Test case for the default field widths enabled by the -fdec-format-defaults flag. -+! -+! This feature is not part of any Fortran standard, but it is supported by the -+! Oracle Fortran compiler and others. -+! -+! libgfortran uses printf() internally to implement FORMAT. If you print float -+! values to a higher precision than the type can actually store, the results -+! are implementation dependent: some platforms print zeros, others print random -+! numbers. Don't depend on this behaviour in tests because they will not be -+! portable. -+ -+ character(50) :: buffer -+ -+ real*4 :: real_4 -+ real*8 :: real_8 -+ real*16 :: real_16 -+ integer :: len -+ -+ real_4 = 4.18 -+ write(buffer, '(A, G, A)') ':',real_4,':' -+ print *,buffer -+ if (buffer.ne.": 4.180000 :") call abort -+ -+ real_4 = 0.00000018 -+ write(buffer, '(A, G, A)') ':',real_4,':' -+ print *,buffer -+ if (buffer.ne.": 0.1800000E-06:") call abort -+ -+ real_4 = 18000000.4 -+ write(buffer, '(A, G, A)') ':',real_4,':' -+ print *,buffer -+ if (buffer.ne.": 0.1800000E+08:") call abort -+ -+ real_8 = 4.18 -+ write(buffer, '(A, G, A)') ':',real_8,':' -+ print *,buffer -+ len = len_trim(buffer) -+ if (len /= 27) call abort -+ -+ real_16 = 4.18 -+ write(buffer, '(A, G, A)') ':',real_16,':' -+ print *,buffer -+ len = len_trim(buffer) -+ if (len /= 44) call abort -+end -diff --git a/gcc/testsuite/gfortran.dg/fmt_i_default_field_width.f90 b/gcc/testsuite/gfortran.dg/fmt_i_default_field_width.f90 -new file mode 100644 -index 0000000..ac4e165 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/fmt_i_default_field_width.f90 -@@ -0,0 +1,38 @@ -+! { dg-do run } -+! { dg-options -fdec } -+! -+! Test case for the default field widths enabled by the -fdec-format-defaults flag. -+! -+! This feature is not part of any Fortran standard, but it is supported by the -+! Oracle Fortran compiler and others. -+ -+ character(50) :: buffer -+ character(1) :: colon -+ -+ integer*2 :: integer_2 -+ integer*4 :: integer_4 -+ integer*8 :: integer_8 -+ -+ write(buffer, '(A, I, A)') ':',12340,':' -+ print *,buffer -+ if (buffer.ne.": 12340:") call abort -+ -+ read(buffer, '(A1, I, A1)') colon, integer_4, colon -+ if (integer_4.ne.12340) call abort -+ -+ integer_2 = -99 -+ write(buffer, '(A, I, A)') ':',integer_2,':' -+ print *,buffer -+ if (buffer.ne.": -99:") call abort -+ -+ integer_8 = -11112222 -+ write(buffer, '(A, I, A)') ':',integer_8,':' -+ print *,buffer -+ if (buffer.ne.": -11112222:") call abort -+ -+! If the width is 7 and there are 7 leading zeroes, the result should be zero. -+ integer_2 = 789 -+ buffer = '0000000789' -+ read(buffer, '(I)') integer_2 -+ if (integer_2.ne.0) call abort -+end -diff --git a/libgfortran/io/format.c b/libgfortran/io/format.c -index c2abdd7..692b1ff 100644 ---- a/libgfortran/io/format.c -+++ b/libgfortran/io/format.c -@@ -956,12 +956,33 @@ parse_format_list (st_parameter_dt *dtp, bool *seen_dd) - *seen_dd = true; - if (u != FMT_POSINT && u != FMT_ZERO) - { -+ if (dtp->common.flags & IOPARM_DT_DEC_EXT) -+ { -+ tail->u.real.w = DEFAULT_WIDTH; -+ tail->u.real.d = 0; -+ tail->u.real.e = -1; -+ fmt->saved_token = u; -+ break; -+ } - fmt->error = nonneg_required; - goto finished; - } - } -+ else if (u == FMT_ZERO) -+ { -+ fmt->error = posint_required; -+ goto finished; -+ } - else if (u != FMT_POSINT) - { -+ if (dtp->common.flags & IOPARM_DT_DEC_EXT) -+ { -+ tail->u.real.w = DEFAULT_WIDTH; -+ tail->u.real.d = 0; -+ tail->u.real.e = -1; -+ fmt->saved_token = u; -+ break; -+ } - fmt->error = posint_required; - goto finished; - } -@@ -1099,6 +1120,13 @@ parse_format_list (st_parameter_dt *dtp, bool *seen_dd) - { - if (t != FMT_POSINT) - { -+ if (dtp->common.flags & IOPARM_DT_DEC_EXT) -+ { -+ tail->u.integer.w = DEFAULT_WIDTH; -+ tail->u.integer.m = -1; -+ fmt->saved_token = t; -+ break; -+ } - fmt->error = posint_required; - goto finished; - } -@@ -1107,6 +1135,13 @@ parse_format_list (st_parameter_dt *dtp, bool *seen_dd) - { - if (t != FMT_ZERO && t != FMT_POSINT) - { -+ if (dtp->common.flags & IOPARM_DT_DEC_EXT) -+ { -+ tail->u.integer.w = DEFAULT_WIDTH; -+ tail->u.integer.m = -1; -+ fmt->saved_token = t; -+ break; -+ } - fmt->error = nonneg_required; - goto finished; - } -diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h -index 5583183..d1d08e8 100644 ---- a/libgfortran/io/io.h -+++ b/libgfortran/io/io.h -@@ -981,5 +981,55 @@ memset4 (gfc_char4_t *p, gfc_char4_t c, int k) - *p++ = c; - } - -+/* Used in width fields to indicate that the default should be used */ -+#define DEFAULT_WIDTH -1 -+ -+/* Defaults for certain format field descriptors. These are decided based on -+ * the type of the value being formatted. -+ * -+ * The behaviour here is modelled on the Oracle Fortran compiler. At the time -+ * of writing, the details were available at this URL: -+ * -+ * https://docs.oracle.com/cd/E19957-01/805-4939/6j4m0vnc3/index.html#z4000743746d -+ */ -+ -+static inline int -+default_width_for_integer (int kind) -+{ -+ switch (kind) -+ { -+ case 1: -+ case 2: return 7; -+ case 4: return 12; -+ case 8: return 23; -+ case 16: return 44; -+ default: return 0; -+ } -+} -+ -+static inline int -+default_width_for_float (int kind) -+{ -+ switch (kind) -+ { -+ case 4: return 15; -+ case 8: return 25; -+ case 16: return 42; -+ default: return 0; -+ } -+} -+ -+static inline int -+default_precision_for_float (int kind) -+{ -+ switch (kind) -+ { -+ case 4: return 7; -+ case 8: return 16; -+ case 16: return 33; -+ default: return 0; -+ } -+} -+ - #endif - -diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c -index 2c9de48..e911e35 100644 ---- a/libgfortran/io/read.c -+++ b/libgfortran/io/read.c -@@ -629,6 +629,12 @@ read_decimal (st_parameter_dt *dtp, const fnode *f, char *dest, int length) - - w = f->u.w; - -+ /* This is a legacy extension, and the frontend will only allow such cases -+ * through when -fdec-format-defaults is passed. -+ */ -+ if (w == DEFAULT_WIDTH) -+ w = default_width_for_integer (length); -+ - p = read_block_form (dtp, &w); - - if (p == NULL) -diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c -index a7307a8..c8e52fb 100644 ---- a/libgfortran/io/write.c -+++ b/libgfortran/io/write.c -@@ -684,9 +684,8 @@ write_l (st_parameter_dt *dtp, const fnode *f, char *source, int len) - p[wlen - 1] = (n) ? 'T' : 'F'; - } - -- - static void --write_boz (st_parameter_dt *dtp, const fnode *f, const char *q, int n) -+write_boz (st_parameter_dt *dtp, const fnode *f, const char *q, int n, int len) - { - int w, m, digits, nzero, nblank; - char *p; -@@ -719,6 +718,9 @@ write_boz (st_parameter_dt *dtp, const fnode *f, const char *q, int n) - /* Select a width if none was specified. The idea here is to always - print something. */ - -+ if (w == DEFAULT_WIDTH) -+ w = default_width_for_integer (len); -+ - if (w == 0) - w = ((digits < m) ? m : digits); - -@@ -845,6 +847,8 @@ write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source, - - /* Select a width if none was specified. The idea here is to always - print something. */ -+ if (w == DEFAULT_WIDTH) -+ w = default_width_for_integer (len); - - if (w == 0) - w = ((digits < m) ? m : digits) + nsign; -@@ -1187,13 +1191,13 @@ write_b (st_parameter_dt *dtp, const fnode *f, const char *source, int len) - if (len > (int) sizeof (GFC_UINTEGER_LARGEST)) - { - p = btoa_big (source, itoa_buf, len, &n); -- write_boz (dtp, f, p, n); -+ write_boz (dtp, f, p, n, len); - } - else - { - n = extract_uint (source, len); - p = btoa (n, itoa_buf, sizeof (itoa_buf)); -- write_boz (dtp, f, p, n); -+ write_boz (dtp, f, p, n, len); - } - } - -@@ -1208,13 +1212,13 @@ write_o (st_parameter_dt *dtp, const fnode *f, const char *source, int len) - if (len > (int) sizeof (GFC_UINTEGER_LARGEST)) - { - p = otoa_big (source, itoa_buf, len, &n); -- write_boz (dtp, f, p, n); -+ write_boz (dtp, f, p, n, len); - } - else - { - n = extract_uint (source, len); - p = otoa (n, itoa_buf, sizeof (itoa_buf)); -- write_boz (dtp, f, p, n); -+ write_boz (dtp, f, p, n, len); - } - } - -@@ -1228,13 +1232,13 @@ write_z (st_parameter_dt *dtp, const fnode *f, const char *source, int len) - if (len > (int) sizeof (GFC_UINTEGER_LARGEST)) - { - p = ztoa_big (source, itoa_buf, len, &n); -- write_boz (dtp, f, p, n); -+ write_boz (dtp, f, p, n, len); - } - else - { - n = extract_uint (source, len); - p = gfc_xtoa (n, itoa_buf, sizeof (itoa_buf)); -- write_boz (dtp, f, p, n); -+ write_boz (dtp, f, p, n, len); - } - } - -@@ -1504,7 +1508,7 @@ size_from_kind (st_parameter_dt *dtp, const fnode *f, int kind) - { - int size; - -- if (f->format == FMT_F && f->u.real.w == 0) -+ if ((f->format == FMT_F && f->u.real.w == 0) || f->u.real.w == DEFAULT_WIDTH) - { - switch (kind) - { -diff --git a/libgfortran/io/write_float.def b/libgfortran/io/write_float.def -index 7f0aa1d..73dc910 100644 ---- a/libgfortran/io/write_float.def -+++ b/libgfortran/io/write_float.def -@@ -113,7 +113,8 @@ determine_precision (st_parameter_dt * d - static void - build_float_string (st_parameter_dt *dtp, const fnode *f, char *buffer, - size_t size, int nprinted, int precision, int sign_bit, -- bool zero_flag, int npad, char *result, size_t *len) -+ bool zero_flag, int npad, int default_width, char *result, -+ size_t *len) - { - char *put; - char *digits; -@@ -132,8 +133,17 @@ build_float_string (st_parameter_dt *dtp - sign_t sign; - - ft = f->format; -- w = f->u.real.w; -- d = f->u.real.d; -+ if (f->u.real.w == DEFAULT_WIDTH) -+ /* This codepath can only be reached with -fdec-format-defaults. */ -+ { -+ w = default_width; -+ d = precision; -+ } -+ else -+ { -+ w = f->u.real.w; -+ d = f->u.real.d; -+ } - p = dtp->u.p.scale_factor; - *len = 0; - -@@ -959,6 +969,11 @@ determine_en_precision (st_parameter_dt - int save_scale_factor;\ - volatile GFC_REAL_ ## x temp;\ - save_scale_factor = dtp->u.p.scale_factor;\ -+ if (w == DEFAULT_WIDTH)\ -+ {\ -+ w = default_width;\ -+ d = precision;\ -+ }\ - switch (dtp->u.p.current_unit->round_status)\ - {\ - case ROUND_ZERO:\ -@@ -1034,7 +1049,8 @@ determine_en_precision (st_parameter_dt - nprinted = FDTOA(y,precision,m);\ - }\ - build_float_string (dtp, &newf, buffer, size, nprinted, precision,\ -- sign_bit, zero_flag, npad, result, res_len);\ -+ sign_bit, zero_flag, npad, default_width,\ -+ result, res_len);\ - dtp->u.p.scale_factor = save_scale_factor;\ - }\ - else\ -@@ -1044,7 +1060,8 @@ determine_en_precision (st_parameter_dt - else\ - nprinted = DTOA(y,precision,m);\ - build_float_string (dtp, f, buffer, size, nprinted, precision,\ -- sign_bit, zero_flag, npad, result, res_len);\ -+ sign_bit, zero_flag, npad, default_width,\ -+ result, res_len);\ - }\ - }\ - -@@ -1058,6 +1075,16 @@ get_float_string (st_parameter_dt *dtp, - { - int sign_bit, nprinted; - bool zero_flag; -+ int default_width = 0; -+ -+ if (f->u.real.w == DEFAULT_WIDTH) -+ /* This codepath can only be reached with -fdec-format-defaults. The default -+ * values are based on those used in the Oracle Fortran compiler. -+ */ -+ { -+ default_width = default_width_for_float (kind); -+ precision = default_precision_for_float (kind); -+ } - - switch (kind) - { diff --git a/SOURCES/gcc8-fortran-equivalence.patch b/SOURCES/gcc8-fortran-equivalence.patch deleted file mode 100644 index 03caf62..0000000 --- a/SOURCES/gcc8-fortran-equivalence.patch +++ /dev/null @@ -1,202 +0,0 @@ -diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h -index c373419..880630a 100644 ---- a/gcc/fortran/gfortran.h -+++ b/gcc/fortran/gfortran.h -@@ -2867,6 +2867,7 @@ bool gfc_merge_new_implicit (gfc_typespec *); - void gfc_set_implicit_none (bool, bool, locus *); - void gfc_check_function_type (gfc_namespace *); - bool gfc_is_intrinsic_typename (const char *); -+bool check_conflict (symbol_attribute *, const char *, locus *); - - gfc_typespec *gfc_get_default_type (const char *, gfc_namespace *); - bool gfc_set_default_type (gfc_symbol *, int, gfc_namespace *); -diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c -index 67ad504..29b40fd 100644 ---- a/gcc/fortran/symbol.c -+++ b/gcc/fortran/symbol.c -@@ -363,7 +363,7 @@ gfc_check_function_type (gfc_namespace *ns) - goto conflict_std;\ - } - --static bool -+bool - check_conflict (symbol_attribute *attr, const char *name, locus *where) - { - static const char *dummy = "DUMMY", *save = "SAVE", *pointer = "POINTER", -@@ -496,7 +496,9 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) - conf (allocatable, elemental); - - conf (in_common, automatic); -+#if 0 - conf (in_equivalence, automatic); -+#endif - conf (result, automatic); - conf (use_assoc, automatic); - conf (dummy, automatic); -diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c -index 36370eb..4cfaf61 100644 ---- a/gcc/fortran/trans-common.c -+++ b/gcc/fortran/trans-common.c -@@ -948,6 +948,61 @@ add_condition (segment_info *f, gfc_equiv *eq1, gfc_equiv *eq2) - confirm_condition (f, eq1, n, eq2); - } - -+static void -+accumulate_equivalence_attributes (symbol_attribute *dummy_symbol, gfc_equiv *e) -+{ -+ symbol_attribute attr = e->expr->symtree->n.sym->attr; -+ -+ dummy_symbol->dummy |= attr.dummy; -+ dummy_symbol->pointer |= attr.pointer; -+ dummy_symbol->target |= attr.target; -+ dummy_symbol->external |= attr.external; -+ dummy_symbol->intrinsic |= attr.intrinsic; -+ dummy_symbol->allocatable |= attr.allocatable; -+ dummy_symbol->elemental |= attr.elemental; -+ dummy_symbol->recursive |= attr.recursive; -+ dummy_symbol->in_common |= attr.in_common; -+ dummy_symbol->result |= attr.result; -+ dummy_symbol->in_namelist |= attr.in_namelist; -+ dummy_symbol->optional |= attr.optional; -+ dummy_symbol->entry |= attr.entry; -+ dummy_symbol->function |= attr.function; -+ dummy_symbol->subroutine |= attr.subroutine; -+ dummy_symbol->dimension |= attr.dimension; -+ dummy_symbol->in_equivalence |= attr.in_equivalence; -+ dummy_symbol->use_assoc |= attr.use_assoc; -+ dummy_symbol->cray_pointer |= attr.cray_pointer; -+ dummy_symbol->cray_pointee |= attr.cray_pointee; -+ dummy_symbol->data |= attr.data; -+ dummy_symbol->value |= attr.value; -+ dummy_symbol->volatile_ |= attr.volatile_; -+ dummy_symbol->is_protected |= attr.is_protected; -+ dummy_symbol->is_bind_c |= attr.is_bind_c; -+ dummy_symbol->procedure |= attr.procedure; -+ dummy_symbol->proc_pointer |= attr.proc_pointer; -+ dummy_symbol->abstract |= attr.abstract; -+ dummy_symbol->asynchronous |= attr.asynchronous; -+ dummy_symbol->codimension |= attr.codimension; -+ dummy_symbol->contiguous |= attr.contiguous; -+ dummy_symbol->generic |= attr.generic; -+ dummy_symbol->automatic |= attr.automatic; -+ dummy_symbol->threadprivate |= attr.threadprivate; -+ dummy_symbol->omp_declare_target |= attr.omp_declare_target; -+ dummy_symbol->omp_declare_target_link |= attr.omp_declare_target_link; -+ dummy_symbol->oacc_declare_copyin |= attr.oacc_declare_copyin; -+ dummy_symbol->oacc_declare_create |= attr.oacc_declare_create; -+ dummy_symbol->oacc_declare_deviceptr |= attr.oacc_declare_deviceptr; -+ dummy_symbol->oacc_declare_device_resident -+ |= attr.oacc_declare_device_resident; -+ -+ /* Not strictly correct, but probably close enough. */ -+ if (attr.save > dummy_symbol->save) -+ dummy_symbol->save = attr.save; -+ if (attr.intent > dummy_symbol->intent) -+ dummy_symbol->intent = attr.intent; -+ if (attr.access > dummy_symbol->access) -+ dummy_symbol->access = attr.access; -+} - - /* Given a segment element, search through the equivalence lists for unused - conditions that involve the symbol. Add these rules to the segment. */ -@@ -966,8 +1021,11 @@ find_equivalence (segment_info *n) - - /* Search the equivalence list, including the root (first) element - for the symbol that owns the segment. */ -+ symbol_attribute dummy_symbol; -+ memset (&dummy_symbol, 0, sizeof (dummy_symbol)); - for (e2 = e1; e2; e2 = e2->eq) - { -+ accumulate_equivalence_attributes (&dummy_symbol, e2); - if (!e2->used && e2->expr->symtree->n.sym == n->sym) - { - eq = e2; -@@ -975,6 +1033,8 @@ find_equivalence (segment_info *n) - } - } - -+ check_conflict (&dummy_symbol, e1->expr->symtree->name, &e1->expr->where); -+ - /* Go to the next root element. */ - if (eq == NULL) - continue; -diff -Nrcp gcc-8.2.1-20180801/gcc/fortran/trans-common.c save/gcc/fortran/trans-common.c -*** a/gcc/fortran/trans-common.c 2018-08-14 18:17:28.000000000 -0400 ---- b/gcc/fortran/trans-common.c 2018-08-14 17:57:51.000000000 -0400 -*************** build_field (segment_info *h, tree union -*** 339,345 **** - /* Get storage for local equivalence. */ - - static tree -! build_equiv_decl (tree union_type, bool is_init, bool is_saved) - { - tree decl; - char name[18]; ---- 339,345 ---- - /* Get storage for local equivalence. */ - - static tree -! build_equiv_decl (tree union_type, bool is_init, bool is_saved, bool is_auto) - { - tree decl; - char name[18]; -*************** build_equiv_decl (tree union_type, bool -*** 359,366 **** - DECL_ARTIFICIAL (decl) = 1; - DECL_IGNORED_P (decl) = 1; - -! if (!gfc_can_put_var_on_stack (DECL_SIZE_UNIT (decl)) -! || is_saved) - TREE_STATIC (decl) = 1; - - TREE_ADDRESSABLE (decl) = 1; ---- 359,367 ---- - DECL_ARTIFICIAL (decl) = 1; - DECL_IGNORED_P (decl) = 1; - -! if (!is_auto -! && (!gfc_can_put_var_on_stack (DECL_SIZE_UNIT (decl)) -! || is_saved)) - TREE_STATIC (decl) = 1; - - TREE_ADDRESSABLE (decl) = 1; -*************** create_common (gfc_common_head *com, seg -*** 611,616 **** ---- 612,618 ---- - tree decl; - bool is_init = false; - bool is_saved = false; -+ bool is_auto = false; - - /* Declare the variables inside the common block. - If the current common block contains any equivalence object, then -*************** create_common (gfc_common_head *com, seg -*** 654,659 **** ---- 656,665 ---- - /* Has SAVE attribute. */ - if (s->sym->attr.save) - is_saved = true; -+ -+ /* Has AUTOMATIC attribute. */ -+ if (s->sym->attr.automatic) -+ is_auto = true; - } - - finish_record_layout (rli, true); -*************** create_common (gfc_common_head *com, seg -*** 661,667 **** - if (com) - decl = build_common_decl (com, union_type, is_init); - else -! decl = build_equiv_decl (union_type, is_init, is_saved); - - if (is_init) - { ---- 667,673 ---- - if (com) - decl = build_common_decl (com, union_type, is_init); - else -! decl = build_equiv_decl (union_type, is_init, is_saved, is_auto); - - if (is_init) - { diff --git a/SOURCES/gcc8-fortran-fdec-include-doc.patch b/SOURCES/gcc8-fortran-fdec-include-doc.patch deleted file mode 100644 index 9e519e9..0000000 --- a/SOURCES/gcc8-fortran-fdec-include-doc.patch +++ /dev/null @@ -1,30 +0,0 @@ -2018-11-21 Jakub Jelinek - - * invoke.texi (-fdec-include): Document. - -diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi -index ee84a0be8b1..33afab1517f 100644 ---- a/gcc/fortran/invoke.texi -+++ b/gcc/fortran/invoke.texi -@@ -119,7 +119,7 @@ by type. Explanations are in the following sections. - @gccoptlist{-fall-intrinsics -fbackslash -fcray-pointer -fd-lines-as-code @gol - -fd-lines-as-comments @gol - -fdec -fdec-structure -fdec-intrinsic-ints -fdec-static -fdec-math @gol ---fdefault-double-8 -fdefault-integer-8 -fdefault-real-8 @gol -+-fdec-include -fdefault-double-8 -fdefault-integer-8 -fdefault-real-8 @gol - -fdefault-real-10 -fdefault-real-16 -fdollar-ok -ffixed-line-length-@var{n} @gol - -ffixed-line-length-none -ffree-form -ffree-line-length-@var{n} @gol - -ffree-line-length-none -fimplicit-none -finteger-4-integer-8 @gol -@@ -277,6 +277,12 @@ functions (e.g. TAND, ATAND, etc...) for compatability with older code. - Enable DEC-style STATIC and AUTOMATIC attributes to explicitly specify - the storage of variables and other objects. - -+@item -fdec-include -+@opindex @code{fdec-include} -+Enable parsing of INCLUDE as a statement in addition to parsing it as -+INCLUDE line. When parsed as INCLUDE statement, INCLUDE does not have to -+be on a single line and can use line continuations. -+ - @item -fdollar-ok - @opindex @code{fdollar-ok} - @cindex @code{$} diff --git a/SOURCES/gcc8-fortran-fdec-include.patch b/SOURCES/gcc8-fortran-fdec-include.patch deleted file mode 100644 index 01979df..0000000 --- a/SOURCES/gcc8-fortran-fdec-include.patch +++ /dev/null @@ -1,687 +0,0 @@ -2018-11-21 Jakub Jelinek - Mark Eggleston - - * lang.opt (fdec-include): New option. - * options.c (set_dec_flags): Set also flag_dec_include. - * scanner.c (include_line): Change return type from bool to int. - In fixed form allow spaces in between include keyword letters. - For -fdec-include, allow in fixed form 0 in column 6. With - -fdec-include return -1 if the parsed line is not full include - statement and it could be successfully completed on continuation - lines. - (include_stmt): New function. - (load_file): Adjust include_line caller. If it returns -1, keep - trying include_stmt until it stops returning -1 whenever adding - further line of input. - -diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt -index 2b7f2903761..fe0c6934220 100644 ---- a/gcc/fortran/lang.opt -+++ b/gcc/fortran/lang.opt -@@ -440,6 +440,10 @@ fdec - Fortran Var(flag_dec_pad_with_spaces) - For character to integer conversions, use spaces for the pad rather than NUL. - -+fdec-include -+Fortran Var(flag_dec_include) -+Enable legacy parsing of INCLUDE as statement. -+ - fdec-intrinsic-ints - Fortran Var(flag_dec_intrinsic_ints) - Enable kind-specific variants of integer intrinsic functions. -diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c -index 73f5389361d..e59ba31ba7b 100644 ---- a/gcc/fortran/options.c -+++ b/gcc/fortran/options.c -@@ -68,6 +68,7 @@ set_dec_flags (int value) - flag_dec_intrinsic_ints |= value; - flag_dec_static |= value; - flag_dec_math |= value; -+ flag_dec_include |= value; - } - - -diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c -index 55d6dafdb5d..5b27ab5e52d 100644 ---- a/gcc/fortran/scanner.c -+++ b/gcc/fortran/scanner.c -@@ -2135,14 +2135,18 @@ static bool load_file (const char *, const char *, bool); - /* include_line()-- Checks a line buffer to see if it is an include - line. If so, we call load_file() recursively to load the included - file. We never return a syntax error because a statement like -- "include = 5" is perfectly legal. We return false if no include was -- processed or true if we matched an include. */ -+ "include = 5" is perfectly legal. We return 0 if no include was -+ processed, 1 if we matched an include or -1 if include was -+ partially processed, but will need continuation lines. */ - --static bool -+static int - include_line (gfc_char_t *line) - { - gfc_char_t quote, *c, *begin, *stop; - char *filename; -+ const char *include = "include"; -+ bool allow_continuation = flag_dec_include; -+ int i; - - c = line; - -@@ -2158,42 +2162,133 @@ include_line (gfc_char_t *line) - else - { - if ((*c == '!' || *c == 'c' || *c == 'C' || *c == '*') -- && c[1] == '$' && (c[2] == ' ' || c[2] == '\t')) -+ && c[1] == '$' && c[2] == ' ') - c += 3; - } - } - -- while (*c == ' ' || *c == '\t') -- c++; -+ if (gfc_current_form == FORM_FREE) -+ { -+ while (*c == ' ' || *c == '\t') -+ c++; -+ if (gfc_wide_strncasecmp (c, "include", 7)) -+ { -+ if (!allow_continuation) -+ return 0; -+ for (i = 0; i < 7; ++i) -+ { -+ gfc_char_t c1 = gfc_wide_tolower (*c); -+ if (c1 != (unsigned char) include[i]) -+ break; -+ c++; -+ } -+ if (i == 0 || *c != '&') -+ return 0; -+ c++; -+ while (*c == ' ' || *c == '\t') -+ c++; -+ if (*c == '\0' || *c == '!') -+ return -1; -+ return 0; -+ } - -- if (gfc_wide_strncasecmp (c, "include", 7)) -- return false; -+ c += 7; -+ } -+ else -+ { -+ while (*c == ' ' || *c == '\t') -+ c++; -+ if (flag_dec_include && *c == '0' && c - line == 5) -+ { -+ c++; -+ while (*c == ' ' || *c == '\t') -+ c++; -+ } -+ if (c - line < 6) -+ allow_continuation = false; -+ for (i = 0; i < 7; ++i) -+ { -+ gfc_char_t c1 = gfc_wide_tolower (*c); -+ if (c1 != (unsigned char) include[i]) -+ break; -+ c++; -+ while (*c == ' ' || *c == '\t') -+ c++; -+ } -+ if (!allow_continuation) -+ { -+ if (i != 7) -+ return 0; -+ } -+ else if (i != 7) -+ { -+ if (i == 0) -+ return 0; -+ -+ /* At the end of line or comment this might be continued. */ -+ if (*c == '\0' || *c == '!') -+ return -1; -+ -+ return 0; -+ } -+ } - -- c += 7; - while (*c == ' ' || *c == '\t') - c++; - - /* Find filename between quotes. */ -- -+ - quote = *c++; - if (quote != '"' && quote != '\'') -- return false; -+ { -+ if (allow_continuation) -+ { -+ if (gfc_current_form == FORM_FREE) -+ { -+ if (quote == '&') -+ { -+ while (*c == ' ' || *c == '\t') -+ c++; -+ if (*c == '\0' || *c == '!') -+ return -1; -+ } -+ } -+ else if (quote == '\0' || quote == '!') -+ return -1; -+ } -+ return 0; -+ } - - begin = c; - -+ bool cont = false; - while (*c != quote && *c != '\0') -- c++; -+ { -+ if (allow_continuation && gfc_current_form == FORM_FREE) -+ { -+ if (*c == '&') -+ cont = true; -+ else if (*c != ' ' && *c != '\t') -+ cont = false; -+ } -+ c++; -+ } - - if (*c == '\0') -- return false; -+ { -+ if (allow_continuation -+ && (cont || gfc_current_form != FORM_FREE)) -+ return -1; -+ return 0; -+ } - - stop = c++; -- -+ - while (*c == ' ' || *c == '\t') - c++; - - if (*c != '\0' && *c != '!') -- return false; -+ return 0; - - /* We have an include line at this point. */ - -@@ -2205,9 +2300,130 @@ include_line (gfc_char_t *line) - exit (FATAL_EXIT_CODE); - - free (filename); -- return true; -+ return 1; - } - -+/* Similarly, but try to parse an INCLUDE statement, using gfc_next_char etc. -+ APIs. Return 1 if recognized as valid INCLUDE statement and load_file has -+ been called, 0 if it is not a valid INCLUDE statement and -1 if eof has -+ been encountered while parsing it. */ -+static int -+include_stmt (gfc_linebuf *b) -+{ -+ int ret = 0, i, length; -+ const char *include = "include"; -+ gfc_char_t c, quote = 0; -+ locus str_locus; -+ char *filename; -+ -+ continue_flag = 0; -+ end_flag = 0; -+ gcc_attribute_flag = 0; -+ openmp_flag = 0; -+ openacc_flag = 0; -+ continue_count = 0; -+ continue_line = 0; -+ gfc_current_locus.lb = b; -+ gfc_current_locus.nextc = b->line; -+ -+ gfc_skip_comments (); -+ gfc_gobble_whitespace (); -+ -+ for (i = 0; i < 7; i++) -+ { -+ c = gfc_next_char (); -+ if (c != (unsigned char) include[i]) -+ { -+ if (gfc_current_form == FORM_FIXED -+ && i == 0 -+ && c == '0' -+ && gfc_current_locus.nextc == b->line + 6) -+ { -+ gfc_gobble_whitespace (); -+ i--; -+ continue; -+ } -+ gcc_assert (i != 0); -+ if (c == '\n') -+ { -+ gfc_advance_line (); -+ gfc_skip_comments (); -+ if (gfc_at_eof ()) -+ ret = -1; -+ } -+ goto do_ret; -+ } -+ } -+ gfc_gobble_whitespace (); -+ -+ c = gfc_next_char (); -+ if (c == '\'' || c == '"') -+ quote = c; -+ else -+ { -+ if (c == '\n') -+ { -+ gfc_advance_line (); -+ gfc_skip_comments (); -+ if (gfc_at_eof ()) -+ ret = -1; -+ } -+ goto do_ret; -+ } -+ -+ str_locus = gfc_current_locus; -+ length = 0; -+ do -+ { -+ c = gfc_next_char_literal (INSTRING_NOWARN); -+ if (c == quote) -+ break; -+ if (c == '\n') -+ { -+ gfc_advance_line (); -+ gfc_skip_comments (); -+ if (gfc_at_eof ()) -+ ret = -1; -+ goto do_ret; -+ } -+ length++; -+ } -+ while (1); -+ -+ gfc_gobble_whitespace (); -+ c = gfc_next_char (); -+ if (c != '\n') -+ goto do_ret; -+ -+ gfc_current_locus = str_locus; -+ ret = 1; -+ filename = XNEWVEC (char, length + 1); -+ for (i = 0; i < length; i++) -+ { -+ c = gfc_next_char_literal (INSTRING_WARN); -+ gcc_assert (gfc_wide_fits_in_byte (c)); -+ filename[i] = (unsigned char) c; -+ } -+ filename[length] = '\0'; -+ if (!load_file (filename, NULL, false)) -+ exit (FATAL_EXIT_CODE); -+ -+ free (filename); -+ -+do_ret: -+ continue_flag = 0; -+ end_flag = 0; -+ gcc_attribute_flag = 0; -+ openmp_flag = 0; -+ openacc_flag = 0; -+ continue_count = 0; -+ continue_line = 0; -+ memset (&gfc_current_locus, '\0', sizeof (locus)); -+ memset (&openmp_locus, '\0', sizeof (locus)); -+ memset (&openacc_locus, '\0', sizeof (locus)); -+ memset (&gcc_attribute_locus, '\0', sizeof (locus)); -+ return ret; -+} - - /* Load a file into memory by calling load_line until the file ends. */ - -@@ -2215,7 +2431,7 @@ static bool - load_file (const char *realfilename, const char *displayedname, bool initial) - { - gfc_char_t *line; -- gfc_linebuf *b; -+ gfc_linebuf *b, *include_b = NULL; - gfc_file *f; - FILE *input; - int len, line_len; -@@ -2318,6 +2534,7 @@ load_file (const char *realfilename, const char *displayedname, bool initial) - for (;;) - { - int trunc = load_line (input, &line, &line_len, NULL); -+ int inc_line; - - len = gfc_wide_strlen (line); - if (feof (input) && len == 0) -@@ -2366,11 +2583,12 @@ load_file (const char *realfilename, const char *displayedname, bool initial) - } - - /* Preprocessed files have preprocessor lines added before the byte -- order mark, so first_line is not about the first line of the file -+ order mark, so first_line is not about the first line of the file - but the first line that's not a preprocessor line. */ - first_line = false; - -- if (include_line (line)) -+ inc_line = include_line (line); -+ if (inc_line > 0) - { - current_file->line++; - continue; -@@ -2403,6 +2621,36 @@ load_file (const char *realfilename, const char *displayedname, bool initial) - - while (file_changes_cur < file_changes_count) - file_changes[file_changes_cur++].lb = b; -+ -+ if (flag_dec_include) -+ { -+ if (include_b && b != include_b) -+ { -+ int inc_line2 = include_stmt (include_b); -+ if (inc_line2 == 0) -+ include_b = NULL; -+ else if (inc_line2 > 0) -+ { -+ do -+ { -+ if (gfc_current_form == FORM_FIXED) -+ { -+ for (gfc_char_t *p = include_b->line; *p; p++) -+ *p = ' '; -+ } -+ else -+ include_b->line[0] = '\0'; -+ if (include_b == b) -+ break; -+ include_b = include_b->next; -+ } -+ while (1); -+ include_b = NULL; -+ } -+ } -+ if (inc_line == -1 && !include_b) -+ include_b = b; -+ } - } - - /* Release the line buffer allocated in load_line. */ -diff --git a/gcc/testsuite/gfortran.dg/gomp/include_1.f b/gcc/testsuite/gfortran.dg/gomp/include_1.f -new file mode 100644 -index 00000000000..715eb5b97e3 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/gomp/include_1.f -@@ -0,0 +1,49 @@ -+c { dg-do compile } -+c { dg-options "-fopenmp -fdec" } -+ subroutine foo -+ implicit none -+c$ 0include 'include_1.inc' -+ i = 1 -+ end subroutine foo -+ subroutine bar -+ implicit none -+ i -+C$ ;n -+ +c -+ -+c some comment -+ -+*$ ll -+C comment line -+ uu -+ DD -+ ee'include_1.inc' -+ i = 1 -+ end subroutine bar -+ subroutine baz -+ implicit none -+ 0include -+ + 'include_1.inc' -+ i = 1 -+ end subroutine baz -+ subroutine qux -+ implicit none -+!$ i n C lude 'inc -+* another comment line -+ &lude_1.inc' -+ i = 1 -+ end subroutine qux -+ subroutine quux -+ implicit none -+C$ 0inc -+*$ 1lud -+c$ 2e ' -+!$ 3include_1.inc' -+ i = 1 -+ end subroutine quux -+ program include_12 -+ implicit none -+ include -+! comment -+c$ +'include_1.inc' -+ end program -diff --git a/gcc/testsuite/gfortran.dg/gomp/include_1.inc b/gcc/testsuite/gfortran.dg/gomp/include_1.inc -new file mode 100644 -index 00000000000..5dd841c5573 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/gomp/include_1.inc -@@ -0,0 +1 @@ -+ integer i -diff --git a/gcc/testsuite/gfortran.dg/gomp/include_2.f90 b/gcc/testsuite/gfortran.dg/gomp/include_2.f90 -new file mode 100644 -index 00000000000..9c4ff15afb8 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/gomp/include_2.f90 -@@ -0,0 +1,32 @@ -+! { dg-do compile } -+! { dg-options "-fopenmp -fdec-include" } -+subroutine foo -+ implicit none -+!$ incl& ! comment1 -+!$ &u& -+!$ &de & ! comment2 -+!$ 'include& -+ &_1.inc' -+ i = 1 -+end subroutine foo -+subroutine bar -+ implicit none -+!$ include & -+ -+! comment3 -+ -+!$ "include_1.inc" -+ i = 1 -+end subroutine bar -+subroutine baz -+ implicit none -+!$ include& -+!$ &'include_1.& -+!$ &inc' -+ i = 1 -+end subroutine baz -+subroutine qux -+ implicit none -+!$ include '& -+include_1.inc' -+end subroutine qux -diff --git a/gcc/testsuite/gfortran.dg/include_10.f b/gcc/testsuite/gfortran.dg/include_10.f -new file mode 100644 -index 00000000000..7df2a196954 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/include_10.f -@@ -0,0 +1,11 @@ -+c { dg-do compile } -+ subroutine foo -+ implicit none -+ include 'include_10.inc' -+ i = 1 -+ end subroutine foo -+ subroutine bar -+ implicit none -+ i n cl UD e'include_10.inc' -+ i = 1 -+ end subroutine bar -diff --git a/gcc/testsuite/gfortran.dg/include_10.inc b/gcc/testsuite/gfortran.dg/include_10.inc -new file mode 100644 -index 00000000000..5dd841c5573 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/include_10.inc -@@ -0,0 +1 @@ -+ integer i -diff --git a/gcc/testsuite/gfortran.dg/include_11.f b/gcc/testsuite/gfortran.dg/include_11.f -new file mode 100644 -index 00000000000..0e68a78c236 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/include_11.f -@@ -0,0 +1,20 @@ -+c { dg-do compile } -+ subroutine foo -+ implicit none -+c We used to accept following in fixed mode. Shall we at least -+c warn about it? -+include 'include_10.inc' -+ i = 1 -+ end subroutine foo -+ subroutine bar -+c Likewise here. -+ implicit none -+ include'include_10.inc' -+ i = 1 -+ end subroutine bar -+ subroutine baz -+c And here. -+ implicit none -+ include 'include_10.inc' -+ i = 1 -+ end subroutine baz -diff --git a/gcc/testsuite/gfortran.dg/include_12.f b/gcc/testsuite/gfortran.dg/include_12.f -new file mode 100644 -index 00000000000..4b3e3bed075 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/include_12.f -@@ -0,0 +1,65 @@ -+c { dg-do compile } -+c { dg-options "-fdec-include" } -+ subroutine foo -+ implicit none -+ 0include 'include_10.inc' -+ i = 1 -+ end subroutine foo -+ subroutine bar -+ implicit none -+ i -+ ;n -+ +c -+ -+c some comment -+ -+ ll -+C comment line -+ uu -+ DD -+ ee'include_10.inc' -+ i = 1 -+ end subroutine bar -+ subroutine baz -+ implicit none -+ 0include -+ + 'include_10.inc' -+ i = 1 -+ end subroutine baz -+ subroutine qux -+ implicit none -+ i n C lude 'inc -+* another comment line -+ &lude_10.inc' -+ i = 1 -+ end subroutine qux -+ subroutine quux -+ implicit none -+ 0inc -+ 1lud -+ 2e ' -+ 3include_10.inc' -+ i = 1 -+ end subroutine quux -+ program include_12 -+ implicit none -+ include -+! comment -+ +'include_10.inc' -+ end program -+ subroutine quuz -+ implicit none -+ integer include -+ include -+ +"include_10.inc" -+ i = 1 -+ include -+ + = 2 -+ write (*,*) include -+ end subroutine quuz -+ subroutine corge -+ implicit none -+ include -+ +'include_10.inc' -+ i = 1 -+ end subroutine corge -diff --git a/gcc/testsuite/gfortran.dg/include_13.f90 b/gcc/testsuite/gfortran.dg/include_13.f90 -new file mode 100644 -index 00000000000..418ee5585e2 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/include_13.f90 -@@ -0,0 +1,44 @@ -+! { dg-do compile } -+! { dg-options "-fdec" } -+subroutine foo -+ implicit none -+ incl& ! comment1 -+&u& -+ &de & ! comment2 -+'include& -+ &_10.inc' -+ i = 1 -+end subroutine foo -+subroutine bar -+ implicit none -+include & -+ -+! comment3 -+ -+"include_10.inc" -+ i = 1 -+end subroutine bar -+subroutine baz -+ implicit none -+ include& -+&'include_10.& -+&inc' -+ i = 1 -+end subroutine baz -+subroutine qux -+ implicit none -+ include '& -+include_10.inc' -+end subroutine qux -+subroutine quux -+ implicit none -+ include & -+ &'include_10.inc' -+ i = 1 -+end subroutine quux -+subroutine quuz -+ implicit none -+ include & -+ &"include_10.inc" -+ i = 1 -+end subroutine quuz diff --git a/SOURCES/gcc8-fortran-fpad-source.patch b/SOURCES/gcc8-fortran-fpad-source.patch deleted file mode 100644 index d97c76e..0000000 --- a/SOURCES/gcc8-fortran-fpad-source.patch +++ /dev/null @@ -1,144 +0,0 @@ -2018-11-23 Jakub Jelinek - - * lang.opt (fpad-source): New option. - * scanner.c (load_line): Don't pad fixed form lines if - !flag_pad_source. - * invoke.texi (-fno-pad-source): Document. - -diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi -index 33afab1517f..d6a278b1cc2 100644 ---- a/gcc/fortran/invoke.texi -+++ b/gcc/fortran/invoke.texi -@@ -121,7 +121,7 @@ by type. Explanations are in the following sections. - -fdec -fdec-structure -fdec-intrinsic-ints -fdec-static -fdec-math @gol - -fdec-include -fdefault-double-8 -fdefault-integer-8 -fdefault-real-8 @gol - -fdefault-real-10 -fdefault-real-16 -fdollar-ok -ffixed-line-length-@var{n} @gol ---ffixed-line-length-none -ffree-form -ffree-line-length-@var{n} @gol -+-ffixed-line-length-none -fpad-source -ffree-form -ffree-line-length-@var{n} @gol - -ffree-line-length-none -fimplicit-none -finteger-4-integer-8 @gol - -fmax-identifier-length -fmodule-private -ffixed-form -fno-range-check @gol - -fopenacc -fopenmp -freal-4-real-10 -freal-4-real-16 -freal-4-real-8 @gol -@@ -321,8 +321,9 @@ declared as @code{PUBLIC}. - @opindex @code{ffixed-line-length-}@var{n} - @cindex file format, fixed - Set column after which characters are ignored in typical fixed-form --lines in the source file, and through which spaces are assumed (as --if padded to that length) after the ends of short fixed-form lines. -+lines in the source file, and, unless @code{-fno-pad-source}, through which -+spaces are assumed (as if padded to that length) after the ends of short -+fixed-form lines. - - Popular values for @var{n} include 72 (the - standard and the default), 80 (card image), and 132 (corresponding -@@ -333,6 +334,15 @@ to them to fill out the line. - @option{-ffixed-line-length-0} means the same thing as - @option{-ffixed-line-length-none}. - -+@item -fno-pad-source -+@opindex @code{fpad-source} -+By default fixed-form lines have spaces assumed (as if padded to that length) -+after the ends of short fixed-form lines. This is not done either if -+@option{-ffixed-line-length-0}, @option{-ffixed-line-length-none} or -+if @option{-fno-pad-source} option is used. With any of those options -+continued character constants never have implicit spaces appended -+to them to fill out the line. -+ - @item -ffree-line-length-@var{n} - @opindex @code{ffree-line-length-}@var{n} - @cindex file format, free -diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt -index fe0c6934220..ae4957e176c 100644 ---- a/gcc/fortran/lang.opt -+++ b/gcc/fortran/lang.opt -@@ -536,6 +536,10 @@ ffixed-line-length- - Fortran RejectNegative Joined UInteger Var(flag_fixed_line_length) Init(72) - -ffixed-line-length- Use n as character line width in fixed mode. - -+fpad-source -+Fortran Var(flag_pad_source) Init(1) -+Pad shorter fixed form lines to line width with spaces. -+ - ffpe-trap= - Fortran RejectNegative JoinedOrMissing - -ffpe-trap=[...] Stop on following floating point exceptions. -diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c -index 5b27ab5e52d..2ef32b279fe 100644 ---- a/gcc/fortran/scanner.c -+++ b/gcc/fortran/scanner.c -@@ -1924,6 +1924,7 @@ next_char: - /* Pad lines to the selected line length in fixed form. */ - if (gfc_current_form == FORM_FIXED - && flag_fixed_line_length != 0 -+ && flag_pad_source - && !preprocessor_flag - && c != EOF) - { -diff --git a/gcc/testsuite/gfortran.dg/pad_source_1.f b/gcc/testsuite/gfortran.dg/pad_source_1.f -new file mode 100644 -index 00000000000..a616bba60de ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/pad_source_1.f -@@ -0,0 +1,8 @@ -+c { dg-do run } -+c { dg-skip-if "non-standard options" { *-*-* } { "-ffixed-line-length*" "-f*pad-source" } } -+ character(80) a -+ a = 'abc -+ +def' -+ if (a(:61) .ne. 'abc') stop 1 -+ if (a(62:) .ne. 'def') stop 2 -+ end -diff --git a/gcc/testsuite/gfortran.dg/pad_source_2.f b/gcc/testsuite/gfortran.dg/pad_source_2.f -new file mode 100644 -index 00000000000..bcf9439cd14 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/pad_source_2.f -@@ -0,0 +1,9 @@ -+c { dg-do run } -+c { dg-skip-if "non-standard options" { *-*-* } { "-ffixed-line-length*" } } -+c { dg-options "-fpad-source" } -+ character(80) a -+ a = 'abc -+ +def' -+ if (a(:61) .ne. 'abc') stop 1 -+ if (a(62:) .ne. 'def') stop 2 -+ end -diff --git a/gcc/testsuite/gfortran.dg/pad_source_3.f b/gcc/testsuite/gfortran.dg/pad_source_3.f -new file mode 100644 -index 00000000000..8fbdae0d67d ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/pad_source_3.f -@@ -0,0 +1,8 @@ -+c { dg-do run } -+c { dg-skip-if "non-standard options" { *-*-* } { "-ffixed-line-length*" } } -+c { dg-options "-fno-pad-source" } -+ character(80) a -+ a = 'abc -+ +def' -+ if (a .ne. 'abcdef') stop 1 -+ end -diff --git a/gcc/testsuite/gfortran.dg/pad_source_4.f b/gcc/testsuite/gfortran.dg/pad_source_4.f -new file mode 100644 -index 00000000000..5479cec217a ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/pad_source_4.f -@@ -0,0 +1,7 @@ -+c { dg-do run } -+c { dg-options "-ffixed-line-length-none" } -+ character(80) a -+ a = 'abc -+ +def' -+ if (a .ne. 'abcdef') stop 1 -+ end -diff --git a/gcc/testsuite/gfortran.dg/pad_source_5.f b/gcc/testsuite/gfortran.dg/pad_source_5.f -new file mode 100644 -index 00000000000..4122c85ba66 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/pad_source_5.f -@@ -0,0 +1,7 @@ -+c { dg-do run } -+c { dg-options "-ffixed-line-length-0" } -+ character(80) a -+ a = 'abc -+ +def' -+ if (a .ne. 'abcdef') stop 1 -+ end diff --git a/SOURCES/gcc8-fortran-pr87919-2.patch b/SOURCES/gcc8-fortran-pr87919-2.patch deleted file mode 100644 index 00364ce..0000000 --- a/SOURCES/gcc8-fortran-pr87919-2.patch +++ /dev/null @@ -1,87 +0,0 @@ -2018-12-03 Fritz Reese - Mark Eggleston - - PR fortran/87919 - * options.c (SET_FLAG, SET_BITFLAG, SET_BITFLAG2): New macros. - (set_dec_flags): Set/unset DEC and std flags according to value. - (post_dec_flags, set_init_local_zero): New functions. - (gfc_init_options): Use set_init_local_zero and post_dec_flags. - (gfc_handle_options) : Use - SET_BITFLAG. - : Use set_init_local_zero. - : Pass value to set_dec_flags. - : Remove. - -diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c -index b35bed32974..48e35e3524d 100644 ---- a/gcc/fortran/options.c -+++ b/gcc/fortran/options.c -@@ -147,11 +147,7 @@ gfc_init_options (unsigned int decoded_options_count, - - gfc_option.flag_preprocessed = 0; - gfc_option.flag_d_lines = -1; -- gfc_option.flag_init_integer = GFC_INIT_INTEGER_OFF; -- gfc_option.flag_init_integer_value = 0; -- gfc_option.flag_init_logical = GFC_INIT_LOGICAL_OFF; -- gfc_option.flag_init_character = GFC_INIT_CHARACTER_OFF; -- gfc_option.flag_init_character_value = (char)0; -+ set_init_local_zero (0); - - gfc_option.fpe = 0; - /* All except GFC_FPE_INEXACT. */ -@@ -261,6 +257,9 @@ gfc_post_options (const char **pfilename) - char *source_path; - int i; - -+ /* Finalize DEC flags. */ -+ post_dec_flags (flag_dec); -+ - /* Excess precision other than "fast" requires front-end - support. */ - if (flag_excess_precision_cmdline == EXCESS_PRECISION_STANDARD) -@@ -644,7 +643,7 @@ gfc_handle_option (size_t scode, const char *arg, HOST_WIDE_INT value, - break; - - case OPT_fcheck_array_temporaries: -- gfc_option.rtcheck |= GFC_RTCHECK_ARRAY_TEMPS; -+ SET_BITFLAG (gfc_option.rtcheck, value, GFC_RTCHECK_ARRAY_TEMPS); - break; - - case OPT_fd_lines_as_code: -@@ -694,12 +693,7 @@ gfc_handle_option (size_t scode, const char *arg, HOST_WIDE_INT value, - break; - - case OPT_finit_local_zero: -- gfc_option.flag_init_integer = GFC_INIT_INTEGER_ON; -- gfc_option.flag_init_integer_value = 0; -- flag_init_real = GFC_INIT_REAL_ZERO; -- gfc_option.flag_init_logical = GFC_INIT_LOGICAL_FALSE; -- gfc_option.flag_init_character = GFC_INIT_CHARACTER_ON; -- gfc_option.flag_init_character_value = (char)0; -+ set_init_local_zero (value); - break; - - case OPT_finit_logical_: -@@ -798,12 +792,8 @@ gfc_handle_option (size_t scode, const char *arg, HOST_WIDE_INT value, - break; - - case OPT_fdec: -- /* Enable all DEC extensions. */ -- set_dec_flags (1); -- break; -- -- case OPT_fdec_structure: -- flag_dec_structure = 1; -+ /* Set (or unset) the DEC extension flags. */ -+ set_dec_flags (value); - break; - } - -@@ -895,3 +885,7 @@ gfc_get_option_string (void) - result[--pos] = '\0'; - return result; - } -+ -+#undef SET_BITFLAG -+#undef SET_BITFLAG2 -+#undef SET_FLAG diff --git a/SOURCES/gcc8-fortran-pr87919.patch b/SOURCES/gcc8-fortran-pr87919.patch deleted file mode 100644 index bda21dc..0000000 --- a/SOURCES/gcc8-fortran-pr87919.patch +++ /dev/null @@ -1,419 +0,0 @@ -2018-12-03 Fritz Reese - Mark Eggleston - - PR fortran/87919 - * options.c (SET_FLAG, SET_BITFLAG, SET_BITFLAG2): New macros. - (set_dec_flags): Set/unset DEC and std flags according to value. - (set_init_local_zero): New helper for -finit-local-zero flag group. - (gfc_init_options): Fix disabling of init flags, array temporaries - check, and dec flags when value is zero (from -fno-*). - -diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c -index e59ba31ba7b..b35bed32974 100644 ---- a/gcc/fortran/options.c -+++ b/gcc/fortran/options.c -@@ -32,6 +32,20 @@ along with GCC; see the file COPYING3. If not see - - gfc_option_t gfc_option; - -+#define SET_FLAG(flag, condition, on_value, off_value) \ -+ do \ -+ { \ -+ if (condition) \ -+ flag = (on_value); \ -+ else \ -+ flag = (off_value); \ -+ } while (0) -+ -+#define SET_BITFLAG2(m) m -+ -+#define SET_BITFLAG(flag, condition, value) \ -+ SET_BITFLAG2 (SET_FLAG (flag, condition, (flag | (value)), (flag & ~(value)))) -+ - - /* Set flags that control warnings and errors for different - Fortran standards to their default values. Keep in sync with -@@ -47,30 +61,55 @@ set_default_std_flags (void) - gfc_option.warn_std = GFC_STD_F95_DEL | GFC_STD_LEGACY; - } - -- --/* Set all the DEC extension flags. */ -+/* Set (or unset) the DEC extension flags. */ - - static void - set_dec_flags (int value) - { -+ /* Set (or unset) other DEC compatibility extensions. */ -+ SET_BITFLAG (flag_dollar_ok, value, value); -+ SET_BITFLAG (flag_cray_pointer, value, value); -+ SET_BITFLAG (flag_dec_structure, value, value); -+ SET_BITFLAG (flag_dec_intrinsic_ints, value, value); -+ SET_BITFLAG (flag_dec_static, value, value); -+ SET_BITFLAG (flag_dec_math, value, value); -+ SET_BITFLAG (flag_dec_include, value, value); -+} -+ -+/* Finalize DEC flags. */ -+ -+static void -+post_dec_flags (int value) -+{ -+ /* Don't warn for legacy code if -fdec is given; however, setting -fno-dec -+ does not force these warnings. We make one final determination on this -+ at the end because -std= is always set first; thus, we can avoid -+ clobbering the user's desired standard settings in gfc_handle_option -+ e.g. when -fdec and -fno-dec are both given. */ - if (value) - { -- /* Allow legacy code without warnings. */ - gfc_option.allow_std |= GFC_STD_F95_OBS | GFC_STD_F95_DEL -- | GFC_STD_GNU | GFC_STD_LEGACY; -+ | GFC_STD_GNU | GFC_STD_LEGACY; - gfc_option.warn_std &= ~(GFC_STD_LEGACY | GFC_STD_F95_DEL); - } -- -- /* Set other DEC compatibility extensions. */ -- flag_dollar_ok |= value; -- flag_cray_pointer |= value; -- flag_dec_structure |= value; -- flag_dec_intrinsic_ints |= value; -- flag_dec_static |= value; -- flag_dec_math |= value; -- flag_dec_include |= value; - } - -+/* Enable (or disable) -finit-local-zero. */ -+ -+static void -+set_init_local_zero (int value) -+{ -+ gfc_option.flag_init_integer_value = 0; -+ gfc_option.flag_init_character_value = (char)0; -+ -+ SET_FLAG (gfc_option.flag_init_integer, value, GFC_INIT_INTEGER_ON, -+ GFC_INIT_INTEGER_OFF); -+ SET_FLAG (gfc_option.flag_init_logical, value, GFC_INIT_LOGICAL_FALSE, -+ GFC_INIT_LOGICAL_OFF); -+ SET_FLAG (gfc_option.flag_init_character, value, GFC_INIT_CHARACTER_ON, -+ GFC_INIT_CHARACTER_OFF); -+ SET_FLAG (flag_init_real, value, GFC_INIT_REAL_ZERO, GFC_INIT_REAL_OFF); -+} - - /* Return language mask for Fortran options. */ - -diff --git a/gcc/testsuite/gfortran.dg/array_temporaries_5.f90 b/gcc/testsuite/gfortran.dg/array_temporaries_5.f90 -new file mode 100644 -index 00000000000..dd147ba38ed ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/array_temporaries_5.f90 -@@ -0,0 +1,10 @@ -+! { dg-do run } -+! { dg-options "-fcheck-array-temporaries -fno-check-array-temporaries" } -+! -+! PR fortran/87919 -+! -+! Ensure -fno-check-array-temporaries disables array temporary checking. -+! -+ -+! Note that 'include' drops the dg-output check from the original test case. -+include 'array_temporaries_2.f90' -diff --git a/gcc/testsuite/gfortran.dg/dec_bitwise_ops_3.f90 b/gcc/testsuite/gfortran.dg/dec_bitwise_ops_3.f90 -new file mode 100644 -index 00000000000..c28cf81fc04 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_bitwise_ops_3.f90 -@@ -0,0 +1,29 @@ -+! { dg-do compile } -+! { dg-options "-std=legacy -fdec -fno-dec" } -+! -+! PR fortran/87919 -+! -+! Make sure -fno-dec disables bitwise ops and check for the right errors. -+! -std=legacy is added to avoid the .XOR. extension warning. -+! -+ -+include 'dec_bitwise_ops_1.f90' -+ -+! { dg-error "Operands of logical operator" " " { target *-*-* } 33 } -+! { dg-error "Operands of logical operator" " " { target *-*-* } 34 } -+! { dg-error "Operands of logical operator" " " { target *-*-* } 35 } -+! { dg-error "Operands of logical operator" " " { target *-*-* } 46 } -+! { dg-error "Operands of logical operator" " " { target *-*-* } 47 } -+! { dg-error "Operands of logical operator" " " { target *-*-* } 48 } -+! { dg-error "Operands of logical operator" " " { target *-*-* } 59 } -+! { dg-error "Operands of logical operator" " " { target *-*-* } 60 } -+! { dg-error "Operands of logical operator" " " { target *-*-* } 61 } -+! { dg-error "Operand of .not. operator" " " { target *-*-* } 72 } -+! { dg-error "Operand of .not. operator" " " { target *-*-* } 73 } -+! { dg-error "Operand of .not. operator" " " { target *-*-* } 74 } -+! { dg-error "Operands of logical operator" " " { target *-*-* } 85 } -+! { dg-error "Operands of logical operator" " " { target *-*-* } 86 } -+! { dg-error "Operands of logical operator" " " { target *-*-* } 87 } -+! { dg-error "Operands of logical operator" " " { target *-*-* } 98 } -+! { dg-error "Operands of logical operator" " " { target *-*-* } 99 } -+! { dg-error "Operands of logical operator" " " { target *-*-* } 100 } -diff --git a/gcc/testsuite/gfortran.dg/dec_d_lines_3.f b/gcc/testsuite/gfortran.dg/dec_d_lines_3.f -new file mode 100644 -index 00000000000..2df4341c0e4 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_d_lines_3.f -@@ -0,0 +1,14 @@ -+! { dg-do compile } -+! { dg-options "-ffixed-form -fdec -fno-dec" } -+! -+! PR fortran/87919 -+! -+! Ensure -fno-dec disables -fdec, leaving d-lines as code by default. -+! -+ -+include 'dec_d_lines_2.f' -+ -+! { dg-error "character in statement label" " " { target *-*-*} 6 } -+! { dg-error "Unclassifiable statement" " " { target *-*-*} 6 } -+! { dg-error "character in statement label" " " { target *-*-*} 7 } -+! { dg-error "Unclassifiable statement" " " { target *-*-*} 7 } -diff --git a/gcc/testsuite/gfortran.dg/dec_exp_4.f90 b/gcc/testsuite/gfortran.dg/dec_exp_4.f90 -new file mode 100644 -index 00000000000..9d8b10db6a7 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_exp_4.f90 -@@ -0,0 +1,12 @@ -+! { dg-do compile } -+! { dg-options "-fdec -fno-dec" } -+! -+! PR fortran/87919 -+! -+! Make sure -fno-dec disables -fdec as with dec_exp_2. -+! -+ -+include 'dec_exp_2.f90' -+ -+! { dg-error "Missing exponent" "" { target *-*-* } 9 } -+! { dg-error "Missing exponent" "" { target *-*-* } 11 } -diff --git a/gcc/testsuite/gfortran.dg/dec_exp_5.f90 b/gcc/testsuite/gfortran.dg/dec_exp_5.f90 -new file mode 100644 -index 00000000000..faf3a9b306b ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_exp_5.f90 -@@ -0,0 +1,11 @@ -+! { dg-do run "xfail *-*-*" } -+! { dg-options "-fdec -fno-dec" } -+! -+! PR fortran/87919 -+! -+! Make sure -fno-dec disables -fdec as with dec_exp_3. -+! -+ -+include 'dec_exp_3.f90' -+ -+! { XFAIL "Bad real number" "" { target *-*-* } 13 } -diff --git a/gcc/testsuite/gfortran.dg/dec_io_7.f90 b/gcc/testsuite/gfortran.dg/dec_io_7.f90 -new file mode 100644 -index 00000000000..4a931c15fe7 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_io_7.f90 -@@ -0,0 +1,20 @@ -+! { dg-do compile } -+! { dg-options "-fdec -fno-dec" } -+! -+! PR fortran/87919 -+! -+! Make sure -fno-dec rejects -fdec I/O specifiers as with dec_io_1. -+! -+ -+include 'dec_io_1.f90' -+ -+! { dg-error "is a DEC extension" "" { target *-*-* } 12 } -+! { dg-error "is a DEC extension" "" { target *-*-* } 24 } -+! { dg-error "is a DEC extension" "" { target *-*-* } 58 } -+! { dg-error "is a DEC extension" "" { target *-*-* } 64 } -+! { dg-error "is a DEC extension" "" { target *-*-* } 68 } -+! { dg-error "is a DEC extension" "" { target *-*-* } 74 } -+! { dg-error "is a DEC extension" "" { target *-*-* } 78 } -+! { dg-error "is a DEC extension" "" { target *-*-* } 84 } -+! { dg-error "is a DEC extension" "" { target *-*-* } 90 } -+! { dg-error "is a DEC extension" "" { target *-*-* } 96 } -diff --git a/gcc/testsuite/gfortran.dg/dec_structure_24.f90 b/gcc/testsuite/gfortran.dg/dec_structure_24.f90 -new file mode 100644 -index 00000000000..02842b315dc ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_structure_24.f90 -@@ -0,0 +1,32 @@ -+! { dg-do compile } -+! -+! PR fortran/87919 -+! -+! Should fail to compile without the -fdec or -fdec-structure options. -+! -+! Contributed by Mark Eggleston -+ -+include 'dec_structure_1.f90' -+ -+! { dg-error "-fdec-structure" " " { target *-*-* } 14 } -+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 19 } -+! { dg-error "-fdec-structure" " " { target *-*-* } 21 } -+! { dg-error "-fdec-structure" " " { target *-*-* } 22 } -+! { dg-error "Unclassifiable statement" " " { target *-*-* } 25 } -+! { dg-error "Unclassifiable statement" " " { target *-*-* } 26 } -+! { dg-error "Unclassifiable statement" " " { target *-*-* } 27 } -+! { dg-error "Unclassifiable statement" " " { target *-*-* } 28 } -+! { dg-error "is not a variable" " " { target *-*-* } 30 } -+! { dg-error "Bad character" " " { target *-*-* } 32 } -+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 34 } -+! { dg-error "Bad character" " " { target *-*-* } 36 } -+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 38 } -+! { dg-error "Bad character" " " { target *-*-* } 40 } -+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 42 } -+! { dg-error "Bad character" " " { target *-*-* } 44 } -+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 46 } -+! { dg-error "Bad character" " " { target *-*-* } 48 } -+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 50 } -+! { dg-error "Bad character" " " { target *-*-* } 52 } -+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 54 } -+! { dg-error "function result" " " { target *-*-* } 29 } -diff --git a/gcc/testsuite/gfortran.dg/dec_structure_25.f90 b/gcc/testsuite/gfortran.dg/dec_structure_25.f90 -new file mode 100644 -index 00000000000..a64d85a88a4 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_structure_25.f90 -@@ -0,0 +1,11 @@ -+! { dg-do run } -+! { dg-options "-fdec" } -+! -+! PR fortran/87919 -+! -+! Should compile and run with the -fdec option. -+! -+! Contributed by Mark Eggleston -+! -+ -+include 'dec_structure_1.f90' -diff --git a/gcc/testsuite/gfortran.dg/dec_structure_26.f90 b/gcc/testsuite/gfortran.dg/dec_structure_26.f90 -new file mode 100644 -index 00000000000..7829103b995 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_structure_26.f90 -@@ -0,0 +1,34 @@ -+! { dg-do compile } -+! { dg-options "-fdec -fno-dec-structure" } -+! -+! PR fortran/87919 -+! -+! Should fail to compile with -fdec and -fno-dec-structure. -+! -+! Contributed by Mark Eggleston -+! -+ -+include 'dec_structure_1.f90' -+ -+! { dg-error "-fdec-structure" " " { target *-*-* } 14 } -+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 19 } -+! { dg-error "-fdec-structure" " " { target *-*-* } 21 } -+! { dg-error "-fdec-structure" " " { target *-*-* } 22 } -+! { dg-error "Unclassifiable statement" " " { target *-*-* } 25 } -+! { dg-error "Unclassifiable statement" " " { target *-*-* } 26 } -+! { dg-error "Unclassifiable statement" " " { target *-*-* } 27 } -+! { dg-error "Unclassifiable statement" " " { target *-*-* } 28 } -+! { dg-error "is not a variable" " " { target *-*-* } 30 } -+! { dg-error "Bad character" " " { target *-*-* } 32 } -+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 34 } -+! { dg-error "Bad character" " " { target *-*-* } 36 } -+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 38 } -+! { dg-error "Bad character" " " { target *-*-* } 40 } -+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 42 } -+! { dg-error "Bad character" " " { target *-*-* } 44 } -+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 46 } -+! { dg-error "Bad character" " " { target *-*-* } 48 } -+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 50 } -+! { dg-error "Bad character" " " { target *-*-* } 52 } -+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 54 } -+! { dg-error "function result" " " { target *-*-* } 29 } -diff --git a/gcc/testsuite/gfortran.dg/dec_structure_27.f90 b/gcc/testsuite/gfortran.dg/dec_structure_27.f90 -new file mode 100644 -index 00000000000..1257365deb8 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_structure_27.f90 -@@ -0,0 +1,34 @@ -+! { dg-do compile } -+! { dg-options "-fdec-structure -fno-dec-structure" } -+! -+! PR fortran/87919 -+! -+! Should fail to compile with -fdec-structure and -fno-dec-structure. -+! -+! Contributed by Mark Eggleston -+! -+ -+include 'dec_structure_1.f90' -+ -+! { dg-error "-fdec-structure" " " { target *-*-* } 14 } -+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 19 } -+! { dg-error "-fdec-structure" " " { target *-*-* } 21 } -+! { dg-error "-fdec-structure" " " { target *-*-* } 22 } -+! { dg-error "Unclassifiable statement" " " { target *-*-* } 25 } -+! { dg-error "Unclassifiable statement" " " { target *-*-* } 26 } -+! { dg-error "Unclassifiable statement" " " { target *-*-* } 27 } -+! { dg-error "Unclassifiable statement" " " { target *-*-* } 28 } -+! { dg-error "is not a variable" " " { target *-*-* } 30 } -+! { dg-error "Bad character" " " { target *-*-* } 32 } -+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 34 } -+! { dg-error "Bad character" " " { target *-*-* } 36 } -+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 38 } -+! { dg-error "Bad character" " " { target *-*-* } 40 } -+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 42 } -+! { dg-error "Bad character" " " { target *-*-* } 44 } -+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 46 } -+! { dg-error "Bad character" " " { target *-*-* } 48 } -+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 50 } -+! { dg-error "Bad character" " " { target *-*-* } 52 } -+! { dg-error "Expecting END PROGRAM" " " { target *-*-* } 54 } -+! { dg-error "function result" " " { target *-*-* } 29 } -diff --git a/gcc/testsuite/gfortran.dg/dec_type_print_3.f90 b/gcc/testsuite/gfortran.dg/dec_type_print_3.f90 -new file mode 100644 -index 00000000000..f766bdf0022 ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/dec_type_print_3.f90 -@@ -0,0 +1,21 @@ -+! { dg-do compile } -+! { dg-options "-fdec -fno-dec" } -+! -+! PR fortran/87919 -+! -+! Ensure that -fno-dec disables the usage of TYPE as an alias for PRINT. -+! -+ -+include 'dec_type_print.f90' -+ -+! { dg-error "Invalid character in name" "" { target *-*-* } 52 } -+! { dg-error "Invalid character in name" "" { target *-*-* } 53 } -+! { dg-error "Invalid character in name" "" { target *-*-* } 54 } -+! { dg-error "Invalid character in name" "" { target *-*-* } 55 } -+! { dg-error "Invalid character in name" "" { target *-*-* } 56 } -+! { dg-error "Invalid character in name" "" { target *-*-* } 57 } -+! { dg-error "Invalid character in name" "" { target *-*-* } 58 } -+! { dg-error "Unclassifiable statement" "" { target *-*-* } 59 } -+! { dg-error "conflicts with PROCEDURE" "" { target *-*-* } 60 } -+! { dg-error "Cannot assign to a named constant" "" { target *-*-* } 80 } -+ -diff --git a/gcc/testsuite/gfortran.dg/init_flag_20.f90 b/gcc/testsuite/gfortran.dg/init_flag_20.f90 -new file mode 100644 -index 00000000000..6f15c1ace0d ---- /dev/null -+++ b/gcc/testsuite/gfortran.dg/init_flag_20.f90 -@@ -0,0 +1,15 @@ -+! { dg-do compile } -+! { dg-options "-fbackslash -finit-local-zero -fno-init-local-zero -fdump-tree-original" } -+! -+! PR fortran/87919 -+! -+! Make sure -fno-init-local-zero disables -finit-local-zero. -+! -+ -+include 'init_flag_1.f90' -+ -+! Make sure no initialization code is generated. -+! { dg-final { scan-tree-dump-times "r\[1-4] *= *\[0\{]" 0 "original" } } -+! { dg-final { scan-tree-dump-times "l\[12] *= *\[0\{]" 0 "original" } } -+! { dg-final { scan-tree-dump-times "i\[1-4] *= *\[0\{]" 0 "original" } } -+! { dg-final { scan-tree-dump-times "memmove *\[(]\[^,]*c\[1-4]" 0 "original" } } diff --git a/SOURCES/gcc8-fortranlines.patch b/SOURCES/gcc8-fortranlines.patch deleted file mode 100644 index 87600da..0000000 --- a/SOURCES/gcc8-fortranlines.patch +++ /dev/null @@ -1,36 +0,0 @@ -diff -Nrup a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c ---- a/gcc/fortran/scanner.c 2017-03-08 12:35:48.000000000 -0500 -+++ b/gcc/fortran/scanner.c 2018-05-03 19:01:52.000000000 -0400 -@@ -2097,6 +2097,10 @@ preprocessor_line (gfc_char_t *c) - in the linemap. Alternative could be using GC or updating linemap to - point to the new name, but there is no API for that currently. */ - current_file->filename = xstrdup (filename); -+ -+ /* We need to tell the linemap API that the filename changed. Just -+ changing current_file is insufficient. */ -+ linemap_add (line_table, LC_RENAME, false, current_file->filename, line); - } - - /* Set new line number. */ -diff -Nrup a/gcc/testsuite/gfortran.dg/linefile.f90 b/gcc/testsuite/gfortran.dg/linefile.f90 ---- a/gcc/testsuite/gfortran.dg/linefile.f90 1969-12-31 19:00:00.000000000 -0500 -+++ b/gcc/testsuite/gfortran.dg/linefile.f90 2018-05-07 13:34:22.000000000 -0400 -@@ -0,0 +1,18 @@ -+! { dg-do compile } -+! { dg-options "-Wall" } -+ -+! This will verify that the # directive later does not -+! mess up the diagnostic on this line -+SUBROUTINE s(dummy) ! { dg-warning "Unused" } -+ INTEGER, INTENT(in) :: dummy -+END SUBROUTINE -+ -+# 12345 "foo-f" -+SUBROUTINE s2(dummy) -+ INTEGER, INTENT(in) :: dummy -+END SUBROUTINE -+! We want to check that the # directive changes the filename in the -+! diagnostic. Nothing else really matters here. dg-regexp allows us -+! to see the entire diagnostic. We just have to make sure to consume -+! the entire message. -+! { dg-regexp "foo-f\[^\n]*" } diff --git a/SOURCES/gcc9-add-sve-tests.patch b/SOURCES/gcc9-add-sve-tests.patch new file mode 100644 index 0000000..e0368f3 --- /dev/null +++ b/SOURCES/gcc9-add-sve-tests.patch @@ -0,0 +1,159 @@ +These tests are missing from the r273140 commit in gcc-9-branch. + +--- /dev/null ++++ gcc/testsuite/gcc.target/aarch64/pcs_attribute-2.c +@@ -0,0 +1,93 @@ ++/* { dg-do compile } */ ++/* { dg-require-effective-target aarch64_variant_pcs } */ ++ ++/* Test that .variant_pcs is emitted for vector PCS symbol references. */ ++ ++#define ATTR __attribute__ ((aarch64_vector_pcs)) ++ ++void f_undef_basepcs (void); ++ ++void f_def_basepcs (void) ++{ ++} ++ ++ATTR void f_undef_vpcs (void); ++ ++ATTR void f_def_vpcs (void) ++{ ++} ++ ++__attribute__ ((alias ("f_def_vpcs"))) ++ATTR void f_alias_vpcs (void); ++ ++__attribute__ ((weak, alias ("f_def_vpcs"))) ++ATTR void f_weak_alias_vpcs (void); ++ ++__attribute__ ((weak)) ++ATTR void f_weak_undef_vpcs (void); ++ ++__attribute__ ((visibility ("protected"))) ++ATTR void f_protected_vpcs (void) ++{ ++} ++ ++__attribute__ ((visibility ("hidden"))) ++ATTR void f_hidden_vpcs (void) ++{ ++} ++ ++ATTR static void f_local_vpcs (void) ++{ ++} ++ ++__attribute__((weakref ("f_undef_vpcs"))) ++ATTR static void f_local_weakref_undef_vpcs (void); ++ ++__attribute__((weakref ("f_hidden_vpcs"))) ++ATTR static void f_local_weakref_def_vpcs (void); ++ ++ATTR void bar_undef_vpcs (void) __asm__ ("f_undef_renamed_vpcs"); ++ ++ATTR void bar_def_vpcs (void) __asm__ ("f_def_renamed_vpcs"); ++ATTR void bar_def_vpcs (void) ++{ ++} ++ ++void (*refs_basepcs[]) (void) = { ++ f_undef_basepcs, ++ f_def_basepcs, ++}; ++ ++void (*ATTR refs_vpcs[]) (void) = { ++ f_undef_vpcs, ++ f_def_vpcs, ++ f_alias_vpcs, ++ f_weak_alias_vpcs, ++ f_weak_undef_vpcs, ++ f_protected_vpcs, ++ f_hidden_vpcs, ++ f_local_vpcs, ++ f_local_weakref_undef_vpcs, ++ f_local_weakref_def_vpcs, ++ bar_undef_vpcs, ++ bar_def_vpcs, ++}; ++ ++/* Note: local symbols don't need .variant_pcs, but gcc generates it, so ++ we check them here. An undefined weakref does not show up in the ++ symbol table, only the target symbol, so it does not need .variant_pcs. */ ++ ++/* { dg-final { scan-assembler-not {\.variant_pcs\tf_undef_basepcs} } } */ ++/* { dg-final { scan-assembler-not {\.variant_pcs\tf_def_basepcs} } } */ ++/* { dg-final { scan-assembler-times {\.variant_pcs\tf_undef_vpcs} 1 } } */ ++/* { dg-final { scan-assembler-times {\.variant_pcs\tf_def_vpcs} 1 } } */ ++/* { dg-final { scan-assembler-times {\.variant_pcs\tf_alias_vpcs} 1 } } */ ++/* { dg-final { scan-assembler-times {\.variant_pcs\tf_weak_alias_vpcs} 1 } } */ ++/* { dg-final { scan-assembler-times {\.variant_pcs\tf_weak_undef_vpcs} 1 } } */ ++/* { dg-final { scan-assembler-times {\.variant_pcs\tf_protected_vpcs} 1 } } */ ++/* { dg-final { scan-assembler-times {\.variant_pcs\tf_hidden_vpcs} 1 } } */ ++/* { dg-final { scan-assembler-times {\.variant_pcs\tf_local_vpcs} 1 } } */ ++/* { dg-final { scan-assembler-not {\.variant_pcs\tf_local_weakref_undef_vpcs} } } */ ++/* { dg-final { scan-assembler-times {\.variant_pcs\tf_local_weakref_def_vpcs} 1 } } */ ++/* { dg-final { scan-assembler-times {\.variant_pcs\tf_undef_renamed_vpcs} 1 } } */ ++/* { dg-final { scan-assembler-times {\.variant_pcs\tf_def_renamed_vpcs} 1 } } */ +--- /dev/null ++++ gcc/testsuite/gcc.target/aarch64/pcs_attribute-3.c +@@ -0,0 +1,58 @@ ++/* { dg-do compile } */ ++/* { dg-require-ifunc "" } */ ++/* { dg-require-effective-target aarch64_variant_pcs } */ ++ ++/* Test that .variant_pcs is emitted for vector PCS symbol references. */ ++ ++#define ATTR __attribute__ ((aarch64_vector_pcs)) ++ ++static void f_local_basepcs (void) ++{ ++} ++ ++static void (*f_ifunc_basepcs_resolver ()) (void) ++{ ++ return (void (*)(void))f_local_basepcs; ++} ++ ++__attribute__ ((ifunc ("f_ifunc_basepcs_resolver"))) ++void f_ifunc_basepcs (void); ++ ++ATTR static void f_local_vpcs (void) ++{ ++} ++ ++static void (*f_ifunc_vpcs_resolver ()) (void) ++{ ++ return (void (*)(void))f_local_vpcs; ++} ++ ++__attribute__ ((ifunc ("f_ifunc_vpcs_resolver"))) ++ATTR void f_ifunc_vpcs (void); ++ ++__attribute__ ((visibility ("hidden"))) ++__attribute__ ((ifunc ("f_ifunc_vpcs_resolver"))) ++ATTR void f_hidden_ifunc_vpcs (void); ++ ++__attribute__ ((ifunc ("f_ifunc_vpcs_resolver"))) ++ATTR static void f_local_ifunc_vpcs (void); ++ ++void (*refs_basepcs[]) (void) = { ++ f_ifunc_basepcs, ++}; ++ ++void (*ATTR refs_vpcs[]) (void) = { ++ f_ifunc_vpcs, ++ f_hidden_ifunc_vpcs, ++ f_local_ifunc_vpcs, ++}; ++ ++/* Note: local symbols don't need .variant_pcs, but gcc generates it, so ++ we check them here. */ ++ ++/* { dg-final { scan-assembler-not {\.variant_pcs\tf_local_basepcs} } } */ ++/* { dg-final { scan-assembler-not {\.variant_pcs\tf_ifunc_basepcs} } } */ ++/* { dg-final { scan-assembler-times {\.variant_pcs\tf_local_vpcs} 1 } } */ ++/* { dg-final { scan-assembler-times {\.variant_pcs\tf_ifunc_vpcs} 1 } } */ ++/* { dg-final { scan-assembler-times {\.variant_pcs\tf_hidden_ifunc_vpcs} 1 } } */ ++/* { dg-final { scan-assembler-times {\.variant_pcs\tf_local_ifunc_vpcs} 1 } } */ diff --git a/SOURCES/gcc9-fixes.patch b/SOURCES/gcc9-fixes.patch new file mode 100644 index 0000000..e0af38d --- /dev/null +++ b/SOURCES/gcc9-fixes.patch @@ -0,0 +1,481 @@ +2019-11-22 Jonathan Wakely + + Backport from mainline + 2019-10-29 Jonathan Wakely + + PR libstdc++/92267 + * include/bits/stl_deque.h (_Deque_iterator(const _Deque_iterator&)): + Do not define as defaulted. + * testsuite/23_containers/deque/types/92267.cc: New test. + +2019-11-21 Jakub Jelinek + + PR tree-optimization/91355 + * tree-ssa-sink.c (select_best_block): Use >= rather than > + for early_bb scaled count with best_bb count comparison. + +2019-11-21 Richard Biener + + Revert + 2019-09-17 Richard Biener + + PR tree-optimization/91790 + * tree-vect-stmts.c (vectorizable_load): For BB vectorization + use the correct DR for setting up realignment. + +2019-11-20 Peter Bergner + + Backport from mainline + 2019-11-07 Peter Bergner + + PR other/92090 + * config/rs6000/predicates.md (input_operand): Allow MODE_PARTIAL_INT + modes for integer constants. + +2019-11-20 Michael Matz + + Backport from mainline + PR middle-end/90796 + * gimple-loop-jam.c (any_access_function_variant_p): New function. + (adjust_unroll_factor): Use it to constrain safety, new parameter. + (tree_loop_unroll_and_jam): Adjust call and profitable unroll factor. + +2019-11-20 Joseph Myers + + * doc/invoke.texi (-Wc11-c2x-compat): Document. + +--- libstdc++-v3/include/bits/stl_deque.h (revision 278492) ++++ libstdc++-v3/include/bits/stl_deque.h (revision 278614) +@@ -158,13 +158,16 @@ + #else + // Conversion from iterator to const_iterator. + template, +- is_same<_Iter, iterator>>> ++ typename = _Require, ++ is_same<_Iter, iterator>>> + _Deque_iterator(const _Iter& __x) noexcept + : _M_cur(__x._M_cur), _M_first(__x._M_first), +- _M_last(__x._M_last), _M_node(__x._M_node) { } ++ _M_last(__x._M_last), _M_node(__x._M_node) { } + +- _Deque_iterator(const _Deque_iterator&) = default; ++ _Deque_iterator(const _Deque_iterator& __x) noexcept ++ : _M_cur(__x._M_cur), _M_first(__x._M_first), ++ _M_last(__x._M_last), _M_node(__x._M_node) { } ++ + _Deque_iterator& operator=(const _Deque_iterator&) = default; + #endif + +--- libstdc++-v3/testsuite/23_containers/deque/types/92267.cc (nonexistent) ++++ libstdc++-v3/testsuite/23_containers/deque/types/92267.cc (revision 278614) +@@ -0,0 +1,27 @@ ++// Copyright (C) 2019 Free Software Foundation, Inc. ++// ++// This file is part of the GNU ISO C++ Library. This library is free ++// software; you can redistribute it and/or modify it under the ++// terms of the GNU General Public License as published by the ++// Free Software Foundation; either version 3, or (at your option) ++// any later version. ++ ++// This library is distributed in the hope that it will be useful, ++// but WITHOUT ANY WARRANTY; without even the implied warranty of ++// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++// GNU General Public License for more details. ++ ++// You should have received a copy of the GNU General Public License along ++// with this library; see the file COPYING3. If not see ++// . ++ ++// { dg-do compile { target c++11 } } ++ ++#include ++ ++using std::deque; ++using std::is_trivially_copy_constructible; ++ ++// PR libstdc++/92267 ++static_assert(!is_trivially_copy_constructible::iterator>::value); ++static_assert(!is_trivially_copy_constructible::const_iterator>::value); +--- gcc/doc/invoke.texi (revision 278492) ++++ gcc/doc/invoke.texi (revision 278614) +@@ -292,6 +292,7 @@ + -Wbool-compare -Wbool-operation @gol + -Wno-builtin-declaration-mismatch @gol + -Wno-builtin-macro-redefined -Wc90-c99-compat -Wc99-c11-compat @gol ++-Wc11-c2x-compat @gol + -Wc++-compat -Wc++11-compat -Wc++14-compat -Wc++17-compat @gol + -Wcast-align -Wcast-align=strict -Wcast-function-type -Wcast-qual @gol + -Wchar-subscripts -Wcatch-value -Wcatch-value=@var{n} @gol +@@ -6698,6 +6699,14 @@ + and so on. This option is independent of the standards mode. Warnings are + disabled in the expression that follows @code{__extension__}. + ++@item -Wc11-c2x-compat @r{(C and Objective-C only)} ++@opindex Wc11-c2x-compat ++@opindex Wno-c11-c2x-compat ++Warn about features not present in ISO C11, but present in ISO C2X. ++For instance, warn about omitting the string in @code{_Static_assert}. ++This option is independent of the standards mode. Warnings are ++disabled in the expression that follows @code{__extension__}. ++ + @item -Wc++-compat @r{(C and Objective-C only)} + @opindex Wc++-compat + @opindex Wno-c++-compat +--- gcc/testsuite/gcc.target/powerpc/pr92090-2.c (nonexistent) ++++ gcc/testsuite/gcc.target/powerpc/pr92090-2.c (revision 278614) +@@ -0,0 +1,45 @@ ++/* { dg-do compile } */ ++/* { dg-options "-mdejagnu-cpu=power8 -Os -w" } */ ++/* { dg-additional-options "-mbig" { target powerpc64le-*-* } } */ ++ ++/* Verify that we don't ICE. */ ++ ++int a; ++static _Atomic long double b, c, d, m; ++double n; ++extern int foo (void); ++extern void bar (int, int, int, int); ++ ++void ++bug (void) ++{ ++ b = 1.79769313486231580793728971405301199e308L; ++ for (int i = 0; i < 10000; i++) ++ if (__builtin_isinf (n)) ++ b; ++ c = 1; ++ int e, f, g, h; ++ while (a) ++ ; ++ for (int i; i; i++) ++ { ++ double j = c /= foo (); ++ if (__builtin_isinf (j)) ++ { ++ if (foo == 1 << 31) ++ e++; ++ f++; ++ c = 0; ++ } ++ else ++ { ++ if (foo == 1 << 30) ++ g++; ++ h++; ++ c = 1; ++ } ++ } ++ bar (e, f, g, h); ++ d = 1.79769313486231580793728971405301199e308L; ++ m = 1; ++} +--- gcc/testsuite/gcc.target/powerpc/pr92090.c (nonexistent) ++++ gcc/testsuite/gcc.target/powerpc/pr92090.c (revision 278614) +@@ -0,0 +1,43 @@ ++/* { dg-do compile } */ ++/* { dg-options "-mdejagnu-cpu=power8 -Os" } */ ++/* { dg-additional-options "-mbig" { target powerpc64le-*-* } } */ ++ ++/* Verify that we don't ICE. */ ++ ++_Atomic int a; ++_Atomic long double b, c; ++int j; ++void foo (void); ++void bar (int, int, int, int); ++ ++void ++bug (void) ++{ ++ b = 1; ++ int d, e, f, g; ++ while (a) ++ ; ++ for (int h = 0; h < 10000; h++) ++ { ++ double i = b /= 3; ++ foo (); ++ if (i) ++ { ++ if (i == 1) ++ d++; ++ e++; ++ b = 0; ++ } ++ else ++ { ++ if (i == 2) ++ f++; ++ g++; ++ b = 1; ++ } ++ } ++ bar (d, e, f, g); ++ c = 1; ++ for (int h; h; h++) ++ j = 0; ++} +--- gcc/testsuite/gcc.dg/unroll-and-jam.c (revision 278492) ++++ gcc/testsuite/gcc.dg/unroll-and-jam.c (revision 278614) +@@ -1,5 +1,5 @@ + /* { dg-do run } */ +-/* { dg-options "-O3 -floop-unroll-and-jam --param unroll-jam-min-percent=0 -fdump-tree-unrolljam-details" } */ ++/* { dg-options "-O3 -floop-unroll-and-jam -fno-tree-loop-im --param unroll-jam-min-percent=0 -fdump-tree-unrolljam-details" } */ + /* { dg-require-effective-target int32plus } */ + + #include +@@ -34,7 +34,7 @@ + #define TEST(name, body, test) \ + static void __attribute__((noinline,noclone)) name (unsigned long n, unsigned long m) \ + { \ +- unsigned long i, j; \ ++ unsigned i, j; \ + for (i = 1; i < m; i++) { \ + for (j = 1; j < n; j++) { \ + body; \ +@@ -58,9 +58,14 @@ + TEST(foo4, aa[i][j] = aa[i-1][j+1] * aa[i-1][j+1] / 2, checkaa()) //notok, -1,1 + TEST(foo5, aa[i][j] = aa[i+1][j+1] * aa[i+1][j+1] / 2, checkaa()) //ok, 1,1 + TEST(foo6, aa[i][j] = aa[i+1][j] * aa[i+1][j] / 2, checkaa()) //ok, -1,0 ++TEST(foo61, aa[i][0] = aa[i+1][0] * aa[i+1][0] / 2, checkaa()) //notok, -1,0 ++TEST(foo62, aa[i][j/2] = aa[i+1][j/2] * aa[i+1][j/2] / 2, checkaa()) //notok, not affine ++TEST(foo63, aa[i][j%2] = aa[i+1][j%2] * aa[i+1][j%2] / 2, checkaa()) //notok, not affine + TEST(foo7, aa[i+1][j] = aa[i][j] * aa[i][j] / 2, checkaa()) //ok, 1,0 + TEST(foo9, b[j] = 3*b[j+1] + 1, checkb()) //notok, 0,-1 + TEST(foo10, b[j] = 3*b[j] + 1, checkb()) //ok, 0,0 ++extern int f; ++TEST(foo11, f = b[i-1] = 1 + 3* b[i+1], checkb()) //ok, 2,0 but must reduce unroll factor to 2, (it would be incorrect with unroll-by-3, which the profitability would suggest) + + /* foo8 should work as well, but currently doesn't because the distance + vectors we compute are too pessimistic. We compute +@@ -68,6 +73,7 @@ + and the last one causes us to lose. */ + TEST(foo8, b[j+1] = 3*b[j] + 1, checkb()) //ok, 0,1 + ++int f; + unsigned int a[1024]; + unsigned int b[1024]; + unsigned int aa[16][1024]; +@@ -88,10 +94,12 @@ + printf(" %s\n", #name); \ + init();for(i=0;i<4;i++)name##noopt(32,8); checka = checksum; \ + init();for(i=0;i<4;i++)name(32,8); \ ++ if (checka != checksum) fail = 1; \ + printf("%sok %s\n", checka != checksum ? "NOT " : "", #name); + + int main() + { ++ int fail = 0; + int i; + unsigned checka; + RUN(foo1); +@@ -100,12 +108,18 @@ + RUN(foo4); + RUN(foo5); + RUN(foo6); ++ RUN(foo61); ++ RUN(foo62); ++ RUN(foo63); + RUN(foo7); + RUN(foo8); + RUN(foo9); + RUN(foo10); +- return 0; ++ RUN(foo11); ++ if (fail) ++ __builtin_abort(); ++ return fail; + } + +-/* Five loops should be unroll-jammed (actually six, but see above). */ +-/* { dg-final { scan-tree-dump-times "applying unroll and jam" 5 "unrolljam" } } */ ++/* Six loops should be unroll-jammed (actually seven, but see above). */ ++/* { dg-final { scan-tree-dump-times "applying unroll and jam" 6 "unrolljam" } } */ +--- gcc/testsuite/g++.dg/torture/pr91355.C (nonexistent) ++++ gcc/testsuite/g++.dg/torture/pr91355.C (revision 278614) +@@ -0,0 +1,28 @@ ++// PR tree-optimization/91355 ++// { dg-do run } ++// { dg-options "-std=c++14" } ++ ++unsigned int d = 0; ++ ++struct S { ++ S () { d++; } ++ S (const S &) { d++; } ++ ~S () { d--; } ++}; ++ ++void ++foo (int i) throw (int) // { dg-warning "dynamic exception specifications are deprecated" } ++{ ++ if (i == 0) ++ throw 3; ++ S d; ++ throw 3; ++} ++ ++int ++main () ++{ ++ try { foo (1); } catch (...) {} ++ if (d) ++ __builtin_abort (); ++} +--- gcc/tree-ssa-sink.c (revision 278492) ++++ gcc/tree-ssa-sink.c (revision 278614) +@@ -229,7 +229,7 @@ + /* If result of comparsion is unknown, preffer EARLY_BB. + Thus use !(...>=..) rather than (...<...) */ + && !(best_bb->count.apply_scale (100, 1) +- > (early_bb->count.apply_scale (threshold, 1)))) ++ >= early_bb->count.apply_scale (threshold, 1))) + return best_bb; + + /* No better block found, so return EARLY_BB, which happens to be the +--- gcc/tree-vect-stmts.c (revision 278492) ++++ gcc/tree-vect-stmts.c (revision 278614) +@@ -8276,9 +8276,7 @@ + || alignment_support_scheme == dr_explicit_realign) + && !compute_in_loop) + { +- msq = vect_setup_realignment (first_stmt_info_for_drptr +- ? first_stmt_info_for_drptr +- : first_stmt_info, gsi, &realignment_token, ++ msq = vect_setup_realignment (first_stmt_info, gsi, &realignment_token, + alignment_support_scheme, NULL_TREE, + &at_loop); + if (alignment_support_scheme == dr_explicit_realign_optimized) +--- gcc/gimple-loop-jam.c (revision 278492) ++++ gcc/gimple-loop-jam.c (revision 278614) +@@ -360,9 +360,26 @@ + rewrite_into_loop_closed_ssa_1 (NULL, 0, SSA_OP_USE, loop); + } + ++/* Return true if any of the access functions for dataref A ++ isn't invariant with respect to loop LOOP_NEST. */ ++static bool ++any_access_function_variant_p (const struct data_reference *a, ++ const class loop *loop_nest) ++{ ++ unsigned int i; ++ vec fns = DR_ACCESS_FNS (a); ++ tree t; ++ ++ FOR_EACH_VEC_ELT (fns, i, t) ++ if (!evolution_function_is_invariant_p (t, loop_nest->num)) ++ return true; ++ ++ return false; ++} ++ + /* Returns true if the distance in DDR can be determined and adjusts + the unroll factor in *UNROLL to make unrolling valid for that distance. +- Otherwise return false. ++ Otherwise return false. DDR is with respect to the outer loop of INNER. + + If this data dep can lead to a removed memory reference, increment + *REMOVED and adjust *PROFIT_UNROLL to be the necessary unroll factor +@@ -369,7 +386,7 @@ + for this to happen. */ + + static bool +-adjust_unroll_factor (struct data_dependence_relation *ddr, ++adjust_unroll_factor (class loop *inner, struct data_dependence_relation *ddr, + unsigned *unroll, unsigned *profit_unroll, + unsigned *removed) + { +@@ -392,9 +409,59 @@ + gcc_unreachable (); + else if ((unsigned)dist >= *unroll) + ; +- else if (lambda_vector_lexico_pos (dist_v + 1, DDR_NB_LOOPS (ddr) - 1) +- || (lambda_vector_zerop (dist_v + 1, DDR_NB_LOOPS (ddr) - 1) +- && dist > 0)) ++ else if (lambda_vector_zerop (dist_v + 1, DDR_NB_LOOPS (ddr) - 1)) ++ { ++ /* We have (a,0) with a < N, so this will be transformed into ++ (0,0) after unrolling by N. This might potentially be a ++ problem, if it's not a read-read dependency. */ ++ if (DR_IS_READ (DDR_A (ddr)) && DR_IS_READ (DDR_B (ddr))) ++ ; ++ else ++ { ++ /* So, at least one is a write, and we might reduce the ++ distance vector to (0,0). This is still no problem ++ if both data-refs are affine with respect to the inner ++ loops. But if one of them is invariant with respect ++ to an inner loop our reordering implicit in loop fusion ++ corrupts the program, as our data dependences don't ++ capture this. E.g. for: ++ for (0 <= i < n) ++ for (0 <= j < m) ++ a[i][0] = a[i+1][0] + 2; // (1) ++ b[i][j] = b[i+1][j] + 2; // (2) ++ the distance vector for both statements is (-1,0), ++ but exchanging the order for (2) is okay, while ++ for (1) it is not. To see this, write out the original ++ accesses (assume m is 2): ++ a i j original ++ 0 0 0 r a[1][0] b[1][0] ++ 1 0 0 w a[0][0] b[0][0] ++ 2 0 1 r a[1][0] b[1][1] ++ 3 0 1 w a[0][0] b[0][1] ++ 4 1 0 r a[2][0] b[2][0] ++ 5 1 0 w a[1][0] b[1][0] ++ after unroll-by-2 and fusion the accesses are done in ++ this order (from column a): 0,1, 4,5, 2,3, i.e. this: ++ a i j transformed ++ 0 0 0 r a[1][0] b[1][0] ++ 1 0 0 w a[0][0] b[0][0] ++ 4 1 0 r a[2][0] b[2][0] ++ 5 1 0 w a[1][0] b[1][0] ++ 2 0 1 r a[1][0] b[1][1] ++ 3 0 1 w a[0][0] b[0][1] ++ Note how access 2 accesses the same element as access 5 ++ for array 'a' but not for array 'b'. */ ++ if (any_access_function_variant_p (DDR_A (ddr), inner) ++ && any_access_function_variant_p (DDR_B (ddr), inner)) ++ ; ++ else ++ /* And if any dataref of this pair is invariant with ++ respect to the inner loop, we have no chance than ++ to reduce the unroll factor. */ ++ *unroll = dist; ++ } ++ } ++ else if (lambda_vector_lexico_pos (dist_v + 1, DDR_NB_LOOPS (ddr) - 1)) + ; + else + *unroll = dist; +@@ -486,7 +553,7 @@ + /* Now check the distance vector, for determining a sensible + outer unroll factor, and for validity of merging the inner + loop copies. */ +- if (!adjust_unroll_factor (ddr, &unroll_factor, &profit_unroll, ++ if (!adjust_unroll_factor (loop, ddr, &unroll_factor, &profit_unroll, + &removed)) + { + /* Couldn't get the distance vector. For two reads that's +@@ -506,7 +573,7 @@ + to ignore all profitability concerns and apply the transformation + always. */ + if (!PARAM_VALUE (PARAM_UNROLL_JAM_MIN_PERCENT)) +- profit_unroll = 2; ++ profit_unroll = MAX(2, profit_unroll); + else if (removed * 100 / datarefs.length () + < (unsigned)PARAM_VALUE (PARAM_UNROLL_JAM_MIN_PERCENT)) + profit_unroll = 1; +--- gcc/config/rs6000/predicates.md (revision 278492) ++++ gcc/config/rs6000/predicates.md (revision 278614) +@@ -1053,8 +1053,7 @@ + return 1; + + /* Allow any integer constant. */ +- if (GET_MODE_CLASS (mode) == MODE_INT +- && CONST_SCALAR_INT_P (op)) ++ if (SCALAR_INT_MODE_P (mode) && CONST_SCALAR_INT_P (op)) + return 1; + + /* Allow easy vector constants. */ diff --git a/SOURCES/gcc9-libstdc++-compat.patch b/SOURCES/gcc9-libstdc++-compat.patch index d9b2d85..ceec138 100644 --- a/SOURCES/gcc9-libstdc++-compat.patch +++ b/SOURCES/gcc9-libstdc++-compat.patch @@ -9692,7 +9692,7 @@ } // namespace --- libstdc++-v3/src/nonshared17/cow-fs_ops.cc.jj 2019-05-13 10:33:09.443939688 +0200 +++ libstdc++-v3/src/nonshared17/cow-fs_ops.cc 2019-05-14 19:54:55.667219247 +0200 -@@ -0,0 +1,41 @@ +@@ -0,0 +1,40 @@ +// Copyright (C) 2019 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free @@ -9728,7 +9728,6 @@ +asm (".hidden _ZNSt5dequeINSt10filesystem4pathESaIS1_EED2Ev"); +#ifdef __x86_64__ +asm (".hidden _ZNSt11_Deque_baseINSt10filesystem4pathESaIS1_EE17_M_initialize_mapEm"); -+asm (".hidden _ZSt13move_backwardINSt10filesystem4pathEESt15_Deque_iteratorIT_RS3_PS3_ES2_IS3_RKS3_PS7_ESA_S6_"); +asm (".hidden _ZNSt5dequeINSt10filesystem4pathESaIS1_EE13_M_insert_auxINS1_8iteratorEEEvSt15_Deque_iteratorIS1_RS1_PS1_ET_SA_m"); +asm (".hidden _ZNSt5dequeINSt10filesystem4pathESaIS1_EE17_M_reallocate_mapEmb"); +asm (".hidden _ZNSt5dequeINSt10filesystem4pathESaIS1_EE23_M_new_elements_at_backEm"); @@ -11128,7 +11127,7 @@ +.NOEXPORT: --- libstdc++-v3/src/nonshared17/fs_ops.cc.jj 2019-05-13 10:33:09.456939472 +0200 +++ libstdc++-v3/src/nonshared17/fs_ops.cc 2019-05-14 20:00:02.088105705 +0200 -@@ -0,0 +1,53 @@ +@@ -0,0 +1,52 @@ +// Copyright (C) 2019 Free Software Foundation, Inc. +// +// This file is part of the GNU ISO C++ Library. This library is free @@ -11180,7 +11179,6 @@ +asm (".hidden _ZNSt5dequeINSt10filesystem7__cxx114pathESaIS2_EE13_M_insert_auxINS2_8iteratorEEEvSt15_Deque_iteratorIS2_RS2_PS2_ET_SB_m"); +asm (".hidden _ZNSt5dequeINSt10filesystem7__cxx114pathESaIS2_EE23_M_new_elements_at_backEm"); +asm (".hidden _ZNSt5dequeINSt10filesystem7__cxx114pathESaIS2_EE24_M_new_elements_at_frontEm"); -+asm (".hidden _ZSt13move_backwardINSt10filesystem7__cxx114pathEESt15_Deque_iteratorIT_RS4_PS4_ES3_IS4_RKS4_PS8_ESB_S7_"); +#endif --- libstdc++-v3/src/nonshared17/ostream-inst.cc.jj 2019-05-13 10:33:09.466939305 +0200 +++ libstdc++-v3/src/nonshared17/ostream-inst.cc 2019-05-14 18:43:03.283254489 +0200 @@ -11878,17 +11876,17 @@ } void -@@ -127,6 +129,7 @@ namespace std _GLIBCXX_VISIBILITY(defaul - _M_mt.seed(_M_strtoul(token)); +@@ -147,6 +149,7 @@ + #endif } +#ifndef _GLIBCXX_NONSHARED_CXX11_48 void random_device::_M_fini() { -@@ -172,6 +175,7 @@ namespace std _GLIBCXX_VISIBILITY(defaul - { +@@ -196,6 +199,7 @@ return _M_mt(); + #endif } +#endif diff --git a/SOURCES/gcc9-pr90303.patch b/SOURCES/gcc9-pr90303.patch deleted file mode 100644 index f67c9dd..0000000 --- a/SOURCES/gcc9-pr90303.patch +++ /dev/null @@ -1,39 +0,0 @@ -2019-05-03 Jakub Jelinek - - PR tree-optimization/90303 - * ipa-devirt.c (obj_type_ref_class, get_odr_type): Don't use - TYPE_CANONICAL for TYPE_STRUCTURAL_EQUALITY_P types in !in_lto_p mode. - - * g++.target/i386/pr90303.C: New test. - ---- gcc/ipa-devirt.c (revision 270834) -+++ gcc/ipa-devirt.c (revision 270835) -@@ -2020,7 +2020,7 @@ obj_type_ref_class (const_tree ref) - ref = TREE_VALUE (TYPE_ARG_TYPES (ref)); - gcc_checking_assert (TREE_CODE (ref) == POINTER_TYPE); - tree ret = TREE_TYPE (ref); -- if (!in_lto_p) -+ if (!in_lto_p && !TYPE_STRUCTURAL_EQUALITY_P (ret)) - ret = TYPE_CANONICAL (ret); - else - ret = get_odr_type (ret)->type; -@@ -2042,7 +2042,7 @@ get_odr_type (tree type, bool insert) - int base_id = -1; - - type = TYPE_MAIN_VARIANT (type); -- if (!in_lto_p) -+ if (!in_lto_p && !TYPE_STRUCTURAL_EQUALITY_P (type)) - type = TYPE_CANONICAL (type); - - gcc_checking_assert (can_be_name_hashed_p (type) ---- gcc/testsuite/g++.target/i386/pr90303.C (nonexistent) -+++ gcc/testsuite/g++.target/i386/pr90303.C (revision 270835) -@@ -0,0 +1,8 @@ -+// PR tree-optimization/90303 -+// { dg-do compile { target ia32 } } -+// { dg-additional-options "-O2" } -+ -+struct A { virtual void foo (); }; -+template class B : A {}; -+typedef void (__attribute__((fastcall)) F) (); -+B e; diff --git a/SOURCES/nvptx-tools-build.patch b/SOURCES/nvptx-tools-build.patch new file mode 100644 index 0000000..53d7483 --- /dev/null +++ b/SOURCES/nvptx-tools-build.patch @@ -0,0 +1,11 @@ +--- nvptx-tools/nvptx-as.c.jj 2017-01-20 12:40:18.000000000 +0100 ++++ nvptx-tools/nvptx-as.c 2017-01-20 12:43:53.864271442 +0100 +@@ -939,7 +939,7 @@ fork_execute (const char *prog, char *co + fatal_error ("%s: %m", errmsg); + } + else +- fatal_error (errmsg); ++ fatal_error ("%s", errmsg); + } + do_wait (prog, pex); + } diff --git a/SOURCES/nvptx-tools-glibc.patch b/SOURCES/nvptx-tools-glibc.patch new file mode 100644 index 0000000..4b50114 --- /dev/null +++ b/SOURCES/nvptx-tools-glibc.patch @@ -0,0 +1,32 @@ +--- nvptx-tools/configure.ac.jj 2017-01-13 12:48:31.000000000 +0100 ++++ nvptx-tools/configure.ac 2017-05-03 10:26:57.076092259 +0200 +@@ -66,6 +66,8 @@ CPPFLAGS=$save_CPPFLAGS + LDFLAGS=$save_LDFLAGS + LIBS=$save_LIBS + ++AC_CHECK_DECLS(getopt) ++ + AC_CONFIG_SUBDIRS([libiberty]) + AC_CONFIG_FILES([Makefile dejagnu.exp]) + AC_OUTPUT +--- nvptx-tools/configure.jj 2017-01-13 12:48:54.000000000 +0100 ++++ nvptx-tools/configure 2017-05-03 10:27:13.503876809 +0200 +@@ -3963,6 +3963,18 @@ CPPFLAGS=$save_CPPFLAGS + LDFLAGS=$save_LDFLAGS + LIBS=$save_LIBS + ++ac_fn_c_check_decl "$LINENO" "getopt" "ac_cv_have_decl_getopt" "$ac_includes_default" ++if test "x$ac_cv_have_decl_getopt" = x""yes; then : ++ ac_have_decl=1 ++else ++ ac_have_decl=0 ++fi ++ ++cat >>confdefs.h <<_ACEOF ++#define HAVE_DECL_GETOPT $ac_have_decl ++_ACEOF ++ ++ + + + subdirs="$subdirs libiberty" diff --git a/SOURCES/nvptx-tools-no-ptxas.patch b/SOURCES/nvptx-tools-no-ptxas.patch new file mode 100644 index 0000000..28bc597 --- /dev/null +++ b/SOURCES/nvptx-tools-no-ptxas.patch @@ -0,0 +1,947 @@ +--- nvptx-tools/configure.ac ++++ nvptx-tools/configure.ac +@@ -51,6 +51,7 @@ LIBS="$LIBS -lcuda" + AC_CHECK_FUNCS([[cuGetErrorName] [cuGetErrorString]]) + AC_CHECK_DECLS([[cuGetErrorName], [cuGetErrorString]], + [], [], [[#include ]]) ++AC_CHECK_HEADERS(unistd.h sys/stat.h) + + AC_MSG_CHECKING([for extra programs to build requiring -lcuda]) + NVPTX_RUN= +--- nvptx-tools/include/libiberty.h ++++ nvptx-tools/include/libiberty.h +@@ -390,6 +390,17 @@ extern void hex_init (void); + /* Save files used for communication between processes. */ + #define PEX_SAVE_TEMPS 0x4 + ++/* Max number of alloca bytes per call before we must switch to malloc. ++ ++ ?? Swiped from gnulib's regex_internal.h header. Is this actually ++ the case? This number seems arbitrary, though sane. ++ ++ The OS usually guarantees only one guard page at the bottom of the stack, ++ and a page size can be as small as 4096 bytes. So we cannot safely ++ allocate anything larger than 4096 bytes. Also care for the possibility ++ of a few compiler-allocated temporary stack slots. */ ++#define MAX_ALLOCA_SIZE 4032 ++ + /* Prepare to execute one or more programs, with standard output of + each program fed to standard input of the next. + FLAGS As above. +--- nvptx-tools/nvptx-as.c ++++ nvptx-tools/nvptx-as.c +@@ -30,6 +30,9 @@ + #include + #include + #include ++#ifdef HAVE_SYS_STAT_H ++#include ++#endif + #include + #define obstack_chunk_alloc malloc + #define obstack_chunk_free free +@@ -42,6 +45,38 @@ + + #include "version.h" + ++#ifndef R_OK ++#define R_OK 4 ++#define W_OK 2 ++#define X_OK 1 ++#endif ++ ++#ifndef DIR_SEPARATOR ++# define DIR_SEPARATOR '/' ++#endif ++ ++#if defined (_WIN32) || defined (__MSDOS__) \ ++ || defined (__DJGPP__) || defined (__OS2__) ++# define HAVE_DOS_BASED_FILE_SYSTEM ++# define HAVE_HOST_EXECUTABLE_SUFFIX ++# define HOST_EXECUTABLE_SUFFIX ".exe" ++# ifndef DIR_SEPARATOR_2 ++# define DIR_SEPARATOR_2 '\\' ++# endif ++# define PATH_SEPARATOR ';' ++#else ++# define PATH_SEPARATOR ':' ++#endif ++ ++#ifndef DIR_SEPARATOR_2 ++# define IS_DIR_SEPARATOR(ch) ((ch) == DIR_SEPARATOR) ++#else ++# define IS_DIR_SEPARATOR(ch) \ ++ (((ch) == DIR_SEPARATOR) || ((ch) == DIR_SEPARATOR_2)) ++#endif ++ ++#define DIR_UP ".." ++ + static const char *outname = NULL; + + static void __attribute__ ((format (printf, 1, 2))) +@@ -816,7 +851,7 @@ traverse (void **slot, void *data) + } + + static void +-process (FILE *in, FILE *out) ++process (FILE *in, FILE *out, int verify, const char *outname) + { + symbol_table = htab_create (500, hash_string_hash, hash_string_eq, + NULL); +@@ -824,6 +859,18 @@ process (FILE *in, FILE *out) + const char *input = read_file (in); + Token *tok = tokenize (input); + ++ /* By default, when ptxas is not in PATH, do minimalistic verification, ++ just require that the first non-comment directive is .version. */ ++ if (verify < 0) ++ { ++ size_t i; ++ for (i = 0; tok[i].kind == K_comment; i++) ++ ; ++ if (tok[i].kind != K_dotted || !is_keyword (&tok[i], "version")) ++ fatal_error ("missing .version directive at start of file '%s'", ++ outname); ++ } ++ + do + tok = parse_file (tok); + while (tok->kind); +@@ -897,9 +944,83 @@ fork_execute (const char *prog, char *const *argv) + do_wait (prog, pex); + } + ++/* Determine if progname is available in PATH. */ ++static bool ++program_available (const char *progname) ++{ ++ char *temp = getenv ("PATH"); ++ if (temp) ++ { ++ char *startp, *endp, *nstore, *alloc_ptr = NULL; ++ size_t prefixlen = strlen (temp) + 1; ++ size_t len; ++ if (prefixlen < 2) ++ prefixlen = 2; ++ ++ len = prefixlen + strlen (progname) + 1; ++#ifdef HAVE_HOST_EXECUTABLE_SUFFIX ++ len += strlen (HOST_EXECUTABLE_SUFFIX); ++#endif ++ if (len < MAX_ALLOCA_SIZE) ++ nstore = (char *) alloca (len); ++ else ++ alloc_ptr = nstore = (char *) malloc (len); ++ ++ startp = endp = temp; ++ while (1) ++ { ++ if (*endp == PATH_SEPARATOR || *endp == 0) ++ { ++ if (endp == startp) ++ { ++ nstore[0] = '.'; ++ nstore[1] = DIR_SEPARATOR; ++ nstore[2] = '\0'; ++ } ++ else ++ { ++ memcpy (nstore, startp, endp - startp); ++ if (! IS_DIR_SEPARATOR (endp[-1])) ++ { ++ nstore[endp - startp] = DIR_SEPARATOR; ++ nstore[endp - startp + 1] = 0; ++ } ++ else ++ nstore[endp - startp] = 0; ++ } ++ strcat (nstore, progname); ++ if (! access (nstore, X_OK) ++#ifdef HAVE_HOST_EXECUTABLE_SUFFIX ++ || ! access (strcat (nstore, HOST_EXECUTABLE_SUFFIX), X_OK) ++#endif ++ ) ++ { ++#if defined (HAVE_SYS_STAT_H) && defined (S_ISREG) ++ struct stat st; ++ if (stat (nstore, &st) >= 0 && S_ISREG (st.st_mode)) ++#endif ++ { ++ free (alloc_ptr); ++ return true; ++ } ++ } ++ ++ if (*endp == 0) ++ break; ++ endp = startp = endp + 1; ++ } ++ else ++ endp++; ++ } ++ free (alloc_ptr); ++ } ++ return false; ++} ++ + static struct option long_options[] = { + {"traditional-format", no_argument, 0, 0 }, + {"save-temps", no_argument, 0, 0 }, ++ {"verify", no_argument, 0, 0 }, + {"no-verify", no_argument, 0, 0 }, + {"help", no_argument, 0, 'h' }, + {"version", no_argument, 0, 'V' }, +@@ -912,7 +1033,7 @@ main (int argc, char **argv) + FILE *in = stdin; + FILE *out = stdout; + bool verbose __attribute__((unused)) = false; +- bool verify = true; ++ int verify = -1; + const char *smver = "sm_30"; + + int o; +@@ -923,7 +1044,9 @@ main (int argc, char **argv) + { + case 0: + if (option_index == 2) +- verify = false; ++ verify = 1; ++ else if (option_index == 3) ++ verify = 0; + break; + case 'v': + verbose = true; +@@ -948,7 +1071,8 @@ Usage: nvptx-none-as [option...] [asmfile]\n\ + Options:\n\ + -o FILE Write output to FILE\n\ + -v Be verbose\n\ ++ --verify Do verify output is acceptable to ptxas\n\ + --no-verify Do not verify output is acceptable to ptxas\n\ + --help Print this help and exit\n\ + --version Print version number and exit\n\ + \n\ +@@ -983,11 +1108,17 @@ This program has absolutely no warranty.\n", + if (!in) + fatal_error ("cannot open input ptx file"); + +- process (in, out); +- if (outname) ++ if (outname == NULL) ++ verify = 0; ++ else if (verify == -1) ++ if (program_available ("ptxas")) ++ verify = 1; ++ ++ process (in, out, verify, outname); ++ if (outname) + fclose (out); + +- if (verify && outname) ++ if (verify > 0) + { + struct obstack argv_obstack; + obstack_init (&argv_obstack); +--- nvptx-tools/configure ++++ nvptx-tools/configure +@@ -168,7 +168,8 @@ test x\$exitcode = x0 || exit 1" + as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO + as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO + eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && +- test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1" ++ test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1 ++test \$(( 1 + 1 )) = 2 || exit 1" + if (eval "$as_required") 2>/dev/null; then : + as_have_required=yes + else +@@ -552,11 +553,50 @@ PACKAGE_URL= + + ac_unique_file="nvptx-tools" + ac_unique_file="nvptx-as.c" ++# Factoring default headers for most tests. ++ac_includes_default="\ ++#include ++#ifdef HAVE_SYS_TYPES_H ++# include ++#endif ++#ifdef HAVE_SYS_STAT_H ++# include ++#endif ++#ifdef STDC_HEADERS ++# include ++# include ++#else ++# ifdef HAVE_STDLIB_H ++# include ++# endif ++#endif ++#ifdef HAVE_STRING_H ++# if !defined STDC_HEADERS && defined HAVE_MEMORY_H ++# include ++# endif ++# include ++#endif ++#ifdef HAVE_STRINGS_H ++# include ++#endif ++#ifdef HAVE_INTTYPES_H ++# include ++#endif ++#ifdef HAVE_STDINT_H ++# include ++#endif ++#ifdef HAVE_UNISTD_H ++# include ++#endif" ++ + enable_option_checking=no + ac_subst_vars='LTLIBOBJS + LIBOBJS + subdirs + NVPTX_RUN ++EGREP ++GREP ++CPP + CUDA_DRIVER_LDFLAGS + CUDA_DRIVER_CPPFLAGS + AR +@@ -635,7 +675,8 @@ LIBS + CPPFLAGS + CXX + CXXFLAGS +-CCC' ++CCC ++CPP' + ac_subdirs_all='libiberty' + + # Initialize some variables set by options. +@@ -1267,6 +1308,7 @@ Some influential environment variables: + you have headers in a nonstandard directory + CXX C++ compiler command + CXXFLAGS C++ compiler flags ++ CPP C preprocessor + + Use these variables to override the choices made by `configure' or to help + it to find libraries and programs with nonstandard names/locations. +@@ -1575,6 +1617,203 @@ $as_echo "$ac_res" >&6; } + eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + + } # ac_fn_c_check_decl ++ ++# ac_fn_c_try_cpp LINENO ++# ---------------------- ++# Try to preprocess conftest.$ac_ext, and return whether this succeeded. ++ac_fn_c_try_cpp () ++{ ++ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack ++ if { { ac_try="$ac_cpp conftest.$ac_ext" ++case "(($ac_try" in ++ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; ++ *) ac_try_echo=$ac_try;; ++esac ++eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" ++$as_echo "$ac_try_echo"; } >&5 ++ (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err ++ ac_status=$? ++ if test -s conftest.err; then ++ grep -v '^ *+' conftest.err >conftest.er1 ++ cat conftest.er1 >&5 ++ mv -f conftest.er1 conftest.err ++ fi ++ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 ++ test $ac_status = 0; } >/dev/null && { ++ test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || ++ test ! -s conftest.err ++ }; then : ++ ac_retval=0 ++else ++ $as_echo "$as_me: failed program was:" >&5 ++sed 's/^/| /' conftest.$ac_ext >&5 ++ ++ ac_retval=1 ++fi ++ eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} ++ return $ac_retval ++ ++} # ac_fn_c_try_cpp ++ ++# ac_fn_c_check_header_mongrel LINENO HEADER VAR INCLUDES ++# ------------------------------------------------------- ++# Tests whether HEADER exists, giving a warning if it cannot be compiled using ++# the include files in INCLUDES and setting the cache variable VAR ++# accordingly. ++ac_fn_c_check_header_mongrel () ++{ ++ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack ++ if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then : ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 ++$as_echo_n "checking for $2... " >&6; } ++if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then : ++ $as_echo_n "(cached) " >&6 ++fi ++eval ac_res=\$$3 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 ++$as_echo "$ac_res" >&6; } ++else ++ # Is the header compilable? ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 usability" >&5 ++$as_echo_n "checking $2 usability... " >&6; } ++cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++$4 ++#include <$2> ++_ACEOF ++if ac_fn_c_try_compile "$LINENO"; then : ++ ac_header_compiler=yes ++else ++ ac_header_compiler=no ++fi ++rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_compiler" >&5 ++$as_echo "$ac_header_compiler" >&6; } ++ ++# Is the header present? ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 presence" >&5 ++$as_echo_n "checking $2 presence... " >&6; } ++cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++#include <$2> ++_ACEOF ++if ac_fn_c_try_cpp "$LINENO"; then : ++ ac_header_preproc=yes ++else ++ ac_header_preproc=no ++fi ++rm -f conftest.err conftest.$ac_ext ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_preproc" >&5 ++$as_echo "$ac_header_preproc" >&6; } ++ ++# So? What about this header? ++case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in #(( ++ yes:no: ) ++ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&5 ++$as_echo "$as_me: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&2;} ++ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 ++$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} ++ ;; ++ no:yes:* ) ++ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: present but cannot be compiled" >&5 ++$as_echo "$as_me: WARNING: $2: present but cannot be compiled" >&2;} ++ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: check for missing prerequisite headers?" >&5 ++$as_echo "$as_me: WARNING: $2: check for missing prerequisite headers?" >&2;} ++ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: see the Autoconf documentation" >&5 ++$as_echo "$as_me: WARNING: $2: see the Autoconf documentation" >&2;} ++ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&5 ++$as_echo "$as_me: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&2;} ++ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 ++$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} ++ ;; ++esac ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 ++$as_echo_n "checking for $2... " >&6; } ++if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then : ++ $as_echo_n "(cached) " >&6 ++else ++ eval "$3=\$ac_header_compiler" ++fi ++eval ac_res=\$$3 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 ++$as_echo "$ac_res" >&6; } ++fi ++ eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} ++ ++} # ac_fn_c_check_header_mongrel ++ ++# ac_fn_c_try_run LINENO ++# ---------------------- ++# Try to link conftest.$ac_ext, and return whether this succeeded. Assumes ++# that executables *can* be run. ++ac_fn_c_try_run () ++{ ++ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack ++ if { { ac_try="$ac_link" ++case "(($ac_try" in ++ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; ++ *) ac_try_echo=$ac_try;; ++esac ++eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" ++$as_echo "$ac_try_echo"; } >&5 ++ (eval "$ac_link") 2>&5 ++ ac_status=$? ++ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 ++ test $ac_status = 0; } && { ac_try='./conftest$ac_exeext' ++ { { case "(($ac_try" in ++ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; ++ *) ac_try_echo=$ac_try;; ++esac ++eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" ++$as_echo "$ac_try_echo"; } >&5 ++ (eval "$ac_try") 2>&5 ++ ac_status=$? ++ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 ++ test $ac_status = 0; }; }; then : ++ ac_retval=0 ++else ++ $as_echo "$as_me: program exited with status $ac_status" >&5 ++ $as_echo "$as_me: failed program was:" >&5 ++sed 's/^/| /' conftest.$ac_ext >&5 ++ ++ ac_retval=$ac_status ++fi ++ rm -rf conftest.dSYM conftest_ipa8_conftest.oo ++ eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} ++ return $ac_retval ++ ++} # ac_fn_c_try_run ++ ++# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES ++# ------------------------------------------------------- ++# Tests whether HEADER exists and can be compiled using the include files in ++# INCLUDES, setting the cache variable VAR accordingly. ++ac_fn_c_check_header_compile () ++{ ++ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 ++$as_echo_n "checking for $2... " >&6; } ++if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then : ++ $as_echo_n "(cached) " >&6 ++else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++$4 ++#include <$2> ++_ACEOF ++if ac_fn_c_try_compile "$LINENO"; then : ++ eval "$3=yes" ++else ++ eval "$3=no" ++fi ++rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ++fi ++eval ac_res=\$$3 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 ++$as_echo "$ac_res" >&6; } ++ eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} ++ ++} # ac_fn_c_check_header_compile + cat >config.log <<_ACEOF + This file contains any messages produced by compilers while + running configure, to aid debugging if configure makes a mistake. +@@ -3284,6 +3523,418 @@ cat >>confdefs.h <<_ACEOF + #define HAVE_DECL_CUGETERRORSTRING $ac_have_decl + _ACEOF + ++ac_ext=c ++ac_cpp='$CPP $CPPFLAGS' ++ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ++ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ++ac_compiler_gnu=$ac_cv_c_compiler_gnu ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5 ++$as_echo_n "checking how to run the C preprocessor... " >&6; } ++# On Suns, sometimes $CPP names a directory. ++if test -n "$CPP" && test -d "$CPP"; then ++ CPP= ++fi ++if test -z "$CPP"; then ++ if test "${ac_cv_prog_CPP+set}" = set; then : ++ $as_echo_n "(cached) " >&6 ++else ++ # Double quotes because CPP needs to be expanded ++ for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" ++ do ++ ac_preproc_ok=false ++for ac_c_preproc_warn_flag in '' yes ++do ++ # Use a header file that comes with gcc, so configuring glibc ++ # with a fresh cross-compiler works. ++ # Prefer to if __STDC__ is defined, since ++ # exists even on freestanding compilers. ++ # On the NeXT, cc -E runs the code through the compiler's parser, ++ # not just through cpp. "Syntax error" is here to catch this case. ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++#ifdef __STDC__ ++# include ++#else ++# include ++#endif ++ Syntax error ++_ACEOF ++if ac_fn_c_try_cpp "$LINENO"; then : ++ ++else ++ # Broken: fails on valid input. ++continue ++fi ++rm -f conftest.err conftest.$ac_ext ++ ++ # OK, works on sane cases. Now check whether nonexistent headers ++ # can be detected and how. ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++#include ++_ACEOF ++if ac_fn_c_try_cpp "$LINENO"; then : ++ # Broken: success on invalid input. ++continue ++else ++ # Passes both tests. ++ac_preproc_ok=: ++break ++fi ++rm -f conftest.err conftest.$ac_ext ++ ++done ++# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. ++rm -f conftest.err conftest.$ac_ext ++if $ac_preproc_ok; then : ++ break ++fi ++ ++ done ++ ac_cv_prog_CPP=$CPP ++ ++fi ++ CPP=$ac_cv_prog_CPP ++else ++ ac_cv_prog_CPP=$CPP ++fi ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5 ++$as_echo "$CPP" >&6; } ++ac_preproc_ok=false ++for ac_c_preproc_warn_flag in '' yes ++do ++ # Use a header file that comes with gcc, so configuring glibc ++ # with a fresh cross-compiler works. ++ # Prefer to if __STDC__ is defined, since ++ # exists even on freestanding compilers. ++ # On the NeXT, cc -E runs the code through the compiler's parser, ++ # not just through cpp. "Syntax error" is here to catch this case. ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++#ifdef __STDC__ ++# include ++#else ++# include ++#endif ++ Syntax error ++_ACEOF ++if ac_fn_c_try_cpp "$LINENO"; then : ++ ++else ++ # Broken: fails on valid input. ++continue ++fi ++rm -f conftest.err conftest.$ac_ext ++ ++ # OK, works on sane cases. Now check whether nonexistent headers ++ # can be detected and how. ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++#include ++_ACEOF ++if ac_fn_c_try_cpp "$LINENO"; then : ++ # Broken: success on invalid input. ++continue ++else ++ # Passes both tests. ++ac_preproc_ok=: ++break ++fi ++rm -f conftest.err conftest.$ac_ext ++ ++done ++# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. ++rm -f conftest.err conftest.$ac_ext ++if $ac_preproc_ok; then : ++ ++else ++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++as_fn_error "C preprocessor \"$CPP\" fails sanity check ++See \`config.log' for more details." "$LINENO" 5; } ++fi ++ ++ac_ext=c ++ac_cpp='$CPP $CPPFLAGS' ++ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ++ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ++ac_compiler_gnu=$ac_cv_c_compiler_gnu ++ ++ ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5 ++$as_echo_n "checking for grep that handles long lines and -e... " >&6; } ++if test "${ac_cv_path_GREP+set}" = set; then : ++ $as_echo_n "(cached) " >&6 ++else ++ if test -z "$GREP"; then ++ ac_path_GREP_found=false ++ # Loop through the user's path and test for each of PROGNAME-LIST ++ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR ++for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin ++do ++ IFS=$as_save_IFS ++ test -z "$as_dir" && as_dir=. ++ for ac_prog in grep ggrep; do ++ for ac_exec_ext in '' $ac_executable_extensions; do ++ ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext" ++ { test -f "$ac_path_GREP" && $as_test_x "$ac_path_GREP"; } || continue ++# Check for GNU ac_path_GREP and select it if it is found. ++ # Check for GNU $ac_path_GREP ++case `"$ac_path_GREP" --version 2>&1` in ++*GNU*) ++ ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;; ++*) ++ ac_count=0 ++ $as_echo_n 0123456789 >"conftest.in" ++ while : ++ do ++ cat "conftest.in" "conftest.in" >"conftest.tmp" ++ mv "conftest.tmp" "conftest.in" ++ cp "conftest.in" "conftest.nl" ++ $as_echo 'GREP' >> "conftest.nl" ++ "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break ++ diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break ++ as_fn_arith $ac_count + 1 && ac_count=$as_val ++ if test $ac_count -gt ${ac_path_GREP_max-0}; then ++ # Best one so far, save it but keep looking for a better one ++ ac_cv_path_GREP="$ac_path_GREP" ++ ac_path_GREP_max=$ac_count ++ fi ++ # 10*(2^10) chars as input seems more than enough ++ test $ac_count -gt 10 && break ++ done ++ rm -f conftest.in conftest.tmp conftest.nl conftest.out;; ++esac ++ ++ $ac_path_GREP_found && break 3 ++ done ++ done ++ done ++IFS=$as_save_IFS ++ if test -z "$ac_cv_path_GREP"; then ++ as_fn_error "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 ++ fi ++else ++ ac_cv_path_GREP=$GREP ++fi ++ ++fi ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5 ++$as_echo "$ac_cv_path_GREP" >&6; } ++ GREP="$ac_cv_path_GREP" ++ ++ ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5 ++$as_echo_n "checking for egrep... " >&6; } ++if test "${ac_cv_path_EGREP+set}" = set; then : ++ $as_echo_n "(cached) " >&6 ++else ++ if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 ++ then ac_cv_path_EGREP="$GREP -E" ++ else ++ if test -z "$EGREP"; then ++ ac_path_EGREP_found=false ++ # Loop through the user's path and test for each of PROGNAME-LIST ++ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR ++for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin ++do ++ IFS=$as_save_IFS ++ test -z "$as_dir" && as_dir=. ++ for ac_prog in egrep; do ++ for ac_exec_ext in '' $ac_executable_extensions; do ++ ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext" ++ { test -f "$ac_path_EGREP" && $as_test_x "$ac_path_EGREP"; } || continue ++# Check for GNU ac_path_EGREP and select it if it is found. ++ # Check for GNU $ac_path_EGREP ++case `"$ac_path_EGREP" --version 2>&1` in ++*GNU*) ++ ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;; ++*) ++ ac_count=0 ++ $as_echo_n 0123456789 >"conftest.in" ++ while : ++ do ++ cat "conftest.in" "conftest.in" >"conftest.tmp" ++ mv "conftest.tmp" "conftest.in" ++ cp "conftest.in" "conftest.nl" ++ $as_echo 'EGREP' >> "conftest.nl" ++ "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break ++ diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break ++ as_fn_arith $ac_count + 1 && ac_count=$as_val ++ if test $ac_count -gt ${ac_path_EGREP_max-0}; then ++ # Best one so far, save it but keep looking for a better one ++ ac_cv_path_EGREP="$ac_path_EGREP" ++ ac_path_EGREP_max=$ac_count ++ fi ++ # 10*(2^10) chars as input seems more than enough ++ test $ac_count -gt 10 && break ++ done ++ rm -f conftest.in conftest.tmp conftest.nl conftest.out;; ++esac ++ ++ $ac_path_EGREP_found && break 3 ++ done ++ done ++ done ++IFS=$as_save_IFS ++ if test -z "$ac_cv_path_EGREP"; then ++ as_fn_error "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 ++ fi ++else ++ ac_cv_path_EGREP=$EGREP ++fi ++ ++ fi ++fi ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5 ++$as_echo "$ac_cv_path_EGREP" >&6; } ++ EGREP="$ac_cv_path_EGREP" ++ ++ ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5 ++$as_echo_n "checking for ANSI C header files... " >&6; } ++if test "${ac_cv_header_stdc+set}" = set; then : ++ $as_echo_n "(cached) " >&6 ++else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++#include ++#include ++#include ++#include ++ ++int ++main () ++{ ++ ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_compile "$LINENO"; then : ++ ac_cv_header_stdc=yes ++else ++ ac_cv_header_stdc=no ++fi ++rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ++ ++if test $ac_cv_header_stdc = yes; then ++ # SunOS 4.x string.h does not declare mem*, contrary to ANSI. ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++#include ++ ++_ACEOF ++if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | ++ $EGREP "memchr" >/dev/null 2>&1; then : ++ ++else ++ ac_cv_header_stdc=no ++fi ++rm -f conftest* ++ ++fi ++ ++if test $ac_cv_header_stdc = yes; then ++ # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++#include ++ ++_ACEOF ++if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | ++ $EGREP "free" >/dev/null 2>&1; then : ++ ++else ++ ac_cv_header_stdc=no ++fi ++rm -f conftest* ++ ++fi ++ ++if test $ac_cv_header_stdc = yes; then ++ # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. ++ if test "$cross_compiling" = yes; then : ++ : ++else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++#include ++#include ++#if ((' ' & 0x0FF) == 0x020) ++# define ISLOWER(c) ('a' <= (c) && (c) <= 'z') ++# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) ++#else ++# define ISLOWER(c) \ ++ (('a' <= (c) && (c) <= 'i') \ ++ || ('j' <= (c) && (c) <= 'r') \ ++ || ('s' <= (c) && (c) <= 'z')) ++# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c)) ++#endif ++ ++#define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) ++int ++main () ++{ ++ int i; ++ for (i = 0; i < 256; i++) ++ if (XOR (islower (i), ISLOWER (i)) ++ || toupper (i) != TOUPPER (i)) ++ return 2; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : ++ ++else ++ ac_cv_header_stdc=no ++fi ++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext ++fi ++ ++fi ++fi ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5 ++$as_echo "$ac_cv_header_stdc" >&6; } ++if test $ac_cv_header_stdc = yes; then ++ ++$as_echo "#define STDC_HEADERS 1" >>confdefs.h ++ ++fi ++ ++# On IRIX 5.3, sys/types and inttypes.h are conflicting. ++for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \ ++ inttypes.h stdint.h unistd.h ++do : ++ as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` ++ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default ++" ++eval as_val=\$$as_ac_Header ++ if test "x$as_val" = x""yes; then : ++ cat >>confdefs.h <<_ACEOF ++#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 ++_ACEOF ++ ++fi ++ ++done ++ ++ ++for ac_header in unistd.h sys/stat.h ++do : ++ as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` ++ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default" ++eval as_val=\$$as_ac_Header ++ if test "x$as_val" = x""yes; then : ++ cat >>confdefs.h <<_ACEOF ++#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 ++_ACEOF ++ ++fi ++ ++done ++ + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for extra programs to build requiring -lcuda" >&5 + $as_echo_n "checking for extra programs to build requiring -lcuda... " >&6; } diff --git a/SPECS/gcc.spec b/SPECS/gcc.spec index 1283a85..cc018e0 100644 --- a/SPECS/gcc.spec +++ b/SPECS/gcc.spec @@ -2,13 +2,13 @@ %{?scl:%global __strip %%{_scl_root}/usr/bin/strip} %{?scl:%global __objdump %%{_scl_root}/usr/bin/objdump} %{?scl:%scl_package gcc} -%global DATE 20190503 -%global SVNREV 270850 -%global gcc_version 9.1.1 +%global DATE 20191120 +%global SVNREV 278493 +%global gcc_version 9.2.1 %global gcc_major 9 # Note, gcc_release must be integer, if you want to add suffixes to # %%{release}, append them after %%{gcc_release} on Release: line. -%global gcc_release 1 +%global gcc_release 2 %global nvptx_tools_gitrev c28050f60193b3b95a18866a96f03334e874e78f %global nvptx_newlib_gitrev aadc8eb0ec43b7cd0dd2dfb484bae63c8b05ef24 %global mpc_version 0.8.1 @@ -94,7 +94,7 @@ %global attr_ifunc 0 %endif %ifarch x86_64 ppc64le -%global build_offload_nvptx 0 +%global build_offload_nvptx 1 %else %global build_offload_nvptx 0 %endif @@ -113,7 +113,7 @@ Summary: GCC version 9 Name: %{?scl_prefix}gcc Version: %{gcc_version} -Release: %{gcc_release}%{?dist} +Release: %{gcc_release}.2%{?dist} # libgcc, libgfortran, libgomp, libstdc++ and crtstuff have # GCC Runtime Exception. License: GPLv3+ and GPLv3+ with exceptions and GPLv2+ with exceptions and LGPLv2+ and BSD @@ -125,6 +125,21 @@ Source0: gcc-%{version}-%{DATE}.tar.xz Source1: ftp://gcc.gnu.org/pub/gcc/infrastructure/isl-%{isl_version}.tar.bz2 Source2: http://www.multiprecision.org/mpc/download/mpc-%{mpc_version}.tar.gz Source3: ftp://ftp.stack.nl/pub/users/dimitri/doxygen-%{doxygen_version}.src.tar.gz +# The source for nvptx-tools package was pulled from upstream's vcs. Use the +# following commands to generate the tarball: +# git clone https://github.com/MentorEmbedded/nvptx-tools.git +# cd nvptx-tools +# git archive origin/master --prefix=nvptx-tools-%%{nvptx_tools_gitrev}/ | xz -9e > ../nvptx-tools-%%{nvptx_tools_gitrev}.tar.xz +# cd ..; rm -rf nvptx-tools +Source4: nvptx-tools-%{nvptx_tools_gitrev}.tar.xz +# The source for nvptx-newlib package was pulled from upstream's vcs. Use the +# following commands to generate the tarball: +# git clone https://github.com/MentorEmbedded/nvptx-newlib.git +# cd nvptx-newlib +# git archive origin/master --prefix=nvptx-newlib-%%{nvptx_newlib_gitrev}/ | xz -9 > ../nvptx-newlib-%%{nvptx_newlib_gitrev}.tar.xz +# cd ..; rm -rf nvptx-newlib +Source5: nvptx-newlib-%{nvptx_newlib_gitrev}.tar.xz +%global isl_version 0.16.1 URL: http://gcc.gnu.org # Need binutils with -pie support >= 2.14.90.0.4-4 # Need binutils which can omit dot symbols and overlap .opd on ppc64 >= 2.15.91.0.2-4 @@ -135,16 +150,17 @@ URL: http://gcc.gnu.org # Need binutils which support --build-id >= 2.17.50.0.17-3 # Need binutils which support %%gnu_unique_object >= 2.19.51.0.14 # Need binutils which support .cfi_sections >= 2.19.51.0.14-33 +# Need binutils which support new PowerPC relocs >= 2.31 BuildRequires: binutils >= 2.19.51.0.14-33 # While gcc doesn't include statically linked binaries, during testing # -static is used several times. BuildRequires: glibc-static %if 0%{?scl:1} -BuildRequires: %{?scl_prefix}binutils >= 2.22.52.0.1 +BuildRequires: %{?scl_prefix}binutils >= 2.31 # For testing -%if 0%{?rhel} > 7 +%if 0%{?rhel} >= 6 # FIXME gcc-toolset-9-gdb isn't yet in the buildroot. -BuildRequires: gdb >= 7.4.50 +BuildRequires: gdb %else BuildRequires: %{?scl_prefix}gdb >= 7.4.50 %endif @@ -273,7 +289,8 @@ Patch8: gcc9-foffload-default.patch Patch9: gcc9-Wno-format-security.patch Patch10: gcc9-rh1574936.patch Patch11: gcc9-d-shared-libphobos.patch -Patch12: gcc9-pr90303.patch +Patch12: gcc9-fixes.patch +Patch13: gcc9-add-sve-tests.patch Patch1000: gcc9-libstdc++-compat.patch Patch1001: gcc9-alt-compat-test.patch @@ -284,32 +301,26 @@ Patch2001: doxygen-1.7.1-config.patch Patch2002: doxygen-1.7.5-timestamp.patch Patch2003: doxygen-1.8.0-rh856725.patch -Patch3001: 0001-Allow-repeated-compatible-type-specifications.patch -Patch3002: 0002-Pad-character-to-int-conversions-with-spaces-instead.patch -Patch3003: 0003-Add-std-extra-legacy.patch -Patch3004: 0004-Allow-conversion-between-Hollerith-constants-and-CHA.patch -Patch3005: 0005-Allow-comparisons-between-INTEGER-and-REAL.patch +Patch3001: 0001-Default-widths-for-i-f-and-g-format-specifiers-in-fo.patch +Patch3002: 0002-Allow-duplicate-declarations.patch +Patch3003: 0003-Convert-LOGICAL-to-INTEGER-for-arithmetic-ops-and-vi.patch +Patch3004: 0004-Allow-CHARACTER-literals-in-assignments-and-data-sta.patch +Patch3005: 0005-dec-comparisons.patch Patch3006: 0006-Allow-blank-format-items-in-format-strings.patch Patch3007: 0007-Allow-more-than-one-character-as-argument-to-ICHAR.patch Patch3008: 0008-Allow-non-integer-substring-indexes.patch -Patch3009: 0009-Convert-LOGICAL-to-INTEGER-for-arithmetic-ops-and-vi.patch -Patch3010: 0010-Allow-mixed-string-length-and-array-specification-in.patch -Patch3011: 0011-Allow-character-to-int-conversions-in-DATA-statement.patch -Patch3012: 0012-Allow-old-style-initializers-in-derived-types.patch -Patch3013: 0013-Allow-per-variable-kind-specification.patch -Patch3014: 0014-Allow-non-logical-expressions-in-IF-statements.patch -Patch3016: 0016-Allow-calls-to-intrinsics-with-smaller-types-than-sp.patch -Patch3017: 0017-Add-the-SEQUENCE-attribute-by-default-if-it-s-not-pr.patch -Patch3018: 0018-Fill-in-missing-array-dimensions-using-the-lower-bou.patch -Patch3019: 0019-Add-tests-for-AUTOMATIC-keyword.patch -Patch3022: 0022-Default-values-for-certain-field-descriptors-in-form.patch -Patch3023: gcc8-fortranlines.patch -Patch3025: gcc8-fortran-equivalence.patch -Patch3026: gcc8-fortran-fdec-include.patch -Patch3027: gcc8-fortran-fdec-include-doc.patch -Patch3028: gcc8-fortran-fpad-source.patch -Patch3029: gcc8-fortran-pr87919.patch -Patch3030: gcc8-fortran-pr87919-2.patch +Patch3009: 0009-Allow-old-style-initializers-in-derived-types.patch +Patch3010: 0010-Allow-string-length-and-kind-to-be-specified-on-a-pe.patch +Patch3011: 0011-Allow-non-logical-expressions-in-IF-statements.patch +Patch3012: 0012-Support-type-promotion-in-calls-to-intrinsics.patch +Patch3013: 0013-Add-the-SEQUENCE-attribute-by-default-if-it-s-not-pr.patch +Patch3014: 0014-Fill-in-missing-array-dimensions-using-the-lower-bou.patch +Patch3015: 0015-Allow-automatics-in-equivalence.patch +Patch3016: 0016-Suppress-warning-with-Wno-overwrite-recursive.patch + +Patch4000: nvptx-tools-no-ptxas.patch +Patch4001: nvptx-tools-build.patch +Patch4002: nvptx-tools-glibc.patch %if 0%{?rhel} > 7 %global nonsharedver 80 @@ -469,10 +480,10 @@ for __float128 math support and for Fortran REAL*16 support. Summary: GCC 9 __float128 support Group: Development/Libraries %if 0%{!?scl:1} -Requires: %{?scl_prefix}libquadmath = %{version}-%{release} +Requires: %{?scl_prefix}libquadmath%{_isa} = %{version}-%{release} %else %if 0%{?rhel} >= 7 -Requires: libquadmath +Requires: libquadmath%{_isa} %endif %endif Requires: %{?scl_prefix}gcc%{!?scl:5} = %{version}-%{release} @@ -493,7 +504,7 @@ which is a GCC transactional memory support runtime library. %package -n %{?scl_prefix}libitm-devel Summary: The GNU Transactional Memory support -Requires: libitm >= 4.7.0-1 +Requires: libitm%{_isa} >= 4.7.0-1 Requires: %{?scl_prefix}gcc%{!?scl:5} = %{version}-%{release} %description -n %{?scl_prefix}libitm-devel @@ -527,21 +538,11 @@ by hardware. %package -n %{?scl_prefix}libatomic-devel Summary: The GNU Atomic static library -Requires: libatomic >= 4.8.0 +Requires: libatomic%{_isa} >= 4.8.0 %description -n %{?scl_prefix}libatomic-devel This package contains GNU Atomic static libraries. -%package -n libasan -Summary: The Address Sanitizer runtime library from GCC 9 -Group: System Environment/Libraries -Requires(post): /sbin/install-info -Requires(preun): /sbin/install-info - -%description -n libasan -This package contains the Address Sanitizer library from GCC 9 -which is used for -fsanitize=address instrumented programs. - %package -n libasan5 Summary: The Address Sanitizer runtime library from GCC 9 Group: System Environment/Libraries @@ -554,10 +555,11 @@ which is used for -fsanitize=address instrumented programs. %package -n %{?scl_prefix}libasan-devel Summary: The Address Sanitizer static library -%if 0%{?rhel} > 8 -Requires: libasan >= 9.1.1 +%if 0%{?rhel} > 7 +Requires: libasan%{_isa} >= 8.3.1 +Obsoletes: libasan5 %else -Requires: libasan5 >= 9.1.1 +Requires: libasan5%{_isa} >= 8.3.1 %endif %description -n %{?scl_prefix}libasan-devel @@ -574,7 +576,7 @@ which is used for -fsanitize=thread instrumented programs. %package -n %{?scl_prefix}libtsan-devel Summary: The Thread Sanitizer static library -Requires: libtsan >= 5.1.1 +Requires: libtsan%{_isa} >= 5.1.1 %description -n %{?scl_prefix}libtsan-devel This package contains Thread Sanitizer static runtime library. @@ -590,10 +592,11 @@ which is used for -fsanitize=undefined instrumented programs. %package -n %{?scl_prefix}libubsan-devel Summary: The Undefined Behavior Sanitizer static library -%if 0%{?rhel} > 8 -Requires: libubsan >= 9.1.1 +%if 0%{?rhel} > 7 +Requires: libubsan%{_isa} >= 8.3.1 +Obsoletes: libubsan1 %else -Requires: libubsan1 >= 9.1.1 +Requires: libubsan1%{_isa} >= 8.3.1 %endif %description -n %{?scl_prefix}libubsan-devel @@ -610,17 +613,27 @@ which is used for -fsanitize=leak instrumented programs. %package -n %{?scl_prefix}liblsan-devel Summary: The Leak Sanitizer static library -Requires: liblsan >= 5.1.1 +Requires: liblsan%{_isa} >= 5.1.1 %description -n %{?scl_prefix}liblsan-devel This package contains Leak Sanitizer static runtime library. +%package -n %{?scl_prefix}offload-nvptx +Summary: Offloading compiler to NVPTX +Requires: gcc >= 8.3.1 +Requires: libgomp-offload-nvptx >= 8.3.1 + +%description -n %{?scl_prefix}offload-nvptx +The gcc-offload-nvptx package provides offloading support for +NVidia PTX. OpenMP and OpenACC programs linked with -fopenmp will +by default add PTX code into the binaries, which can be offloaded +to NVidia PTX capable devices if available. %prep %if 0%{?rhel} >= 7 -%setup -q -n gcc-%{version}-%{DATE} -a 1 +%setup -q -n gcc-%{version}-%{DATE} -a 1 -a 4 -a 5 %else -%setup -q -n gcc-%{version}-%{DATE} -a 1 -a 2 -a 3 +%setup -q -n gcc-%{version}-%{DATE} -a 1 -a 2 -a 3 -a 4 -a 5 %endif %patch0 -p0 -b .hack~ %patch1 -p0 -b .i386-libgomp~ @@ -640,7 +653,8 @@ This package contains Leak Sanitizer static runtime library. %patch10 -p0 -b .rh1574936~ %endif %patch11 -p0 -b .d-shared-libphobos~ -%patch12 -p0 -b .pr90303~ +%patch12 -p0 -b .fixes~ +%patch13 -p0 -b .add-sve-tests~ %patch1000 -p0 -b .libstdc++-compat~ %ifarch %{ix86} x86_64 @@ -665,11 +679,9 @@ cd .. %endif %endif -%if 0 -%if 0%{?rhel} <= 7 -%patch3003 -p1 -b .fortran03~ %patch3001 -p1 -b .fortran01~ %patch3002 -p1 -b .fortran02~ +%patch3003 -p1 -b .fortran03~ %patch3004 -p1 -b .fortran04~ %patch3005 -p1 -b .fortran05~ %patch3006 -p1 -b .fortran06~ @@ -681,20 +693,14 @@ cd .. %patch3012 -p1 -b .fortran12~ %patch3013 -p1 -b .fortran13~ %patch3014 -p1 -b .fortran14~ +%patch3015 -p1 -b .fortran15~ %patch3016 -p1 -b .fortran16~ -%patch3017 -p1 -b .fortran17~ -%patch3018 -p1 -b .fortran18~ -%patch3019 -p1 -b .fortran19~ -%patch3022 -p1 -b .fortran22~ -%patch3023 -p1 -b .fortran23~ -%patch3025 -p1 -b .fortran25~ -%patch3026 -p1 -b .fortran26~ -%patch3027 -p1 -b .fortran27~ -%patch3028 -p1 -b .fortran28~ -%patch3029 -p1 -b .fortran29~ -%patch3030 -p1 -b .fortran30~ -%endif -%endif + +cd nvptx-tools-%{nvptx_tools_gitrev} +%patch4000 -p1 -b .nvptx-tools-no-ptxas~ +%patch4001 -p1 -b .nvptx-tools-build~ +%patch4002 -p1 -b .nvptx-tools-glibc~ +cd .. echo 'Red Hat %{version}-%{gcc_release}' > gcc/DEV-PHASE @@ -739,6 +745,41 @@ rm -f gcc/testsuite/go.test/test/chan/goroutines.go # Undo the broken autoconf change in recent Fedora versions export CONFIG_SITE=NONE +%if %{build_offload_nvptx} +mkdir obji +IROOT=`pwd`/obji +cd nvptx-tools-%{nvptx_tools_gitrev} +rm -rf obj-%{gcc_target_platform} +mkdir obj-%{gcc_target_platform} +cd obj-%{gcc_target_platform} +CC="$CC" CXX="$CXX" CFLAGS="%{optflags}" CXXFLAGS="%{optflags}" \ +../configure --prefix=%{_prefix} +make %{?_smp_mflags} +make install prefix=${IROOT}%{_prefix} +cd ../.. + +ln -sf nvptx-newlib-%{nvptx_newlib_gitrev}/newlib newlib +rm -rf obj-offload-nvptx-none +mkdir obj-offload-nvptx-none + +cd obj-offload-nvptx-none +CC="$CC" CXX="$CXX" CFLAGS="$OPT_FLAGS" \ + CXXFLAGS="`echo " $OPT_FLAGS " | sed 's/ -Wall / /g;s/ -fexceptions / /g' \ + | sed 's/ -Wformat-security / -Wformat -Wformat-security /'`" \ + XCFLAGS="$OPT_FLAGS" TCFLAGS="$OPT_FLAGS" \ + ../configure --disable-bootstrap --disable-sjlj-exceptions \ + --enable-newlib-io-long-long --with-build-time-tools=${IROOT}%{_prefix}/nvptx-none/bin \ + --target nvptx-none --enable-as-accelerator-for=%{gcc_target_platform} \ + --enable-languages=c,c++,fortran,lto \ + --prefix=%{_prefix} --mandir=%{_mandir} --infodir=%{_infodir} \ + --with-bugurl=http://bugzilla.redhat.com/bugzilla \ + --enable-checking=release --with-system-zlib \ + --with-gcc-major-version-only --without-isl +make %{?_smp_mflags} +cd .. +rm -f newlib +%endif + rm -fr obj-%{gcc_target_platform} mkdir obj-%{gcc_target_platform} cd obj-%{gcc_target_platform} @@ -791,10 +832,7 @@ ln -sf libisl.so.15 libisl.so cd ../.. %endif -# Disable for now. -%if 0%{?rhel} == 6 %{?scl:PATH=%{_bindir}${PATH:+:${PATH}}} -%endif CC=gcc CXX=g++ @@ -841,6 +879,10 @@ CONFIGURE_OPTS="\ --with-isl=`pwd`/isl-install \ %else --without-isl \ +%if %{build_offload_nvptx} + --enable-offload-targets=nvptx-none \ + --without-cuda-driver \ +%endif %endif --disable-libmpx \ %if 0%{?rhel} < 7 @@ -1054,6 +1096,32 @@ cd .. %install rm -rf %{buildroot} +%if %{build_offload_nvptx} +cd nvptx-tools-%{nvptx_tools_gitrev} +cd obj-%{gcc_target_platform} +make install prefix=%{buildroot}%{_prefix} +cd ../.. + +ln -sf nvptx-newlib-%{nvptx_newlib_gitrev}/newlib newlib +cd obj-offload-nvptx-none +make prefix=%{buildroot}%{_prefix} mandir=%{buildroot}%{_mandir} \ + infodir=%{buildroot}%{_infodir} install +rm -rf %{buildroot}%{_prefix}/libexec/gcc/nvptx-none/%{gcc_major}/install-tools +rm -rf %{buildroot}%{_prefix}/libexec/gcc/%{gcc_target_platform}/%{gcc_major}/accel/nvptx-none/{install-tools,plugin,cc1,cc1plus,f951} +rm -rf %{buildroot}%{_infodir} %{buildroot}%{_mandir}/man7 %{buildroot}%{_prefix}/share/locale +rm -rf %{buildroot}%{_prefix}/lib/gcc/nvptx-none/%{gcc_major}/{install-tools,plugin} +rm -rf %{buildroot}%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/accel/nvptx-none/{install-tools,plugin,include-fixed} +rm -rf %{buildroot}%{_prefix}/%{_lib}/libc[cp]1* +mv -f %{buildroot}%{_prefix}/nvptx-none/lib/*.{a,spec} %{buildroot}%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/accel/nvptx-none/ +mv -f %{buildroot}%{_prefix}/nvptx-none/lib/mgomp/*.{a,spec} %{buildroot}%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/accel/nvptx-none/mgomp/ +mv -f %{buildroot}%{_prefix}/lib/gcc/nvptx-none/%{gcc_major}/*.a %{buildroot}%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/accel/nvptx-none/ +mv -f %{buildroot}%{_prefix}/lib/gcc/nvptx-none/%{gcc_major}/mgomp/*.a %{buildroot}%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/accel/nvptx-none/mgomp/ +find %{buildroot}%{_prefix}/lib/gcc/nvptx-none %{buildroot}%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/accel/nvptx-none \ + %{buildroot}%{_prefix}/nvptx-none/lib -name \*.la | xargs rm +cd .. +rm -f newlib +%endif + %if %{build_libstdcxx_docs} %if 0%{?rhel} < 7 export PATH=`pwd`/obj-%{gcc_target_platform}/doxygen-install/bin/${PATH:+:${PATH}} @@ -1876,10 +1944,6 @@ fi %postun -n libatomic -p /sbin/ldconfig -%post -n libasan -p /sbin/ldconfig - -%postun -n libasan -p /sbin/ldconfig - %post -n libasan5 -p /sbin/ldconfig %postun -n libasan5 -p /sbin/ldconfig @@ -2412,8 +2476,11 @@ fi %endif %if %{build_libasan} +# GTS 9 libasan5 would clash with the system RHEL 8 libasan. +%if 0%{?rhel} < 8 %files -n libasan5 %{?scl:%{_root_prefix}}%{!?scl:%{_prefix}}/%{_lib}/libasan.so.5* +%endif %files -n %{?scl_prefix}libasan-devel %dir %{_prefix}/lib/gcc @@ -2438,8 +2505,11 @@ fi %endif %if %{build_libtsan} +# Use the system libtsan. +%if 0%{?rhel} < 8 %files -n libtsan %{?scl:%{_root_prefix}}%{!?scl:%{_prefix}}/%{_lib}/libtsan.so.0* +%endif %files -n %{?scl_prefix}libtsan-devel %dir %{_prefix}/lib/gcc @@ -2452,8 +2522,11 @@ fi %endif %if %{build_libubsan} +# GTS 9 libubsan1 would clash with the system RHEL 8 libubsan. +%if 0%{?rhel} < 8 %files -n libubsan1 %{?scl:%{_root_prefix}}%{!?scl:%{_prefix}}/%{_lib}/libubsan.so.1* +%endif %files -n %{?scl_prefix}libubsan-devel %dir %{_prefix}/lib/gcc @@ -2465,8 +2538,11 @@ fi %endif %if %{build_liblsan} +# Use the system liblsan. +%if 0%{?rhel} < 8 %files -n liblsan %{?scl:%{_root_prefix}}%{!?scl:%{_prefix}}/%{_lib}/liblsan.so.0* +%endif %files -n %{?scl_prefix}liblsan-devel %dir %{_prefix}/lib/gcc @@ -2517,6 +2593,61 @@ fi %{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/plugin/libcp1plugin.so* %doc rpm.doc/changelogs/libcc1/ChangeLog* +%if %{build_offload_nvptx} +%files -n %{?scl_prefix}offload-nvptx +%{_prefix}/bin/nvptx-none-* +%{_prefix}/bin/%{gcc_target_platform}-accel-nvptx-none-gcc +%dir %{_prefix}/lib/gcc +%dir %{_prefix}/lib/gcc/%{gcc_target_platform} +%dir %{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major} +%dir %{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/accel +%dir %{_prefix}/libexec/gcc +%dir %{_prefix}/libexec/gcc/%{gcc_target_platform} +%dir %{_prefix}/libexec/gcc/%{gcc_target_platform}/%{gcc_major} +%dir %{_prefix}/libexec/gcc/%{gcc_target_platform}/%{gcc_major}/accel +%{_prefix}/lib/gcc/nvptx-none +%{_prefix}/lib/gcc/%{gcc_target_platform}/%{gcc_major}/accel/nvptx-none +%{_prefix}/libexec/gcc/%{gcc_target_platform}/%{gcc_major}/accel/nvptx-none +%dir %{_prefix}/nvptx-none +%{_prefix}/nvptx-none/bin +%{_prefix}/nvptx-none/include + %endif + %changelog +* Wed Nov 27 2019 Marek Polacek 9.2.1-2.2 +- fix offload-nvptx requires + +* Mon Nov 25 2019 Marek Polacek 9.2.1-2.1 +- add offload-nvptx (#1698607) + +* Thu Nov 21 2019 Marek Polacek 9.2.1-2 +- update from Fedora gcc-9.2.1-2 (#1747158) +- fix ABI change in deque iterators (PR libstdc++/92267) +- fix up sink select_best_block (PR tree-optimization/91355) +- revert PR tree-optimization/91790 fix +- allow MODE_PARTIAL_INT modes for integer constant input operands + (PR other/92090) +- fix adjust_unroll_factor (PR middle-end/90796) +- fixes for SVE Vector PCS on AArch64: emit .variant_pcs for + aarch64_vector_pcs symbol references (#1726641) + +* Tue Sep 24 2019 Marek Polacek 9.1.1-2.4 +- drop libtsan and liblsan (#1729402) + +* Tue Aug 27 2019 Marek Polacek 9.1.1-2.3 +- require binutils >= 2.31 so that gcc supports -mpltseq (#1744988) + +* Mon Jul 22 2019 Marek Polacek 9.1.1-2.2 +- small fixes for the Fortran patches (#1722881) + +* Sun Jul 21 2019 Marek Polacek 9.1.1-2.1 +- add Obsoletes for libasan5 and libubsan1 on RHEL 8 (#1722892) + +* Fri Jul 19 2019 Marek Polacek 9.1.1-2 +- update from Fedora 9.1.1-2 (#1728745) +- apply Fortran patches (#1722881) +- do not include libasan5 and libubsan1 on RHEL 8 and use the system + version (#1722892) + * Tue Jun 4 2019 Marek Polacek 9.1.1-1 - new package