Parse nested structure

Adds * parsing rules for StructStructures * name to StructStructure used for data reference notation * test for parsing a nested structure
camfort · Aug 19, 2019 · cb0cb91 · cb0cb91
1 parent e278e82
commit cb0cb91
Show file tree

Hide file tree

Showing 4 changed files with 18 additions and 2 deletions.
diff --git a/src/Language/Fortran/AST.hs b/src/Language/Fortran/AST.hs
@@ -461,7 +461,7 @@ data DataGroup a =
 data StructureItem a =
     StructFields a SrcSpan (TypeSpec a) (Maybe (AList Attribute a)) (AList Declarator a)
   | StructUnion a SrcSpan (AList UnionMap a)
-  | StructStructure a SrcSpan (Maybe String) (AList StructureItem a)
+  | StructStructure a SrcSpan (Maybe String) String (AList StructureItem a)
   deriving (Eq, Show, Data, Typeable, Generic, Functor)
 
 data UnionMap a =

diff --git a/src/Language/Fortran/Parser/Fortran77.y b/src/Language/Fortran/Parser/Fortran77.y
@@ -525,6 +525,8 @@ STRUCTURE_DECLARATION_STATEMENT
     in StructFields () s t attrs decls }
 | union NEWLINE UNION_MAPS endunion NEWLINE
   { StructUnion () (getTransSpan $1 $5) (fromReverseList $3) }
+| structure MAYBE_NAME NAME NEWLINE STRUCTURE_DECLARATIONS endstructure NEWLINE
+  { StructStructure () (getTransSpan $1 $7) $2 $3 (fromReverseList $5) }
 
 UNION_MAPS :: { [ UnionMap A0 ] }
 UNION_MAPS

diff --git a/src/Language/Fortran/PrettyPrint.hs b/src/Language/Fortran/PrettyPrint.hs
@@ -974,7 +974,7 @@ instance IndentablePretty (StructureItem a) where
     "union" <> newline <>
     foldl' (\doc item -> doc <> pprint v item (incIndentation i) <> newline) empty (aStrip maps) <>
     "end union"
-  pprint v (StructStructure a s mName items) _ = pprint' v (StStructure a s mName items)
+  pprint v (StructStructure a s mName _ items) _ = pprint' v (StStructure a s mName items)
 
 instance IndentablePretty (UnionMap a) where
   pprint v (UnionMap _ _ items) i =

diff --git a/test/Language/Fortran/Parser/Fortran77/ParserSpec.hs b/test/Language/Fortran/Parser/Fortran77/ParserSpec.hs
@@ -236,6 +236,20 @@ spec =
             st = StStructure () u (Just "foo") $ AList () u [StructUnion () u $ AList () u ds]
         resetSrcSpan (slParser src) `shouldBe` st
 
+      it "parses nested structure blocks" $ do
+        let src = init
+                $ unlines [ "      structure /foo/"
+                          , "        structure /bar/ baz"
+                          , "          integer qux"
+                          , "        end structure"
+                          , "      end structure"]
+            var = DeclVariable () u (varGen "qux") Nothing Nothing
+            innerst = StructStructure () u (Just "bar") ("baz")
+              $ AList () u [StructFields () u (TypeSpec () u TypeInteger Nothing) Nothing
+                $ AList () u [var]]
+            st = StStructure () u (Just "foo") $ AList () u [innerst]
+        resetSrcSpan (slParser src) `shouldBe` st
+
       it "parses character declarations with unspecfied lengths" $ do
         let src = "      character s*(*)"
             st = StDeclaration () u (TypeSpec () u (TypeCharacter Nothing Nothing) Nothing) Nothing $