diff options
| -rw-r--r-- | bootstrap/src/BuildModel.hs | 28 | ||||
| -rw-r--r-- | bootstrap/unit_test/SubmoduleSourceConstructionTest.hs | 11 |
2 files changed, 28 insertions, 11 deletions
diff --git a/bootstrap/src/BuildModel.hs b/bootstrap/src/BuildModel.hs index c6e422b..b8fc537 100644 --- a/bootstrap/src/BuildModel.hs +++ b/bootstrap/src/BuildModel.hs @@ -30,7 +30,7 @@ data LineContents = | ModuleDeclaration String | ModuleUsed String | ModuleSubprogramDeclaration - | SubmoduleDeclaration String + | SubmoduleDeclaration String String | Other data RawSource = RawSource { @@ -55,6 +55,7 @@ data Source = { submoduleSourceFileName :: FilePath , submoduleObjectFileName :: FilePath -> FilePath , submoduleModulesUsed :: [String] + , submoduleParentName :: String , submoduleName :: String } @@ -86,11 +87,13 @@ processRawSource rawSource = , moduleProducesSmod = hasModuleSubprogramDeclaration parsedContents } else if hasSubmoduleDeclaration parsedContents - then Submodule { submoduleSourceFileName = sourceFileName - , submoduleObjectFileName = objectFileName - , submoduleModulesUsed = modulesUsed - , submoduleName = getSubmoduleName parsedContents - } + then Submodule + { submoduleSourceFileName = sourceFileName + , submoduleObjectFileName = objectFileName + , submoduleModulesUsed = modulesUsed + , submoduleParentName = getSubmoduleParentName parsedContents + , submoduleName = getSubmoduleName parsedContents + } else undefined constructCompileTimeInfo :: Source -> [String] -> FilePath -> CompileTimeInfo @@ -178,11 +181,20 @@ getModuleName pc = head $ mapMaybe contentToMaybeModuleName pc ModuleDeclaration moduleName -> Just moduleName _ -> Nothing +getSubmoduleParentName :: [LineContents] -> String +getSubmoduleParentName pc = head $ mapMaybe contentToMaybeModuleName pc + where + contentToMaybeModuleName content = case content of + SubmoduleDeclaration submoduleParentName submoduleName -> + Just submoduleParentName + _ -> Nothing + getSubmoduleName :: [LineContents] -> String getSubmoduleName pc = head $ mapMaybe contentToMaybeModuleName pc where contentToMaybeModuleName content = case content of - SubmoduleDeclaration submoduleName -> Just submoduleName + SubmoduleDeclaration submoduleParentName submoduleName -> + Just submoduleName _ -> Nothing readFileLinesIO :: FilePath -> IO [String] @@ -236,7 +248,7 @@ submoduleDeclaration = do skipSpaces name <- validIdentifier skipSpaceCommentOrEnd - return $ SubmoduleDeclaration ((intercalate "@" parents) ++ "@" ++ name) + return $ SubmoduleDeclaration (intercalate "@" parents) name submoduleParents :: ReadP [String] submoduleParents = do diff --git a/bootstrap/unit_test/SubmoduleSourceConstructionTest.hs b/bootstrap/unit_test/SubmoduleSourceConstructionTest.hs index 577207e..d07a6ed 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 parent's name" checkSubmoduleParentName , then' "it knows its name" checkSubmoduleName ] ] @@ -68,7 +69,11 @@ checkSubmoduleModulesUsed s@(Submodule{}) = assertEquals ["module1", "module2"] $ submoduleModulesUsed s checkSubmoduleModulesUsed _ = fail' "wasn't a Submodule" +checkSubmoduleParentName :: Source -> Result +checkSubmoduleParentName s@(Submodule{}) = + assertEquals "some_module@parent" (submoduleParentName s) +checkSubmoduleParentName _ = fail' "wasn't a Submodule" + checkSubmoduleName :: Source -> Result -checkSubmoduleName s@(Submodule{}) = - assertEquals "some_module@parent@child" $ submoduleName s -checkSubmoduleName _ = fail' "wasn't a Submodule" +checkSubmoduleName s@(Submodule{}) = assertEquals "child" $ submoduleName s +checkSubmoduleName _ = fail' "wasn't a Submodule" |