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