aboutsummaryrefslogtreecommitdiff
path: root/bootstrap
diff options
context:
space:
mode:
authorBrad Richardson <everythingfunctional@protonmail.com>2020-10-14 13:51:18 -0500
committerBrad Richardson <everythingfunctional@protonmail.com>2020-10-14 13:51:18 -0500
commitd1400eeb1401dee32729d2752b8ca4a072766068 (patch)
treeaacb87a51a3e64277401e10756897994afd0c408 /bootstrap
parent0a0b3ec5a27d198832023ef5822087beb1ed860f (diff)
downloadfpm-d1400eeb1401dee32729d2752b8ca4a072766068.tar.gz
fpm-d1400eeb1401dee32729d2752b8ca4a072766068.zip
Add test for modules a program uses
Diffstat (limited to 'bootstrap')
-rw-r--r--bootstrap/src/BuildModel.hs106
-rw-r--r--bootstrap/unit_test/SourceConstructionTest.hs7
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"