From a9995749d18809760068feaecc6026b32ddce72c Mon Sep 17 00:00:00 2001 From: hyperpolymath <6759885+hyperpolymath@users.noreply.github.com> Date: Wed, 20 May 2026 15:25:57 +0100 Subject: [PATCH] test(idris2): port 7 TS test files to Idris2 (estate port 11/11) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Converts the panic-free-tests-and-benches suite to Idris2 under the same cladistic Test.Spec harness used by ipfs-overlay, betlang, stapeln, zerotier-k8s-link, thunderbird-template-reloaded, etc. Modules (9 total, 165 tests): - UnitTest 20 tests - ContractTest 21 tests - AspectTest 28 tests (iterated TS loops expanded for granular reporting) - PropertyTest 16 tests - SmokeTest 46 tests - E2ETest 23 tests - BenchTest 11 tests (functional pre-conditions only; no timing) Closes the final estate port (11/11). Local build verified on idris2 0.8.0. 165/165 PASS. Source bug fixed in the same PR: tests/property_test.ts iterates over contractileFiles = [Dustfile, Mustfile, Intentfile]. Only the first two existed in the repo — contractiles/lust/Intentfile was a missing scaffold companion to the Dust (recovery) and Must (invariants) legs. Created the missing Intentfile with the intent-contract template shape, mirroring the convention of its siblings. Same scaffold gap was observed and fixed in thunderbird-template-reloaded #63. Build gotchas pinned: - `mod n 60` on `Nat` without an Integral instance — defined explicit `modNat60` that recurses by subtraction. - BenchTest needed `import Data.Maybe` for `isJust` (Prelude doesn't re-export it in 0.8.0). Co-Authored-By: Claude Opus 4.7 (1M context) --- contractiles/lust/Intentfile | 29 +++ tests/idris2/AspectTest.idr | 199 ++++++++++++++++++++ tests/idris2/BenchTest.idr | 208 ++++++++++++++++++++ tests/idris2/ContractTest.idr | 160 ++++++++++++++++ tests/idris2/E2ETest.idr | 153 +++++++++++++++ tests/idris2/Main.idr | 33 ++++ tests/idris2/PropertyTest.idr | 282 ++++++++++++++++++++++++++++ tests/idris2/SmokeTest.idr | 248 ++++++++++++++++++++++++ tests/idris2/Test/Spec.idr | 112 +++++++++++ tests/idris2/UnitTest.idr | 236 +++++++++++++++++++++++ universal-chat-extractor-tests.ipkg | 24 +++ 11 files changed, 1684 insertions(+) create mode 100644 contractiles/lust/Intentfile create mode 100644 tests/idris2/AspectTest.idr create mode 100644 tests/idris2/BenchTest.idr create mode 100644 tests/idris2/ContractTest.idr create mode 100644 tests/idris2/E2ETest.idr create mode 100644 tests/idris2/Main.idr create mode 100644 tests/idris2/PropertyTest.idr create mode 100644 tests/idris2/SmokeTest.idr create mode 100644 tests/idris2/Test/Spec.idr create mode 100644 tests/idris2/UnitTest.idr create mode 100644 universal-chat-extractor-tests.ipkg diff --git a/contractiles/lust/Intentfile b/contractiles/lust/Intentfile new file mode 100644 index 0000000..ea45801 --- /dev/null +++ b/contractiles/lust/Intentfile @@ -0,0 +1,29 @@ +# SPDX-License-Identifier: PLMP-1.0-or-later +# Intentfile - declarative intent contract (template) +# Sibling of contractiles/must/Mustfile (invariants) and +# contractiles/dust/Dustfile (recovery). Captures the *desired* +# end-state of the system separately from its invariants and +# rollback hooks. + +version: 1 + +metadata: + name: project-intent-contract + spec: v0.0.1 + description: "Declarative end-state intent for the project." + +intents: + - name: dependencies-resolved + description: "All declared runtime dependencies must be locatable on PATH or via Guix." + desired: "deno --version && pkg-config --version" + rationale: "A missing dep at deploy time degrades to a non-recoverable error." + + - name: scaffolding-complete + description: "Templating scaffold renders without unresolved placeholders." + desired: "grep -RE '\\{\\{\\s*[A-Z_]+\\s*\\}\\}' templates/ | wc -l | grep -q '^0$'" + rationale: "Unrendered placeholders ship broken templates to downstream users." + + - name: license-headers-present + description: "Every source file carries an SPDX header." + desired: "scripts/check-spdx.sh" + rationale: "Estate-wide compliance posture (Hyperpolymath standard)." diff --git a/tests/idris2/AspectTest.idr b/tests/idris2/AspectTest.idr new file mode 100644 index 0000000..692ff20 --- /dev/null +++ b/tests/idris2/AspectTest.idr @@ -0,0 +1,199 @@ +-- SPDX-License-Identifier: PMPL-1.0-or-later +-- Copyright (c) 2026 Jonathan D.A. Jewell (hyperpolymath) +-- +-- Port of tests/aspect_test.ts to Idris2, estate-rollout port 11/11. +-- 21 of 21 cross-cutting aspect tests ported. Each iterated check (BANNED_FILES, +-- DOCS, the tests/ directory walk) becomes one Idris2 test case to preserve +-- granular per-name reporting. +-- +-- The TS regex for secret-leak detection in README is replaced by literal +-- substring checks against `api_key=`, `password=`, `secret=`, `token=` +-- (case-insensitive); the equivalence is exact within ASCII. + +module AspectTest + +import Test.Spec +import Data.String +import System.File + +%default covering + +readFileToString : String -> IO String +readFileToString path = do + Right contents <- readFile path + | Left _ => pure "" + pure contents + +fileExists : String -> IO Bool +fileExists path = do + Right _ <- readFile path + | Left _ => pure False + pure True + +toLowerC : Char -> Char +toLowerC c = + if c >= 'A' && c <= 'Z' + then chr (ord c + 32) + else c + +asciiLower : String -> String +asciiLower s = pack (map toLowerC (unpack s)) + +||| True iff `content` (case-insensitively) contains any of the listed +||| secret-leak patterns of the form `=`. +hasSecretLeak : String -> Bool +hasSecretLeak content = + let lc = asciiLower content in + isInfixOf "api_key=" lc || isInfixOf "api_key =" lc || + isInfixOf "password=" lc || isInfixOf "password =" lc || + isInfixOf "secret=" lc || isInfixOf "secret =" lc || + isInfixOf "token=" lc || isInfixOf "token =" lc + +public export +allSuites : List TestCase +allSuites = + [ -- ---------- Security policy ---------- + + test "aspect/security: SECURITY.md exists" $ do + ok <- fileExists "SECURITY.md" + assertTrue "SECURITY.md present" ok + + , test "aspect/security: SECURITY.md mentions vulnerability reporting" $ do + content <- readFileToString "SECURITY.md" + let lc = asciiLower content + let hasDisclosure = + isInfixOf "vulnerabilit" lc || isInfixOf "disclosure" lc || + isInfixOf "report" lc || isInfixOf "security" lc + allPass + [ assertTrue "SECURITY.md present" (content /= "") + , assertTrue "SECURITY.md mentions security reporting" hasDisclosure + ] + + , test "aspect/security: .well-known/security.txt exists" $ do + ok <- fileExists ".well-known/security.txt" + assertTrue ".well-known/security.txt present" ok + + , test "aspect/security: no .env files in repo" $ do + ok <- fileExists ".env" + assertTrue ".env must not be committed" (not ok) + + , test "aspect/security: no hardcoded secret patterns in README" $ do + content <- readFileToString "README.adoc" + allPass + [ assertTrue "README.adoc present" (content /= "") + , assertTrue "README.adoc has no hardcoded secrets" + (not (hasSecretLeak content)) + ] + + -- ---------- Code of conduct ---------- + + , test "aspect/community: CODE_OF_CONDUCT.md exists" $ do + ok <- fileExists "CODE_OF_CONDUCT.md" + assertTrue "CODE_OF_CONDUCT.md present" ok + + , test "aspect/community: CODE_OF_CONDUCT.md has meaningful content" $ do + content <- readFileToString "CODE_OF_CONDUCT.md" + assertTrue "CODE_OF_CONDUCT.md > 100 chars" (length content > 100) + + -- ---------- EditorConfig consistency ---------- + + , test "aspect/formatting: .editorconfig exists" $ do + ok <- fileExists ".editorconfig" + assertTrue ".editorconfig present" ok + + , test "aspect/formatting: .editorconfig has root = true" $ do + content <- readFileToString ".editorconfig" + let lc = asciiLower content + allPass + [ assertTrue ".editorconfig present" (content /= "") + , assertTrue ".editorconfig declares root = true" + (isInfixOf "root = true" lc || isInfixOf "root=true" lc) + ] + + , test "aspect/formatting: .editorconfig defines indent_style" $ do + content <- readFileToString ".editorconfig" + assertTrue "indent_style present" (isInfixOf "indent_style" content) + + -- ---------- No banned file patterns ---------- + -- TS iterates over a list; we expand to one test per name for clearer reports. + + , test "aspect/policy: banned file must not exist - package.json" $ do + ok <- fileExists "package.json" + assertTrue "package.json must not exist" (not ok) + + , test "aspect/policy: banned file must not exist - package-lock.json" $ do + ok <- fileExists "package-lock.json" + assertTrue "package-lock.json must not exist" (not ok) + + , test "aspect/policy: banned file must not exist - yarn.lock" $ do + ok <- fileExists "yarn.lock" + assertTrue "yarn.lock must not exist" (not ok) + + , test "aspect/policy: banned file must not exist - bun.lockb" $ do + ok <- fileExists "bun.lockb" + assertTrue "bun.lockb must not exist" (not ok) + + , test "aspect/policy: banned file must not exist - node_modules" $ do + ok <- fileExists "node_modules" + assertTrue "node_modules must not exist" (not ok) + + , test "aspect/policy: banned file must not exist - .npmrc" $ do + ok <- fileExists ".npmrc" + assertTrue ".npmrc must not exist" (not ok) + + , test "aspect/policy: banned file must not exist - Dockerfile" $ do + ok <- fileExists "Dockerfile" + assertTrue "Dockerfile must not exist (use Containerfile)" (not ok) + + -- ---------- No tsconfig.json ---------- + + , test "aspect/language: no tsconfig.json (TS only via Deno, not tsc)" $ do + ok <- fileExists "tsconfig.json" + assertTrue "tsconfig.json must not exist" (not ok) + + -- ---------- Documentation completeness ---------- + + , test "aspect/docs: documentation file is non-empty - README.adoc" $ do + content <- readFileToString "README.adoc" + assertTrue "README.adoc > 50 chars" (length content > 50) + + , test "aspect/docs: documentation file is non-empty - EXPLAINME.adoc" $ do + content <- readFileToString "EXPLAINME.adoc" + assertTrue "EXPLAINME.adoc > 50 chars" (length content > 50) + + , test "aspect/docs: documentation file is non-empty - CONTRIBUTING.md" $ do + content <- readFileToString "CONTRIBUTING.md" + assertTrue "CONTRIBUTING.md > 50 chars" (length content > 50) + + , test "aspect/docs: documentation file is non-empty - ROADMAP.adoc" $ do + content <- readFileToString "ROADMAP.adoc" + assertTrue "ROADMAP.adoc > 50 chars" (length content > 50) + + -- ---------- All non-bench test files use Deno.test ---------- + -- The TS walks the tests/ dir; we enumerate explicitly. bench_test.ts is + -- excluded per the TS predicate. + + , test "aspect/tests: tests/unit_test.ts uses Deno.test" $ do + content <- readFileToString "tests/unit_test.ts" + assertTrue "Deno.test( present" (isInfixOf "Deno.test(" content) + + , test "aspect/tests: tests/contract_test.ts uses Deno.test" $ do + content <- readFileToString "tests/contract_test.ts" + assertTrue "Deno.test( present" (isInfixOf "Deno.test(" content) + + , test "aspect/tests: tests/aspect_test.ts uses Deno.test" $ do + content <- readFileToString "tests/aspect_test.ts" + assertTrue "Deno.test( present" (isInfixOf "Deno.test(" content) + + , test "aspect/tests: tests/property_test.ts uses Deno.test" $ do + content <- readFileToString "tests/property_test.ts" + assertTrue "Deno.test( present" (isInfixOf "Deno.test(" content) + + , test "aspect/tests: tests/smoke_test.ts uses Deno.test" $ do + content <- readFileToString "tests/smoke_test.ts" + assertTrue "Deno.test( present" (isInfixOf "Deno.test(" content) + + , test "aspect/tests: tests/e2e_test.ts uses Deno.test" $ do + content <- readFileToString "tests/e2e_test.ts" + assertTrue "Deno.test( present" (isInfixOf "Deno.test(" content) + ] diff --git a/tests/idris2/BenchTest.idr b/tests/idris2/BenchTest.idr new file mode 100644 index 0000000..9f94193 --- /dev/null +++ b/tests/idris2/BenchTest.idr @@ -0,0 +1,208 @@ +-- SPDX-License-Identifier: PMPL-1.0-or-later +-- Copyright (c) 2026 Jonathan D.A. Jewell (hyperpolymath) +-- +-- Port of tests/bench_test.ts to Idris2, estate-rollout port 11/11. +-- 10 of 10 bench tests ported as functional assertions (timing skipped per +-- the rollout's bucket-1 rules; this Idris2 build is not a perf harness). +-- +-- For each Deno.bench fn we extract the assertion it implicitly makes +-- (the operation completes without throwing) and turn it into an +-- explicit content check: read the file is non-empty, parse the chat line +-- yields the expected fields, SPDX regex finds PMPL, platform routing +-- recognises the expected platform. + +module BenchTest + +import Test.Spec +import Data.String +import Data.List +import Data.Maybe +import System.File + +%default covering + +readFileToString : String -> IO String +readFileToString path = do + Right contents <- readFile path + | Left _ => pure "" + pure contents + +-- --------------------------------------------------------------------------- +-- Pure helpers redeclared (module independence) +-- --------------------------------------------------------------------------- + +prefixOfChars : List Char -> List Char -> Bool +prefixOfChars _ [] = True +prefixOfChars [] (_ :: _) = False +prefixOfChars (x :: xs) (y :: ys) = x == y && prefixOfChars xs ys + +dropN : Nat -> List a -> List a +dropN Z xs = xs +dropN _ [] = [] +dropN (S k) (_ :: xs) = dropN k xs + +afterNeedleGo : List Char -> List Char -> Nat -> String +afterNeedleGo [] _ _ = "" +afterNeedleGo cs ns nl = + if prefixOfChars cs ns + then pack (dropN nl cs) + else case cs of + [] => "" + (_ :: rest) => afterNeedleGo rest ns nl + +afterNeedle : String -> String -> String +afterNeedle s n = + let nc = unpack n + nl = length nc + in afterNeedleGo (unpack s) nc nl + +firstToken : String -> String +firstToken s = pack (takeTok (unpack s)) + where + takeTok : List Char -> List Char + takeTok [] = [] + takeTok (c :: cs) = + if c == ' ' || c == '\t' || c == '\n' || c == '\r' + then [] + else c :: takeTok cs + +trimLeading : String -> String +trimLeading s = case unpack s of + [] => s + (c :: cs) => if c == ' ' || c == '\t' + then trimLeading (pack cs) + else s + +extractSpdxId : String -> String +extractSpdxId content = + let needle = "SPDX-License-Identifier:" in + if isInfixOf needle content + then firstToken (trimLeading (afterNeedle content needle)) + else "" + +||| ASCII-only chat-log line parser. +||| Expected form: "YYYY-MM-DDThh:mm:ssZ : ". +||| Returns Nothing if the prefix is not a 20-char ISO-like timestamp followed +||| by a single space; otherwise returns (ts, platform, author, message). +parseChatLine : String -> Maybe (String, String, String, String) +parseChatLine line = + let cs = unpack line + tsChars = take 20 cs + restAfterTs = drop 20 cs + in case restAfterTs of + (' ' :: rest) => + case break (== ' ') rest of + (platChars, ' ' :: rest2) => + case break (== ':') rest2 of + (authChars, ':' :: ' ' :: msgChars) => + Just (pack tsChars, pack platChars, pack authChars, pack msgChars) + _ => Nothing + _ => Nothing + _ => Nothing + +knownPlatforms : List String +knownPlatforms = + [ "slack", "discord", "teams", "matrix", "telegram" + , "signal", "whatsapp", "irc", "zulip" ] + +isKnownPlatform : String -> Bool +isKnownPlatform p = elem p knownPlatforms + +sampleLine : String +sampleLine = "2026-04-04T12:00:00Z slack alice: hello world this is a test message" + +||| Zero-padded show for Nat values up to 59 (minutes). +pad2 : Nat -> String +pad2 k = if k < 10 then "0" ++ show k else show k + +||| Modulo for Nat without relying on the Integral instance. +modNat60 : Nat -> Nat +modNat60 n = if n < 60 then n else modNat60 (n `minus` 60) + +||| Generate the same batch line shape the TS bench loops over. +benchLineFor : Nat -> String +benchLineFor n = + "2026-04-04T12:" ++ pad2 (modNat60 n) ++ ":00Z slack user" ++ + show n ++ ": message " ++ show n + +||| Fixed-content sample mirroring the TS `sampleContent` (used to verify the +||| SPDX extractor reliably finds the identifier in scaffold-shaped content). +sampleContent : String +sampleContent = + "# SPDX-License-Identifier: PMPL-1.0-or-later\n" ++ + "# Copyright (c) 2026 Jonathan D.A. Jewell\n\n" ++ + "[metadata]\n" ++ + "project = \"universal-chat-extractor\"\n" ++ + "version = \"0.1.0\"\n" + +||| Mirrors TS placeholder-detection regex `\{\{[A-Z_]+\}\}`. True iff a +||| `{{XXX}}` placeholder (XXX in `[A-Z_]`) is present. +containsPlaceholder : String -> Bool +containsPlaceholder content = scan (unpack content) + where + upper : Char -> Bool + upper c = c == '_' || (c >= 'A' && c <= 'Z') + inside : List Char -> Bool -> Bool + inside [] _ = False + inside ('}' :: '}' :: _) seen = seen + inside (c :: cs) seen = + if upper c then inside cs True else False + scan : List Char -> Bool + scan [] = False + scan ('{' :: '{' :: rest) = if inside rest False then True else scan rest + scan (_ :: rest) = scan rest + +-- --------------------------------------------------------------------------- +-- Test cases (each bench becomes a correctness assertion) +-- --------------------------------------------------------------------------- + +public export +allSuites : List TestCase +allSuites = + [ test "bench-assert: read LICENSE - file I/O baseline" $ do + content <- readFileToString "LICENSE" + assertTrue "LICENSE readable and non-empty" (length content > 0) + + , test "bench-assert: read README.adoc" $ do + content <- readFileToString "README.adoc" + assertTrue "README.adoc readable and non-empty" (length content > 0) + + , test "bench-assert: read STATE.a2ml" $ do + content <- readFileToString ".machine_readable/6a2/STATE.a2ml" + assertTrue "STATE.a2ml readable and non-empty" (length content > 0) + + , test "bench-assert: read src/abi/Layout.idr" $ do + content <- readFileToString "src/abi/Layout.idr" + assertTrue "Layout.idr readable and non-empty" (length content > 0) + + , test "bench-assert: parse single chat log line" $ do + case parseChatLine sampleLine of + Nothing => assertTrue "chat line parses" False + Just (ts, plat, auth, msg) => + allPass + [ assertEq ts "2026-04-04T12:00:00Z" + , assertEq plat "slack" + , assertEq auth "alice" + , assertTrue "message body non-empty" (length msg > 0) + ] + + , test "bench-assert: parse 100 chat log lines (batch)" $ do + -- The TS bench loops 100 lines through `chatLinePattern.exec`. The + -- correctness assertion is that every generated line parses cleanly. + let batch = map benchLineFor [0 .. 99] + let parsed = map parseChatLine batch + assertTrue "all 100 lines parsed" (all isJust parsed) + + , test "bench-assert: SPDX regex match on sample content" $ + assertEq (extractSpdxId sampleContent) "PMPL-1.0-or-later" + + , test "bench-assert: placeholder detection on sample content" $ + -- sampleContent has no `{{XXX}}` placeholder, so detection must return False. + assertEq (containsPlaceholder sampleContent) False + + , test "bench-assert: platform lookup recognises slack" $ + assertEq (isKnownPlatform "slack") True + + , test "bench-assert: platform lookup rejects unknown" $ + assertEq (isKnownPlatform "somenovelchat") False + ] diff --git a/tests/idris2/ContractTest.idr b/tests/idris2/ContractTest.idr new file mode 100644 index 0000000..9859773 --- /dev/null +++ b/tests/idris2/ContractTest.idr @@ -0,0 +1,160 @@ +-- SPDX-License-Identifier: PMPL-1.0-or-later +-- Copyright (c) 2026 Jonathan D.A. Jewell (hyperpolymath) +-- +-- Port of tests/contract_test.ts to Idris2, estate-rollout port 11/11. +-- 19 of 19 contract obligations ported. Each TS sub-iteration of a banned-name +-- list becomes one Idris2 test case to preserve granular reporting. + +module ContractTest + +import Test.Spec +import Data.String +import System.File + +%default covering + +readFileToString : String -> IO String +readFileToString path = do + Right contents <- readFile path + | Left _ => pure "" + pure contents + +fileExists : String -> IO Bool +fileExists path = do + Right _ <- readFile path + | Left _ => pure False + pure True + +||| ASCII lowercase a single character. +toLowerC : Char -> Char +toLowerC c = + if c >= 'A' && c <= 'Z' + then chr (ord c + 32) + else c + +asciiLower : String -> String +asciiLower s = pack (map toLowerC (unpack s)) + +public export +allSuites : List TestCase +allSuites = + [ -- ---------- RSR obligations ---------- + + test "contract/RSR: STATE.a2ml exists in .machine_readable/6a2/" $ do + ok <- fileExists ".machine_readable/6a2/STATE.a2ml" + assertTrue "STATE.a2ml present" ok + + , test "contract/RSR: META.a2ml exists in .machine_readable/6a2/" $ do + ok <- fileExists ".machine_readable/6a2/META.a2ml" + assertTrue "META.a2ml present" ok + + , test "contract/RSR: ECOSYSTEM.a2ml exists in .machine_readable/6a2/" $ do + ok <- fileExists ".machine_readable/6a2/ECOSYSTEM.a2ml" + assertTrue "ECOSYSTEM.a2ml present" ok + + , test "contract/RSR: AGENTIC.a2ml exists in .machine_readable/6a2/" $ do + ok <- fileExists ".machine_readable/6a2/AGENTIC.a2ml" + assertTrue "AGENTIC.a2ml present" ok + + , test "contract/RSR: no SCM checkpoint files in repo root" $ do + a <- fileExists "STATE.scm" + b <- fileExists "META.scm" + c <- fileExists "ECOSYSTEM.scm" + d <- fileExists "AGENTIC.scm" + assertTrue "no SCM checkpoint files in repo root" + (not a && not b && not c && not d) + + , test "contract/RSR: no SCM checkpoint files in .machine_readable/" $ do + a <- fileExists ".machine_readable/STATE.scm" + b <- fileExists ".machine_readable/META.scm" + c <- fileExists ".machine_readable/ECOSYSTEM.scm" + d <- fileExists ".machine_readable/AGENTIC.scm" + assertTrue "no SCM checkpoint files in .machine_readable/" + (not a && not b && not c && not d) + + , test "contract/RSR: EXPLAINME.adoc is present" $ do + ok <- fileExists "EXPLAINME.adoc" + assertTrue "EXPLAINME.adoc present" ok + + , test "contract/RSR: ABI-FFI-README.md is present" $ do + ok <- fileExists "ABI-FFI-README.md" + assertTrue "ABI-FFI-README.md present" ok + + -- ---------- ABI/FFI standard ---------- + + , test "contract/ABI: src/abi/ directory follows Idris2 ABI standard" $ do + -- proxy by Layout.idr presence (src/abi/ must contain it) + ok <- fileExists "src/abi/Layout.idr" + assertTrue "src/abi/Layout.idr present" ok + + , test "contract/ABI: Layout.idr defines ABI layout" $ do + content <- readFileToString "src/abi/Layout.idr" + assertTrue "Layout.idr non-empty" (content /= "") + + , test "contract/ABI: Foreign.idr declares FFI interface" $ do + content <- readFileToString "src/abi/Foreign.idr" + assertTrue "Foreign.idr non-empty" (content /= "") + + , test "contract/FFI: ffi/zig/ implements C-compatible FFI" $ do + ok <- fileExists "ffi/zig/src/main.zig" + assertTrue "ffi/zig/src/main.zig present" ok + + -- ---------- License policy ---------- + + , test "contract/license: LICENSE file uses PMPL" $ do + content <- readFileToString "LICENSE" + let lc = asciiLower content + allPass + [ assertTrue "LICENSE present" (content /= "") + , assertTrue "LICENSE references palimpsest" (isInfixOf "palimpsest" lc) + ] + + , test "contract/license: LICENSES/PMPL-1.0-or-later.txt present" $ do + ok <- fileExists "LICENSES/PMPL-1.0-or-later.txt" + assertTrue "PMPL text present" ok + + , test "contract/license: README.adoc has SPDX header" $ do + content <- readFileToString "README.adoc" + allPass + [ assertTrue "README.adoc present" (content /= "") + , assertTrue "README.adoc has SPDX line" + (isInfixOf "SPDX-License-Identifier:" content) + ] + + -- ---------- Hypatia CI integration ---------- + + , test "contract/hypatia: .hypatia/ directory exists" $ do + -- proxied via last-visit.json since Idris2 readFile only inspects files + ok <- fileExists ".hypatia/last-visit.json" + assertTrue ".hypatia/last-visit.json present" ok + + , test "contract/hypatia: .hypatia/last-visit.json exists" $ do + ok <- fileExists ".hypatia/last-visit.json" + assertTrue ".hypatia/last-visit.json present" ok + + -- ---------- Author attribution ---------- + + , test "contract/author: MAINTAINERS.adoc references hyperpolymath or Jonathan" $ do + content <- readFileToString "MAINTAINERS.adoc" + let hasAuthor = isInfixOf "Jonathan" content || isInfixOf "hyperpolymath" content + allPass + [ assertTrue "MAINTAINERS.adoc present" (content /= "") + , assertTrue "MAINTAINERS.adoc references the author" hasAuthor + ] + + -- ---------- Stapeln container definition ---------- + + , test "contract/stapeln: stapeln.toml exists and is non-empty" $ do + content <- readFileToString "stapeln.toml" + assertTrue "stapeln.toml non-empty" (length content > 0) + + -- ---------- Contractiles interface ---------- + + , test "contract/contractiles: TRUST.contractile exists in .machine_readable/" $ do + ok <- fileExists ".machine_readable/TRUST.contractile" + assertTrue "TRUST.contractile present" ok + + , test "contract/contractiles: MUST.contractile exists in .machine_readable/" $ do + ok <- fileExists ".machine_readable/MUST.contractile" + assertTrue "MUST.contractile present" ok + ] diff --git a/tests/idris2/E2ETest.idr b/tests/idris2/E2ETest.idr new file mode 100644 index 0000000..8c913a9 --- /dev/null +++ b/tests/idris2/E2ETest.idr @@ -0,0 +1,153 @@ +-- SPDX-License-Identifier: PMPL-1.0-or-later +-- Copyright (c) 2026 Jonathan D.A. Jewell (hyperpolymath) +-- +-- Port of tests/e2e_test.ts to Idris2, estate-rollout port 11/11. +-- 17 of 17 e2e/reflexive tests ported. +-- +-- The "tests run under Deno runtime" test is replaced by an Idris2-equivalent +-- "tests run under Idris2 runtime" check (trivially True at compile time) +-- to preserve the reflexive shape. +-- +-- The TS reflexive test reads tests/e2e_test.ts and checks its own SPDX +-- header; we additionally check this Idris2 file's analogue +-- (tests/idris2/E2ETest.idr) and the TS original. + +module E2ETest + +import Test.Spec +import Data.String +import System.File + +%default covering + +readFileToString : String -> IO String +readFileToString path = do + Right contents <- readFile path + | Left _ => pure "" + pure contents + +fileExists : String -> IO Bool +fileExists path = do + Right _ <- readFile path + | Left _ => pure False + pure True + +public export +allSuites : List TestCase +allSuites = + [ -- ---------- Reflexive SPDX checks ---------- + + test "e2e/reflexive: tests/e2e_test.ts carries PMPL-1.0-or-later header" $ do + content <- readFileToString "tests/e2e_test.ts" + assertTrue "PMPL header present" + (isInfixOf "SPDX-License-Identifier: PMPL-1.0-or-later" content) + + , test "e2e/reflexive: tests/idris2/E2ETest.idr carries PMPL-1.0-or-later header" $ do + content <- readFileToString "tests/idris2/E2ETest.idr" + assertTrue "PMPL header present" + (isInfixOf "SPDX-License-Identifier: PMPL-1.0-or-later" content) + + , test "e2e/reflexive: tests/unit_test.ts has SPDX header" $ do + content <- readFileToString "tests/unit_test.ts" + assertTrue "SPDX present" (isInfixOf "SPDX-License-Identifier:" content) + + , test "e2e/reflexive: tests/contract_test.ts has SPDX header" $ do + content <- readFileToString "tests/contract_test.ts" + assertTrue "SPDX present" (isInfixOf "SPDX-License-Identifier:" content) + + , test "e2e/reflexive: tests/aspect_test.ts has SPDX header" $ do + content <- readFileToString "tests/aspect_test.ts" + assertTrue "SPDX present" (isInfixOf "SPDX-License-Identifier:" content) + + , test "e2e/reflexive: tests/property_test.ts has SPDX header" $ do + content <- readFileToString "tests/property_test.ts" + assertTrue "SPDX present" (isInfixOf "SPDX-License-Identifier:" content) + + , test "e2e/reflexive: tests/smoke_test.ts has SPDX header" $ do + content <- readFileToString "tests/smoke_test.ts" + assertTrue "SPDX present" (isInfixOf "SPDX-License-Identifier:" content) + + , test "e2e/reflexive: tests/e2e_test.ts has SPDX header" $ do + content <- readFileToString "tests/e2e_test.ts" + assertTrue "SPDX present" (isInfixOf "SPDX-License-Identifier:" content) + + , test "e2e/reflexive: tests/bench_test.ts has SPDX header" $ do + content <- readFileToString "tests/bench_test.ts" + assertTrue "SPDX present" (isInfixOf "SPDX-License-Identifier:" content) + + -- ---------- CI hook scripts present ---------- + + , test "e2e: CI hook file exists - hooks/validate-codeql.sh" $ do + content <- readFileToString "hooks/validate-codeql.sh" + assertTrue "validate-codeql.sh present and non-empty" (length content > 0) + + , test "e2e: CI hook file exists - hooks/validate-permissions.sh" $ do + content <- readFileToString "hooks/validate-permissions.sh" + assertTrue "validate-permissions.sh present and non-empty" (length content > 0) + + , test "e2e: CI hook file exists - hooks/validate-sha-pins.sh" $ do + content <- readFileToString "hooks/validate-sha-pins.sh" + assertTrue "validate-sha-pins.sh present and non-empty" (length content > 0) + + , test "e2e: CI hook file exists - hooks/validate-spdx.sh" $ do + content <- readFileToString "hooks/validate-spdx.sh" + assertTrue "validate-spdx.sh present and non-empty" (length content > 0) + + -- ---------- ABI/FFI README ---------- + + , test "e2e: ABI-FFI-README.md exists and is non-empty" $ do + content <- readFileToString "ABI-FFI-README.md" + assertTrue "ABI-FFI-README.md non-empty" (length content > 0) + + -- ---------- TOPOLOGY ---------- + + , test "e2e: TOPOLOGY.md exists" $ do + ok <- fileExists "TOPOLOGY.md" + assertTrue "TOPOLOGY.md present" ok + + -- ---------- NOTICE ---------- + + , test "e2e: NOTICE file is present and non-trivial" $ do + content <- readFileToString "NOTICE" + assertTrue "NOTICE non-empty" (length content > 0) + + -- ---------- Justfile ---------- + + , test "e2e: Justfile contains a 'test' recipe" $ do + content <- readFileToString "Justfile" + allPass + [ assertTrue "Justfile present" (content /= "") + , assertTrue "Justfile references test" (isInfixOf "test" content) + ] + + -- ---------- Runtime presence ---------- + -- TS asserts `typeof Deno !== "undefined"`; the Idris2 analogue is that + -- this test executable exists and runs at all, which is trivially True. + + , test "e2e: tests run under Idris2 runtime" $ + assertTrue "Idris2 runtime present" True + + -- ---------- QUICKSTART guides ---------- + + , test "e2e: quickstart guide present - QUICKSTART-USER.adoc" $ do + ok <- fileExists "QUICKSTART-USER.adoc" + assertTrue "QUICKSTART-USER.adoc present" ok + + , test "e2e: quickstart guide present - QUICKSTART-DEV.adoc" $ do + ok <- fileExists "QUICKSTART-DEV.adoc" + assertTrue "QUICKSTART-DEV.adoc present" ok + + , test "e2e: quickstart guide present - QUICKSTART-MAINTAINER.adoc" $ do + ok <- fileExists "QUICKSTART-MAINTAINER.adoc" + assertTrue "QUICKSTART-MAINTAINER.adoc present" ok + + -- ---------- ABI files non-empty ---------- + + , test "e2e: src/abi/Layout.idr is non-empty" $ do + content <- readFileToString "src/abi/Layout.idr" + assertTrue "Layout.idr non-empty" (length content > 0) + + , test "e2e: src/abi/Foreign.idr is non-empty" $ do + content <- readFileToString "src/abi/Foreign.idr" + assertTrue "Foreign.idr non-empty" (length content > 0) + ] diff --git a/tests/idris2/Main.idr b/tests/idris2/Main.idr new file mode 100644 index 0000000..d50bfb6 --- /dev/null +++ b/tests/idris2/Main.idr @@ -0,0 +1,33 @@ +-- SPDX-License-Identifier: PMPL-1.0-or-later +-- Copyright (c) 2026 Jonathan D.A. Jewell (hyperpolymath) + +module Main + +import Test.Spec +import UnitTest +import ContractTest +import AspectTest +import PropertyTest +import SmokeTest +import E2ETest +import BenchTest +import System + +%default covering + +main : IO () +main = do + (p1, f1) <- runTestSuite "UnitTest" UnitTest.allSuites + (p2, f2) <- runTestSuite "ContractTest" ContractTest.allSuites + (p3, f3) <- runTestSuite "AspectTest" AspectTest.allSuites + (p4, f4) <- runTestSuite "PropertyTest" PropertyTest.allSuites + (p5, f5) <- runTestSuite "SmokeTest" SmokeTest.allSuites + (p6, f6) <- runTestSuite "E2ETest" E2ETest.allSuites + (p7, f7) <- runTestSuite "BenchTest" BenchTest.allSuites + let totalPassed = p1 + p2 + p3 + p4 + p5 + p6 + p7 + let totalFailed = f1 + f2 + f3 + f4 + f5 + f6 + f7 + putStrLn "" + putStrLn $ "=== Total: " ++ show totalPassed ++ " passed, " ++ show totalFailed ++ " failed ===" + if totalFailed > 0 + then exitWith (ExitFailure 1) + else pure () diff --git a/tests/idris2/PropertyTest.idr b/tests/idris2/PropertyTest.idr new file mode 100644 index 0000000..9e7b1f6 --- /dev/null +++ b/tests/idris2/PropertyTest.idr @@ -0,0 +1,282 @@ +-- SPDX-License-Identifier: PMPL-1.0-or-later +-- Copyright (c) 2026 Jonathan D.A. Jewell (hyperpolymath) +-- +-- Port of tests/property_test.ts to Idris2, estate-rollout port 11/11. +-- 14 of 14 property cases ported. +-- +-- TS walks .machine_readable recursively at runtime to collect .a2ml files. +-- Idris2 0.8.0 has no directory-walk in the base stdlib, so the per-file +-- properties enumerate the known .a2ml files directly. The SPDX_EXEMPT list +-- (ANCHOR.a2ml, 0-AI-MANIFEST.a2ml) is honoured by simply not iterating those. +-- +-- The "all .idr files in src/abi/" and "hook scripts shebang" walks are +-- similarly unrolled over the known set; missing dirs become a single +-- skip-and-pass test, matching the TS try/catch fall-through. +-- +-- The SPDX-extraction property mirrors the TS pure-regex test by inlining +-- the extractor and running it over a table of comment styles. + +module PropertyTest + +import Test.Spec +import Data.String +import Data.List +import System.File + +%default covering + +readFileToString : String -> IO String +readFileToString path = do + Right contents <- readFile path + | Left _ => pure "" + pure contents + +fileExists : String -> IO Bool +fileExists path = do + Right _ <- readFile path + | Left _ => pure False + pure True + +-- --------------------------------------------------------------------------- +-- Inline pure helpers (same as UnitTest, redeclared for module independence) +-- --------------------------------------------------------------------------- + +prefixOfChars : List Char -> List Char -> Bool +prefixOfChars _ [] = True +prefixOfChars [] (_ :: _) = False +prefixOfChars (x :: xs) (y :: ys) = x == y && prefixOfChars xs ys + +dropN : Nat -> List a -> List a +dropN Z xs = xs +dropN _ [] = [] +dropN (S k) (_ :: xs) = dropN k xs + +afterNeedleGo : List Char -> List Char -> Nat -> String +afterNeedleGo [] _ _ = "" +afterNeedleGo cs ns nl = + if prefixOfChars cs ns + then pack (dropN nl cs) + else case cs of + [] => "" + (_ :: rest) => afterNeedleGo rest ns nl + +afterNeedle : String -> String -> String +afterNeedle s n = + let nc = unpack n + nl = length nc + in afterNeedleGo (unpack s) nc nl + +firstToken : String -> String +firstToken s = pack (takeTok (unpack s)) + where + takeTok : List Char -> List Char + takeTok [] = [] + takeTok (c :: cs) = + if c == ' ' || c == '\t' || c == '\n' || c == '\r' + then [] + else c :: takeTok cs + +trimLeading : String -> String +trimLeading s = case unpack s of + [] => s + (c :: cs) => if c == ' ' || c == '\t' + then trimLeading (pack cs) + else s + +extractSpdxId : String -> String +extractSpdxId content = + let needle = "SPDX-License-Identifier:" in + if isInfixOf needle content + then firstToken (trimLeading (afterNeedle content needle)) + else "" + +asciiLower : String -> String +asciiLower s = pack (map low (unpack s)) + where + low : Char -> Char + low c = + if c >= 'A' && c <= 'Z' + then chr (ord c + 32) + else c + +normalisePlatform : String -> String +normalisePlatform = asciiLower . trim + +-- --------------------------------------------------------------------------- +-- Enumerated file lists (replace TS recursive directory walks) +-- --------------------------------------------------------------------------- + +a2mlFiles : List String +a2mlFiles = + [ ".machine_readable/6a2/STATE.a2ml" + , ".machine_readable/6a2/META.a2ml" + , ".machine_readable/6a2/ECOSYSTEM.a2ml" + , ".machine_readable/6a2/AGENTIC.a2ml" + , ".machine_readable/6a2/NEUROSYM.a2ml" + , ".machine_readable/6a2/PLAYBOOK.a2ml" + , ".machine_readable/CLADE.a2ml" + ] + +abiIdrFiles : List String +abiIdrFiles = + [ "src/abi/Layout.idr" + , "src/abi/Foreign.idr" + ] + +hookScripts : List String +hookScripts = + [ "hooks/validate-codeql.sh" + , "hooks/validate-permissions.sh" + , "hooks/validate-sha-pins.sh" + , "hooks/validate-spdx.sh" + ] + +||| All listed files (skipped if absent) carry an SPDX header. +allSpdxOk : List String -> IO Bool +allSpdxOk [] = pure True +allSpdxOk (f :: fs) = do + exists <- fileExists f + if not exists + then allSpdxOk fs + else do + content <- readFileToString f + if isInfixOf "SPDX-License-Identifier:" content + then allSpdxOk fs + else do + putStrLn "" + putStrLn (" missing SPDX header in " ++ f) + pure False + +||| All listed files (skipped if absent) use exactly `PMPL-1.0-or-later`. +allPmplOk : List String -> IO Bool +allPmplOk [] = pure True +allPmplOk (f :: fs) = do + exists <- fileExists f + if not exists + then allPmplOk fs + else do + content <- readFileToString f + let id = extractSpdxId content + if id == "" || id == "PMPL-1.0-or-later" + then allPmplOk fs + else do + putStrLn "" + putStrLn (" expected PMPL-1.0-or-later in " ++ f ++ ", got " ++ id) + pure False + +||| All listed shell scripts (skipped if absent) start with a shebang. +allShebangOk : List String -> IO Bool +allShebangOk [] = pure True +allShebangOk (f :: fs) = do + exists <- fileExists f + if not exists + then allShebangOk fs + else do + content <- readFileToString f + if isPrefixOf "#!" content + then allShebangOk fs + else do + putStrLn "" + putStrLn (" missing shebang in " ++ f) + pure False + +-- --------------------------------------------------------------------------- +-- Tests +-- --------------------------------------------------------------------------- + +||| Heading-line predicate for AsciiDoc: a line consisting of one or more '=' +||| followed by a space and a non-empty title. +hasHeadingBody : List Char -> Bool +hasHeadingBody ('=' :: rs) = hasHeadingBody rs +hasHeadingBody (' ' :: rs) = not (rs == []) +hasHeadingBody _ = False + +isAdocHeading : String -> Bool +isAdocHeading line = + case unpack line of + ('=' :: rest) => hasHeadingBody rest + _ => False + +public export +allSuites : List TestCase +allSuites = + [ test "property: every .a2ml file has SPDX-License-Identifier header" $ + allSpdxOk a2mlFiles + + , test "property: all .a2ml files use PMPL-1.0-or-later" $ + allPmplOk a2mlFiles + + , test "property: all .idr files in src/abi/ have SPDX headers" $ + allSpdxOk abiIdrFiles + + , test "property: all hook scripts have bash/sh shebang" $ + allShebangOk hookScripts + + -- SPDX-extract handles a table of comment styles (table-driven). + + , test "property: SPDX extraction handles comment style \"# SPDX...\"" $ + assertEq (extractSpdxId "# SPDX-License-Identifier: PMPL-1.0-or-later") "PMPL-1.0-or-later" + + , test "property: SPDX extraction handles comment style \"// SPDX...\"" $ + assertEq (extractSpdxId "// SPDX-License-Identifier: PMPL-1.0-or-later") "PMPL-1.0-or-later" + + , test "property: SPDX extraction handles comment style \"/* SPDX...\"" $ + assertEq (extractSpdxId "/* SPDX-License-Identifier: MIT */") "MIT" + + , test "property: SPDX extraction handles comment style \"; SPDX...\"" $ + assertEq (extractSpdxId "; SPDX-License-Identifier: Apache-2.0") "Apache-2.0" + + , test "property: SPDX extraction handles comment style \"-- SPDX...\"" $ + assertEq (extractSpdxId "-- SPDX-License-Identifier: GPL-3.0-only") "GPL-3.0-only" + + -- Platform-name canonicalisation (table-driven). + + , test "property: platform name normalises \"Slack\" -> \"slack\"" $ + assertEq (normalisePlatform "Slack") "slack" + + , test "property: platform name normalises \" Discord \" -> \"discord\"" $ + assertEq (normalisePlatform " Discord ") "discord" + + , test "property: platform name normalises \"TEAMS\" -> \"teams\"" $ + assertEq (normalisePlatform "TEAMS") "teams" + + , test "property: platform name normalises \"Matrix\" -> \"matrix\"" $ + assertEq (normalisePlatform "Matrix") "matrix" + + -- Contractile presence. TS iterates dust/Dustfile, must/Mustfile, + -- lust/Intentfile. NOTE: contractiles/lust/Intentfile is not present in + -- this repo; the TS test would currently fail on it too. We mirror the + -- iteration faithfully so the Idris2 port preserves the TS semantics + -- (one test per name, missing path -> failure). See the source-bug note + -- in the port report. + + , test "property: contractile file exists and non-empty - contractiles/dust/Dustfile" $ do + ok <- fileExists "contractiles/dust/Dustfile" + content <- readFileToString "contractiles/dust/Dustfile" + assertTrue "Dustfile present and non-empty" (ok && length content > 0) + + , test "property: contractile file exists and non-empty - contractiles/must/Mustfile" $ do + ok <- fileExists "contractiles/must/Mustfile" + content <- readFileToString "contractiles/must/Mustfile" + assertTrue "Mustfile present and non-empty" (ok && length content > 0) + + , test "property: contractile file exists and non-empty - contractiles/lust/Intentfile" $ do + -- SOURCE BUG: contractiles/lust/Intentfile is referenced by the TS + -- iteration but the corresponding directory does not exist in this + -- repo (contractiles/ only contains dust/ and must/). The TS test + -- would also fail. Reported separately; this Idris2 port keeps the + -- assertion so the bug remains visible. + ok <- fileExists "contractiles/lust/Intentfile" + content <- readFileToString "contractiles/lust/Intentfile" + assertTrue "Intentfile present and non-empty (KNOWN SOURCE BUG)" (ok && length content > 0) + + -- README.adoc heading count: TS counts /^={1,6}\s+.+/gm matches and + -- requires >= 3. Idris2 substitute counts lines that start with "= ", + -- "== ", ..., "====== " (with a trailing non-empty rest). + + , test "property: README.adoc contains at least 3 AsciiDoc section headings" $ do + content <- readFileToString "README.adoc" + let headings = filter isAdocHeading (lines content) + let n = length headings + assertTrue ("README.adoc heading count = " ++ show n) (n >= 3) + ] diff --git a/tests/idris2/SmokeTest.idr b/tests/idris2/SmokeTest.idr new file mode 100644 index 0000000..f00cc1f --- /dev/null +++ b/tests/idris2/SmokeTest.idr @@ -0,0 +1,248 @@ +-- SPDX-License-Identifier: PMPL-1.0-or-later +-- Copyright (c) 2026 Jonathan D.A. Jewell (hyperpolymath) +-- +-- Port of tests/smoke_test.ts to Idris2, estate-rollout port 11/11. +-- 36 of 36 smoke tests ported. Each iterated path-existence check becomes +-- one Idris2 test case to preserve granular reporting. +-- +-- Idris2 0.8.0 base stdlib has no isDirectory predicate, so directory +-- existence is checked indirectly via a sentinel file inside each +-- directory. Where no sentinel file is available, a leaf file in that +-- directory is used as proxy (e.g. .well-known/security.txt for +-- .well-known/). + +module SmokeTest + +import Test.Spec +import Data.String +import System.File + +%default covering + +readFileToString : String -> IO String +readFileToString path = do + Right contents <- readFile path + | Left _ => pure "" + pure contents + +fileExists : String -> IO Bool +fileExists path = do + Right _ <- readFile path + | Left _ => pure False + pure True + +toLowerC : Char -> Char +toLowerC c = + if c >= 'A' && c <= 'Z' + then chr (ord c + 32) + else c + +asciiLower : String -> String +asciiLower s = pack (map toLowerC (unpack s)) + +public export +allSuites : List TestCase +allSuites = + [ -- ---------- Required top-level files ---------- + + test "smoke: required file exists - LICENSE" $ do + ok <- fileExists "LICENSE" + assertTrue "LICENSE present" ok + + , test "smoke: required file exists - README.adoc" $ do + ok <- fileExists "README.adoc" + assertTrue "README.adoc present" ok + + , test "smoke: required file exists - EXPLAINME.adoc" $ do + ok <- fileExists "EXPLAINME.adoc" + assertTrue "EXPLAINME.adoc present" ok + + , test "smoke: required file exists - SECURITY.md" $ do + ok <- fileExists "SECURITY.md" + assertTrue "SECURITY.md present" ok + + , test "smoke: required file exists - CONTRIBUTING.md" $ do + ok <- fileExists "CONTRIBUTING.md" + assertTrue "CONTRIBUTING.md present" ok + + , test "smoke: required file exists - MAINTAINERS.adoc" $ do + ok <- fileExists "MAINTAINERS.adoc" + assertTrue "MAINTAINERS.adoc present" ok + + , test "smoke: required file exists - ROADMAP.adoc" $ do + ok <- fileExists "ROADMAP.adoc" + assertTrue "ROADMAP.adoc present" ok + + , test "smoke: required file exists - NOTICE" $ do + ok <- fileExists "NOTICE" + assertTrue "NOTICE present" ok + + , test "smoke: required file exists - Justfile" $ do + ok <- fileExists "Justfile" + assertTrue "Justfile present" ok + + , test "smoke: required file exists - 0-AI-MANIFEST.a2ml" $ do + ok <- fileExists "0-AI-MANIFEST.a2ml" + assertTrue "0-AI-MANIFEST.a2ml present" ok + + , test "smoke: required file exists - PROOF-NEEDS.md" $ do + ok <- fileExists "PROOF-NEEDS.md" + assertTrue "PROOF-NEEDS.md present" ok + + , test "smoke: required file exists - .editorconfig" $ do + ok <- fileExists ".editorconfig" + assertTrue ".editorconfig present" ok + + , test "smoke: required file exists - stapeln.toml" $ do + ok <- fileExists "stapeln.toml" + assertTrue "stapeln.toml present" ok + + , test "smoke: required file exists - flake.nix" $ do + ok <- fileExists "flake.nix" + assertTrue "flake.nix present" ok + + , test "smoke: required file exists - guix.scm" $ do + ok <- fileExists "guix.scm" + assertTrue "guix.scm present" ok + + -- ---------- Required directories (proxied via sentinel files) ---------- + + , test "smoke: required directory exists - .machine_readable" $ do + ok <- fileExists ".machine_readable/CLADE.a2ml" + assertTrue ".machine_readable/ present" ok + + , test "smoke: required directory exists - .machine_readable/6a2" $ do + ok <- fileExists ".machine_readable/6a2/STATE.a2ml" + assertTrue ".machine_readable/6a2/ present" ok + + , test "smoke: required directory exists - tests" $ do + ok <- fileExists "tests/unit_test.ts" + assertTrue "tests/ present" ok + + , test "smoke: required directory exists - tests/fuzz" $ do + ok <- fileExists "tests/fuzz/placeholder.txt" + assertTrue "tests/fuzz/ present" ok + + , test "smoke: required directory exists - ffi" $ do + ok <- fileExists "ffi/zig/build.zig" + assertTrue "ffi/ present" ok + + , test "smoke: required directory exists - ffi/zig" $ do + ok <- fileExists "ffi/zig/build.zig" + assertTrue "ffi/zig/ present" ok + + , test "smoke: required directory exists - ffi/zig/src" $ do + ok <- fileExists "ffi/zig/src/main.zig" + assertTrue "ffi/zig/src/ present" ok + + , test "smoke: required directory exists - ffi/zig/test" $ do + ok <- fileExists "ffi/zig/test/integration_test.zig" + assertTrue "ffi/zig/test/ present" ok + + , test "smoke: required directory exists - src" $ do + ok <- fileExists "src/abi/Layout.idr" + assertTrue "src/ present" ok + + , test "smoke: required directory exists - src/abi" $ do + ok <- fileExists "src/abi/Layout.idr" + assertTrue "src/abi/ present" ok + + , test "smoke: required directory exists - docs" $ do + ok <- fileExists "docs/CITATIONS.adoc" + assertTrue "docs/ present" ok + + , test "smoke: required directory exists - examples" $ do + ok <- fileExists "examples/SafeDOMExample.res" + assertTrue "examples/ present" ok + + , test "smoke: required directory exists - contractiles" $ do + ok <- fileExists "contractiles/README.adoc" + assertTrue "contractiles/ present" ok + + , test "smoke: required directory exists - hooks" $ do + ok <- fileExists "hooks/validate-spdx.sh" + assertTrue "hooks/ present" ok + + , test "smoke: required directory exists - .well-known" $ do + ok <- fileExists ".well-known/security.txt" + assertTrue ".well-known/ present" ok + + -- ---------- a2ml checkpoints ---------- + + , test "smoke: a2ml checkpoint exists - .machine_readable/6a2/STATE.a2ml" $ do + ok <- fileExists ".machine_readable/6a2/STATE.a2ml" + assertTrue "STATE.a2ml present" ok + + , test "smoke: a2ml checkpoint exists - .machine_readable/6a2/META.a2ml" $ do + ok <- fileExists ".machine_readable/6a2/META.a2ml" + assertTrue "META.a2ml present" ok + + , test "smoke: a2ml checkpoint exists - .machine_readable/6a2/ECOSYSTEM.a2ml" $ do + ok <- fileExists ".machine_readable/6a2/ECOSYSTEM.a2ml" + assertTrue "ECOSYSTEM.a2ml present" ok + + , test "smoke: a2ml checkpoint exists - .machine_readable/6a2/AGENTIC.a2ml" $ do + ok <- fileExists ".machine_readable/6a2/AGENTIC.a2ml" + assertTrue "AGENTIC.a2ml present" ok + + , test "smoke: a2ml checkpoint exists - .machine_readable/6a2/NEUROSYM.a2ml" $ do + ok <- fileExists ".machine_readable/6a2/NEUROSYM.a2ml" + assertTrue "NEUROSYM.a2ml present" ok + + , test "smoke: a2ml checkpoint exists - .machine_readable/6a2/PLAYBOOK.a2ml" $ do + ok <- fileExists ".machine_readable/6a2/PLAYBOOK.a2ml" + assertTrue "PLAYBOOK.a2ml present" ok + + -- ---------- .well-known files ---------- + + , test "smoke: well-known file exists - .well-known/security.txt" $ do + ok <- fileExists ".well-known/security.txt" + assertTrue "security.txt present" ok + + , test "smoke: well-known file exists - .well-known/ai.txt" $ do + ok <- fileExists ".well-known/ai.txt" + assertTrue "ai.txt present" ok + + , test "smoke: well-known file exists - .well-known/humans.txt" $ do + ok <- fileExists ".well-known/humans.txt" + assertTrue "humans.txt present" ok + + -- ---------- ABI / FFI scaffold ---------- + + , test "smoke: ABI Layout.idr exists" $ do + ok <- fileExists "src/abi/Layout.idr" + assertTrue "src/abi/Layout.idr present" ok + + , test "smoke: ABI Foreign.idr exists" $ do + ok <- fileExists "src/abi/Foreign.idr" + assertTrue "src/abi/Foreign.idr present" ok + + , test "smoke: FFI main.zig exists" $ do + ok <- fileExists "ffi/zig/src/main.zig" + assertTrue "ffi/zig/src/main.zig present" ok + + , test "smoke: FFI build.zig exists" $ do + ok <- fileExists "ffi/zig/build.zig" + assertTrue "ffi/zig/build.zig present" ok + + , test "smoke: FFI integration_test.zig exists" $ do + ok <- fileExists "ffi/zig/test/integration_test.zig" + assertTrue "ffi/zig/test/integration_test.zig present" ok + + -- ---------- SECURITY.md non-empty ---------- + + , test "smoke: SECURITY.md is non-empty" $ do + content <- readFileToString "SECURITY.md" + assertTrue "SECURITY.md non-empty" (length content > 0) + + -- ---------- README domain reference ---------- + + , test "smoke: README.adoc mentions chat or universal" $ do + content <- readFileToString "README.adoc" + let lc = asciiLower content + let hasDomain = isInfixOf "chat" lc || isInfixOf "universal" lc || isInfixOf "extract" lc + allPass + [ assertTrue "README.adoc present" (content /= "") + , assertTrue "README.adoc mentions project domain" hasDomain + ] + ] diff --git a/tests/idris2/Test/Spec.idr b/tests/idris2/Test/Spec.idr new file mode 100644 index 0000000..56de2ba --- /dev/null +++ b/tests/idris2/Test/Spec.idr @@ -0,0 +1,112 @@ +-- SPDX-License-Identifier: PMPL-1.0-or-later +-- Copyright (c) 2026 Jonathan D.A. Jewell (hyperpolymath) +-- +||| Minimal Idris2 test harness for the universal-chat-extractor test suite. +||| +||| Mirrors the Deno.test interface used by the previous TypeScript suite: +||| each test is a named IO action returning Bool (True = pass, False = fail). +||| The runner reports per-test status and exits non-zero on any failure so +||| Justfile / CI can detect breakage. + +module Test.Spec + +import Data.IORef +import Data.List +import System + +%default total + +public export +record TestCase where + constructor MkTest + name : String + body : IO Bool + +public export +test : String -> IO Bool -> TestCase +test = MkTest + +||| Assert that two showable, comparable values are equal. +||| Prints expected/actual on mismatch. +public export +assertEq : (Show a, Eq a) => a -> a -> IO Bool +assertEq actual expected = + if actual == expected + then pure True + else do + putStrLn "" + putStrLn $ " expected: " ++ show expected + putStrLn $ " actual: " ++ show actual + pure False + +||| Assert that two values are not equal. +public export +assertNotEq : (Show a, Eq a) => a -> a -> IO Bool +assertNotEq actual notExpected = + if actual /= notExpected + then pure True + else do + putStrLn "" + putStrLn $ " did not expect: " ++ show notExpected + pure False + +||| Assert that a Bool is True; print the supplied message on failure. +public export +assertTrue : String -> Bool -> IO Bool +assertTrue msg b = + if b + then pure True + else do + putStrLn "" + putStrLn $ " assertion failed: " ++ msg + pure False + +||| Combine a list of sub-assertions; all must pass. +||| Use in a do-block to compose multiple checks in one test case. +public export +allPass : List (IO Bool) -> IO Bool +allPass [] = pure True +allPass (x :: xs) = do + r <- x + if r then allPass xs else pure False + +runOne : TestCase -> IO Bool +runOne (MkTest name body) = do + putStr $ " " ++ name ++ " ... " + result <- body + if result + then putStrLn "PASS" + else putStrLn "FAIL" + pure result + +runAll : List TestCase -> Nat -> Nat -> IO (Nat, Nat) +runAll [] p f = pure (p, f) +runAll (t :: ts) p f = do + ok <- runOne t + if ok + then runAll ts (S p) f + else runAll ts p (S f) + +||| Run a list of test cases. Reports a summary and exits non-zero +||| if any test failed. Use for single-suite executables. +public export +runTests : List TestCase -> IO () +runTests cases = do + (p, f) <- runAll cases 0 0 + putStrLn "" + putStrLn $ show p ++ " passed, " ++ show f ++ " failed" + if f > 0 + then exitWith (ExitFailure 1) + else pure () + +||| Run a named suite without exiting. Returns (passed, failed) so a parent +||| aggregator (e.g. Main) can accumulate across multiple suites and only +||| exit at the end. +public export +runTestSuite : String -> List TestCase -> IO (Nat, Nat) +runTestSuite name cases = do + putStrLn $ "=== " ++ name ++ " ===" + (p, f) <- runAll cases 0 0 + putStrLn $ show p ++ " passed, " ++ show f ++ " failed" + putStrLn "" + pure (p, f) diff --git a/tests/idris2/UnitTest.idr b/tests/idris2/UnitTest.idr new file mode 100644 index 0000000..1c61165 --- /dev/null +++ b/tests/idris2/UnitTest.idr @@ -0,0 +1,236 @@ +-- SPDX-License-Identifier: PMPL-1.0-or-later +-- Copyright (c) 2026 Jonathan D.A. Jewell (hyperpolymath) +-- +-- Port of tests/unit_test.ts to Idris2, estate-rollout port 11/11. +-- 20 of 20 tests ported. SPDX-extract, placeholder, timestamp, and platform +-- helpers are reimplemented inline; metadata file lookups use file-read + +-- substring matching, which is structurally identical to the Deno original. + +module UnitTest + +import Test.Spec +import Data.String +import Data.List +import System.File + +%default covering + +-- --------------------------------------------------------------------------- +-- Inline pure helpers (mirrors of the TS regex-driven ones) +-- --------------------------------------------------------------------------- + +readFileToString : String -> IO String +readFileToString path = do + Right contents <- readFile path + | Left _ => pure "" + pure contents + +fileExists : String -> IO Bool +fileExists path = do + Right _ <- readFile path + | Left _ => pure False + pure True + +||| True if first chars of xs match ys (prefix on List Char). +prefixOfChars : List Char -> List Char -> Bool +prefixOfChars _ [] = True +prefixOfChars [] (_ :: _) = False +prefixOfChars (x :: xs) (y :: ys) = x == y && prefixOfChars xs ys + +||| Drop the first n elements from a list. +dropN : Nat -> List a -> List a +dropN Z xs = xs +dropN _ [] = [] +dropN (S k) (_ :: xs) = dropN k xs + +||| Take the substring of `s` after the first occurrence of `needle`. +||| Returns "" if `needle` not found. +afterNeedleGo : List Char -> List Char -> Nat -> String +afterNeedleGo [] _ _ = "" +afterNeedleGo cs ns nl = + if prefixOfChars cs ns + then pack (dropN nl cs) + else case cs of + [] => "" + (_ :: rest) => afterNeedleGo rest ns nl + +afterNeedle : String -> String -> String +afterNeedle s n = + let nc = unpack n + nl = length nc + in afterNeedleGo (unpack s) nc nl + +||| The first whitespace/newline-terminated token of the given string. +firstToken : String -> String +firstToken s = pack (takeTok (unpack s)) + where + takeTok : List Char -> List Char + takeTok [] = [] + takeTok (c :: cs) = + if c == ' ' || c == '\t' || c == '\n' || c == '\r' + then [] + else c :: takeTok cs + +||| Strip leading whitespace. +trimLeading : String -> String +trimLeading s = case unpack s of + [] => s + (c :: cs) => if c == ' ' || c == '\t' + then trimLeading (pack cs) + else s + +||| Find the substring after the literal "SPDX-License-Identifier:" then return +||| the first whitespace-delimited token. Returns "" if absent. +extractSpdxId : String -> String +extractSpdxId content = + let needle = "SPDX-License-Identifier:" in + if isInfixOf needle content + then firstToken (trimLeading (afterNeedle content needle)) + else "" + +||| True when `c` is an uppercase ASCII letter or underscore (the placeholder +||| alphabet matched by the TS `[A-Z_]+` regex). +isUpperOrUnderscore : Char -> Bool +isUpperOrUnderscore c = + c == '_' || (c >= 'A' && c <= 'Z') + +||| Try to match `{{[A-Z_]+}}` starting at the head of the list. +matchPlaceholder : List Char -> Bool +matchPlaceholder ('{' :: '{' :: rest) = consumeBody rest False + where + consumeBody : List Char -> Bool -> Bool + consumeBody [] _ = False + consumeBody ('}' :: '}' :: _) seenOne = seenOne + consumeBody (c :: cs) seenOne = + if isUpperOrUnderscore c + then consumeBody cs True + else False +matchPlaceholder _ = False + +||| Mirrors TS `/\{\{[A-Z_]+\}\}/.test(content)`. True iff `content` contains +||| `{{XXX}}` where XXX is one-or-more chars from `[A-Z_]`. +containsUnresolvedPlaceholder : String -> Bool +containsUnresolvedPlaceholder content = scan (unpack content) + where + scan : List Char -> Bool + scan [] = False + scan all@(_ :: rest) = + if matchPlaceholder all + then True + else scan rest + +||| True iff `c` is an ASCII digit. +isAsciiDigit : Char -> Bool +isAsciiDigit c = c >= '0' && c <= '9' + +||| True iff string starts with `YYYY-MM-DD` (the TS regex `^\d{4}-\d{2}-\d{2}`). +isValidTimestamp : String -> Bool +isValidTimestamp ts = case unpack ts of + (a :: b :: c :: d :: '-' :: e :: f :: '-' :: g :: h :: _) => + isAsciiDigit a && isAsciiDigit b && isAsciiDigit c && isAsciiDigit d && + isAsciiDigit e && isAsciiDigit f && isAsciiDigit g && isAsciiDigit h + _ => False + +||| ASCII lowercasing (avoids any locale awkwardness; sufficient for the +||| platform-name set used here). +asciiLower : String -> String +asciiLower s = pack (map low (unpack s)) + where + low : Char -> Char + low c = + if c >= 'A' && c <= 'Z' + then chr (ord c + 32) + else c + +||| True iff the (lowercased) `platform` is in the known-platform allowlist. +isKnownPlatform : String -> Bool +isKnownPlatform platform = + let lc = asciiLower platform in + lc == "slack" || lc == "discord" || lc == "teams" || lc == "matrix" || + lc == "telegram" || lc == "signal" || lc == "whatsapp" || lc == "irc" || + lc == "zulip" + +-- --------------------------------------------------------------------------- +-- Test cases (Idris2 mirrors of Deno.test entries) +-- --------------------------------------------------------------------------- + +public export +allSuites : List TestCase +allSuites = + [ test "unit: extractSpdxId parses valid SPDX line" $ do + let content = "// SPDX-License-Identifier: PMPL-1.0-or-later\ncode" + assertEq (extractSpdxId content) "PMPL-1.0-or-later" + + , test "unit: extractSpdxId handles TOML-style comment" $ do + let content = "# SPDX-License-Identifier: PMPL-1.0-or-later\n[section]" + assertEq (extractSpdxId content) "PMPL-1.0-or-later" + + , test "unit: extractSpdxId returns empty when header absent" $ do + assertEq (extractSpdxId "no license here") "" + + , test "unit: extractSpdxId handles leading whitespace" $ do + let content = " // SPDX-License-Identifier: MIT\n" + assertEq (extractSpdxId content) "MIT" + + , test "unit: containsUnresolvedPlaceholder detects {{PROJECT}}" $ do + assertEq (containsUnresolvedPlaceholder "name: {{PROJECT}}") True + + , test "unit: containsUnresolvedPlaceholder ignores lowercase placeholders" $ do + assertEq (containsUnresolvedPlaceholder "fn {{project}}_init()") False + + , test "unit: containsUnresolvedPlaceholder allows clean content" $ do + assertEq (containsUnresolvedPlaceholder "universal-chat-extractor") False + + , test "unit: isValidTimestamp accepts ISO date format" $ do + assertEq (isValidTimestamp "2026-04-04T12:00:00Z") True + + , test "unit: isValidTimestamp accepts date-only format" $ do + assertEq (isValidTimestamp "2026-01-01") True + + , test "unit: isValidTimestamp rejects garbage" $ do + assertEq (isValidTimestamp "not-a-date") False + + , test "unit: isKnownPlatform accepts slack" $ do + assertEq (isKnownPlatform "slack") True + + , test "unit: isKnownPlatform accepts discord (case insensitive)" $ do + assertEq (isKnownPlatform "Discord") True + + , test "unit: isKnownPlatform rejects unknown platform" $ do + assertEq (isKnownPlatform "somenovelchat") False + + , test "unit: STATE.a2ml exists and has valid project name" $ do + content <- readFileToString ".machine_readable/6a2/STATE.a2ml" + allPass + [ assertTrue "STATE.a2ml non-empty" (content /= "") + , assertTrue "project = universal-chat-extractor" + (isInfixOf "project = \"universal-chat-extractor\"" content) + ] + + , test "unit: STATE.a2ml has SPDX header" $ do + content <- readFileToString ".machine_readable/6a2/STATE.a2ml" + assertEq (extractSpdxId content) "PMPL-1.0-or-later" + + , test "unit: STATE.a2ml has version field" $ do + content <- readFileToString ".machine_readable/6a2/STATE.a2ml" + assertTrue "version = present" (isInfixOf "version =" content) + + , test "unit: LICENSE file exists and is non-empty" $ do + content <- readFileToString "LICENSE" + allPass + [ assertTrue "LICENSE present" (content /= "") + , assertTrue "LICENSE not whitespace-only" (length content > 1) + ] + + , test "unit: LICENSES directory contains PMPL text" $ do + ok <- fileExists "LICENSES/PMPL-1.0-or-later.txt" + assertTrue "LICENSES/PMPL-1.0-or-later.txt must exist" ok + + , test "unit: 0-AI-MANIFEST.a2ml exists" $ do + ok <- fileExists "0-AI-MANIFEST.a2ml" + assertTrue "0-AI-MANIFEST.a2ml must exist" ok + + , test "unit: 0-AI-MANIFEST.a2ml is non-empty" $ do + content <- readFileToString "0-AI-MANIFEST.a2ml" + assertTrue "0-AI-MANIFEST.a2ml non-empty" (length content > 0) + ] diff --git a/universal-chat-extractor-tests.ipkg b/universal-chat-extractor-tests.ipkg new file mode 100644 index 0000000..c0b8f4b --- /dev/null +++ b/universal-chat-extractor-tests.ipkg @@ -0,0 +1,24 @@ +-- SPDX-License-Identifier: PMPL-1.0-or-later +-- universal-chat-extractor Idris2 test suite. Estate port 11/11 (final). +-- 7 TS test files ported (unit + contract + aspect + property + smoke + e2e +-- + bench), content-validation pattern plus pure-logic helpers for the unit +-- and bench assertions. + +package universal-chat-extractor-tests + +sourcedir = "tests/idris2" + +depends = base + +modules = Test.Spec + , UnitTest + , ContractTest + , AspectTest + , PropertyTest + , SmokeTest + , E2ETest + , BenchTest + , Main + +main = Main +executable = "universal-chat-extractor-tests"