diff options
author | Brad Richardson <everythingfunctional@protonmail.com> | 2020-10-14 13:51:18 -0500 |
---|---|---|
committer | Brad Richardson <everythingfunctional@protonmail.com> | 2020-10-14 13:51:18 -0500 |
commit | d1400eeb1401dee32729d2752b8ca4a072766068 (patch) | |
tree | aacb87a51a3e64277401e10756897994afd0c408 /bootstrap | |
parent | 0a0b3ec5a27d198832023ef5822087beb1ed860f (diff) | |
download | fpm-d1400eeb1401dee32729d2752b8ca4a072766068.tar.gz fpm-d1400eeb1401dee32729d2752b8ca4a072766068.zip |
Add test for modules a program uses
Diffstat (limited to 'bootstrap')
-rw-r--r-- | bootstrap/src/BuildModel.hs | 106 | ||||
-rw-r--r-- | bootstrap/unit_test/SourceConstructionTest.hs | 7 |
2 files changed, 113 insertions, 0 deletions
diff --git a/bootstrap/src/BuildModel.hs b/bootstrap/src/BuildModel.hs index b8bc122..dab8aed 100644 --- a/bootstrap/src/BuildModel.hs +++ b/bootstrap/src/BuildModel.hs @@ -1,10 +1,31 @@ module BuildModel where +import Control.Applicative ( (<|>) ) +import Data.Char ( isAsciiLower + , isDigit + , toLower + ) +import Data.Maybe ( fromMaybe + , mapMaybe + ) import Data.List ( intercalate ) import System.FilePath ( (</>) , (<.>) , splitDirectories ) +import Text.ParserCombinators.ReadP ( ReadP + , char + , eof + , many + , many1 + , option + , readP_to_S + , satisfy + , skipSpaces + , string + ) + +data LineContents = ModuleUsed String | Other data RawSource = RawSource { rawSourceFilename :: FilePath @@ -14,6 +35,7 @@ data RawSource = RawSource { data Source = Program { programSourceFileName :: FilePath , programObjectFileName :: FilePath -> FilePath + , programModulesUsed :: [String] } processRawSource :: RawSource -> Source @@ -27,8 +49,92 @@ processRawSource rawSource = sourceFileName ) <.> "o" + , programModulesUsed = getModulesUsed rawSource } pathSeparatorsToUnderscores :: FilePath -> FilePath pathSeparatorsToUnderscores fileName = intercalate "_" (splitDirectories fileName) + +getModulesUsed :: RawSource -> [String] +getModulesUsed rawSource = + let fileLines = lines $ rawSourceContents rawSource + lineContents = map parseFortranLine fileLines + in contentsToModuleNames lineContents + +contentsToModuleNames :: [LineContents] -> [String] +contentsToModuleNames = mapMaybe contentToMaybeModuleName + where + contentToMaybeModuleName content = case content of + ModuleUsed moduleName -> Just moduleName + _ -> Nothing + +readFileLinesIO :: FilePath -> IO [String] +readFileLinesIO file = do + contents <- readFile file + return $ lines contents + +parseFortranLine :: String -> LineContents +parseFortranLine line = + let line' = map toLower line + result = readP_to_S doFortranLineParse line' + in getResult result + where + getResult (_ : (contents, _) : _) = contents + getResult [(contents, _) ] = contents + getResult [] = Other + +doFortranLineParse :: ReadP LineContents +doFortranLineParse = option Other fortranUsefulContents + +fortranUsefulContents :: ReadP LineContents +fortranUsefulContents = useStatement + +useStatement :: ReadP LineContents +useStatement = do + skipSpaces + _ <- string "use" + skipAtLeastOneWhiteSpace + modName <- validIdentifier + skipSpaceCommaOrEnd + return $ ModuleUsed modName + +skipAtLeastOneWhiteSpace :: ReadP () +skipAtLeastOneWhiteSpace = do + _ <- many1 whiteSpace + return () + +skipSpaceOrEnd :: ReadP () +skipSpaceOrEnd = eof <|> skipAtLeastOneWhiteSpace + +skipSpaceCommaOrEnd :: ReadP () +skipSpaceCommaOrEnd = eof <|> skipComma <|> skipAtLeastOneWhiteSpace + +skipComma :: ReadP () +skipComma = do + _ <- char ',' + return () + +whiteSpace :: ReadP Char +whiteSpace = satisfy (`elem` " \t") + +validIdentifier :: ReadP String +validIdentifier = do + first <- validFirstCharacter + rest <- many validIdentifierCharacter + return $ first : rest + +validFirstCharacter :: ReadP Char +validFirstCharacter = alphabet + +validIdentifierCharacter :: ReadP Char +validIdentifierCharacter = alphabet <|> digit <|> underscore + +alphabet :: ReadP Char +alphabet = satisfy isAsciiLower + +digit :: ReadP Char +digit = satisfy isDigit + +underscore :: ReadP Char +underscore = char '_' diff --git a/bootstrap/unit_test/SourceConstructionTest.hs b/bootstrap/unit_test/SourceConstructionTest.hs index 24122c5..751d10c 100644 --- a/bootstrap/unit_test/SourceConstructionTest.hs +++ b/bootstrap/unit_test/SourceConstructionTest.hs @@ -31,12 +31,15 @@ test = return $ givenInput , then' "its object file name is the 'flattened' path of the source file with '.o' appended" checkProgramObjectFileName + , then' "it knows what modules it uses directly" checkProgramModulesUsed ] ] exampleProgram :: RawSource exampleProgram = RawSource programSourceFileName' $ unlines [ "program some_program" + , " use module1" + , " USE MODULE2" , " implicit none" , " print *, \"Hello, World!\"" , "end program" @@ -59,3 +62,7 @@ checkProgramObjectFileName p@(Program{}) = assertEquals ("." </> "some_file_somewhere.f90.o") $ (programObjectFileName p) "." checkProgramObjectFileName _ = fail' "wasn't a Program" + +checkProgramModulesUsed :: Source -> Result +checkProgramModulesUsed p@(Program{}) = assertEquals ["module1", "module2"] $ programModulesUsed p +checkProgramModulesUsed _ = fail' "wasn't a Program" |