Skip to content

Commit

Permalink
new syntax (#308, #313): fix pinafore-language tests
Browse files Browse the repository at this point in the history
  • Loading branch information
@AshleyYakeley
AshleyYakeley committed Sep 11, 2024
1 parent 5727141 commit 8e8eb73
Show file tree
Hide file tree
Showing 31 changed files with 1,527 additions and 1,563 deletions.
1,278 changes: 641 additions & 637 deletions Pinafore/pinafore-language/test/Test/Entity.hs
View file

Large diffs are not rendered by default.

610 changes: 304 additions & 306 deletions Pinafore/pinafore-language/test/Test/Language.hs
View file

Large diffs are not rendered by default.

57 changes: 28 additions & 29 deletions Pinafore/pinafore-language/test/Test/Module.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -15,49 +15,48 @@ testModule =
"none"
[ testExpectSuccess "pure ()"
, testExpectThrow "fail \"wrong\""
, testExpectSuccess "let a=4 in if a == 4 then pure () else fail \"wrong\""
, testExpectSuccess "let {a=4} if a == 4 then pure () else fail \"wrong\""
]
, tModule "m" "a=4" $
tGroup
"exprs"
[ testExpectSuccess "import \"m\" in if a == 4 then pure () else fail \"wrong\""
, testExpectSuccess "import \"m\" in let b = a in if b == 4 then pure () else fail \"wrong\""
[ testExpectSuccess "import \"m\" if a == 4 then pure () else fail \"wrong\""
, testExpectSuccess "import \"m\" let {b = a} if b == 4 then pure () else fail \"wrong\""
]
, tModule "m" "datatype T of T1; T2 end" $
, tModule "m" "datatype T {T1; T2}" $
tGroup
"type"
[ testExpectSuccess "import \"m\" in T1.T >- match T1.T => pure (); T2.T => fail \"wrong\" end"
, testExpectSuccess
"import \"m\" in let t: T = T1.T in t >- match T1.T => pure (); T2.T => fail \"wrong\" end"
, testExpectSuccess "import \"m\" in let f: T -> T = fn x => x in pure ()"
, testExpectSuccess "let import \"m\" in expose T in let f: T -> T = fn x => x in pure ()"
, testExpectReject " let import \"m\" in expose in let f: T -> T = fn x => x in pure ()"
, testExpectReject " let import \"m\" in expose T1.T, T2.T in let f: T -> T = fn x => x in pure ()"
, testExpectSuccess "let import \"m\" in expose T1.T in let f = T1.T in pure ()"
, testExpectReject " let import \"m\" in expose T2.T in let f = T1.T in pure ()"
[ testExpectSuccess "import \"m\" T1.T >- fn {T1.T => pure (); T2.T => fail \"wrong\"}"
, testExpectSuccess "import \"m\" let {t: T = T1.T} t >- fn {T1.T => pure (); T2.T => fail \"wrong\"}"
, testExpectSuccess "import \"m\" let {f: T -> T = fn x => x} pure ()"
, testExpectSuccess "let {import \"m\" expose T } let {f: T -> T = fn x => x} pure ()"
, testExpectReject " let {import \"m\" expose } let {f: T -> T = fn x => x} pure ()"
, testExpectReject " let {import \"m\" expose T1.T, T2.T} let {f: T -> T = fn x => x} pure ()"
, testExpectSuccess "let {import \"m\" expose T1.T } let {f = T1.T} pure ()"
, testExpectReject " let {import \"m\" expose T2.T } let {f = T1.T} pure ()"
]
, tModule "m" "entitytype T" $
tGroup "entitytype" [testExpectSuccess "import \"m\" in let datatype D of MkD T end; in pure ()"]
tGroup "entitytype" [testExpectSuccess "import \"m\" let {datatype D {MkD T};} pure ()"]
, tModule "m" "entitytype P; entitytype Q" $
tModule "n" "let import \"m\" end; subtype P <: Q in expose" $
tModule "n" "let {import \"m\"; subtype P <: Q} expose" $
tGroup
"subtype"
[ testExpectReject "import \"m\" in let f: P -> Q = fn x => x in pure ()"
, testExpectSuccess "import \"m\" in import \"n\" in let f: P -> Q = fn x => x in pure ()"
, testExpectSuccess "import \"n\" in import \"m\" in let f: P -> Q = fn x => x in pure ()"
, testExpectSuccess "import \"m\", \"n\" in let f: P -> Q = fn x => x in pure ()"
, testExpectSuccess "import \"n\", \"m\" in let f: P -> Q = fn x => x in pure ()"
, testExpectSuccess "import \"m\" in let import \"n\" in expose; f: P -> Q = fn x => x in pure ()"
[ testExpectReject "import \"m\" let {f: P -> Q = fn x => x} pure ()"
, testExpectSuccess "import \"m\" import \"n\" let {f: P -> Q = fn x => x} pure ()"
, testExpectSuccess "import \"n\" import \"m\" let {f: P -> Q = fn x => x} pure ()"
, testExpectSuccess "import \"m\", \"n\" let {f: P -> Q = fn x => x} pure ()"
, testExpectSuccess "import \"n\", \"m\" let {f: P -> Q = fn x => x} pure ()"
, testExpectSuccess "import \"m\" let {import \"n\" expose; f: P -> Q = fn x => x} pure ()"
]
, tGroup
"purity"
[ tModule "m" "a = 1" $ testExpectSuccess "import \"m\" in pure ()"
, tModule "m" "a = b" $ testExpectReject "import \"m\" in pure ()"
, tModule "m" "a = ?b" $ testExpectSuccess "import \"m\" in pure ()"
, testExpectSuccess "let f = fn x => let y = x in y in pure ()"
, testExpectSuccess "let f = fn x => let let y = x in expose y in y in pure ()"
, testExpectReject "let f = fn x => let let y = z in expose y in y in pure ()"
, testExpectSuccess "let y = ?x in pure ()"
, testExpectSuccess "let let y = ?x in expose y in pure ()"
[ tModule "m" "a = 1" $ testExpectSuccess "import \"m\" pure ()"
, tModule "m" "a = b" $ testExpectReject "import \"m\" pure ()"
, tModule "m" "a = ?b" $ testExpectSuccess "import \"m\" pure ()"
, testExpectSuccess "let {f = fn x => let {y = x} y} pure ()"
, testExpectSuccess "let {f = fn x => let {let {y = x} expose y} y} pure ()"
, testExpectReject "let {f = fn x => let {let {y = z} expose y} y} pure ()"
, testExpectSuccess "let {y = ?x} pure ()"
, testExpectSuccess "let {let {y = ?x} expose y} pure ()"
]
]
Loading

0 comments on commit 8e8eb73

Please sign in to comment.