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