rpms/gcc
7
0
Fork 0
Code Issues Pull Requests Releases Activity
85c684937e
gcc/gcc11-fortran-fdec-old-init.patch
DistroBaker 05e20d1a72 Merged update from upstream sources 
This is an automated DistroBaker update from upstream sources.
If you do not know what this is about or would like to opt out,
contact the OSCI team.

Source: https://src.fedoraproject.org/rpms/gcc.git#89aaf2fccac8d279d2e82e0601574969c00e6833
2021-02-02 15:05:58 +00:00

186 lines
6.9 KiB
Diff
Raw Blame History

From 8bcc0f85ed1718c0dd9033ad4a34df181aabaffe Mon Sep 17 00:00:00 2001
From: Mark Eggleston <markeggleston@gcc.gnu.org>
Date: Fri, 22 Jan 2021 13:11:06 +0000
Subject: [PATCH 05/10] Allow old-style initializers in derived types
This allows simple declarations in derived types and structures, such as:
LOGICAL*1 NIL /0/
Only single value expressions are allowed at the moment.
Use -fdec-old-init to enable. Also enabled by -fdec.
---
gcc/fortran/decl.c | 27 +++++++++++++++----
gcc/fortran/lang.opt | 4 +++
gcc/fortran/options.c | 1 +
...ec_derived_types_initialised_old_style_1.f | 25 +++++++++++++++++
...ec_derived_types_initialised_old_style_2.f | 25 +++++++++++++++++
...ec_derived_types_initialised_old_style_3.f | 26 ++++++++++++++++++
6 files changed, 103 insertions(+), 5 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_1.f
create mode 100644 gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_2.f
create mode 100644 gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_3.f
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 723915822f3..5c8c1b7981b 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -2827,12 +2827,29 @@ variable_decl (int elem)
but not components of derived types. */
else if (gfc_current_state () == COMP_DERIVED)
{
- gfc_error ("Invalid old style initialization for derived type "
- "component at %C");
- m = MATCH_ERROR;
- goto cleanup;
+ if (flag_dec_old_init)
+ {
+ /* Attempt to match an old-style initializer which is a simple
+ integer or character expression; this will not work with
+ multiple values. */
+ m = gfc_match_init_expr (&initializer);
+ if (m == MATCH_ERROR)
+ goto cleanup;
+ else if (m == MATCH_YES)
+ {
+ m = gfc_match ("/");
+ if (m != MATCH_YES)
+ goto cleanup;
+ }
+ }
+ else
+ {
+ gfc_error ("Invalid old style initialization for derived type "
+ "component at %C");
+ m = MATCH_ERROR;
+ goto cleanup;
+ }
}
-
/* For structure components, read the initializer as a special
expression and let the rest of this function apply the initializer
as usual. */
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index d527c106bd6..25cc948699b 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -493,6 +493,10 @@ fdec-non-integer-index
Fortran Var(flag_dec_non_integer_index)
Enable support for non-integer substring indexes.
+fdec-old-init
+Fortran Var(flag_dec_old_init)
+Enable support for old style initializers in derived types.
+
fdec-structure
Fortran Var(flag_dec_structure)
Enable support for DEC STRUCTURE/RECORD.
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index 9a042f64881..d6bd36c3a8a 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_duplicates, value, value);
SET_BITFLAG (flag_dec_non_integer_index, value, value);
+ SET_BITFLAG (flag_dec_old_init, value, value);
}
/* Finalize DEC flags. */
diff --git a/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_1.f b/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_1.f
new file mode 100644
index 00000000000..eac4f9bfcf1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_1.f
@@ -0,0 +1,25 @@
+! { dg-do run }
+! { dg-options "-fdec" }
+!
+! Test old style initializers in derived types
+!
+! Contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+ PROGRAM spec_in_var
+ TYPE STRUCT1
+ INTEGER*4 ID /8/
+ INTEGER*4 TYPE /5/
+ INTEGER*8 DEFVAL /0/
+ CHARACTER*(5) NAME /'tests'/
+ LOGICAL*1 NIL /0/
+ END TYPE STRUCT1
+
+ TYPE (STRUCT1) SINST
+
+ IF(SINST%ID.NE.8) STOP 1
+ IF(SINST%TYPE.NE.5) STOP 2
+ IF(SINST%DEFVAL.NE.0) STOP 3
+ IF(SINST%NAME.NE.'tests') STOP 4
+ IF(SINST%NIL) STOP 5
+ END
diff --git a/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_2.f b/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_2.f
new file mode 100644
index 00000000000..d904c8b2974
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_2.f
@@ -0,0 +1,25 @@
+! { dg-do run }
+! { dg-options "-std=legacy -fdec-old-init" }
+!
+! Test old style initializers in derived types
+!
+! Contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+ PROGRAM spec_in_var
+ TYPE STRUCT1
+ INTEGER*4 ID /8/
+ INTEGER*4 TYPE /5/
+ INTEGER*8 DEFVAL /0/
+ CHARACTER*(5) NAME /'tests'/
+ LOGICAL*1 NIL /0/
+ END TYPE STRUCT1
+
+ TYPE (STRUCT1) SINST
+
+ IF(SINST%ID.NE.8) STOP 1
+ IF(SINST%TYPE.NE.5) STOP 2
+ IF(SINST%DEFVAL.NE.0) STOP 3
+ IF(SINST%NAME.NE.'tests') STOP 4
+ IF(SINST%NIL) STOP 5
+ END
diff --git a/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_3.f b/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_3.f
new file mode 100644
index 00000000000..58c2b4b66cf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_derived_types_initialised_old_style_3.f
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! { dg-options "-std=legacy -fdec -fno-dec-old-init" }
+!
+! Test old style initializers in derived types
+!
+! Contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
+!
+
+ PROGRAM spec_in_var
+ TYPE STRUCT1
+ INTEGER*4 ID /8/ ! { dg-error "Invalid old style initialization" }
+ INTEGER*4 TYPE /5/ ! { dg-error "Invalid old style initialization" }
+ INTEGER*8 DEFVAL /0/ ! { dg-error "Invalid old style initialization" }
+ CHARACTER*(5) NAME /'tests'/ ! { dg-error "Invalid old style initialization" }
+ LOGICAL*1 NIL /0/ ! { dg-error "Invalid old style initialization" }
+ END TYPE STRUCT1
+
+ TYPE (STRUCT1) SINST
+
+ IF(SINST%ID.NE.8) STOP 1 ! { dg-error "'id' at \\(1\\) is not a member" }
+ IF(SINST%TYPE.NE.5) STOP 2 ! { dg-error "'type' at \\(1\\) is not a member" }
+ IF(SINST%DEFVAL.NE.0) STOP 3 ! { dg-error "'defval' at \\(1\\) is not a member" }
+ IF(SINST%NAME.NE.'tests') STOP 4 ! { dg-error "'name' at \\(1\\) is not a member" }
+ IF(SINST%NIL) STOP 5 ! { dg-error "'nil' at \\(1\\) is not a member" }
+ END
--
2.27.0
Reference in New Issue View Git Blame Copy Permalink