diff options
| -rw-r--r-- | bootstrap/src/BuildModel.hs | 43 | ||||
| -rw-r--r-- | bootstrap/unit_test/ModuleSourceConstructionTest.hs | 17 |
2 files changed, 53 insertions, 7 deletions
diff --git a/bootstrap/src/BuildModel.hs b/bootstrap/src/BuildModel.hs index baefda9..dc57f81 100644 --- a/bootstrap/src/BuildModel.hs +++ b/bootstrap/src/BuildModel.hs @@ -29,6 +29,7 @@ data LineContents = ProgramDeclaration | ModuleDeclaration String | ModuleUsed String + | ModuleSubprogramDeclaration | Other data RawSource = RawSource { @@ -47,6 +48,7 @@ data Source = , moduleObjectFileName :: FilePath -> FilePath , moduleModulesUsed :: [String] , moduleName :: String + , moduleProducesSmod :: Bool } processRawSource :: RawSource -> Source @@ -62,11 +64,13 @@ processRawSource rawSource = , programModulesUsed = modulesUsed } else if hasModuleDeclaration parsedContents - then Module { moduleSourceFileName = sourceFileName - , moduleObjectFileName = objectFileName - , moduleModulesUsed = modulesUsed - , moduleName = getModuleName parsedContents - } + then Module + { moduleSourceFileName = sourceFileName + , moduleObjectFileName = objectFileName + , moduleModulesUsed = modulesUsed + , moduleName = getModuleName parsedContents + , moduleProducesSmod = hasModuleSubprogramDeclaration parsedContents + } else undefined pathSeparatorsToUnderscores :: FilePath -> FilePath @@ -96,6 +100,15 @@ hasModuleDeclaration parsedContents = case filter f parsedContents of ModuleDeclaration{} -> True _ -> False +hasModuleSubprogramDeclaration :: [LineContents] -> Bool +hasModuleSubprogramDeclaration parsedContents = case filter f parsedContents of + x : _ -> True + _ -> False + where + f lc = case lc of + ModuleSubprogramDeclaration -> True + _ -> False + getModulesUsed :: [LineContents] -> [String] getModulesUsed = mapMaybe contentToMaybeModuleName where @@ -130,7 +143,10 @@ doFortranLineParse = option Other fortranUsefulContents fortranUsefulContents :: ReadP LineContents fortranUsefulContents = - programDeclaration <|> moduleDeclaration <|> useStatement + programDeclaration + <|> moduleSubprogramDeclaration + <|> moduleDeclaration + <|> useStatement programDeclaration :: ReadP LineContents programDeclaration = do @@ -158,6 +174,16 @@ useStatement = do skipSpaceCommaOrEnd return $ ModuleUsed modName +moduleSubprogramDeclaration :: ReadP LineContents +moduleSubprogramDeclaration = do + skipAnything + _ <- string "module" + skipAtLeastOneWhiteSpace + skipAnything + _ <- string "function" <|> string "subroutine" + skipAtLeastOneWhiteSpace + return $ ModuleSubprogramDeclaration + skipAtLeastOneWhiteSpace :: ReadP () skipAtLeastOneWhiteSpace = do _ <- many1 whiteSpace @@ -182,6 +208,11 @@ skipComment = do _ <- char '!' return () +skipAnything :: ReadP () +skipAnything = do + _ <- many (satisfy (const True)) + return () + whiteSpace :: ReadP Char whiteSpace = satisfy (`elem` " \t") diff --git a/bootstrap/unit_test/ModuleSourceConstructionTest.hs b/bootstrap/unit_test/ModuleSourceConstructionTest.hs index 26f08b2..b98e9d3 100644 --- a/bootstrap/unit_test/ModuleSourceConstructionTest.hs +++ b/bootstrap/unit_test/ModuleSourceConstructionTest.hs @@ -33,12 +33,23 @@ test = return $ givenInput checkModuleObjectFileName , then' "it knows what modules it uses directly" checkModuleModulesUsed , then' "it knows its name" checkModuleName + , then' "it can tell that it will produce a '.smod' file" checkSmod ] ] exampleModule :: RawSource exampleModule = RawSource moduleSourceFileName' $ unlines - ["module some_module", " use module1", "USE MODULE2", "end module"] + [ "module some_module" + , " use module1" + , " USE MODULE2" + , " implicit none" + , " interface" + , " pure module function some_func()" + , " integer :: some_func" + , " end function" + , " end interface" + , "end module" + ] moduleSourceFileName' :: String moduleSourceFileName' = "some" </> "file" </> "somewhere.f90" @@ -66,3 +77,7 @@ checkModuleModulesUsed _ = fail' "wasn't a Module" checkModuleName :: Source -> Result checkModuleName m@(Module{}) = assertEquals "some_module" $ moduleName m checkModuleName _ = fail' "wasn't a Module" + +checkSmod :: Source -> Result +checkSmod m@(Module{}) = assertThat $ moduleProducesSmod m +checkSmod _ = fail' "wasn't a Module" |