From 28b00953f12d2fc0de9de75f26fd3c4346a44974 Mon Sep 17 00:00:00 2001
From: Brad Richardson <everythingfunctional@protonmail.com>
Date: Mon, 19 Oct 2020 16:13:53 -0500
Subject: Add test for a submodule's name

---
 bootstrap/src/BuildModel.hs                        | 41 +++++++++++++++++++---
 .../unit_test/SubmoduleSourceConstructionTest.hs   |  6 ++++
 2 files changed, 42 insertions(+), 5 deletions(-)

(limited to 'bootstrap')

diff --git a/bootstrap/src/BuildModel.hs b/bootstrap/src/BuildModel.hs
index db00e0d..eba1440 100644
--- a/bootstrap/src/BuildModel.hs
+++ b/bootstrap/src/BuildModel.hs
@@ -30,7 +30,7 @@ data LineContents =
   | ModuleDeclaration String
   | ModuleUsed String
   | ModuleSubprogramDeclaration
-  | SubmoduleDeclaration
+  | SubmoduleDeclaration String
   | Other
 
 data RawSource = RawSource {
@@ -55,6 +55,7 @@ data Source =
     { submoduleSourceFileName :: FilePath
     , submoduleObjectFileName :: FilePath -> FilePath
     , submoduleModulesUsed :: [String]
+    , submoduleName :: String
     }
 
 processRawSource :: RawSource -> Source
@@ -81,6 +82,7 @@ processRawSource rawSource =
             then Submodule { submoduleSourceFileName = sourceFileName
                            , submoduleObjectFileName = objectFileName
                            , submoduleModulesUsed    = modulesUsed
+                           , submoduleName = getSubmoduleName parsedContents
                            }
             else undefined
 
@@ -117,8 +119,8 @@ hasSubmoduleDeclaration parsedContents = case filter f parsedContents of
   _     -> False
  where
   f lc = case lc of
-    SubmoduleDeclaration -> True
-    _                    -> False
+    SubmoduleDeclaration{} -> True
+    _                      -> False
 
 hasModuleSubprogramDeclaration :: [LineContents] -> Bool
 hasModuleSubprogramDeclaration parsedContents = case filter f parsedContents of
@@ -143,6 +145,13 @@ getModuleName pc = head $ mapMaybe contentToMaybeModuleName pc
     ModuleDeclaration moduleName -> Just moduleName
     _                            -> Nothing
 
+getSubmoduleName :: [LineContents] -> String
+getSubmoduleName pc = head $ mapMaybe contentToMaybeModuleName pc
+ where
+  contentToMaybeModuleName content = case content of
+    SubmoduleDeclaration submoduleName -> Just submoduleName
+    _ -> Nothing
+
 readFileLinesIO :: FilePath -> IO [String]
 readFileLinesIO file = do
   contents <- readFile file
@@ -189,8 +198,30 @@ moduleDeclaration = do
 submoduleDeclaration :: ReadP LineContents
 submoduleDeclaration = do
   skipSpaces
-  _ <- string "submodule"
-  return $ SubmoduleDeclaration
+  _       <- string "submodule"
+  parents <- submoduleParents
+  skipSpaces
+  name <- validIdentifier
+  skipSpaceCommentOrEnd
+  return $ SubmoduleDeclaration ((intercalate "@" parents) ++ "@" ++ name)
+
+submoduleParents :: ReadP [String]
+submoduleParents = do
+  skipSpaces
+  _ <- char '('
+  skipSpaces
+  firstParent      <- validIdentifier
+  remainingParents <- many
+    (do
+      skipSpaces
+      _ <- char ':'
+      skipSpaces
+      name <- validIdentifier
+      return name
+    )
+  skipSpaces
+  _ <- char ')'
+  return $ firstParent : remainingParents
 
 useStatement :: ReadP LineContents
 useStatement = do
diff --git a/bootstrap/unit_test/SubmoduleSourceConstructionTest.hs b/bootstrap/unit_test/SubmoduleSourceConstructionTest.hs
index 956d782..577207e 100644
--- a/bootstrap/unit_test/SubmoduleSourceConstructionTest.hs
+++ b/bootstrap/unit_test/SubmoduleSourceConstructionTest.hs
@@ -32,6 +32,7 @@ test = return $ givenInput
         "its object file name is the 'flattened' path of the source file with '.o' appeneded"
         checkSubmoduleObjectFileName
       , then' "it knows what modules it uses directly" checkSubmoduleModulesUsed
+      , then' "it knows its name"                      checkSubmoduleName
       ]
   ]
 
@@ -66,3 +67,8 @@ checkSubmoduleModulesUsed :: Source -> Result
 checkSubmoduleModulesUsed s@(Submodule{}) =
   assertEquals ["module1", "module2"] $ submoduleModulesUsed s
 checkSubmoduleModulesUsed _ = fail' "wasn't a Submodule"
+
+checkSubmoduleName :: Source -> Result
+checkSubmoduleName s@(Submodule{}) =
+  assertEquals "some_module@parent@child" $ submoduleName s
+checkSubmoduleName _ = fail' "wasn't a Submodule"
-- 
cgit v1.2.3