Skip to content

Commit 03c9efc

Browse files
everythingfunctionaleverythingfunctional
committed
Add test with submodule example project and fix .smod naming convention
1 parent f196336 commit 03c9efc

File tree

3 files changed

+85
-40
lines changed

3 files changed

+85
-40
lines changed

‎bootstrap/src/BuildModel.hs‎

Lines changed: 51 additions & 33 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
module BuildModel where
22

33
import Control.Applicative ( (<|>) )
4+
import Control.Monad ( when )
45
import Data.Char ( isAsciiLower
56
, isDigit
67
, toLower
@@ -30,7 +31,7 @@ data LineContents =
3031
| ModuleDeclaration String
3132
| ModuleUsed String
3233
| ModuleSubprogramDeclaration
33-
| SubmoduleDeclaration String String
34+
| SubmoduleDeclaration String String String
3435
| Other
3536

3637
data RawSource = RawSource {
@@ -55,6 +56,7 @@ data Source =
5556
{ submoduleSourceFileName :: FilePath
5657
, submoduleObjectFileName :: FilePath -> FilePath
5758
, submoduleModulesUsed :: [String]
59+
, submoduleBaseModuleName :: String
5860
, submoduleParentName :: String
5961
, submoduleName :: String
6062
}
@@ -68,33 +70,37 @@ data CompileTimeInfo = CompileTimeInfo {
6870

6971
processRawSource :: RawSource -> Source
7072
processRawSource rawSource =
71-
let sourceFileName = rawSourceFilename rawSource
72-
parsedContents = parseContents rawSource
73-
objectFileName =
74-
\bd -> bd </> (pathSeparatorsToUnderscores sourceFileName) <.> "o"
75-
modulesUsed = getModulesUsed parsedContents
76-
in if hasProgramDeclaration parsedContents
77-
then Program { programSourceFileName = sourceFileName
78-
, programObjectFileName = objectFileName
79-
, programModulesUsed = modulesUsed
80-
}
81-
else if hasModuleDeclaration parsedContents
82-
then Module
83-
{ moduleSourceFileName = sourceFileName
84-
, moduleObjectFileName = objectFileName
85-
, moduleModulesUsed = modulesUsed
86-
, moduleName = getModuleName parsedContents
87-
, moduleProducesSmod = hasModuleSubprogramDeclaration parsedContents
73+
let
74+
sourceFileName = rawSourceFilename rawSource
75+
parsedContents = parseContents rawSource
76+
objectFileName =
77+
\bd -> bd </> (pathSeparatorsToUnderscores sourceFileName) <.> "o"
78+
modulesUsed = getModulesUsed parsedContents
79+
in
80+
if hasProgramDeclaration parsedContents
81+
then Program { programSourceFileName = sourceFileName
82+
, programObjectFileName = objectFileName
83+
, programModulesUsed = modulesUsed
84+
}
85+
else if hasModuleDeclaration parsedContents
86+
then Module
87+
{ moduleSourceFileName = sourceFileName
88+
, moduleObjectFileName = objectFileName
89+
, moduleModulesUsed = modulesUsed
90+
, moduleName = getModuleName parsedContents
91+
, moduleProducesSmod = hasModuleSubprogramDeclaration parsedContents
92+
}
93+
else if hasSubmoduleDeclaration parsedContents
94+
then Submodule
95+
{ submoduleSourceFileName = sourceFileName
96+
, submoduleObjectFileName = objectFileName
97+
, submoduleModulesUsed = modulesUsed
98+
, submoduleBaseModuleName = getSubmoduleBaseModuleName
99+
parsedContents
100+
, submoduleParentName = getSubmoduleParentName parsedContents
101+
, submoduleName = getSubmoduleName parsedContents
88102
}
89-
else if hasSubmoduleDeclaration parsedContents
90-
then Submodule
91-
{ submoduleSourceFileName = sourceFileName
92-
, submoduleObjectFileName = objectFileName
93-
, submoduleModulesUsed = modulesUsed
94-
, submoduleParentName = getSubmoduleParentName parsedContents
95-
, submoduleName = getSubmoduleName parsedContents
96-
}
97-
else undefined
103+
else undefined
98104

99105
getAvailableModules :: [Source] -> [String]
100106
getAvailableModules = mapMaybe maybeModuleName
@@ -110,8 +116,8 @@ getAllObjectFiles buildDirectory sources = map getObjectFile sources
110116
getObjectFile s@(Submodule{}) = (submoduleObjectFileName s) buildDirectory
111117

112118
getSourceFileName :: Source -> FilePath
113-
getSourceFileName p@(Program{}) = programSourceFileName p
114-
getSourceFileName m@(Module{}) = moduleSourceFileName m
119+
getSourceFileName p@(Program{} ) = programSourceFileName p
120+
getSourceFileName m@(Module{} ) = moduleSourceFileName m
115121
getSourceFileName s@(Submodule{}) = submoduleSourceFileName s
116122

117123
constructCompileTimeInfo :: Source -> [String] -> FilePath -> CompileTimeInfo
@@ -144,7 +150,7 @@ constructCompileTimeInfo s@(Submodule{}) availableModules buildDirectory =
144150
, compileTimeInfoObjectFileProduced = (submoduleObjectFileName s)
145151
buildDirectory
146152
, compileTimeInfoOtherFilesProduced = [ buildDirectory
147-
</> submoduleParentName s
153+
</> submoduleBaseModuleName s
148154
++ "@"
149155
++ submoduleName s
150156
<.> "smod"
@@ -215,19 +221,27 @@ getModuleName pc = head $ mapMaybe contentToMaybeModuleName pc
215221
ModuleDeclaration moduleName -> Just moduleName
216222
_ -> Nothing
217223

224+
getSubmoduleBaseModuleName :: [LineContents] -> String
225+
getSubmoduleBaseModuleName pc = head $ mapMaybe contentToMaybeModuleName pc
226+
where
227+
contentToMaybeModuleName content = case content of
228+
SubmoduleDeclaration baseModuleName submoduleParentName submoduleName ->
229+
Just baseModuleName
230+
_ -> Nothing
231+
218232
getSubmoduleParentName :: [LineContents] -> String
219233
getSubmoduleParentName pc = head $ mapMaybe contentToMaybeModuleName pc
220234
where
221235
contentToMaybeModuleName content = case content of
222-
SubmoduleDeclaration submoduleParentName submoduleName ->
236+
SubmoduleDeclaration baseModuleName submoduleParentName submoduleName ->
223237
Just submoduleParentName
224238
_ -> Nothing
225239

226240
getSubmoduleName :: [LineContents] -> String
227241
getSubmoduleName pc = head $ mapMaybe contentToMaybeModuleName pc
228242
where
229243
contentToMaybeModuleName content = case content of
230-
SubmoduleDeclaration submoduleParentName submoduleName ->
244+
SubmoduleDeclaration baseModuleName submoduleParentName submoduleName ->
231245
Just submoduleName
232246
_ -> Nothing
233247

@@ -271,6 +285,7 @@ moduleDeclaration = do
271285
_ <- string "module"
272286
skipAtLeastOneWhiteSpace
273287
moduleName <- validIdentifier
288+
when (moduleName == "procedure") (fail "")
274289
skipSpaceCommentOrEnd
275290
return $ ModuleDeclaration moduleName
276291

@@ -279,10 +294,13 @@ submoduleDeclaration = do
279294
skipSpaces
280295
_ <- string "submodule"
281296
parents <- submoduleParents
297+
let parentName = case parents of
298+
(baseModule : []) -> baseModule
299+
(multiple ) -> (head multiple) ++ "@" ++ (last multiple)
282300
skipSpaces
283301
name <- validIdentifier
284302
skipSpaceCommentOrEnd
285-
return $ SubmoduleDeclaration (intercalate "@" parents) name
303+
return $ SubmoduleDeclaration (head parents) parentName name
286304

287305
submoduleParents :: ReadP [String]
288306
submoduleParents = do

‎bootstrap/test/Spec.hs‎

Lines changed: 32 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -15,27 +15,53 @@ main = do
1515
testCircular
1616
testWithMakefile
1717
testMakefileComplex
18+
testSubmodule
1819

1920
testHelloWorld :: IO ()
2021
testHelloWorld =
21-
withCurrentDirectory (example_path </> "hello_world") $ start $ Arguments (Run "") False ""
22+
withCurrentDirectory (example_path </> "hello_world") $ start $ Arguments
23+
(Run "")
24+
False
25+
""
2226

2327
testHelloComplex :: IO ()
2428
testHelloComplex =
25-
withCurrentDirectory (example_path </> "hello_complex") $ start $ Arguments (Test "") False ""
29+
withCurrentDirectory (example_path </> "hello_complex") $ start $ Arguments
30+
(Test "")
31+
False
32+
""
2633

2734
testHelloFpm :: IO ()
2835
testHelloFpm =
29-
withCurrentDirectory (example_path </> "hello_fpm") $ start $ Arguments (Run "") False ""
36+
withCurrentDirectory (example_path </> "hello_fpm") $ start $ Arguments
37+
(Run "")
38+
False
39+
""
3040

3141
testCircular :: IO ()
3242
testCircular =
33-
withCurrentDirectory (example_path </> "circular_example") $ start $ Arguments (Test "") False ""
43+
withCurrentDirectory (example_path </> "circular_example") $ start $ Arguments
44+
(Test "")
45+
False
46+
""
3447

3548
testWithMakefile :: IO ()
3649
testWithMakefile =
37-
withCurrentDirectory (example_path </> "with_makefile") $ start $ Arguments (Build) False ""
50+
withCurrentDirectory (example_path </> "with_makefile") $ start $ Arguments
51+
(Build)
52+
False
53+
""
3854

3955
testMakefileComplex :: IO ()
4056
testMakefileComplex =
41-
withCurrentDirectory (example_path </> "makefile_complex") $ start $ Arguments (Run "") False ""
57+
withCurrentDirectory (example_path </> "makefile_complex") $ start $ Arguments
58+
(Run "")
59+
False
60+
""
61+
62+
testSubmodule :: IO ()
63+
testSubmodule =
64+
withCurrentDirectory (example_path </> "submodules") $ start $ Arguments
65+
(Build)
66+
False
67+
""

‎bootstrap/unit_test/SubmoduleToCompileInfoTest.hs‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -37,6 +37,7 @@ exampleSubmodule = Submodule
3737
{ submoduleSourceFileName = submoduleSourceFileName'
3838
, submoduleObjectFileName = \bd -> bd </> "some_file_somewhere.f90.o"
3939
, submoduleModulesUsed = ["module1", "module2", "module3"]
40+
, submoduleBaseModuleName = "base_module"
4041
, submoduleParentName = "base_module@parent"
4142
, submoduleName = "some_submodule"
4243
}
@@ -62,7 +63,7 @@ checkObjectFileName cti = assertEquals
6263

6364
checkOtherFilesProduced :: CompileTimeInfo -> Result
6465
checkOtherFilesProduced cti = assertEquals
65-
["build_dir" </> "base_module@parent@some_submodule.smod"]
66+
["build_dir" </> "base_module@some_submodule.smod"]
6667
(compileTimeInfoOtherFilesProduced cti)
6768

6869
checkDirectDependencies :: CompileTimeInfo -> Result

0 commit comments

Comments
 (0)