diff options
| -rw-r--r-- | bootstrap/src/BuildModel.hs | 84 | ||||
| -rw-r--r-- | bootstrap/test/Spec.hs | 38 | ||||
| -rw-r--r-- | bootstrap/unit_test/SubmoduleToCompileInfoTest.hs | 3 |
3 files changed, 85 insertions, 40 deletions
diff --git a/bootstrap/src/BuildModel.hs b/bootstrap/src/BuildModel.hs index d7b39dc..95d3cac 100644 --- a/bootstrap/src/BuildModel.hs +++ b/bootstrap/src/BuildModel.hs @@ -1,6 +1,7 @@ module BuildModel where import Control.Applicative ( (<|>) ) +import Control.Monad ( when ) import Data.Char ( isAsciiLower , isDigit , toLower @@ -30,7 +31,7 @@ data LineContents = | ModuleDeclaration String | ModuleUsed String | ModuleSubprogramDeclaration - | SubmoduleDeclaration String String + | SubmoduleDeclaration String String String | Other data RawSource = RawSource { @@ -55,6 +56,7 @@ data Source = { submoduleSourceFileName :: FilePath , submoduleObjectFileName :: FilePath -> FilePath , submoduleModulesUsed :: [String] + , submoduleBaseModuleName :: String , submoduleParentName :: String , submoduleName :: String } @@ -68,33 +70,37 @@ data CompileTimeInfo = CompileTimeInfo { processRawSource :: RawSource -> Source processRawSource rawSource = - let sourceFileName = rawSourceFilename rawSource - parsedContents = parseContents rawSource - objectFileName = - \bd -> bd </> (pathSeparatorsToUnderscores sourceFileName) <.> "o" - modulesUsed = getModulesUsed parsedContents - in if hasProgramDeclaration parsedContents - then Program { programSourceFileName = sourceFileName - , programObjectFileName = objectFileName - , programModulesUsed = modulesUsed - } - else if hasModuleDeclaration parsedContents - then Module - { moduleSourceFileName = sourceFileName - , moduleObjectFileName = objectFileName - , moduleModulesUsed = modulesUsed - , moduleName = getModuleName parsedContents - , moduleProducesSmod = hasModuleSubprogramDeclaration parsedContents + let + sourceFileName = rawSourceFilename rawSource + parsedContents = parseContents rawSource + objectFileName = + \bd -> bd </> (pathSeparatorsToUnderscores sourceFileName) <.> "o" + modulesUsed = getModulesUsed parsedContents + in + if hasProgramDeclaration parsedContents + then Program { programSourceFileName = sourceFileName + , programObjectFileName = objectFileName + , programModulesUsed = modulesUsed + } + else if hasModuleDeclaration parsedContents + then Module + { moduleSourceFileName = sourceFileName + , moduleObjectFileName = objectFileName + , moduleModulesUsed = modulesUsed + , moduleName = getModuleName parsedContents + , moduleProducesSmod = hasModuleSubprogramDeclaration parsedContents + } + else if hasSubmoduleDeclaration parsedContents + then Submodule + { submoduleSourceFileName = sourceFileName + , submoduleObjectFileName = objectFileName + , submoduleModulesUsed = modulesUsed + , submoduleBaseModuleName = getSubmoduleBaseModuleName + parsedContents + , submoduleParentName = getSubmoduleParentName parsedContents + , submoduleName = getSubmoduleName parsedContents } - else if hasSubmoduleDeclaration parsedContents - then Submodule - { submoduleSourceFileName = sourceFileName - , submoduleObjectFileName = objectFileName - , submoduleModulesUsed = modulesUsed - , submoduleParentName = getSubmoduleParentName parsedContents - , submoduleName = getSubmoduleName parsedContents - } - else undefined + else undefined getAvailableModules :: [Source] -> [String] getAvailableModules = mapMaybe maybeModuleName @@ -110,8 +116,8 @@ getAllObjectFiles buildDirectory sources = map getObjectFile sources getObjectFile s@(Submodule{}) = (submoduleObjectFileName s) buildDirectory getSourceFileName :: Source -> FilePath -getSourceFileName p@(Program{}) = programSourceFileName p -getSourceFileName m@(Module{}) = moduleSourceFileName m +getSourceFileName p@(Program{} ) = programSourceFileName p +getSourceFileName m@(Module{} ) = moduleSourceFileName m getSourceFileName s@(Submodule{}) = submoduleSourceFileName s constructCompileTimeInfo :: Source -> [String] -> FilePath -> CompileTimeInfo @@ -144,7 +150,7 @@ constructCompileTimeInfo s@(Submodule{}) availableModules buildDirectory = , compileTimeInfoObjectFileProduced = (submoduleObjectFileName s) buildDirectory , compileTimeInfoOtherFilesProduced = [ buildDirectory - </> submoduleParentName s + </> submoduleBaseModuleName s ++ "@" ++ submoduleName s <.> "smod" @@ -215,11 +221,19 @@ getModuleName pc = head $ mapMaybe contentToMaybeModuleName pc ModuleDeclaration moduleName -> Just moduleName _ -> Nothing +getSubmoduleBaseModuleName :: [LineContents] -> String +getSubmoduleBaseModuleName pc = head $ mapMaybe contentToMaybeModuleName pc + where + contentToMaybeModuleName content = case content of + SubmoduleDeclaration baseModuleName submoduleParentName submoduleName -> + Just baseModuleName + _ -> Nothing + getSubmoduleParentName :: [LineContents] -> String getSubmoduleParentName pc = head $ mapMaybe contentToMaybeModuleName pc where contentToMaybeModuleName content = case content of - SubmoduleDeclaration submoduleParentName submoduleName -> + SubmoduleDeclaration baseModuleName submoduleParentName submoduleName -> Just submoduleParentName _ -> Nothing @@ -227,7 +241,7 @@ getSubmoduleName :: [LineContents] -> String getSubmoduleName pc = head $ mapMaybe contentToMaybeModuleName pc where contentToMaybeModuleName content = case content of - SubmoduleDeclaration submoduleParentName submoduleName -> + SubmoduleDeclaration baseModuleName submoduleParentName submoduleName -> Just submoduleName _ -> Nothing @@ -271,6 +285,7 @@ moduleDeclaration = do _ <- string "module" skipAtLeastOneWhiteSpace moduleName <- validIdentifier + when (moduleName == "procedure") (fail "") skipSpaceCommentOrEnd return $ ModuleDeclaration moduleName @@ -279,10 +294,13 @@ submoduleDeclaration = do skipSpaces _ <- string "submodule" parents <- submoduleParents + let parentName = case parents of + (baseModule : []) -> baseModule + (multiple ) -> (head multiple) ++ "@" ++ (last multiple) skipSpaces name <- validIdentifier skipSpaceCommentOrEnd - return $ SubmoduleDeclaration (intercalate "@" parents) name + return $ SubmoduleDeclaration (head parents) parentName name submoduleParents :: ReadP [String] submoduleParents = do diff --git a/bootstrap/test/Spec.hs b/bootstrap/test/Spec.hs index 6fb4006..4e660e7 100644 --- a/bootstrap/test/Spec.hs +++ b/bootstrap/test/Spec.hs @@ -15,27 +15,53 @@ main = do testCircular testWithMakefile testMakefileComplex + testSubmodule testHelloWorld :: IO () testHelloWorld = - withCurrentDirectory (example_path </> "hello_world") $ start $ Arguments (Run "") False "" + withCurrentDirectory (example_path </> "hello_world") $ start $ Arguments + (Run "") + False + "" testHelloComplex :: IO () testHelloComplex = - withCurrentDirectory (example_path </> "hello_complex") $ start $ Arguments (Test "") False "" + withCurrentDirectory (example_path </> "hello_complex") $ start $ Arguments + (Test "") + False + "" testHelloFpm :: IO () testHelloFpm = - withCurrentDirectory (example_path </> "hello_fpm") $ start $ Arguments (Run "") False "" + withCurrentDirectory (example_path </> "hello_fpm") $ start $ Arguments + (Run "") + False + "" testCircular :: IO () testCircular = - withCurrentDirectory (example_path </> "circular_example") $ start $ Arguments (Test "") False "" + withCurrentDirectory (example_path </> "circular_example") $ start $ Arguments + (Test "") + False + "" testWithMakefile :: IO () testWithMakefile = - withCurrentDirectory (example_path </> "with_makefile") $ start $ Arguments (Build) False "" + withCurrentDirectory (example_path </> "with_makefile") $ start $ Arguments + (Build) + False + "" testMakefileComplex :: IO () testMakefileComplex = - withCurrentDirectory (example_path </> "makefile_complex") $ start $ Arguments (Run "") False "" + withCurrentDirectory (example_path </> "makefile_complex") $ start $ Arguments + (Run "") + False + "" + +testSubmodule :: IO () +testSubmodule = + withCurrentDirectory (example_path </> "submodules") $ start $ Arguments + (Build) + False + "" diff --git a/bootstrap/unit_test/SubmoduleToCompileInfoTest.hs b/bootstrap/unit_test/SubmoduleToCompileInfoTest.hs index 4b3f474..d5d3ad8 100644 --- a/bootstrap/unit_test/SubmoduleToCompileInfoTest.hs +++ b/bootstrap/unit_test/SubmoduleToCompileInfoTest.hs @@ -37,6 +37,7 @@ exampleSubmodule = Submodule { submoduleSourceFileName = submoduleSourceFileName' , submoduleObjectFileName = \bd -> bd </> "some_file_somewhere.f90.o" , submoduleModulesUsed = ["module1", "module2", "module3"] + , submoduleBaseModuleName = "base_module" , submoduleParentName = "base_module@parent" , submoduleName = "some_submodule" } @@ -62,7 +63,7 @@ checkObjectFileName cti = assertEquals checkOtherFilesProduced :: CompileTimeInfo -> Result checkOtherFilesProduced cti = assertEquals - ["build_dir" </> "base_module@parent@some_submodule.smod"] + ["build_dir" </> "base_module@some_submodule.smod"] (compileTimeInfoOtherFilesProduced cti) checkDirectDependencies :: CompileTimeInfo -> Result |