2006-08-06 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/28590
	* parse.c (parse_derived): Remove the test for sequence type
	components of a sequence type.
	* resolve.c (resolve_fl_derived): Put the test here so that
	pointer components are tested.

2006-08-06  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/28590
	* gfortran.dg/sequence_types_1.f90: New test.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@115966 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 7be47e2..d5f0cfe 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2006-08-06  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/28590
+       * parse.c (parse_derived): Remove the test for sequence type
+       components of a sequence type.
+       * resolve.c (resolve_fl_derived): Put the test here so that
+       pointer components are tested.
+

 2006-08-05  Steven G. Kargl <kargls@comcast.nt>
 
        PR fortran/28548
 2006-08-05  Steven G. Kargl <kargls@comcast.nt>
 
        PR fortran/28548

diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 972805e..0416d28 100644 (file)
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -1498,7 +1498,6 @@ parse_derived (void)
 {
   int compiling_type, seen_private, seen_sequence, seen_component, error_flag;
   gfc_statement st;
 {
   int compiling_type, seen_private, seen_sequence, seen_component, error_flag;
   gfc_statement st;

-  gfc_component *c;

   gfc_state_data s;
 
   error_flag = 0;
   gfc_state_data s;
 
   error_flag = 0;


@@ -1596,20 +1595,6 @@ parse_derived (void)
        }
     }
 
        }
     }
 

-  /* Sanity checks on the structure.  If the structure has the
-     SEQUENCE attribute, then all component structures must also have
-     SEQUENCE.  */
-  if (error_flag == 0 && gfc_current_block ()->attr.sequence)
-    for (c = gfc_current_block ()->components; c; c = c->next)
-      {
-       if (c->ts.type == BT_DERIVED && c->ts.derived->attr.sequence == 0)
-         {
-           gfc_error
-             ("Component %s of SEQUENCE type declared at %C does not "
-              "have the SEQUENCE attribute", c->ts.derived->name);
-         }
-      }
-

   pop_state ();
 }
 
   pop_state ();
 }
 

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index c327a82..cb45a2b 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -5392,6 +5392,17 @@ resolve_fl_derived (gfc_symbol *sym)
          return FAILURE;
        }
 
          return FAILURE;
        }
 

+      if (sym->attr.sequence)
+       {
+         if (c->ts.type == BT_DERIVED && c->ts.derived->attr.sequence == 0)
+           {
+             gfc_error ("Component %s of SEQUENCE type declared at %L does "
+                        "not have the SEQUENCE attribute",
+                        c->ts.derived->name, &sym->declared_at);
+             return FAILURE;
+           }
+       }
+

       if (c->pointer || c->as == NULL)
        continue;
 
       if (c->pointer || c->as == NULL)
        continue;
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 7aa23eb..bdce8ca 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2006-08-06  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/28590
+       * gfortran.dg/sequence_types_1.f90: New test.
+

 2006-08-05  Steven G. Kargl <kargls@comcast.nt>
 
        PR fortran/28548
 2006-08-05  Steven G. Kargl <kargls@comcast.nt>
 
        PR fortran/28548

diff --git a/gcc/testsuite/gfortran.dg/sequence_types_1.f90 b/gcc/testsuite/gfortran.dg/sequence_types_1.f90
new file mode 100644 (file)
index 0000000..6c0bb24
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/sequence_types_1.f90
@@ -0,0 +1,79 @@
+! { dg-do compile }
+! Tests the fix for PR28590, in which pointer components of sequence
+! types would give the error that the component is itself not a
+! sequence type (4.4.1) if the component was not already defined.
+!
+! Contributed by Chris Nelson <ccnelson@itacllc.com>
+! 
+module data_types
+  Integer, Parameter :: kindAry    = selected_int_kind(r=8)
+  Integer, Parameter :: kindInt    = selected_int_kind(r=8)
+
+  Integer, Parameter :: kindQ      = selected_real_kind(p=6,r=37)
+  Integer, Parameter :: kindXYZ    = selected_real_kind(p=13,r=200)
+  Integer, Parameter :: kindDouble = selected_real_kind(p=13,r=200)
+
+  type GroupLoadInfo
+    sequence
+    Integer(kindAry)          :: loadMode
+    Integer(kindAry)          :: normalDir
+    Real(kindQ)               :: refS, refL, refX, refY, refZ
+    Real(kindQ)               :: forcex,   forcey,   forcez 
+    Real(kindQ)               :: forcexv,  forceyv,  forcezv 
+    Real(kindQ)               :: momx,     momy,     momz 
+    Real(kindQ)               :: momxv,    momyv,    momzv 
+    Real(kindQ)               :: flmassx,  flmassy,  flmassz 
+    Real(kindQ)               :: flmomtmx, flmomtmy, flmomtmz 
+    Real(kindQ)               :: flheatN
+  end type GroupLoadInfo
+
+  type GroupRigidMotion
+    sequence
+    Integer(kindInt)                     :: motiontyp
+    Real(kindXYZ), dimension(3)          :: xref
+    Real(kindXYZ), dimension(3)          :: angCurrent
+    Real(kindXYZ), dimension(3)          :: xdot
+    Real(kindXYZ), dimension(3)          :: angNew
+    Real(kindXYZ), dimension(3)          :: angRate
+    Real(kindDouble)                     :: curTim
+    Real(kindXYZ)              , pointer :: properties
+    Type(PrescribedMotionData) , pointer :: PrescribeDat
+  end type GroupRigidMotion
+
+  type PrescribedMotionData
+    sequence
+    Integer(kindInt)            :: prescr_typ
+    Real(kindXYZ), dimension(3) :: xvel
+    Real(kindXYZ)               :: amplitude
+    Real(kindXYZ)               :: frequency
+    Real(kindXYZ)               :: phase
+    Real(kindXYZ), dimension(3) :: thetadot
+    Real(kindXYZ), dimension(3) :: thetaddot
+  end type PrescribedMotionData
+  
+  type GroupDeformingMotion
+    sequence
+    Integer(kindAry) :: nmodes
+  end type GroupDeformingMotion
+  
+  type GroupLL
+    sequence
+    type(GroupLL)             , pointer :: next
+    type(GroupLL)             , pointer :: parent
+    character(32)                       :: name
+    type(GroupDefLL)          , pointer :: entities
+    type(GroupLoadInfo)       , pointer :: loadInfo
+    type(GroupRigidMotion)    , pointer :: RigidMotion
+    type(GroupDeformingMotion), pointer :: DeformingMotion
+  end type GroupLL
+  
+  type GroupDefLL 
+    sequence
+    type ( GroupDefLL ), pointer            :: next
+    Integer(kindInt)                        :: zone
+    Integer(kindInt)                        :: surface
+    type ( GroupLL ), pointer               :: subGrp
+    Integer(kindInt)                        :: normalDir
+    Integer(kindInt), dimension(:), pointer :: subset
+  end type GroupDefLL
+end module data_types