giles
04ed092f88
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
27 new tests, 432/432 total. char_type/2 supports alpha, alnum, digit, digit(Weight), space/white, upper(Lower), lower(Upper), ascii(Code), punct. Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
290 lines
7.6 KiB
Plaintext
290 lines
7.6 KiB
Plaintext
;; lib/prolog/tests/char_predicates.sx — char_type/2, upcase_atom/2, downcase_atom/2,
|
|
;; string_upper/2, string_lower/2
|
|
|
|
(define pl-cp-test-count 0)
|
|
(define pl-cp-test-pass 0)
|
|
(define pl-cp-test-fail 0)
|
|
(define pl-cp-test-failures (list))
|
|
|
|
(define
|
|
pl-cp-test!
|
|
(fn
|
|
(name got expected)
|
|
(begin
|
|
(set! pl-cp-test-count (+ pl-cp-test-count 1))
|
|
(if
|
|
(= got expected)
|
|
(set! pl-cp-test-pass (+ pl-cp-test-pass 1))
|
|
(begin
|
|
(set! pl-cp-test-fail (+ pl-cp-test-fail 1))
|
|
(append!
|
|
pl-cp-test-failures
|
|
(str name "\n expected: " expected "\n got: " got)))))))
|
|
|
|
(define
|
|
pl-cp-goal
|
|
(fn
|
|
(src env)
|
|
(pl-instantiate (nth (first (pl-parse (str "g :- " src "."))) 2) env)))
|
|
|
|
(define pl-cp-db (pl-mk-db))
|
|
|
|
;; ─── char_type/2 — alpha ──────────────────────────────────────────
|
|
|
|
(pl-cp-test!
|
|
"char_type(a, alpha) succeeds"
|
|
(pl-solve-once!
|
|
pl-cp-db
|
|
(pl-cp-goal "char_type(a, alpha)" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
(pl-cp-test!
|
|
"char_type('1', alpha) fails"
|
|
(pl-solve-once!
|
|
pl-cp-db
|
|
(pl-cp-goal "char_type('1', alpha)" {})
|
|
(pl-mk-trail))
|
|
false)
|
|
|
|
(pl-cp-test!
|
|
"char_type('A', alpha) succeeds"
|
|
(pl-solve-once!
|
|
pl-cp-db
|
|
(pl-cp-goal "char_type('A', alpha)" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
;; ─── char_type/2 — alnum ─────────────────────────────────────────
|
|
|
|
(pl-cp-test!
|
|
"char_type('5', alnum) succeeds"
|
|
(pl-solve-once!
|
|
pl-cp-db
|
|
(pl-cp-goal "char_type('5', alnum)" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
(pl-cp-test!
|
|
"char_type(a, alnum) succeeds"
|
|
(pl-solve-once!
|
|
pl-cp-db
|
|
(pl-cp-goal "char_type(a, alnum)" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
(pl-cp-test!
|
|
"char_type(' ', alnum) fails"
|
|
(pl-solve-once!
|
|
pl-cp-db
|
|
(pl-cp-goal "char_type(' ', alnum)" {})
|
|
(pl-mk-trail))
|
|
false)
|
|
|
|
;; ─── char_type/2 — digit ─────────────────────────────────────────
|
|
|
|
(pl-cp-test!
|
|
"char_type('5', digit) succeeds"
|
|
(pl-solve-once!
|
|
pl-cp-db
|
|
(pl-cp-goal "char_type('5', digit)" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
(pl-cp-test!
|
|
"char_type(a, digit) fails"
|
|
(pl-solve-once!
|
|
pl-cp-db
|
|
(pl-cp-goal "char_type(a, digit)" {})
|
|
(pl-mk-trail))
|
|
false)
|
|
|
|
;; ─── char_type/2 — digit(Weight) ─────────────────────────────────
|
|
|
|
(define pl-cp-env-dw {})
|
|
(pl-solve-once!
|
|
pl-cp-db
|
|
(pl-cp-goal "char_type('5', digit(N))" pl-cp-env-dw)
|
|
(pl-mk-trail))
|
|
(pl-cp-test!
|
|
"char_type('5', digit(N)) -> N=5"
|
|
(pl-num-val (pl-walk-deep (dict-get pl-cp-env-dw "N")))
|
|
5)
|
|
|
|
(define pl-cp-env-dw0 {})
|
|
(pl-solve-once!
|
|
pl-cp-db
|
|
(pl-cp-goal "char_type('0', digit(N))" pl-cp-env-dw0)
|
|
(pl-mk-trail))
|
|
(pl-cp-test!
|
|
"char_type('0', digit(N)) -> N=0"
|
|
(pl-num-val (pl-walk-deep (dict-get pl-cp-env-dw0 "N")))
|
|
0)
|
|
|
|
;; ─── char_type/2 — space/white ───────────────────────────────────
|
|
|
|
(pl-cp-test!
|
|
"char_type(' ', space) succeeds"
|
|
(pl-solve-once!
|
|
pl-cp-db
|
|
(pl-cp-goal "char_type(' ', space)" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
(pl-cp-test!
|
|
"char_type(a, space) fails"
|
|
(pl-solve-once!
|
|
pl-cp-db
|
|
(pl-cp-goal "char_type(a, space)" {})
|
|
(pl-mk-trail))
|
|
false)
|
|
|
|
;; ─── char_type/2 — upper(Lower) ──────────────────────────────────
|
|
|
|
(define pl-cp-env-ul {})
|
|
(pl-solve-once!
|
|
pl-cp-db
|
|
(pl-cp-goal "char_type('A', upper(L))" pl-cp-env-ul)
|
|
(pl-mk-trail))
|
|
(pl-cp-test!
|
|
"char_type('A', upper(L)) -> L=a"
|
|
(pl-atom-name (pl-walk-deep (dict-get pl-cp-env-ul "L")))
|
|
"a")
|
|
|
|
(pl-cp-test!
|
|
"char_type(a, upper(L)) fails — not uppercase"
|
|
(pl-solve-once!
|
|
pl-cp-db
|
|
(pl-cp-goal "char_type(a, upper(_))" {})
|
|
(pl-mk-trail))
|
|
false)
|
|
|
|
;; ─── char_type/2 — lower(Upper) ──────────────────────────────────
|
|
|
|
(define pl-cp-env-lu {})
|
|
(pl-solve-once!
|
|
pl-cp-db
|
|
(pl-cp-goal "char_type(a, lower(U))" pl-cp-env-lu)
|
|
(pl-mk-trail))
|
|
(pl-cp-test!
|
|
"char_type(a, lower(U)) -> U='A'"
|
|
(pl-atom-name (pl-walk-deep (dict-get pl-cp-env-lu "U")))
|
|
"A")
|
|
|
|
;; ─── char_type/2 — ascii(Code) ───────────────────────────────────
|
|
|
|
(define pl-cp-env-as {})
|
|
(pl-solve-once!
|
|
pl-cp-db
|
|
(pl-cp-goal "char_type(a, ascii(C))" pl-cp-env-as)
|
|
(pl-mk-trail))
|
|
(pl-cp-test!
|
|
"char_type(a, ascii(C)) -> C=97"
|
|
(pl-num-val (pl-walk-deep (dict-get pl-cp-env-as "C")))
|
|
97)
|
|
|
|
;; ─── char_type/2 — punct ─────────────────────────────────────────
|
|
|
|
(pl-cp-test!
|
|
"char_type('.', punct) succeeds"
|
|
(pl-solve-once!
|
|
pl-cp-db
|
|
(pl-cp-goal "char_type('.', punct)" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
(pl-cp-test!
|
|
"char_type(a, punct) fails"
|
|
(pl-solve-once!
|
|
pl-cp-db
|
|
(pl-cp-goal "char_type(a, punct)" {})
|
|
(pl-mk-trail))
|
|
false)
|
|
|
|
;; ─── upcase_atom/2 ───────────────────────────────────────────────
|
|
|
|
(define pl-cp-env-ua {})
|
|
(pl-solve-once!
|
|
pl-cp-db
|
|
(pl-cp-goal "upcase_atom(hello, X)" pl-cp-env-ua)
|
|
(pl-mk-trail))
|
|
(pl-cp-test!
|
|
"upcase_atom(hello, X) -> X='HELLO'"
|
|
(pl-atom-name (pl-walk-deep (dict-get pl-cp-env-ua "X")))
|
|
"HELLO")
|
|
|
|
(pl-cp-test!
|
|
"upcase_atom(hello, 'HELLO') succeeds"
|
|
(pl-solve-once!
|
|
pl-cp-db
|
|
(pl-cp-goal "upcase_atom(hello, 'HELLO')" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
(pl-cp-test!
|
|
"upcase_atom('Hello World', 'HELLO WORLD') succeeds"
|
|
(pl-solve-once!
|
|
pl-cp-db
|
|
(pl-cp-goal "upcase_atom('Hello World', 'HELLO WORLD')" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
(pl-cp-test!
|
|
"upcase_atom('', '') succeeds"
|
|
(pl-solve-once!
|
|
pl-cp-db
|
|
(pl-cp-goal "upcase_atom('', '')" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
;; ─── downcase_atom/2 ─────────────────────────────────────────────
|
|
|
|
(define pl-cp-env-da {})
|
|
(pl-solve-once!
|
|
pl-cp-db
|
|
(pl-cp-goal "downcase_atom('HELLO', X)" pl-cp-env-da)
|
|
(pl-mk-trail))
|
|
(pl-cp-test!
|
|
"downcase_atom('HELLO', X) -> X=hello"
|
|
(pl-atom-name (pl-walk-deep (dict-get pl-cp-env-da "X")))
|
|
"hello")
|
|
|
|
(pl-cp-test!
|
|
"downcase_atom('HELLO', hello) succeeds"
|
|
(pl-solve-once!
|
|
pl-cp-db
|
|
(pl-cp-goal "downcase_atom('HELLO', hello)" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
(pl-cp-test!
|
|
"downcase_atom(hello, hello) succeeds — already lowercase"
|
|
(pl-solve-once!
|
|
pl-cp-db
|
|
(pl-cp-goal "downcase_atom(hello, hello)" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
;; ─── string_upper/2 + string_lower/2 (aliases) ───────────────────
|
|
|
|
(define pl-cp-env-su {})
|
|
(pl-solve-once!
|
|
pl-cp-db
|
|
(pl-cp-goal "string_upper(hello, X)" pl-cp-env-su)
|
|
(pl-mk-trail))
|
|
(pl-cp-test!
|
|
"string_upper(hello, X) -> X='HELLO'"
|
|
(pl-atom-name (pl-walk-deep (dict-get pl-cp-env-su "X")))
|
|
"HELLO")
|
|
|
|
(define pl-cp-env-sl {})
|
|
(pl-solve-once!
|
|
pl-cp-db
|
|
(pl-cp-goal "string_lower('WORLD', X)" pl-cp-env-sl)
|
|
(pl-mk-trail))
|
|
(pl-cp-test!
|
|
"string_lower('WORLD', X) -> X=world"
|
|
(pl-atom-name (pl-walk-deep (dict-get pl-cp-env-sl "X")))
|
|
"world")
|
|
|
|
(define pl-char-predicates-tests-run! (fn () {:failed pl-cp-test-fail :passed pl-cp-test-pass :total pl-cp-test-count :failures pl-cp-test-failures})) |