Blame SOURCES/0013-Add-the-SEQUENCE-attribute-by-default-if-it-s-not-pr.patch

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