Projects
home:pandora:RobinOS23
gcc
_service:download_src_package:gcc12-fortran-fde...
Sign Up
Log In
Username
Password
Overview
Repositories
Revisions
Requests
Users
Attributes
Meta
File _service:download_src_package:gcc12-fortran-fdec-old-init.patch of Package gcc
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.cc | 27 +++++++++++++++---- gcc/fortran/lang.opt | 4 +++ gcc/fortran/options.cc | 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.cc b/gcc/fortran/decl.cc index 723915822f3..5c8c1b7981b 100644 --- a/gcc/fortran/decl.cc +++ b/gcc/fortran/decl.cc @@ -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.cc b/gcc/fortran/options.cc index 9a042f64881..d6bd36c3a8a 100644 --- a/gcc/fortran/options.cc +++ b/gcc/fortran/options.cc @@ -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
Locations
Projects
Search
Status Monitor
Help
Open Build Service
OBS Manuals
API Documentation
OBS Portal
Reporting a Bug
Contact
Mailing List
Forums
Chat (IRC)
Twitter
Open Build Service (OBS)
is an
openSUSE project
.
浙ICP备2022010568号-2