|
 |
d0de29 |
From aafd9c215d41b4a846c6724bc25025b124c65ec4 Mon Sep 17 00:00:00 2001
|
|
|
d0de29 |
From: Jim MacArthur <jim.macarthur@codethink.co.uk>
|
|
|
d0de29 |
Date: Wed, 18 Nov 2015 15:08:56 +0000
|
|
|
d0de29 |
Subject: [PATCH 13/16] Add the SEQUENCE attribute by default if it's not
|
|
|
d0de29 |
present.
|
|
|
d0de29 |
|
|
|
d0de29 |
Use -fdec-sequence to enable this feature. Also enabled by -fdec.
|
|
|
d0de29 |
---
|
|
|
d0de29 |
gcc/fortran/lang.opt | 4 ++
|
|
|
d0de29 |
gcc/fortran/options.c | 1 +
|
|
|
d0de29 |
gcc/fortran/resolve.c | 13 +++--
|
|
|
d0de29 |
...dec_add_SEQUENCE_to_COMMON_block_by_default_1.f | 57 ++++++++++++++++++++++
|
|
|
d0de29 |
...dec_add_SEQUENCE_to_COMMON_block_by_default_2.f | 57 ++++++++++++++++++++++
|
|
|
d0de29 |
...dec_add_SEQUENCE_to_COMMON_block_by_default_3.f | 57 ++++++++++++++++++++++
|
|
|
d0de29 |
6 files changed, 186 insertions(+), 3 deletions(-)
|
|
|
d0de29 |
create mode 100644 gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_1.f
|
|
|
d0de29 |
create mode 100644 gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_2.f
|
|
|
d0de29 |
create mode 100644 gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_3.f
|
|
|
d0de29 |
|
|
|
d0de29 |
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
|
|
|
d0de29 |
index 2a8f5f661a8..ffd9ce6f270 100644
|
|
|
d0de29 |
--- a/gcc/fortran/lang.opt
|
|
|
d0de29 |
+++ b/gcc/fortran/lang.opt
|
|
|
d0de29 |
@@ -494,6 +494,10 @@ fdec-promotion
|
|
|
d0de29 |
Fortran Var(flag_dec_promotion)
|
|
|
d0de29 |
Add support for type promotion in intrinsic arguments.
|
|
|
d0de29 |
|
|
|
d0de29 |
+fdec-sequence
|
|
|
d0de29 |
+Fortran Var(flag_dec_sequence)
|
|
|
d0de29 |
+Add the SEQUENCE attribute by default if it's not present.
|
|
|
d0de29 |
+
|
|
|
d0de29 |
fdec-structure
|
|
|
d0de29 |
Fortran Var(flag_dec_structure)
|
|
|
d0de29 |
Enable support for DEC STRUCTURE/RECORD.
|
|
|
d0de29 |
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
|
|
|
d0de29 |
index 7a2583a2076..b6fd327d057 100644
|
|
|
d0de29 |
--- a/gcc/fortran/options.c
|
|
|
d0de29 |
+++ b/gcc/fortran/options.c
|
|
|
d0de29 |
@@ -84,6 +84,7 @@ set_dec_flags (int value)
|
|
|
d0de29 |
SET_BITFLAG (flag_dec_override_kind, value, value);
|
|
|
d0de29 |
SET_BITFLAG (flag_dec_non_logical_if, value, value);
|
|
|
d0de29 |
SET_BITFLAG (flag_dec_promotion, value, value);
|
|
|
d0de29 |
+ SET_BITFLAG (flag_dec_sequence, value, value);
|
|
|
d0de29 |
}
|
|
|
d0de29 |
|
|
|
d0de29 |
/* Finalize DEC flags. */
|
|
|
d0de29 |
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
|
|
|
d0de29 |
index a90f7f849b5..08627866c9c 100644
|
|
|
d0de29 |
--- a/gcc/fortran/resolve.c
|
|
|
d0de29 |
+++ b/gcc/fortran/resolve.c
|
|
|
d0de29 |
@@ -968,9 +968,16 @@ resolve_common_vars (gfc_common_head *common_block, bool named_common)
|
|
|
d0de29 |
|
|
|
d0de29 |
if (!(csym->ts.u.derived->attr.sequence
|
|
|
d0de29 |
|| csym->ts.u.derived->attr.is_bind_c))
|
|
|
d0de29 |
- gfc_error_now ("Derived type variable %qs in COMMON at %L "
|
|
|
d0de29 |
- "has neither the SEQUENCE nor the BIND(C) "
|
|
|
d0de29 |
- "attribute", csym->name, &csym->declared_at);
|
|
|
d0de29 |
+ {
|
|
|
d0de29 |
+ if (flag_dec_sequence)
|
|
|
d0de29 |
+ /* Assume sequence. */
|
|
|
d0de29 |
+ csym->ts.u.derived->attr.sequence = 1;
|
|
|
d0de29 |
+ else
|
|
|
d0de29 |
+ gfc_error_now ("Derived type variable '%s' in COMMON at %L "
|
|
|
d0de29 |
+ "has neither the SEQUENCE nor the BIND(C) "
|
|
|
d0de29 |
+ "attribute", csym->name, &csym->declared_at);
|
|
|
d0de29 |
+ }
|
|
|
d0de29 |
+
|
|
|
d0de29 |
if (csym->ts.u.derived->attr.alloc_comp)
|
|
|
d0de29 |
gfc_error_now ("Derived type variable %qs in COMMON at %L "
|
|
|
d0de29 |
"has an ultimate component that is "
|
|
|
d0de29 |
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
|
|
|
d0de29 |
new file mode 100644
|
|
|
d0de29 |
index 00000000000..fe7b39625eb
|
|
|
d0de29 |
--- /dev/null
|
|
|
d0de29 |
+++ b/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_1.f
|
|
|
d0de29 |
@@ -0,0 +1,57 @@
|
|
|
d0de29 |
+! { dg-do run }
|
|
|
d0de29 |
+! { dg-options "-fdec" }
|
|
|
d0de29 |
+!
|
|
|
d0de29 |
+! Test add default SEQUENCE attribute derived types appearing in
|
|
|
d0de29 |
+! COMMON blocks and EQUIVALENCE statements.
|
|
|
d0de29 |
+!
|
|
|
d0de29 |
+! Contributed by Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
|
|
|
d0de29 |
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
|
|
|
d0de29 |
+!
|
|
|
d0de29 |
+ MODULE SEQ
|
|
|
d0de29 |
+ TYPE STRUCT1
|
|
|
d0de29 |
+ INTEGER*4 ID
|
|
|
d0de29 |
+ INTEGER*4 TYPE
|
|
|
d0de29 |
+ INTEGER*8 DEFVAL
|
|
|
d0de29 |
+ CHARACTER*(4) NAME
|
|
|
d0de29 |
+ LOGICAL*1 NIL
|
|
|
d0de29 |
+ END TYPE STRUCT1
|
|
|
d0de29 |
+ END MODULE
|
|
|
d0de29 |
+
|
|
|
d0de29 |
+ SUBROUTINE A
|
|
|
d0de29 |
+ USE SEQ
|
|
|
d0de29 |
+ TYPE (STRUCT1) S
|
|
|
d0de29 |
+ COMMON /BLOCK1/ S
|
|
|
d0de29 |
+ IF (S%ID.NE.5) STOP 1
|
|
|
d0de29 |
+ IF (S%TYPE.NE.1000) STOP 2
|
|
|
d0de29 |
+ IF (S%DEFVAL.NE.-99) STOP 3
|
|
|
d0de29 |
+ IF (S%NAME.NE."JANE") STOP 4
|
|
|
d0de29 |
+ IF (S%NIL.NEQV..FALSE.) STOP 5
|
|
|
d0de29 |
+ END SUBROUTINE
|
|
|
d0de29 |
+
|
|
|
d0de29 |
+ PROGRAM sequence_att_common
|
|
|
d0de29 |
+ USE SEQ
|
|
|
d0de29 |
+ IMPLICIT NONE
|
|
|
d0de29 |
+ TYPE (STRUCT1) S1
|
|
|
d0de29 |
+ TYPE (STRUCT1) S2
|
|
|
d0de29 |
+ TYPE (STRUCT1) S3
|
|
|
d0de29 |
+
|
|
|
d0de29 |
+ EQUIVALENCE (S1,S2)
|
|
|
d0de29 |
+ COMMON /BLOCK1/ S3
|
|
|
d0de29 |
+
|
|
|
d0de29 |
+ S1%ID = 5
|
|
|
d0de29 |
+ S1%TYPE = 1000
|
|
|
d0de29 |
+ S1%DEFVAL = -99
|
|
|
d0de29 |
+ S1%NAME = "JANE"
|
|
|
d0de29 |
+ S1%NIL = .FALSE.
|
|
|
d0de29 |
+
|
|
|
d0de29 |
+ IF (S2%ID.NE.5) STOP 1
|
|
|
d0de29 |
+ IF (S2%TYPE.NE.1000) STOP 2
|
|
|
d0de29 |
+ IF (S2%DEFVAL.NE.-99) STOP 3
|
|
|
d0de29 |
+ IF (S2%NAME.NE."JANE") STOP 4
|
|
|
d0de29 |
+ IF (S2%NIL.NEQV..FALSE.) STOP 5
|
|
|
d0de29 |
+
|
|
|
d0de29 |
+ S3 = S1
|
|
|
d0de29 |
+
|
|
|
d0de29 |
+ CALL A
|
|
|
d0de29 |
+
|
|
|
d0de29 |
+ END
|
|
|
d0de29 |
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
|
|
|
d0de29 |
new file mode 100644
|
|
|
d0de29 |
index 00000000000..83512f0f3a2
|
|
|
d0de29 |
--- /dev/null
|
|
|
d0de29 |
+++ b/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_2.f
|
|
|
d0de29 |
@@ -0,0 +1,57 @@
|
|
|
d0de29 |
+! { dg-do run }
|
|
|
d0de29 |
+! { dg-options "-fdec-sequence" }
|
|
|
d0de29 |
+!
|
|
|
d0de29 |
+! Test add default SEQUENCE attribute derived types appearing in
|
|
|
d0de29 |
+! COMMON blocks and EQUIVALENCE statements.
|
|
|
d0de29 |
+!
|
|
|
d0de29 |
+! Contributed by Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
|
|
|
d0de29 |
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
|
|
|
d0de29 |
+!
|
|
|
d0de29 |
+ MODULE SEQ
|
|
|
d0de29 |
+ TYPE STRUCT1
|
|
|
d0de29 |
+ INTEGER*4 ID
|
|
|
d0de29 |
+ INTEGER*4 TYPE
|
|
|
d0de29 |
+ INTEGER*8 DEFVAL
|
|
|
d0de29 |
+ CHARACTER*(4) NAME
|
|
|
d0de29 |
+ LOGICAL*1 NIL
|
|
|
d0de29 |
+ END TYPE STRUCT1
|
|
|
d0de29 |
+ END MODULE
|
|
|
d0de29 |
+
|
|
|
d0de29 |
+ SUBROUTINE A
|
|
|
d0de29 |
+ USE SEQ
|
|
|
d0de29 |
+ TYPE (STRUCT1) S
|
|
|
d0de29 |
+ COMMON /BLOCK1/ S
|
|
|
d0de29 |
+ IF (S%ID.NE.5) STOP 1
|
|
|
d0de29 |
+ IF (S%TYPE.NE.1000) STOP 2
|
|
|
d0de29 |
+ IF (S%DEFVAL.NE.-99) STOP 3
|
|
|
d0de29 |
+ IF (S%NAME.NE."JANE") STOP 4
|
|
|
d0de29 |
+ IF (S%NIL.NEQV..FALSE.) STOP 5
|
|
|
d0de29 |
+ END SUBROUTINE
|
|
|
d0de29 |
+
|
|
|
d0de29 |
+ PROGRAM sequence_att_common
|
|
|
d0de29 |
+ USE SEQ
|
|
|
d0de29 |
+ IMPLICIT NONE
|
|
|
d0de29 |
+ TYPE (STRUCT1) S1
|
|
|
d0de29 |
+ TYPE (STRUCT1) S2
|
|
|
d0de29 |
+ TYPE (STRUCT1) S3
|
|
|
d0de29 |
+
|
|
|
d0de29 |
+ EQUIVALENCE (S1,S2)
|
|
|
d0de29 |
+ COMMON /BLOCK1/ S3
|
|
|
d0de29 |
+
|
|
|
d0de29 |
+ S1%ID = 5
|
|
|
d0de29 |
+ S1%TYPE = 1000
|
|
|
d0de29 |
+ S1%DEFVAL = -99
|
|
|
d0de29 |
+ S1%NAME = "JANE"
|
|
|
d0de29 |
+ S1%NIL = .FALSE.
|
|
|
d0de29 |
+
|
|
|
d0de29 |
+ IF (S2%ID.NE.5) STOP 1
|
|
|
d0de29 |
+ IF (S2%TYPE.NE.1000) STOP 2
|
|
|
d0de29 |
+ IF (S2%DEFVAL.NE.-99) STOP 3
|
|
|
d0de29 |
+ IF (S2%NAME.NE."JANE") STOP 4
|
|
|
d0de29 |
+ IF (S2%NIL.NEQV..FALSE.) STOP 5
|
|
|
d0de29 |
+
|
|
|
d0de29 |
+ S3 = S1
|
|
|
d0de29 |
+
|
|
|
d0de29 |
+ CALL A
|
|
|
d0de29 |
+
|
|
|
d0de29 |
+ END
|
|
|
d0de29 |
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
|
|
|
d0de29 |
new file mode 100644
|
|
|
d0de29 |
index 00000000000..26cd59f9090
|
|
|
d0de29 |
--- /dev/null
|
|
|
d0de29 |
+++ b/gcc/testsuite/gfortran.dg/dec_add_SEQUENCE_to_COMMON_block_by_default_3.f
|
|
|
d0de29 |
@@ -0,0 +1,57 @@
|
|
|
d0de29 |
+! { dg-do compile }
|
|
|
d0de29 |
+! { dg-options "-fdec -fno-dec-sequence" }
|
|
|
d0de29 |
+!
|
|
|
d0de29 |
+! Test add default SEQUENCE attribute derived types appearing in
|
|
|
d0de29 |
+! COMMON blocks and EQUIVALENCE statements.
|
|
|
d0de29 |
+!
|
|
|
d0de29 |
+! Contributed by Francisco Redondo Marchena <francisco.marchena@codethink.co.uk>
|
|
|
d0de29 |
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
|
|
|
d0de29 |
+!
|
|
|
d0de29 |
+ MODULE SEQ
|
|
|
d0de29 |
+ TYPE STRUCT1
|
|
|
d0de29 |
+ INTEGER*4 ID
|
|
|
d0de29 |
+ INTEGER*4 TYPE
|
|
|
d0de29 |
+ INTEGER*8 DEFVAL
|
|
|
d0de29 |
+ CHARACTER*(4) NAME
|
|
|
d0de29 |
+ LOGICAL*1 NIL
|
|
|
d0de29 |
+ END TYPE STRUCT1
|
|
|
d0de29 |
+ END MODULE
|
|
|
d0de29 |
+
|
|
|
d0de29 |
+ SUBROUTINE A
|
|
|
d0de29 |
+ USE SEQ
|
|
|
d0de29 |
+ TYPE (STRUCT1) S ! { dg-error "Derived type variable" }
|
|
|
d0de29 |
+ COMMON /BLOCK1/ S
|
|
|
d0de29 |
+ IF (S%ID.NE.5) STOP 1
|
|
|
d0de29 |
+ IF (S%TYPE.NE.1000) STOP 2
|
|
|
d0de29 |
+ IF (S%DEFVAL.NE.-99) STOP 3
|
|
|
d0de29 |
+ IF (S%NAME.NE."JANE") STOP 4
|
|
|
d0de29 |
+ IF (S%NIL.NEQV..FALSE.) STOP 5
|
|
|
d0de29 |
+ END SUBROUTINE
|
|
|
d0de29 |
+
|
|
|
d0de29 |
+ PROGRAM sequence_att_common
|
|
|
d0de29 |
+ USE SEQ
|
|
|
d0de29 |
+ IMPLICIT NONE
|
|
|
d0de29 |
+ TYPE (STRUCT1) S1
|
|
|
d0de29 |
+ TYPE (STRUCT1) S2
|
|
|
d0de29 |
+ TYPE (STRUCT1) S3 ! { dg-error "Derived type variable" }
|
|
|
d0de29 |
+
|
|
|
d0de29 |
+ EQUIVALENCE (S1,S2) ! { dg-error "Derived type variable" }
|
|
|
d0de29 |
+ COMMON /BLOCK1/ S3
|
|
|
d0de29 |
+
|
|
|
d0de29 |
+ S1%ID = 5
|
|
|
d0de29 |
+ S1%TYPE = 1000
|
|
|
d0de29 |
+ S1%DEFVAL = -99
|
|
|
d0de29 |
+ S1%NAME = "JANE"
|
|
|
d0de29 |
+ S1%NIL = .FALSE.
|
|
|
d0de29 |
+
|
|
|
d0de29 |
+ IF (S2%ID.NE.5) STOP 1
|
|
|
d0de29 |
+ IF (S2%TYPE.NE.1000) STOP 2
|
|
|
d0de29 |
+ IF (S2%DEFVAL.NE.-99) STOP 3
|
|
|
d0de29 |
+ IF (S2%NAME.NE."JANE") STOP 4
|
|
|
d0de29 |
+ IF (S2%NIL.NEQV..FALSE.) STOP 5
|
|
|
d0de29 |
+
|
|
|
d0de29 |
+ S3 = S1
|
|
|
d0de29 |
+
|
|
|
d0de29 |
+ CALL A
|
|
|
d0de29 |
+
|
|
|
d0de29 |
+ END
|
|
|
d0de29 |
--
|
|
|
d0de29 |
2.11.0
|
|
|
d0de29 |
|