Skip to content

Commit 4a6c842

Browse files
nebasukenebasuke
committed
Add tasty test suite, QuickCheck properties, and GitHub Actions CI
1 parent 985b481 commit 4a6c842

File tree

6 files changed

+407
-0
lines changed

6 files changed

+407
-0
lines changed

‎.github/workflows/ci.yml‎

Lines changed: 40 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,40 @@
1+
name: CI
2+
3+
on:
4+
push:
5+
branches: [master]
6+
pull_request:
7+
branches: [master]
8+
9+
jobs:
10+
build:
11+
name: GHC ${{ matrix.ghc }}
12+
runs-on: ubuntu-latest
13+
strategy:
14+
fail-fast: false
15+
matrix:
16+
ghc: ['9.4', '9.6', '9.8', '9.10']
17+
18+
steps:
19+
- uses: actions/checkout@v4
20+
21+
- uses: haskell-actions/setup@v2
22+
with:
23+
ghc-version: ${{ matrix.ghc }}
24+
25+
- name: Cache cabal store
26+
uses: actions/cache@v4
27+
with:
28+
path: ~/.cabal/store
29+
key: ${{ runner.os }}-ghc-${{ matrix.ghc }}-cabal-${{ hashFiles('Dung.cabal') }}
30+
restore-keys: |
31+
${{ runner.os }}-ghc-${{ matrix.ghc }}-cabal-
32+
33+
- name: Update cabal package list
34+
run: cabal update
35+
36+
- name: Build
37+
run: cabal build all
38+
39+
- name: Run tests
40+
run: cabal test all --test-show-details=direct

‎test/Doctest.hs‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
module Main (main) where
2+
3+
import Test.DocTest
4+
5+
main :: IO ()
6+
main = doctest
7+
[ "-isrc"
8+
, "src/Language/Dung/Examples.hs"
9+
]

‎test/Main.hs‎

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,14 @@
1+
module Main (main) where
2+
3+
import Test.Tasty
4+
5+
import qualified Test.Language.Dung.AF as AF
6+
import qualified Test.Language.Dung.Input as Input
7+
import qualified Test.Language.Dung.Properties as Properties
8+
9+
main :: IO ()
10+
main = defaultMain $ testGroup "Dung"
11+
[ AF.tests
12+
, Input.tests
13+
, Properties.tests
14+
]

‎test/Test/Language/Dung/AF.hs‎

Lines changed: 184 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,184 @@
1+
module Test.Language.Dung.AF (tests) where
2+
3+
import Data.List (sort)
4+
import Test.Tasty
5+
import Test.Tasty.HUnit
6+
7+
import Language.Dung.AF
8+
9+
-- Convenience definitions matching Examples.hs
10+
a, b, c, d, e :: String
11+
a = "A"
12+
b = "B"
13+
c = "C"
14+
d = "D"
15+
e = "E"
16+
17+
-- A -> B -> C
18+
exampleAF :: DungAF String
19+
exampleAF = AF [a, b, c] [(a, b), (b, c)]
20+
21+
-- A <-> B
22+
exampleAF2 :: DungAF String
23+
exampleAF2 = AF [a, b] [(a, b), (b, a)]
24+
25+
-- Fig1 LHS in Caminada: {(a,a), (a,c), (b,c), (c,d)}
26+
exampleAF3 :: DungAF String
27+
exampleAF3 = AF [a, b, c, d] [(a, a), (a, c), (b, c), (c, d)]
28+
29+
-- Fig1 RHS in Caminada: {(a,b), (b,a), (b,c), (c,d), (d,e), (e,c)}
30+
exampleAF4 :: DungAF String
31+
exampleAF4 = AF [a, b, c, d, e] [(a, b), (b, a), (b, c), (c, d), (d, e), (e, c)]
32+
33+
tests :: TestTree
34+
tests = testGroup "Language.Dung.AF"
35+
[ setAttacksTests
36+
, conflictFreeTests
37+
, acceptableTests
38+
, admissibleTests
39+
, groundedTests
40+
, groundedExtTests
41+
, groundedFTests
42+
, completeTests
43+
, completeExtTests
44+
, preferredExtTests
45+
, stableExtTests
46+
, semiStableTests
47+
, semiStableExtTests
48+
]
49+
50+
setAttacksTests :: TestTree
51+
setAttacksTests = testGroup "setAttacks"
52+
[ testCase "[a,b] attacks c in exampleAF" $
53+
setAttacks exampleAF [a, b] c @?= True
54+
, testCase "[b,c] does not attack a in exampleAF" $
55+
setAttacks exampleAF [b, c] a @?= False
56+
, testCase "[] does not attack b in exampleAF2" $
57+
setAttacks exampleAF2 [] b @?= False
58+
]
59+
60+
conflictFreeTests :: TestTree
61+
conflictFreeTests = testGroup "conflictFree"
62+
[ testCase "[a,c] is conflict-free in exampleAF" $
63+
conflictFree exampleAF [a, c] @?= True
64+
, testCase "[a,b,c] is not conflict-free in exampleAF" $
65+
conflictFree exampleAF [a, b, c] @?= False
66+
, testCase "[a,b] is not conflict-free in exampleAF2" $
67+
conflictFree exampleAF2 [a, b] @?= False
68+
]
69+
70+
acceptableTests :: TestTree
71+
acceptableTests = testGroup "acceptable"
72+
[ testCase "c acceptable w.r.t. [a,b] in exampleAF" $
73+
acceptable exampleAF c [a, b] @?= True
74+
, testCase "c not acceptable w.r.t. [] in exampleAF" $
75+
acceptable exampleAF c [] @?= False
76+
, testCase "b not acceptable w.r.t. [a,b,c] in exampleAF" $
77+
acceptable exampleAF b [a, b, c] @?= False
78+
]
79+
80+
admissibleTests :: TestTree
81+
admissibleTests = testGroup "admissible"
82+
[ testCase "[a,b,c] not admissible in exampleAF" $
83+
admissible exampleAF [a, b, c] @?= False
84+
, testCase "[a,c] is admissible in exampleAF" $
85+
admissible exampleAF [a, c] @?= True
86+
, testCase "[a] is admissible in exampleAF" $
87+
admissible exampleAF [a] @?= True
88+
]
89+
90+
groundedTests :: TestTree
91+
groundedTests = testGroup "grounded"
92+
[ testCase "grounded exampleAF" $
93+
sort (grounded exampleAF) @?= sort [("A", In), ("C", In), ("B", Out)]
94+
, testCase "grounded exampleAF2" $
95+
sort (grounded exampleAF2) @?= sort [("A", Undecided), ("B", Undecided)]
96+
]
97+
98+
groundedExtTests :: TestTree
99+
groundedExtTests = testGroup "groundedExt"
100+
[ testCase "groundedExt exampleAF" $
101+
sort (groundedExt exampleAF) @?= sort ["A", "C"]
102+
, testCase "groundedExt exampleAF2" $
103+
groundedExt exampleAF2 @?= []
104+
]
105+
106+
groundedFTests :: TestTree
107+
groundedFTests = testGroup "groundedF"
108+
[ testCase "groundedF (f exampleAF)" $
109+
sort (groundedF (f exampleAF)) @?= sort ["A", "C"]
110+
, testCase "groundedF (f exampleAF2)" $
111+
groundedF (f exampleAF2) @?= []
112+
, testCase "groundedF' (f exampleAF)" $
113+
sort (groundedF' (f exampleAF)) @?= sort ["A", "C"]
114+
, testCase "groundedF' (f exampleAF2)" $
115+
groundedF' (f exampleAF2) @?= []
116+
]
117+
118+
completeTests :: TestTree
119+
completeTests = testGroup "complete"
120+
[ testCase "complete exampleAF3 has one labelling" $
121+
length (complete exampleAF3) @?= 1
122+
, testCase "complete exampleAF3 content" $ case complete exampleAF3 of
123+
(lab:_) -> sort lab @?= sort [("A", Undecided), ("B", In), ("C", Out), ("D", In)]
124+
[] -> assertFailure "Expected at least one complete labelling"
125+
, testCase "complete exampleAF4 has three labellings" $
126+
length (complete exampleAF4) @?= 3
127+
]
128+
129+
completeExtTests :: TestTree
130+
completeExtTests = testGroup "completeExt"
131+
[ testCase "completeExt exampleAF3" $
132+
map sort (completeExt exampleAF3) @?= [sort ["B", "D"]]
133+
, testCase "completeExt exampleAF4 has three extensions" $
134+
length (completeExt exampleAF4) @?= 3
135+
, testCase "completeExt exampleAF4 content" $ do
136+
let exts = map sort (completeExt exampleAF4)
137+
sort ["B", "D"] `elem` exts @?= True
138+
sort ["A"] `elem` exts @?= True
139+
sort ["B"] `elem` exts @?= True
140+
]
141+
142+
preferredExtTests :: TestTree
143+
preferredExtTests = testGroup "preferredExt"
144+
[ testCase "preferredExt exampleAF" $
145+
map sort (preferredExt exampleAF) @?= [sort ["A", "C"]]
146+
, testCase "preferredExt exampleAF2" $ do
147+
let exts = map sort (preferredExt exampleAF2)
148+
length exts @?= 2
149+
["A"] `elem` exts @?= True
150+
["B"] `elem` exts @?= True
151+
]
152+
153+
stableExtTests :: TestTree
154+
stableExtTests = testGroup "stableExt"
155+
[ testCase "stableExt exampleAF" $
156+
map sort (stableExt exampleAF) @?= [sort ["A", "C"]]
157+
, testCase "stableExt exampleAF2" $ do
158+
let exts = map sort (stableExt exampleAF2)
159+
length exts @?= 2
160+
["A"] `elem` exts @?= True
161+
["B"] `elem` exts @?= True
162+
]
163+
164+
semiStableTests :: TestTree
165+
semiStableTests = testGroup "semiStable"
166+
[ testCase "semiStable exampleAF3 has one labelling" $
167+
length (semiStable exampleAF3) @?= 1
168+
, testCase "semiStable exampleAF3 content" $ case semiStable exampleAF3 of
169+
(s:_) -> sort s @?= sort [("A", Undecided), ("B", In), ("C", Out), ("D", In)]
170+
[] -> assertFailure "Expected at least one semi-stable labelling"
171+
, testCase "semiStable exampleAF4 has one labelling" $
172+
length (semiStable exampleAF4) @?= 1
173+
, testCase "semiStable exampleAF4 content" $ case semiStable exampleAF4 of
174+
(s:_) -> sort s @?= sort [("A", Out), ("B", In), ("C", Out), ("D", In), ("E", Out)]
175+
[] -> assertFailure "Expected at least one semi-stable labelling"
176+
]
177+
178+
semiStableExtTests :: TestTree
179+
semiStableExtTests = testGroup "semiStableExt"
180+
[ testCase "semiStableExt exampleAF3" $
181+
map sort (semiStableExt exampleAF3) @?= [sort ["B", "D"]]
182+
, testCase "semiStableExt exampleAF4" $
183+
map sort (semiStableExt exampleAF4) @?= [sort ["B", "D"]]
184+
]

‎test/Test/Language/Dung/Input.hs‎

Lines changed: 79 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,79 @@
1+
module Test.Language.Dung.Input (tests) where
2+
3+
import Test.Tasty
4+
import Test.Tasty.HUnit
5+
6+
import Language.Dung.AF
7+
import Language.Dung.Input
8+
import Language.Dung.Output
9+
10+
tests :: TestTree
11+
tests = testGroup "Language.Dung.Input"
12+
[ parseTests
13+
, roundTripTests
14+
, edgeCaseTests
15+
]
16+
17+
-- Helper to unwrap a Right or fail the test
18+
expectRight :: Either a b -> IO b
19+
expectRight (Right x) = return x
20+
expectRight (Left _) = assertFailure "Expected Right but got Left" >> undefined
21+
22+
parseTests :: TestTree
23+
parseTests = testGroup "parseAF"
24+
[ testCase "parses single argument" $ do
25+
af <- expectRight $ parseAF "arg(a)."
26+
af @?= AF ["a"] []
27+
, testCase "parses argument and attack" $ do
28+
af <- expectRight $ parseAF "arg(a). arg(b). att(a,b)."
29+
af @?= AF ["a", "b"] [("a", "b")]
30+
, testCase "parses atk syntax" $ do
31+
af <- expectRight $ parseAF "arg(a). arg(b). atk(a,b)."
32+
af @?= AF ["a", "b"] [("a", "b")]
33+
, testCase "parses multi-line input" $ do
34+
let input = unlines
35+
[ "arg(a)."
36+
, "arg(b)."
37+
, "arg(c)."
38+
, "att(a,b)."
39+
, "att(b,c)."
40+
]
41+
af <- expectRight $ parseAF input
42+
af @?= AF ["a", "b", "c"] [("a", "b"), ("b", "c")]
43+
, testCase "parses exampleaf.txt format" $ do
44+
let input = "arg(a). arg(b). arg(c). arg(d). arg(e). arg(f). arg(g). att(a,b). att(c,b). att(c,d). att(d,c). att(d,e). att(e,g). att(f,e). att(g,f)."
45+
af <- expectRight $ parseAF input
46+
af @?= AF ["a","b","c","d","e","f","g"]
47+
[("a","b"),("c","b"),("c","d"),("d","c"),("d","e"),("e","g"),("f","e"),("g","f")]
48+
, testCase "returns Left on invalid input" $ do
49+
let result = parseAF "invalid input"
50+
case result of
51+
Left _ -> return ()
52+
Right _ -> assertFailure "Expected parse error"
53+
]
54+
55+
roundTripTests :: TestTree
56+
roundTripTests = testGroup "round-trip"
57+
[ testCase "parse . toCegartix identity for simple AF" $ do
58+
let af = AF ["a", "b", "c"] [("a", "b"), ("b", "c")] :: DungAF String
59+
output = toCegartix af
60+
case parseAF output of
61+
Left err -> assertFailure $ "Parse error: " ++ show err
62+
Right af' -> af' @?= af
63+
, testCase "parse . toCegartix identity for self-attacking AF" $ do
64+
let af = AF ["a", "b"] [("a", "a"), ("a", "b")] :: DungAF String
65+
output = toCegartix af
66+
case parseAF output of
67+
Left err -> assertFailure $ "Parse error: " ++ show err
68+
Right af' -> af' @?= af
69+
]
70+
71+
edgeCaseTests :: TestTree
72+
edgeCaseTests = testGroup "edge cases"
73+
[ testCase "single argument, no attacks" $ do
74+
af <- expectRight $ parseAF "arg(x)."
75+
af @?= AF ["x"] []
76+
, testCase "string literal argument names" $ do
77+
af <- expectRight $ parseAF "arg(\"hello\"). arg(\"world\"). att(\"hello\", \"world\")."
78+
af @?= AF ["hello", "world"] [("hello", "world")]
79+
]

0 commit comments

Comments
 (0)