Skip to content

Commit 0624c1e

Browse files
test(idris2): port DSL + playground test suites from Racket/TS (#22)
Estate ports 5a/11 + 5b/11 — converts the betlang test surface to Idris2 under the same cladistic Test.Spec harness used by ipfs-overlay, format-registrations, awesome-nickel, etc. tests/idris2/ (DSL, content-validation): - DslStructureTest 16 unit tests: file existence, #lang racket, SPDX coverage, primitive provides, structural substring checks across 8 .rkt source files - DslContractsTest 12 INVARIANT tests pinning the documented contracts (ternary shape, weighted-3 enforcement, seed reproducibility, entropy bounds, 25-test basics coverage, parallel list-comprehension form) - Total 28 tests; all PASS playground/tests/idris2/ (hybrid: pure-logic + content-validation): - PlaygroundTernaryTest 13 tests; inline Idris2 reimpl of the Kleene 3-value logic (Tri/notT/andT/orT/ impliesT/betT). De Morgan + truth-table property checks over all 9 pairs. - PlaygroundProbabilityTest 12 tests; pure-logic port of Branch/ betWeighted/betConditional/analyticEV. mulberry32 PRNG falls back to content- validation (no clean Idris2 port for the bitwise-uint32 arithmetic). - PlaygroundStructureTest 14 tests; SPDX + structural checks across the 4 .ts files and deno.json. - Total 39 tests; all PASS Local build verified on idris2 0.8.0 with the standard estate incantation (IDRIS2_PREFIX/IDRIS2_DATA/IDRIS2_PACKAGE_PATH/ LD_LIBRARY_PATH). 67/67 PASS total across both suites. SPDX coverage note: only the 2 conformance/*.rkt files carry SPDX headers. The DSL structure test pins current truth (asserts those two specifically) rather than failing on absent headers across the other 6 .rkt source files. Backfilling SPDX across core/ + lib/ + tests/basics.rkt is filed separately as part of the licence-debt ledger (estate-wide scaffold-placeholder sweep). Closes the 2026-05-20 bimodal-rollout DEFERRED tags on betlang in the estate test rollout campaign. Co-authored-by: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
1 parent e37c2d9 commit 0624c1e

11 files changed

Lines changed: 1158 additions & 0 deletions

betlang-tests.ipkg

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,19 @@
1+
-- SPDX-License-Identifier: PMPL-1.0-or-later
2+
-- betlang Idris2 test suite. Estate port 5a/11 - both .rkt test families
3+
-- ported (basics + conformance) as content-validation (file-read +
4+
-- substring matching) since Racket's (random 3) has no pure Idris2 analogue.
5+
6+
package betlang-tests
7+
8+
sourcedir = "tests/idris2"
9+
10+
depends = base
11+
12+
modules = Test.Spec
13+
, DslStructureTest
14+
, DslContractsTest
15+
, Main
16+
17+
main = Main
18+
19+
executable = "betlang-tests"

playground/playground-tests.ipkg

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,15 @@
1+
-- SPDX-License-Identifier: PMPL-1.0-or-later
2+
package playground-tests
3+
4+
sourcedir = "tests/idris2"
5+
6+
depends = base
7+
8+
modules = Test.Spec
9+
, PlaygroundTernaryTest
10+
, PlaygroundProbabilityTest
11+
, PlaygroundStructureTest
12+
, Main
13+
14+
main = Main
15+
executable = "playground-tests"

playground/tests/idris2/Main.idr

Lines changed: 27 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,27 @@
1+
-- SPDX-License-Identifier: PMPL-1.0-or-later
2+
-- Copyright (c) 2026 Jonathan D.A. Jewell (hyperpolymath) <j.d.a.jewell@open.ac.uk>
3+
--
4+
-- Aggregator entry point for the playground Idris2 test suite.
5+
6+
module Main
7+
8+
import Test.Spec
9+
import PlaygroundTernaryTest
10+
import PlaygroundProbabilityTest
11+
import PlaygroundStructureTest
12+
import System
13+
14+
%default covering
15+
16+
main : IO ()
17+
main = do
18+
(p1, f1) <- runTestSuite "PlaygroundTernaryTest" PlaygroundTernaryTest.allSuites
19+
(p2, f2) <- runTestSuite "PlaygroundProbabilityTest" PlaygroundProbabilityTest.allSuites
20+
(p3, f3) <- runTestSuite "PlaygroundStructureTest" PlaygroundStructureTest.allSuites
21+
let totalPassed = p1 + p2 + p3
22+
let totalFailed = f1 + f2 + f3
23+
putStrLn ""
24+
putStrLn $ "=== Total: " ++ show totalPassed ++ " passed, " ++ show totalFailed ++ " failed ==="
25+
if totalFailed > 0
26+
then exitWith (ExitFailure 1)
27+
else pure ()
Lines changed: 160 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,160 @@
1+
-- SPDX-License-Identifier: PMPL-1.0-or-later
2+
-- Copyright (c) 2026 Jonathan D.A. Jewell (hyperpolymath) <j.d.a.jewell@open.ac.uk>
3+
--
4+
-- Port of playground/test/probability_test.ts to Idris2, estate-rollout 5b/11.
5+
-- The probability layer mixes pure deterministic ops (expectation reduction,
6+
-- conditional dispatch) with PRNG-driven Monte Carlo. We port the pure parts
7+
-- directly (weighted-choice over [0,1) inputs, analytic expectation,
8+
-- conditional dispatch via Tri) and keep content-validation for the parts
9+
-- that need the Deno mulberry32 PRNG.
10+
11+
module PlaygroundProbabilityTest
12+
13+
import Test.Spec
14+
import PlaygroundTernaryTest
15+
import Data.String
16+
import System.File
17+
18+
%default covering
19+
20+
-- Inline weighted-branch model -----------------------------------------------
21+
22+
-- A branch carries a weight and a lazy value. Mirrors playground/src/probability.ts.
23+
public export
24+
record Branch a where
25+
constructor MkBranch
26+
weight : Double
27+
value : Lazy a
28+
29+
-- Sum of weights.
30+
totalWeight : List (Branch a) -> Double
31+
totalWeight = foldr (\b, acc => weight b + acc) 0.0
32+
33+
-- Pick a branch given a draw in [0,1). Returns Nothing when weights are
34+
-- non-positive or the input list is empty (we model the runtime error
35+
-- defensively so tests can assert on it).
36+
public export
37+
betWeighted : List (Branch a) -> Double -> Maybe a
38+
betWeighted [] _ = Nothing
39+
betWeighted branches@(b0 :: _) draw =
40+
let tot = totalWeight branches in
41+
if tot <= 0.0
42+
then Nothing
43+
else Just (pick branches (draw * tot) (Force (value b0)))
44+
where
45+
pick : List (Branch a) -> Double -> a -> a
46+
pick [] _ fallback = fallback
47+
pick (b :: bs) r fallback =
48+
let r' = r - weight b in
49+
if r' <= 0.0
50+
then Force (value b)
51+
else pick bs r' fallback
52+
53+
-- Predicate-driven Tri dispatch: total under U. Mirrors the Deno
54+
-- betConditional, which is just a Tri-flavoured wrapper over bet().
55+
public export
56+
betConditional : Tri -> Lazy a -> Lazy a -> Lazy a -> a
57+
betConditional T onT _ _ = onT
58+
betConditional U _ onU _ = onU
59+
betConditional F _ _ onF = onF
60+
61+
-- Analytic expectation of a numeric weighted bet (no sampling needed).
62+
public export
63+
analyticEV : List (Branch Double) -> Double
64+
analyticEV bs =
65+
let tot = totalWeight bs in
66+
if tot <= 0.0
67+
then 0.0
68+
else foldr (\b, acc => weight b * Force (value b) + acc) 0.0 bs / tot
69+
70+
-- File helpers for content validation ----------------------------------------
71+
72+
readFileToString : String -> IO String
73+
readFileToString path = do
74+
Right contents <- readFile path
75+
| Left _ => pure ""
76+
pure contents
77+
78+
fileExists : String -> IO Bool
79+
fileExists path = do
80+
Right _ <- readFile path
81+
| Left _ => pure False
82+
pure True
83+
84+
-- Sample weighted payout used in the Deno expectation test.
85+
samplePayout : List (Branch Double)
86+
samplePayout =
87+
[ MkBranch 1.0 100.0
88+
, MkBranch 2.0 10.0
89+
, MkBranch 7.0 0.0
90+
]
91+
92+
-- Tests ----------------------------------------------------------------------
93+
94+
public export
95+
allSuites : List TestCase
96+
allSuites =
97+
[ test "analyticEV computes the documented EV = 12 for the sample payout" $
98+
assertEq (analyticEV samplePayout) 12.0
99+
100+
, test "betWeighted with draw=0.0 picks the first branch" $ do
101+
let bs : List (Branch String) =
102+
[ MkBranch 0.6 "T", MkBranch 0.3 "U", MkBranch 0.1 "F" ]
103+
assertEq (betWeighted bs 0.0) (Just "T")
104+
105+
, test "betWeighted with draw=0.5 picks branch with cumulative weight" $ do
106+
-- weights 0.6/0.3/0.1; draw 0.5 -> target 0.5 -> consume 0.6 first -> T
107+
let bs : List (Branch String) =
108+
[ MkBranch 0.6 "T", MkBranch 0.3 "U", MkBranch 0.1 "F" ]
109+
assertEq (betWeighted bs 0.5) (Just "T")
110+
111+
, test "betWeighted with draw 0.75 picks the middle branch" $ do
112+
-- target 0.75; 0.6 used by T (-0.15 leftover -> would early-return)
113+
-- Actually 0.75*1.0 = 0.75; 0.75 - 0.6 = 0.15 > 0, then 0.15 - 0.3 < 0 -> U
114+
let bs : List (Branch String) =
115+
[ MkBranch 0.6 "T", MkBranch 0.3 "U", MkBranch 0.1 "F" ]
116+
assertEq (betWeighted bs 0.75) (Just "U")
117+
118+
, test "betWeighted with draw 0.95 picks the tail branch" $ do
119+
let bs : List (Branch String) =
120+
[ MkBranch 0.6 "T", MkBranch 0.3 "U", MkBranch 0.1 "F" ]
121+
assertEq (betWeighted bs 0.95) (Just "F")
122+
123+
, test "betWeighted rejects empty branch list" $ do
124+
let bs : List (Branch String) = []
125+
assertEq (betWeighted bs 0.5) Nothing
126+
127+
, test "betWeighted rejects non-positive total weight" $ do
128+
let bs : List (Branch String) = [ MkBranch 0.0 "x" ]
129+
assertEq (betWeighted bs 0.5) Nothing
130+
131+
, test "betConditional defers to the uncertain branch on Unknown" $
132+
assertEq (betConditional U "yes" "maybe" "no") "maybe"
133+
134+
, test "betConditional commits on True" $
135+
assertEq (betConditional T "yes" "maybe" "no") "yes"
136+
137+
, test "betConditional declines on False" $
138+
assertEq (betConditional F "yes" "maybe" "no") "no"
139+
140+
-- Content validation for the parts of probability.ts that rely on Deno's
141+
-- mulberry32 PRNG: we cannot port the bit-twiddling RNG identically into
142+
-- Idris2, so we cross-check that the TS source still exposes the public API
143+
-- the tests above mirror.
144+
, test "Structure: probability.ts exports rng/betWeighted/betConditional/expectation" $ do
145+
content <- readFileToString "src/probability.ts"
146+
allPass
147+
[ assertTrue "export rng" (isInfixOf "export function rng" content)
148+
, assertTrue "export betWeighted" (isInfixOf "export function betWeighted" content)
149+
, assertTrue "export betConditional" (isInfixOf "export function betConditional" content)
150+
, assertTrue "export expectation" (isInfixOf "export function expectation" content)
151+
]
152+
153+
, test "Structure: probability.ts uses mulberry32 PRNG (deterministic, seedable)" $ do
154+
content <- readFileToString "src/probability.ts"
155+
allPass
156+
[ assertTrue "mulberry32 mention" (isInfixOf "mulberry32" content)
157+
, assertTrue "0x6d2b79f5 constant" (isInfixOf "0x6d2b79f5" content)
158+
, assertTrue "Math.imul" (isInfixOf "Math.imul" content)
159+
]
160+
]
Lines changed: 121 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,121 @@
1+
-- SPDX-License-Identifier: PMPL-1.0-or-later
2+
-- Copyright (c) 2026 Jonathan D.A. Jewell (hyperpolymath) <j.d.a.jewell@open.ac.uk>
3+
--
4+
-- Content-validation tests for the playground sub-project, estate-rollout 5b/11.
5+
-- Mirrors the Deno test-file inventory: each .ts source must exist, carry the
6+
-- SPDX header, and expose the public API the unit tests depend on.
7+
8+
module PlaygroundStructureTest
9+
10+
import Test.Spec
11+
import Data.String
12+
import System.File
13+
14+
%default covering
15+
16+
readFileToString : String -> IO String
17+
readFileToString path = do
18+
Right contents <- readFile path
19+
| Left _ => pure ""
20+
pure contents
21+
22+
fileExists : String -> IO Bool
23+
fileExists path = do
24+
Right _ <- readFile path
25+
| Left _ => pure False
26+
pure True
27+
28+
spdxLine : String
29+
spdxLine = "SPDX-License-Identifier: PMPL-1.0-or-later"
30+
31+
public export
32+
allSuites : List TestCase
33+
allSuites =
34+
[ test "Structure: all 4 .ts files plus deno.json exist" $ do
35+
a <- fileExists "src/ternary.ts"
36+
b <- fileExists "src/probability.ts"
37+
c <- fileExists "test/ternary_test.ts"
38+
d <- fileExists "test/probability_test.ts"
39+
e <- fileExists "deno.json"
40+
assertTrue "all 5 playground files present" (a && b && c && d && e)
41+
42+
, test "Structure: ternary.ts carries SPDX header" $ do
43+
content <- readFileToString "src/ternary.ts"
44+
assertTrue "ternary.ts SPDX" (isInfixOf spdxLine content)
45+
46+
, test "Structure: probability.ts carries SPDX header" $ do
47+
content <- readFileToString "src/probability.ts"
48+
assertTrue "probability.ts SPDX" (isInfixOf spdxLine content)
49+
50+
, test "Structure: ternary_test.ts carries SPDX header" $ do
51+
content <- readFileToString "test/ternary_test.ts"
52+
assertTrue "ternary_test.ts SPDX" (isInfixOf spdxLine content)
53+
54+
, test "Structure: probability_test.ts carries SPDX header" $ do
55+
content <- readFileToString "test/probability_test.ts"
56+
assertTrue "probability_test.ts SPDX" (isInfixOf spdxLine content)
57+
58+
, test "Structure: ternary.ts exports the Tri type and all 5 operators" $ do
59+
content <- readFileToString "src/ternary.ts"
60+
allPass
61+
[ assertTrue "export Tri" (isInfixOf "export type Tri" content)
62+
, assertTrue "export not" (isInfixOf "export function not" content)
63+
, assertTrue "export and" (isInfixOf "export function and" content)
64+
, assertTrue "export or" (isInfixOf "export function or" content)
65+
, assertTrue "export implies" (isInfixOf "export function implies" content)
66+
, assertTrue "export bet" (isInfixOf "export function bet" content)
67+
]
68+
69+
, test "Structure: ternary.ts documents the F < U < T order" $ do
70+
content <- readFileToString "src/ternary.ts"
71+
assertTrue "F < U < T order documented" (isInfixOf "F < U < T" content)
72+
73+
, test "Structure: ternary.ts uses min/max from Math (Kleene = min/max)" $ do
74+
content <- readFileToString "src/ternary.ts"
75+
allPass
76+
[ assertTrue "Math.min present" (isInfixOf "Math.min" content)
77+
, assertTrue "Math.max present" (isInfixOf "Math.max" content)
78+
]
79+
80+
, test "Structure: probability.ts imports from ternary.ts" $ do
81+
content <- readFileToString "src/probability.ts"
82+
allPass
83+
[ assertTrue "imports from ./ternary.ts" (isInfixOf "from './ternary.ts'" content)
84+
, assertTrue "imports Tri type" (isInfixOf "type Tri" content)
85+
, assertTrue "imports bet" (isInfixOf "bet" content)
86+
]
87+
88+
, test "Structure: probability.ts exports the Branch interface" $ do
89+
content <- readFileToString "src/probability.ts"
90+
assertTrue "export interface Branch" (isInfixOf "export interface Branch" content)
91+
92+
, test "Structure: ternary_test.ts uses @std/assert" $ do
93+
content <- readFileToString "test/ternary_test.ts"
94+
allPass
95+
[ assertTrue "imports assertEquals" (isInfixOf "assertEquals" content)
96+
, assertTrue "uses Deno.test" (isInfixOf "Deno.test" content)
97+
]
98+
99+
, test "Structure: probability_test.ts uses assertThrows for weight-validation" $ do
100+
content <- readFileToString "test/probability_test.ts"
101+
allPass
102+
[ assertTrue "assertThrows present" (isInfixOf "assertThrows" content)
103+
, assertTrue "Deno.test present" (isInfixOf "Deno.test" content)
104+
]
105+
106+
, test "Structure: deno.json declares the betlang-playground name" $ do
107+
content <- readFileToString "deno.json"
108+
allPass
109+
[ assertTrue "name field" (isInfixOf "betlang-playground" content)
110+
, assertTrue "test task" (isInfixOf "\"test\"" content)
111+
, assertTrue "@std/assert" (isInfixOf "@std/assert" content)
112+
]
113+
114+
, test "Structure: deno.json enables strict TypeScript" $ do
115+
content <- readFileToString "deno.json"
116+
allPass
117+
[ assertTrue "strict mode" (isInfixOf "\"strict\": true" content)
118+
, assertTrue "noImplicitAny" (isInfixOf "noImplicitAny" content)
119+
, assertTrue "strictNullChecks" (isInfixOf "strictNullChecks" content)
120+
]
121+
]

0 commit comments

Comments
 (0)