LibraryProgramTests.hs (29311B)
1 -- Behavioral expectations survive the retirement of the historical frontend. 2 -- Compile tiny test programs against published portable library interfaces only. 3 module LibraryProgramTests (maybeTests, providedLibraries, contractsTests, arithmetic) where 4 5 import Runtime 6 import ReferenceFixtures (fixtureExports) 7 import PortableTestCompiler (compileFixtureDefinitions) 8 import qualified Data.Map as Map 9 import Test.Tasty 10 import Test.Tasty.HUnit 11 12 runExpression :: String -> IO T 13 runExpression expression = runProgram ("main = " ++ expression) 14 15 runProgram :: String -> IO T 16 runProgram source = do 17 env <- compileFixtureDefinitions (fixtureExports "prelude") source 18 maybe (assertFailure "library test program has no main" >> pure Leaf) pure (Map.lookup "main" env) 19 20 trueT, falseT, nothingT :: T 21 trueT = Stem Leaf 22 falseT = Leaf 23 nothingT = Leaf 24 justT :: T -> T 25 justT = Stem 26 pairT :: T -> T -> T 27 pairT = Fork 28 29 maybeTests :: TestTree 30 maybeTests = testGroup "Maybe Tests" 31 [ testCase "nothing is Leaf" $ do 32 let input = "nothing" 33 env <- runExpression input 34 env @?= Leaf 35 36 , testCase "just wraps value in Stem" $ do 37 let input = "just (t t)" 38 env <- runExpression input 39 env @?= Stem (Stem Leaf) 40 41 , testCase "matchMaybe on nothing returns default" $ do 42 let input = "matchMaybe \"empty\" (x : x) nothing" 43 env <- runExpression input 44 env @?= ofString "empty" 45 46 , testCase "matchMaybe on just extracts value" $ do 47 let input = "matchMaybe \"empty\" (x : x) (just (t t))" 48 env <- runExpression input 49 env @?= Stem Leaf 50 51 , testCase "maybe applies f inside just" $ do 52 let input = "maybe 0 (x : succ x) (just 5)" 53 env <- runExpression input 54 env @?= ofNumber 6 55 56 , testCase "maybe returns default on nothing" $ do 57 let input = "maybe 0 (x : succ x) nothing" 58 env <- runExpression input 59 env @?= ofNumber 0 60 61 , testCase "maybeMap transforms just value" $ do 62 let input = "maybeMap (x : succ x) (just 3)" 63 env <- runExpression input 64 env @?= justT (ofNumber 4) 65 66 , testCase "maybeMap returns nothing on nothing" $ do 67 let input = "maybeMap (x : succ x) nothing" 68 env <- runExpression input 69 env @?= nothingT 70 71 , testCase "maybeBind flattens just" $ do 72 let input = "maybeBind (just 3) (x : just (succ x))" 73 env <- runExpression input 74 env @?= justT (ofNumber 4) 75 76 , testCase "maybeBind returns nothing on nothing" $ do 77 let input = "maybeBind nothing (x : just (succ x))" 78 env <- runExpression input 79 env @?= Leaf 80 81 , testCase "maybeOr returns just value" $ do 82 let input = "maybeOr 99 (just 5)" 83 env <- runExpression input 84 env @?= ofNumber 5 85 86 , testCase "maybeOr returns default on nothing" $ do 87 let input = "maybeOr 99 nothing" 88 env <- runExpression input 89 env @?= ofNumber 99 90 91 , testCase "maybe? on just is true" $ do 92 let input = "maybe? (just t)" 93 env <- runExpression input 94 env @?= trueT 95 96 , testCase "maybe? on nothing is false" $ do 97 let input = "maybe? nothing" 98 env <- runExpression input 99 env @?= falseT 100 ] 101 102 providedLibraries :: TestTree 103 providedLibraries = testGroup "Library Tests" 104 [ testCase "Triage test Leaf" $ do 105 let input = "test t" 106 value <- runExpression input 107 let env = decodeResult value 108 env @?= "\"Leaf\"" 109 110 , testCase "Triage test (Stem Leaf)" $ do 111 let input = "test (t t)" 112 value <- runExpression input 113 let env = decodeResult value 114 env @?= "\"Stem\"" 115 116 , testCase "Triage test (Fork Leaf Leaf)" $ do 117 let input = "test (t t t)" 118 value <- runExpression input 119 let env = decodeResult value 120 env @?= "\"Fork\"" 121 122 , testCase "Boolean NOT: true" $ do 123 let input = "not? true" 124 env <- runExpression input 125 env @?= Leaf 126 127 , testCase "Boolean NOT: false" $ do 128 let input = "not? false" 129 env <- runExpression input 130 env @?= Stem Leaf 131 132 133 , testCase "Boolean AND TF" $ do 134 let input = "and? (t t) (t)" 135 env <- runExpression input 136 env @?= Leaf 137 138 , testCase "Boolean AND FT" $ do 139 let input = "and? (t) (t t)" 140 env <- runExpression input 141 env @?= Leaf 142 143 , testCase "Boolean AND FF" $ do 144 let input = "and? (t) (t)" 145 env <- runExpression input 146 env @?= Leaf 147 148 , testCase "Boolean AND TT" $ do 149 let input = "and? (t t) (t t)" 150 env <- runExpression input 151 env @?= Stem Leaf 152 153 , testCase "List head" $ do 154 let input = "head [(t) (t t) (t t t)]" 155 env <- runExpression input 156 env @?= Leaf 157 158 , testCase "List tail" $ do 159 let input = "head (tail (tail [(t) (t t) (t t t)]))" 160 env <- runExpression input 161 env @?= Fork Leaf Leaf 162 163 , testCase "List map" $ do 164 let input = "head (tail (map (a : (t t t)) [(t) (t) (t)]))" 165 env <- runExpression input 166 env @?= Fork Leaf Leaf 167 168 , testCase "Empty list check" $ do 169 let input = "emptyList? []" 170 env <- runExpression input 171 env @?= Stem Leaf 172 173 , testCase "Non-empty list check" $ do 174 let input = "not? (emptyList? [(1) (2) (3)])" 175 env <- runExpression input 176 env @?= Stem Leaf 177 178 , testCase "Concatenate strings" $ do 179 let input = "append \"Hello, \" \"world!\"" 180 value <- runExpression input 181 let env = decodeResult value 182 env @?= "\"Hello, world!\"" 183 184 , testCase "Verifying Equality" $ do 185 let input = "equal? (t t t) (t t t)" 186 env <- runExpression input 187 env @?= Stem Leaf 188 189 , testCase "headMaybe on empty list" $ do 190 let input = "headMaybe []" 191 env <- runExpression input 192 env @?= nothingT 193 194 , testCase "headMaybe on non-empty list" $ do 195 let input = "headMaybe [(t) (t t)]" 196 env <- runExpression input 197 env @?= justT Leaf 198 199 , testCase "lastMaybe on empty list" $ do 200 let input = "lastMaybe []" 201 env <- runExpression input 202 env @?= nothingT 203 204 , testCase "lastMaybe on single element" $ do 205 let input = "lastMaybe [(t t)]" 206 env <- runExpression input 207 env @?= justT (Stem Leaf) 208 209 , testCase "lastMaybe on multi-element list" $ do 210 let input = "lastMaybe [(t) (t t) (t t t)]" 211 env <- runExpression input 212 env @?= justT (Fork Leaf Leaf) 213 214 , testCase "nthMaybe first element" $ do 215 let input = "nthMaybe 0 [(t) (t t)]" 216 env <- runExpression input 217 env @?= justT Leaf 218 219 , testCase "nthMaybe middle element" $ do 220 let input = "nthMaybe 1 [(t) (t t) (t t t)]" 221 env <- runExpression input 222 env @?= justT (Stem Leaf) 223 224 , testCase "nthMaybe out of bounds" $ do 225 let input = "nthMaybe 5 [(t) (t t)]" 226 env <- runExpression input 227 env @?= nothingT 228 229 , testCase "reverse empty list" $ do 230 let input = "reverse []" 231 env <- runExpression input 232 env @?= ofList [] 233 234 , testCase "reverse non-empty list" $ do 235 let input = "reverse [(1) (2) (3)]" 236 env <- runExpression input 237 env @?= ofList [ofNumber 3, ofNumber 2, ofNumber 1] 238 239 , testCase "take 0 any list = empty" $ do 240 let input = "take 0 [(1) (2) (3)]" 241 env <- runExpression input 242 env @?= ofList [] 243 244 , testCase "take 2 [1,2,3] = [1,2]" $ do 245 let input = "take 2 [(1) (2) (3)]" 246 env <- runExpression input 247 env @?= ofList [ofNumber 1, ofNumber 2] 248 249 , testCase "take overlong returns whole list" $ do 250 let input = "take 5 [(1) (2)]" 251 env <- runExpression input 252 env @?= ofList [ofNumber 1, ofNumber 2] 253 254 , testCase "drop 0 any list = list" $ do 255 let input = "drop 0 [(1) (2) (3)]" 256 env <- runExpression input 257 env @?= ofList [ofNumber 1, ofNumber 2, ofNumber 3] 258 259 , testCase "drop 2 [1,2,3] = [3]" $ do 260 let input = "drop 2 [(1) (2) (3)]" 261 env <- runExpression input 262 env @?= ofList [ofNumber 3] 263 264 , testCase "drop overlong returns empty" $ do 265 let input = "drop 5 [(1) (2)]" 266 env <- runExpression input 267 env @?= ofList [] 268 269 , testCase "splitAt 0 [1,2] = pair [] [1,2]" $ do 270 let input = "splitAt 0 [(1) (2)]" 271 env <- runExpression input 272 env @?= pairT (ofList []) (ofList [ofNumber 1, ofNumber 2]) 273 274 , testCase "splitAt 2 [1,2,3] = pair [1,2] [3]" $ do 275 let input = "splitAt 2 [(1) (2) (3)]" 276 env <- runExpression input 277 env @?= pairT (ofList [ofNumber 1, ofNumber 2]) (ofList [ofNumber 3]) 278 279 , testCase "splitAt overlong = pair [1,2] []" $ do 280 let input = "splitAt 5 [(1) (2)]" 281 env <- runExpression input 282 env @?= pairT (ofList [ofNumber 1, ofNumber 2]) (ofList []) 283 284 , testCase "concatMap on empty list" $ do 285 let input = "concatMap (x : [(x) (x)]) []" 286 env <- runExpression input 287 env @?= ofList [] 288 289 , testCase "concatMap doubles elements" $ do 290 let input = "concatMap (x : [(x) (x)]) [(1) (2)]" 291 env <- runExpression input 292 env @?= ofList [ofNumber 1, ofNumber 1, ofNumber 2, ofNumber 2] 293 294 , testCase "find on empty list" $ do 295 let input = "find (x : equal? x 2) []" 296 env <- runExpression input 297 env @?= nothingT 298 299 , testCase "find finds element" $ do 300 let input = "find (x : equal? x 2) [(1) (2) (3)]" 301 env <- runExpression input 302 env @?= justT (ofNumber 2) 303 304 , testCase "find missing element" $ do 305 let input = "find (x : equal? x 9) [(1) (2) (3)]" 306 env <- runExpression input 307 env @?= nothingT 308 309 , testCase "partition empty list" $ do 310 let input = "partition (x : equal? x 2) []" 311 env <- runExpression input 312 env @?= pairT (ofList []) (ofList []) 313 314 , testCase "partition splits list" $ do 315 let input = "partition (x : lt? 2 x) [(1) (2) (3) (4)]" 316 env <- runExpression input 317 env @?= pairT (ofList [ofNumber 3, ofNumber 4]) (ofList [ofNumber 1, ofNumber 2]) 318 319 , testCase "zipWith on empty lists" $ do 320 let input = "zipWith add [] []" 321 env <- runExpression input 322 env @?= ofList [] 323 324 , testCase "zipWith adds pairwise" $ do 325 let input = "zipWith add [(1) (2)] [(10) (20)]" 326 env <- runExpression input 327 env @?= ofList [ofNumber 11, ofNumber 22] 328 329 , testCase "zipWith truncates to shorter list" $ do 330 let input = "zipWith add [(1) (2)] [(10)]" 331 env <- runExpression input 332 env @?= ofList [ofNumber 11] 333 334 , testCase "strLength" $ do 335 let input = "strLength \"hello\"" 336 env <- runExpression input 337 env @?= ofNumber 5 338 339 , testCase "strAppend" $ do 340 let input = "strAppend \"hello\" \" world\"" 341 env <- runExpression input 342 env @?= ofString "hello world" 343 344 , testCase "equal? equal strings" $ do 345 let input = "equal? \"abc\" \"abc\"" 346 env <- runExpression input 347 env @?= trueT 348 349 , testCase "equal? different strings" $ do 350 let input = "equal? \"abc\" \"def\"" 351 env <- runExpression input 352 env @?= falseT 353 354 , testCase "strEmpty? on empty" $ do 355 let input = "strEmpty? \"\"" 356 env <- runExpression input 357 env @?= trueT 358 359 , testCase "strEmpty? on non-empty" $ do 360 let input = "strEmpty? \"a\"" 361 env <- runExpression input 362 env @?= falseT 363 364 , testCase "startsWith? prefix matches" $ do 365 let input = "startsWith? \"he\" \"hello\"" 366 env <- runExpression input 367 env @?= trueT 368 369 , testCase "startsWith? prefix too long" $ do 370 let input = "startsWith? \"hello\" \"he\"" 371 env <- runExpression input 372 env @?= falseT 373 374 , testCase "startsWith? empty prefix" $ do 375 let input = "startsWith? \"\" \"hello\"" 376 env <- runExpression input 377 env @?= trueT 378 379 , testCase "endsWith? suffix matches" $ do 380 let input = "endsWith? \"lo\" \"hello\"" 381 env <- runExpression input 382 env @?= trueT 383 384 , testCase "endsWith? suffix too long" $ do 385 let input = "endsWith? \"hello\" \"lo\"" 386 env <- runExpression input 387 env @?= falseT 388 389 , testCase "endsWith? empty suffix" $ do 390 let input = "endsWith? \"\" \"hello\"" 391 env <- runExpression input 392 env @?= trueT 393 394 , testCase "contains? substring found" $ do 395 let input = "contains? \"ell\" \"hello\"" 396 env <- runExpression input 397 env @?= trueT 398 399 , testCase "contains? substring missing" $ do 400 let input = "contains? \"xyz\" \"hello\"" 401 env <- runExpression input 402 env @?= falseT 403 404 , testCase "contains? empty needle" $ do 405 let input = "contains? \"\" \"hello\"" 406 env <- runExpression input 407 env @?= trueT 408 409 , testCase "lines splits on newline" $ do 410 let input = "lines \"a\\nb\\nc\"" 411 env <- runExpression input 412 env @?= ofList [ofString "a", ofString "b", ofString "c"] 413 414 , testCase "lines single line" $ do 415 let input = "lines \"hello\"" 416 env <- runExpression input 417 env @?= ofList [ofString "hello"] 418 419 , testCase "lines empty string" $ do 420 let input = "lines \"\"" 421 env <- runExpression input 422 env @?= ofList [ofString ""] 423 424 , testCase "lines trailing newline" $ do 425 let input = "lines \"a\\n\"" 426 env <- runExpression input 427 env @?= ofList [ofString "a", ofString ""] 428 429 , testCase "unlines joins with newline" $ do 430 let input = "unlines [(\"a\") (\"b\")]" 431 env <- runExpression input 432 env @?= ofString "a\nb\n" 433 434 , testCase "unlines empty list" $ do 435 let input = "unlines []" 436 env <- runExpression input 437 env @?= ofString "" 438 439 , testCase "words splits on space" $ do 440 let input = "words \"hello world\"" 441 env <- runExpression input 442 env @?= ofList [ofString "hello", ofString "world"] 443 444 , testCase "words empty string" $ do 445 let input = "words \"\"" 446 env <- runExpression input 447 env @?= ofList [] 448 449 , testCase "words multiple spaces" $ do 450 let input = "words \" hello world \"" 451 env <- runExpression input 452 env @?= ofList [ofString "hello", ofString "world"] 453 454 , testCase "unwords joins with space" $ do 455 let input = "unwords [(\"hello\") (\"world\")]" 456 env <- runExpression input 457 env @?= ofString "hello world" 458 459 , testCase "unwords single word" $ do 460 let input = "unwords [(\"hello\")]" 461 env <- runExpression input 462 env @?= ofString "hello" 463 464 , testCase "unwords empty list" $ do 465 let input = "unwords []" 466 env <- runExpression input 467 env @?= ofString "" 468 469 , testCase "intercalate joins fields" $ do 470 let input = "intercalate \", \" [(\"a\") (\"b\") (\"c\")]" 471 env <- runExpression input 472 env @?= ofString "a, b, c" 473 474 , testCase "intercalate leaves a lone field alone" $ do 475 let input = "intercalate \", \" [(\"a\")]" 476 env <- runExpression input 477 env @?= ofString "a" 478 479 , testCase "intercalate empty list" $ do 480 let input = "intercalate \", \" []" 481 env <- runExpression input 482 env @?= ofString "" 483 484 , testCase "joinSuffix terminates every field" $ do 485 let input = "joinSuffix \"-\" [(\"a\") (\"b\")]" 486 env <- runExpression input 487 env @?= ofString "a-b-" 488 489 , testCase "splitOnByte splits on a byte" $ do 490 let input = "splitOnByte 58 \"a:b:c\"" 491 env <- runExpression input 492 env @?= ofList [ofString "a", ofString "b", ofString "c"] 493 494 , testCase "splitOnByte keeps empty fields" $ do 495 let input = "splitOnByte 58 \"a::b\"" 496 env <- runExpression input 497 env @?= ofList [ofString "a", ofString "", ofString "b"] 498 499 , testCase "splitOnByte trailing separator leaves an empty field" $ do 500 let input = "splitOnByte 58 \"a:\"" 501 env <- runExpression input 502 env @?= ofList [ofString "a", ofString ""] 503 504 , testCase "splitOnByte without a match" $ do 505 let input = "splitOnByte 58 \"abc\"" 506 env <- runExpression input 507 env @?= ofList [ofString "abc"] 508 509 , testCase "splitOnByte empty input" $ do 510 let input = "splitOnByte 58 \"\"" 511 env <- runExpression input 512 env @?= ofList [ofString ""] 513 514 , testCase "intercalate round trips splitOnByte" $ do 515 let input = "equal? (intercalate \":\" (splitOnByte 58 \"a:b:c\")) \"a:b:c\"" 516 env <- runExpression input 517 env @?= trueT 518 519 , testCase "takeWhile keeps the matching prefix" $ do 520 let input = "takeWhile (n : lt? n 3) [(1) (2) (3) (1)]" 521 env <- runExpression input 522 env @?= ofList [ofNumber 1, ofNumber 2] 523 524 , testCase "takeWhile stops at the first mismatch" $ do 525 let input = "takeWhile (n : lt? n 3) [(3) (1)]" 526 env <- runExpression input 527 env @?= ofList [] 528 529 , testCase "dropWhile drops the matching prefix" $ do 530 let input = "dropWhile (n : lt? n 3) [(1) (2) (3) (1)]" 531 env <- runExpression input 532 env @?= ofList [ofNumber 3, ofNumber 1] 533 534 , testCase "dropWhile on an all matching list" $ do 535 let input = "dropWhile (n : lt? n 3) [(1) (2)]" 536 env <- runExpression input 537 env @?= ofList [] 538 539 , testCase "trim strips surrounding spaces and tabs" $ do 540 let input = "trim \" \\ttrimmed \\t\"" 541 env <- runExpression input 542 env @?= ofString "trimmed" 543 544 , testCase "trim leaves interior bytes alone" $ do 545 let input = "trim \" a b \"" 546 env <- runExpression input 547 env @?= ofString "a b" 548 549 , testCase "trim all whitespace is empty" $ do 550 let input = "trim \" \\t \"" 551 env <- runExpression input 552 env @?= ofString "" 553 ] 554 555 contractsTests :: TestTree 556 contractsTests = testGroup "Contracts library tests" 557 [ testCase "anyC passes any value" $ do 558 let input = "main = resultIsOk (checkContract anyC 7)" 559 env <- runProgram input 560 env @?= trueT 561 562 , testCase "guardC rejects failures" $ do 563 let input = "main = resultIsErr (checkContract (guardC \"odd\" even?) 5)" 564 env <- runProgram input 565 env @?= trueT 566 567 , testCase "andC combines contracts" $ do 568 let input = "main = resultIsOk (checkContract (andC (guardC \"odd\" odd?) (guardC \"gt0\" (n : gt? n 0))) 5)" 569 env <- runProgram input 570 env @?= trueT 571 572 , testCase "listOf checks every element" $ do 573 let input = "main = resultIsOk (checkContract (listOf (guardC \"odd\" odd?)) [1 3 5])" 574 env <- runProgram input 575 env @?= trueT 576 577 , testCase "fnContract wraps a function" $ do 578 let input = "main = resultIsOk (checkContract (fnContract (guardC \"odd\" odd?) anyC) (x : x))" 579 env <- runProgram input 580 env @?= trueT 581 582 , testCase "runM reduces pureM" $ do 583 let input = "main = resultIsOk (runM (pureM 42))" 584 env <- runProgram input 585 env @?= trueT 586 587 , testCase "do notation chains checkM and pureM" $ do 588 let input = unlines 589 [ "program = (xs :" 590 , " do bindM" 591 , " n <- pureM (length xs)" 592 , " _ <- checkM (guardC \"positive\" (n : gte? n 1)) n" 593 , " pureM n)" 594 , "main = runM (program [1 2 3 4])" 595 ] 596 env <- runProgram input 597 decodeResult (env) @?= "[t t, 4]" 598 599 , testCase "handleM replaces exception with a new action" $ do 600 let input = unlines 601 [ "lookupConfig = (key defaultValue :" 602 , " exceptE \"missing\" key (resume : pureM defaultValue))" 603 , "pipeline = (xs :" 604 , " do bindM" 605 , " divisor <- lookupConfig \"divisor\" 1" 606 , " total <- pureM (sum xs)" 607 , " scaled <- liftM (x : div x divisor) total" 608 , " pureM scaled)" 609 , "handled = handleM \"missing\" (key k : pureM 2) (pipeline [10 20 30])" 610 , "main = runM handled" 611 ] 612 env <- runProgram input 613 decodeResult (env) @?= "[t t, 30]" 614 615 , testCase "=@ return annotation passes" $ do 616 let input = unlines 617 [ "five =@anyC 5" 618 , "main = five" 619 ] 620 env <- runProgram input 621 env @?= ofNumber 5 622 623 , testCase "=@ return annotation fails" $ do 624 let input = unlines 625 [ "boom =@(neverC \"boom\") 5" 626 , "main = boom" 627 ] 628 env <- runProgram input 629 decodeResult (env) @?= "[t, \"boom\"]" 630 631 , testCase "@ argument annotation passes" $ do 632 let input = unlines 633 [ "idNat x@anyC =@anyC x" 634 , "main = idNat 5" 635 ] 636 env <- runProgram input 637 env @?= ofNumber 5 638 639 , testCase "@ argument annotation fails" $ do 640 let input = unlines 641 [ "idNat x@(neverC \"bad\") =@anyC x" 642 , "main = idNat 5" 643 ] 644 env <- runProgram input 645 decodeResult (env) @?= "[t, \"bad\"]" 646 ] 647 648 arithmetic :: TestTree 649 arithmetic = testGroup "Arithmetic Tests" 650 [ testCase "isZero? on 0" $ do 651 let input = "isZero? 0" 652 env <- runExpression input 653 env @?= trueT 654 655 , testCase "isZero? on 5" $ do 656 let input = "isZero? 5" 657 env <- runExpression input 658 env @?= falseT 659 660 , testCase "add 0 3 = 3" $ do 661 let input = "add 0 3" 662 env <- runExpression input 663 env @?= ofNumber 3 664 665 , testCase "add 3 0 = 3" $ do 666 let input = "add 3 0" 667 env <- runExpression input 668 env @?= ofNumber 3 669 670 , testCase "add 2 3 = 5" $ do 671 let input = "add 2 3" 672 env <- runExpression input 673 env @?= ofNumber 5 674 675 , testCase "sub 5 2 = 3" $ do 676 let input = "sub 5 2" 677 env <- runExpression input 678 env @?= ofNumber 3 679 680 , testCase "sub 2 5 = 0 (saturated)" $ do 681 let input = "sub 2 5" 682 env <- runExpression input 683 env @?= ofNumber 0 684 685 , testCase "sub 5 5 = 0" $ do 686 let input = "sub 5 5" 687 env <- runExpression input 688 env @?= ofNumber 0 689 690 , testCase "lt? 2 3 = true" $ do 691 let input = "lt? 2 3" 692 env <- runExpression input 693 env @?= trueT 694 695 , testCase "lt? 3 2 = false" $ do 696 let input = "lt? 3 2" 697 env <- runExpression input 698 env @?= falseT 699 700 , testCase "lt? 2 2 = false" $ do 701 let input = "lt? 2 2" 702 env <- runExpression input 703 env @?= falseT 704 705 , testCase "lte? 2 3 = true" $ do 706 let input = "lte? 2 3" 707 env <- runExpression input 708 env @?= trueT 709 710 , testCase "lte? 3 2 = false" $ do 711 let input = "lte? 3 2" 712 env <- runExpression input 713 env @?= falseT 714 715 , testCase "lte? 2 2 = true" $ do 716 let input = "lte? 2 2" 717 env <- runExpression input 718 env @?= trueT 719 720 , testCase "mul 0 5 = 0" $ do 721 let input = "mul 0 5" 722 env <- runExpression input 723 env @?= ofNumber 0 724 725 , testCase "mul 5 0 = 0" $ do 726 let input = "mul 5 0" 727 env <- runExpression input 728 env @?= ofNumber 0 729 730 , testCase "mul 2 3 = 6" $ do 731 let input = "mul 2 3" 732 env <- runExpression input 733 env @?= ofNumber 6 734 735 , testCase "mul 3 3 = 9" $ do 736 let input = "mul 3 3" 737 env <- runExpression input 738 env @?= ofNumber 9 739 740 , testCase "pred 0 = 0" $ do 741 let input = "pred 0" 742 env <- runExpression input 743 env @?= ofNumber 0 744 745 , testCase "pred 1 = 0" $ do 746 let input = "pred 1" 747 env <- runExpression input 748 env @?= ofNumber 0 749 750 , testCase "pred 5 = 4" $ do 751 let input = "pred 5" 752 env <- runExpression input 753 env @?= ofNumber 4 754 755 , testCase "add is commutative" $ do 756 let input = "equal? (add 4 7) (add 7 4)" 757 env <- runExpression input 758 env @?= trueT 759 760 , testCase "add is associative" $ do 761 let input = "equal? (add (add 2 3) 4) (add 2 (add 3 4))" 762 env <- runExpression input 763 env @?= trueT 764 765 , testCase "sub x 0 = x" $ do 766 let input = "sub 7 0" 767 env <- runExpression input 768 env @?= ofNumber 7 769 770 , testCase "sub chained" $ do 771 let input = "sub (sub 10 3) 2" 772 env <- runExpression input 773 env @?= ofNumber 5 774 775 , testCase "mul identity 1" $ do 776 let input = "mul 1 5" 777 env <- runExpression input 778 env @?= ofNumber 5 779 780 , testCase "mul identity 2" $ do 781 let input = "mul 5 1" 782 env <- runExpression input 783 env @?= ofNumber 5 784 785 , testCase "mul is commutative" $ do 786 let input = "equal? (mul 3 4) (mul 4 3)" 787 env <- runExpression input 788 env @?= trueT 789 790 , testCase "mul is associative" $ do 791 let input = "equal? (mul (mul 2 3) 4) (mul 2 (mul 3 4))" 792 env <- runExpression input 793 env @?= trueT 794 795 , testCase "mul distributes over add" $ do 796 let input = "equal? (mul 2 (add 3 4)) (add (mul 2 3) (mul 2 4))" 797 env <- runExpression input 798 env @?= trueT 799 800 , testCase "lt? reflexive is false" $ do 801 let input = "lt? 5 5" 802 env <- runExpression input 803 env @?= falseT 804 805 , testCase "lte? reflexive is true" $ do 806 let input = "lte? 5 5" 807 env <- runExpression input 808 env @?= trueT 809 810 , testCase "lt? transitivity" $ do 811 let input = "and? (lt? 2 5) (lt? 5 7)" 812 env <- runExpression input 813 env @?= trueT 814 815 , testCase "add larger numbers" $ do 816 let input = "add 12 15" 817 env <- runExpression input 818 env @?= ofNumber 27 819 820 , testCase "mul larger numbers" $ do 821 let input = "mul 5 6" 822 env <- runExpression input 823 env @?= ofNumber 30 824 825 , testCase "isZero? on add 0 0" $ do 826 let input = "isZero? (add 0 0)" 827 env <- runExpression input 828 env @?= trueT 829 830 , testCase "div 10 3 = 3" $ do 831 let input = "div 10 3" 832 env <- runExpression input 833 env @?= ofNumber 3 834 835 , testCase "div 12 4 = 3 (exact)" $ do 836 let input = "div 12 4" 837 env <- runExpression input 838 env @?= ofNumber 3 839 840 , testCase "div 3 5 = 0 (divisor larger)" $ do 841 let input = "div 3 5" 842 env <- runExpression input 843 env @?= ofNumber 0 844 845 , testCase "div 7 1 = 7 (identity)" $ do 846 let input = "div 7 1" 847 env <- runExpression input 848 env @?= ofNumber 7 849 850 , testCase "div 0 5 = 0" $ do 851 let input = "div 0 5" 852 env <- runExpression input 853 env @?= ofNumber 0 854 855 , testCase "div rejects a zero divisor" $ do 856 let input = "div 5 0" 857 env <- runExpression input 858 env @?= Fork Leaf (Fork (ofString "non-zero") Leaf) 859 860 , testCase "mod 10 3 = 1" $ do 861 let input = "mod 10 3" 862 env <- runExpression input 863 env @?= ofNumber 1 864 865 , testCase "mod 12 4 = 0 (exact)" $ do 866 let input = "mod 12 4" 867 env <- runExpression input 868 env @?= ofNumber 0 869 870 , testCase "mod 3 5 = 3 (divisor larger)" $ do 871 let input = "mod 3 5" 872 env <- runExpression input 873 env @?= ofNumber 3 874 875 , testCase "mod 7 1 = 0" $ do 876 let input = "mod 7 1" 877 env <- runExpression input 878 env @?= ofNumber 0 879 880 , testCase "mod rejects a zero divisor" $ do 881 let input = "mod 5 0" 882 env <- runExpression input 883 env @?= Fork Leaf (Fork (ofString "non-zero") Leaf) 884 885 , testCase "div mod consistency" $ do 886 let input = "equal? (add (mul 3 7) 4) 25" 887 env <- runExpression input 888 env @?= trueT 889 890 , testCase "pow 2 0 = 1" $ do 891 let input = "pow 2 0" 892 env <- runExpression input 893 env @?= ofNumber 1 894 895 , testCase "pow 2 3 = 8" $ do 896 let input = "pow 2 3" 897 env <- runExpression input 898 env @?= ofNumber 8 899 900 , testCase "pow 3 2 = 9" $ do 901 let input = "pow 3 2" 902 env <- runExpression input 903 env @?= ofNumber 9 904 905 , testCase "pow 0 0 = 1" $ do 906 let input = "pow 0 0" 907 env <- runExpression input 908 env @?= ofNumber 1 909 910 , testCase "pow 0 5 = 0" $ do 911 let input = "pow 0 5" 912 env <- runExpression input 913 env @?= ofNumber 0 914 915 , testCase "pow 1 10 = 1" $ do 916 let input = "pow 1 10" 917 env <- runExpression input 918 env @?= ofNumber 1 919 920 , testCase "pow 5 1 = 5" $ do 921 let input = "pow 5 1" 922 env <- runExpression input 923 env @?= ofNumber 5 924 925 , testCase "min 3 7 = 3" $ do 926 let input = "min 3 7" 927 env <- runExpression input 928 env @?= ofNumber 3 929 930 , testCase "min 7 3 = 3" $ do 931 let input = "min 7 3" 932 env <- runExpression input 933 env @?= ofNumber 3 934 935 , testCase "min 5 5 = 5" $ do 936 let input = "min 5 5" 937 env <- runExpression input 938 env @?= ofNumber 5 939 940 , testCase "min 0 5 = 0" $ do 941 let input = "min 0 5" 942 env <- runExpression input 943 env @?= ofNumber 0 944 945 , testCase "max 3 7 = 7" $ do 946 let input = "max 3 7" 947 env <- runExpression input 948 env @?= ofNumber 7 949 950 , testCase "max 7 3 = 7" $ do 951 let input = "max 7 3" 952 env <- runExpression input 953 env @?= ofNumber 7 954 955 , testCase "max 5 5 = 5" $ do 956 let input = "max 5 5" 957 env <- runExpression input 958 env @?= ofNumber 5 959 960 , testCase "max 0 5 = 5" $ do 961 let input = "max 0 5" 962 env <- runExpression input 963 env @?= ofNumber 5 964 965 , testCase "even? 0 = true" $ do 966 let input = "even? 0" 967 env <- runExpression input 968 env @?= trueT 969 970 , testCase "even? 1 = false" $ do 971 let input = "even? 1" 972 env <- runExpression input 973 env @?= falseT 974 975 , testCase "even? 2 = true" $ do 976 let input = "even? 2" 977 env <- runExpression input 978 env @?= trueT 979 980 , testCase "even? 7 = false" $ do 981 let input = "even? 7" 982 env <- runExpression input 983 env @?= falseT 984 985 , testCase "odd? 0 = false" $ do 986 let input = "odd? 0" 987 env <- runExpression input 988 env @?= falseT 989 990 , testCase "odd? 1 = true" $ do 991 let input = "odd? 1" 992 env <- runExpression input 993 env @?= trueT 994 995 , testCase "odd? 2 = false" $ do 996 let input = "odd? 2" 997 env <- runExpression input 998 env @?= falseT 999 1000 , testCase "odd? 7 = true" $ do 1001 let input = "odd? 7" 1002 env <- runExpression input 1003 env @?= trueT 1004 ] 1005