@@ -12,24 +12,32 @@ import Ochrance.A2ML.Lexer
1212import Ochrance.A2ML.Parser
1313import Ochrance.A2ML.Serializer
1414import Ochrance.A2ML.Types
15+ import System
1516
1617%default total
1718
1819-- ------------------------------------------------------------------------------
1920-- Test Helpers
2021-- ------------------------------------------------------------------------------
2122
23+ ||| Report a failure and exit nonzero, so CI actually gates on this suite
24+ ||| (fail-fast: the first failure ends the run with exit code 1).
25+ failWith : String -> IO ()
26+ failWith msg = do
27+ putStrLn msg
28+ exitFailure
29+
2230||| Assert that a value is Right
2331assertRight : Show e => Either e a -> IO ()
24- assertRight (Left err) = putStrLn (" FAIL: " ++ show err)
32+ assertRight (Left err) = failWith (" FAIL: " ++ show err)
2533assertRight (Right _ ) = pure ()
2634
2735||| Assert two values are equal
2836assertEqual : (Eq a , Show a ) => a -> a -> IO ()
2937assertEqual expected actual =
3038 if expected == actual
3139 then pure ()
32- else putStrLn (" FAIL: Expected " ++ show expected ++ " , got " ++ show actual)
40+ else failWith (" FAIL: Expected " ++ show expected ++ " , got " ++ show actual)
3341
3442||| Test case wrapper
3543testCase : String -> IO () -> IO ()
@@ -107,27 +115,27 @@ lexerTests = do
107115 testCase " Lex empty string" $ do
108116 case lex " " of
109117 Right tokens => assertEqual [EOF] tokens
110- Left err => putStrLn (" FAIL : " ++ show err)
118+ Left err => failWith (" FAIL : " ++ show err)
111119
112120 testCase " Lex minimal manifest" $ do
113121 case lex minimalManifest of
114122 Right tokens => pure () -- Success if no error
115- Left err => putStrLn (" FAIL: " ++ show err)
123+ Left err => failWith (" FAIL: " ++ show err)
116124
117125 testCase " Lex with attestation" $ do
118126 case lex attestedManifest of
119127 Right tokens => pure ()
120- Left err => putStrLn (" FAIL: " ++ show err)
128+ Left err => failWith (" FAIL: " ++ show err)
121129
122130 testCase " Lex with policy" $ do
123131 case lex policyManifest of
124132 Right tokens => pure ()
125- Left err => putStrLn (" FAIL: " ++ show err)
133+ Left err => failWith (" FAIL: " ++ show err)
126134
127135 testCase " Lex rejects invalid characters" $ do
128136 case lex " @manifest { version = \x00 }" of
129137 Left _ => pure () -- Should fail
130- Right _ => putStrLn " FAIL: Should reject null bytes"
138+ Right _ => failWith " FAIL: Should reject null bytes"
131139
132140-- ------------------------------------------------------------------------------
133141-- Parser Tests
@@ -145,44 +153,44 @@ parserTests = do
145153 Right manifest => do
146154 assertEqual " 0.1.0" manifest. manifestData. version
147155 assertEqual " test" manifest. manifestData. subsystem
148- Left err => putStrLn (" FAIL: " ++ show err)
149- Left err => putStrLn (" FAIL lex: " ++ show err)
156+ Left err => failWith (" FAIL: " ++ show err)
157+ Left err => failWith (" FAIL lex: " ++ show err)
150158
151159 testCase " Parse attested manifest" $ do
152160 case lex attestedManifest of
153161 Right tokens =>
154162 case parse tokens of
155163 Right manifest => do
156164 case manifest. attestation of
157- Nothing => putStrLn " FAIL: Expected attestation"
165+ Nothing => failWith " FAIL: Expected attestation"
158166 Just att => do
159167 assertEqual " test-witness" att. witness
160168 assertEqual " sig123" att. signature
161- Left err => putStrLn (" FAIL: " ++ show err)
162- Left err => putStrLn (" FAIL lex: " ++ show err)
169+ Left err => failWith (" FAIL: " ++ show err)
170+ Left err => failWith (" FAIL lex: " ++ show err)
163171
164172 testCase " Parse policy manifest" $ do
165173 case lex policyManifest of
166174 Right tokens =>
167175 case parse tokens of
168176 Right manifest => do
169177 case manifest. policy of
170- Nothing => putStrLn " FAIL: Expected policy"
178+ Nothing => failWith " FAIL: Expected policy"
171179 Just pol => do
172180 assertEqual Checked pol. mode
173181 case pol. maxAge of
174- Nothing => putStrLn " FAIL: Expected max_age"
182+ Nothing => failWith " FAIL: Expected max_age"
175183 Just age => assertEqual 3600 age
176- Left err => putStrLn (" FAIL: " ++ show err)
177- Left err => putStrLn (" FAIL lex: " ++ show err)
184+ Left err => failWith (" FAIL: " ++ show err)
185+ Left err => failWith (" FAIL lex: " ++ show err)
178186
179187 testCase " Parse rejects duplicate sections" $ do
180188 let duplicateManifest = minimalManifest ++ " \n @manifest { version = \" 0.2.0\" }\n "
181189 case lex duplicateManifest of
182190 Right tokens =>
183191 case parse tokens of
184192 Left _ => pure () -- Should fail
185- Right _ => putStrLn " FAIL: Should reject duplicate sections"
193+ Right _ => failWith " FAIL: Should reject duplicate sections"
186194 Left _ => pure () -- Lex error also acceptable
187195
188196-- ------------------------------------------------------------------------------
@@ -206,10 +214,10 @@ roundtripTests = do
206214 Right manifest2 => do
207215 assertEqual manifest1. manifestData. version manifest2. manifestData. version
208216 assertEqual manifest1. manifestData. subsystem manifest2. manifestData. subsystem
209- Left err => putStrLn (" FAIL parse2: " ++ show err)
210- Left err => putStrLn (" FAIL lex2: " ++ show err)
211- Left err => putStrLn (" FAIL parse1: " ++ show err)
212- Left err => putStrLn (" FAIL lex1: " ++ show err)
217+ Left err => failWith (" FAIL parse2: " ++ show err)
218+ Left err => failWith (" FAIL lex2: " ++ show err)
219+ Left err => failWith (" FAIL parse1: " ++ show err)
220+ Left err => failWith (" FAIL lex1: " ++ show err)
213221
214222-- ------------------------------------------------------------------------------
215223-- Error Handling Tests
@@ -226,7 +234,7 @@ errorHandlingTests = do
226234 Right tokens =>
227235 case parse tokens of
228236 Left _ => pure () -- Should fail
229- Right _ => putStrLn " FAIL: Should require version field"
237+ Right _ => failWith " FAIL: Should require version field"
230238 Left _ => pure () -- Lex error also acceptable
231239
232240 testCase " Invalid hash format" $ do
@@ -235,14 +243,14 @@ errorHandlingTests = do
235243 Right tokens =>
236244 case parse tokens of
237245 Left _ => pure () -- Should fail
238- Right _ => putStrLn " FAIL: Should reject invalid hash format"
246+ Right _ => failWith " FAIL: Should reject invalid hash format"
239247 Left _ => pure () -- Lex error also acceptable
240248
241249 testCase " Unterminated string" $ do
242250 let invalid = " @manifest { version = \" unterminated }"
243251 case lex invalid of
244252 Left _ => pure () -- Should fail at lex stage
245- Right _ => putStrLn " FAIL: Should reject unterminated string"
253+ Right _ => failWith " FAIL: Should reject unterminated string"
246254
247255-- ------------------------------------------------------------------------------
248256-- Main Test Runner
0 commit comments