diff options
Diffstat (limited to 'bootstrap')
| -rw-r--r-- | bootstrap/src/BuildModel.hs | 22 | ||||
| -rw-r--r-- | bootstrap/unit_test/SubmoduleSourceConstructionTest.hs | 37 |
2 files changed, 58 insertions, 1 deletions
diff --git a/bootstrap/src/BuildModel.hs b/bootstrap/src/BuildModel.hs index dc57f81..f784624 100644 --- a/bootstrap/src/BuildModel.hs +++ b/bootstrap/src/BuildModel.hs @@ -30,6 +30,7 @@ data LineContents = | ModuleDeclaration String | ModuleUsed String | ModuleSubprogramDeclaration + | SubmoduleDeclaration | Other data RawSource = RawSource { @@ -50,6 +51,7 @@ data Source = , moduleName :: String , moduleProducesSmod :: Bool } + | Submodule processRawSource :: RawSource -> Source processRawSource rawSource = @@ -71,7 +73,9 @@ processRawSource rawSource = , moduleName = getModuleName parsedContents , moduleProducesSmod = hasModuleSubprogramDeclaration parsedContents } - else undefined + else if hasSubmoduleDeclaration parsedContents + then Submodule + else undefined pathSeparatorsToUnderscores :: FilePath -> FilePath pathSeparatorsToUnderscores fileName = @@ -100,6 +104,15 @@ hasModuleDeclaration parsedContents = case filter f parsedContents of ModuleDeclaration{} -> True _ -> False +hasSubmoduleDeclaration :: [LineContents] -> Bool +hasSubmoduleDeclaration parsedContents = case filter f parsedContents of + x : _ -> True + _ -> False + where + f lc = case lc of + SubmoduleDeclaration -> True + _ -> False + hasModuleSubprogramDeclaration :: [LineContents] -> Bool hasModuleSubprogramDeclaration parsedContents = case filter f parsedContents of x : _ -> True @@ -146,6 +159,7 @@ fortranUsefulContents = programDeclaration <|> moduleSubprogramDeclaration <|> moduleDeclaration + <|> submoduleDeclaration <|> useStatement programDeclaration :: ReadP LineContents @@ -165,6 +179,12 @@ moduleDeclaration = do skipSpaceCommentOrEnd return $ ModuleDeclaration moduleName +submoduleDeclaration :: ReadP LineContents +submoduleDeclaration = do + skipSpaces + _ <- string "submodule" + return $ SubmoduleDeclaration + useStatement :: ReadP LineContents useStatement = do skipSpaces diff --git a/bootstrap/unit_test/SubmoduleSourceConstructionTest.hs b/bootstrap/unit_test/SubmoduleSourceConstructionTest.hs new file mode 100644 index 0000000..96492fb --- /dev/null +++ b/bootstrap/unit_test/SubmoduleSourceConstructionTest.hs @@ -0,0 +1,37 @@ +module SubmoduleSourceConstructionTest + ( test + ) +where + +import BuildModel ( RawSource(..) + , Source(..) + , processRawSource + ) +import Hedge ( Result + , Test + , assertThat + , givenInput + , then' + , whenTransformed + ) +import System.FilePath ( (</>) ) + +test :: IO (Test ()) +test = return $ givenInput + "a submodule" + exampleSubmodule + [ whenTransformed "processed to a source" + processRawSource + [then' "it is a Submodule" checkIsSubmodule] + ] + +exampleSubmodule :: RawSource +exampleSubmodule = RawSource submoduleSourceFileName' + $ unlines ["submodule (some_module:parent) child", "end submodule"] + +submoduleSourceFileName' :: String +submoduleSourceFileName' = "some" </> "file" </> "somewhere.f90" + +checkIsSubmodule :: Source -> Result +checkIsSubmodule Submodule{} = assertThat True +checkIsSubmodule _ = assertThat False |