#!/bin/sh
# SPDX-License-Identifier: BSD-2-Clause
LOG_LEVEL=1
# vvv https://github.com/dnmfarrell/tap.sh/
TAP_TEST_COUNT=0
TAP_FAIL_COUNT=0
tap_pass() {
TAP_TEST_COUNT=$((TAP_TEST_COUNT + 1))
echo "ok $TAP_TEST_COUNT $1"
}
tap_fail() {
TAP_TEST_COUNT=$((TAP_TEST_COUNT + 1))
TAP_FAIL_COUNT=$((TAP_FAIL_COUNT + 1))
echo "not ok $TAP_TEST_COUNT $1"
}
tap_end() {
num_tests="$1"
[ -z "$num_tests" ] && num_tests="$TAP_TEST_COUNT"
# echo "1..$num_tests"
[ "$num_tests" = "$TAP_TEST_COUNT" ] || exit 1
exit $((TAP_FAIL_COUNT > 0)) # C semantics
}
tap_ok() {
if [ "$1" -eq 0 ]; then
tap_pass "$2"
else
tap_fail "$2"
fi
}
tap_cmp() {
if [ "$1" = "$2" ]; then
tap_pass "$3"
else
tap_fail "$3 - expected '$2' but got '$1'"
fi
}
# ^^^
# in all cases, awk has to be the last thing in the pipeline so we can
# see its exitcode
lisp_with_input () {
${TEST_AWK:-awk} -v PROMPT= -v LOG_LEVEL=$LOG_LEVEL -f glotawk
}
lisp_with_string () {
echo "$@" | lisp_with_input
}
lisp_eval_should_be () {
[ $LOG_LEVEL -ge 2 ] && echo "INF ---- test $(($TAP_TEST_COUNT + 1)) ---------"
local output="$(lisp_with_string "$1")"
local exitcode=$?
if [ "$exitcode" -ne 0 ] ; then
tap_fail "$3 - nonzero exit code"
else
tap_cmp "$output" "$2" "$3"
fi
}
lisp_eval_should_be_tricky_tricky () {
[ $LOG_LEVEL -ge 2 ] && echo "INF ---- test $(($TAP_TEST_COUNT + 1)) ---------"
echo "$1" | base64 -d | lisp_with_input >/dev/null 2>&1
local exitcode=$?
if [ "$exitcode" -ne 0 ] ; then
tap_fail "$3 - nonzero exit code"
else
local output="$(echo "$1" | base64 -d | lisp_with_input | base64)"
tap_cmp "$output" "$2" "$3"
fi
}
if [ "$#" -gt 0 ]; then
while [ "$#" -gt 0 ]; do
if [ "$1" = "-v" ]; then
if [ $LOG_LEVEL -lt 3 ]; then
LOG_LEVEL=$(( $LOG_LEVEL + 1 ))
fi
elif [ "$1" = "-vv" ]; then
if [ $LOG_LEVEL -lt 2 ]; then
LOG_LEVEL=$(( $LOG_LEVEL + 2 ))
fi
fi
shift
done
fi
TEST_COUNT=0
lisp_eval_should_be '(quote 5)' '5' 'basic quote'
lisp_eval_should_be '5' '5' 'numbers are literal'
lisp_eval_should_be '((lambda (x) 3) 5)' '3' 'lambda evaluation'
lisp_eval_should_be '(label ((foo 3)) foo)' '3' 'label evaluation'
lisp_eval_should_be '(cond (false 5) (true 3))' '3' 'cond evaluation'
lisp_eval_should_be '(atom 5)' 'true' 'atom: number'
lisp_eval_should_be '(atom (quote "foo"))' 'true' 'atom: string'
lisp_eval_should_be '(atom (quote (1 2 3)))' 'false' 'atom: list'
lisp_eval_should_be '(atom (quote (1 . 2)))' 'false' 'atom: pair'
lisp_eval_should_be '(atom (quote socrates))' 'true' 'atom: symbol'
lisp_eval_should_be '(cons (quote foo) (quote bar))' '(foo . bar)' 'cons: pair'
lisp_eval_should_be '(cons 1 (cons 2 (cons 3 nil)))' '(1 2 3)' 'cons: list'
lisp_eval_should_be '(car (quote (foo bar)))' 'foo' 'car'
lisp_eval_should_be '(cdr (quote (foo bar)))' '(bar)' 'cdr'
lisp_eval_should_be '(eq "foo" "bar")' 'false' 'eq: unequal strings'
lisp_eval_should_be '(eq "foo" "foo")' 'false' 'eq: strings are not interned (non-normative)'
lisp_eval_should_be '(equal "foo" "foo")' 'true' 'equal tests for string equality irrespective of identity'
lisp_eval_should_be '(equal 42 42)' 'true' 'equal: numbers'
lisp_eval_should_be '(equal '\''foo '\''foo)' 'true' 'equal: symbols'
lisp_eval_should_be '(equal '\''(1 2 "foo") '\''(1 2 "foo"))' 'true' 'equal: lists'
lisp_eval_should_be '(equal '\''(1 foo "foo") '\''(1 foo "bar"))' 'false' 'equal: unequal things'
lisp_eval_should_be '(list (not true) (not false) (not nil) (not 0) (not "") (not "0"))' '(false true true false false false)' 'not'
lisp_eval_should_be '(list (null true) (null false) (null nil) (null '\''(1)))' '(false false true false)' 'null'
lisp_eval_should_be '((lambda xs (car xs)) 1 2 3)' '1' 'lexpr'
# the first result 3 is the return value of setq; the second is the
# result of evaluating symbol three
lisp_eval_should_be '(setq three 3)
three' \
'3
3' \
'setq global'
lisp_eval_should_be '(setq fst (lambda (a b) a))
(fst 9 8)' \
'(*lambda (a b) a)
9' \
'setq global tailable lambda'
lisp_eval_should_be '(setq a (quote (1 2 3)))
(setq b (quote (4 5)))
(nconc a b)
a
b' '(1 2 3)
(4 5)
(1 2 3 4 5)
(1 2 3 4 5)
(4 5)' 'nconc'
# the macro function returns the name of the macro; that's what the q
# in the output is
lisp_eval_should_be '(macro q (lambda (x) (list (quote quote) (car x))))
(q foo)' \
'q
foo' 'macro'
lisp_eval_should_be '(quote (1 2 3))' '(1 2 3)' 'quote double-check'
lisp_eval_should_be \''(1 2 3)' '(1 2 3)' 'reader syntax: apostrophe short for quote'
lisp_eval_should_be '(quasiquote (1 (unquote (+ 2 3)) 4))' '(1 5 4)' 'quasiquote with words'
lisp_eval_should_be '`(1 ,(+ 2 3) 4)' '(1 5 4)' 'quasiquote with reader syntax'
lisp_eval_should_be '(+ 1 2 3)' '6' 'multiarg +'
lisp_eval_should_be '(* 2 3 5)' '30' 'multiarg *'
lisp_eval_should_be '(/ 3 5)' '0.6' '/'
lisp_eval_should_be '(// 6 5)' '1' 'quotient'
lisp_eval_should_be '(% 6 5)' '1' 'modulo'
lisp_eval_should_be '(** 3 4)' '81' 'power'
lisp_eval_should_be '(atan2 0 -1)' '3.14159' 'atan2'
lisp_eval_should_be '(sin 0)' '0' 'sin'
lisp_eval_should_be '(cos 0)' '1' 'cos'
lisp_eval_should_be '(sqrt 9)' '3' 'sqrt'
lisp_eval_should_be '(tolower "Title Case")' '"title case"' 'tolower'
lisp_eval_should_be '(toupper "Title Case")' '"TITLE CASE"' 'toupper'
lisp_eval_should_be '(substr "Foo" 2)' '"oo"' 'substr 2'
lisp_eval_should_be '(substr "Foo" 1 2)' '"Fo"' 'substr 3'
lisp_eval_should_be '(list-length '\''(1 2 3 4 5))' '5' 'list-length'
lisp_eval_should_be '(string-length "1234567890")' '10' 'string-length'
lisp_eval_should_be '(split "a b c d e" " ")' '("a" "b" "c" "d" "e")' 'split'
lisp_eval_should_be '(sprintf "foo %d bar %d baz %s" 3 5 "bletch")' \
'"foo 3 bar 5 baz bletch"' 'sprintf'
lisp_eval_should_be '(strcat "foo" "bar" "baz")' '"foobarbaz"' 'strcat'
lisp_eval_should_be '(sprintf "%03d%%03d%s" 5 "foo")' \
'"005%03dfoo"' 'sprintf % escape'
lisp_eval_should_be '(sub "o" "e" "foo quux blotch")' \
'"feo quux blotch"' 'sub'
lisp_eval_should_be '(gsub "o" "e" "foo quux blotch")' \
'"fee quux bletch"' 'gsub'
lisp_eval_should_be '(with-ors "" (print "foo"))' \
'"foo"()' 'with-ors'
lisp_eval_should_be '(printf "%03d%%03d%s" 5 "foo")' \
'005%03dfoo()' 'printf'
lisp_eval_should_be '(with-output-to ">>" "/dev/null" (printf "%03d%%03d%s" 5 "foo"))' \
'()' 'with-output-to'
lisp_eval_should_be '(let ((seconds '\''(4 5 6))) `(1 2 3 ,@(mapcar (lambda (x) (+ 2 x)) seconds) 1 ,(+ 5 7) 3))' '(1 2 3 6 7 8 1 12 3)' 'quasiquote with unquote and unquote-splicing'
f=$(mktemp)
lisp_eval_should_be "(progn (with-output-to \">\" \"${f}\" (print \"foo\") (print 3) (fflush)) (close \"${f}\"))" '()' 'with-output-to print close'
lisp_eval_should_be "(with-input-from \"<\" \"${f}\" (print (getline)) (print (getline)))" '("\"foo\"" 1)
("3" 1)
()' 'with-input-from getline'
# a double-quoted string, with a single quote, the word foo, and a single quote
lisp_eval_should_be '(shellquote "foo")' '"'\''foo'\''"' 'shellquote, trivial'
lisp_eval_should_be '(shellquote "foo'\''s")' '"'\''foo'\'\\\\\'\''s'\''"' 'shellquote, single single quote'
lisp_eval_should_be '(shellquote "c d")' '"'\''c d'\''"' 'shellquote, space'
lisp_eval_should_be '(shellquote "$foo")' '"'\''$foo'\''"' 'shellquote, dollarsign'
lisp_eval_should_be '(shellquote "a\nb")' \"\'a\\nb\'\" 'shellquote, newline'
lisp_eval_should_be '(unsafe-system "echo hi; echo ho")' 'hi
ho
0' 'unsafe-system vulnerable to command injection'
lisp_eval_should_be '(system "echo" "hi;" "echo" "ho")' 'hi; echo ho
0' 'system properly escapes arguments'
lisp_eval_should_be '(let ((a '\''(1 2 3))) (apply + 6 a))' '12' 'apply'
lisp_eval_should_be '(reduce only2+ 1)' '1' 'reduce with atom does not call f'
lisp_eval_should_be '(reduce only2+ '\''(1))' '1' 'reduce without enough in list does not call f'
lisp_eval_should_be '(reduce only2+ '\''(1 2))' '3' 'reduce with enough items calls f'
lisp_eval_should_be '`()' '()' 'quasiquote nil'
lisp_eval_should_be '`foo' '()' 'quasiquoting atom makes error'
lisp_eval_should_be '`(1)' '(1)' 'quasiquote single item list'
lisp_eval_should_be '`(foo (bar) baz)' '(foo (bar) baz)' 'quasiquote with list inside'
lisp_eval_should_be '`(foo (bar ,(+ 1 2)) baz)' '(foo (bar 3) baz)' 'quasiquote with unquote inside list'
lisp_eval_should_be '(let ((xs '\''(1 2))) `(foo ,@xs baz))' \
'(foo 1 2 baz)' 'quasiquote splicing unquote'
lisp_eval_should_be '(let ((xs '\''(1 2))) `(foo (bar ,@xs bletch) baz))' \
'(foo (bar 1 2 bletch) baz)' \
'quasiquote splicing unquote inside list'
lisp_eval_should_be '(let* () 5)' '5' 'let* with nothing'
lisp_eval_should_be '(let* ((x 1)) x)' '1' 'let* with one thing, not special'
lisp_eval_should_be '(let* ((x 1) (y (+ 1 x))) y)' '2' 'let* with two things where order matters'
lisp_eval_should_be '(prog1 5 (print "foo"))' '"foo"
5' 'prog1'
lisp_eval_should_be '(let ((foo '\''bar) (baz 3)) (list (symbolp '\''a) (symbolp foo) (symbolp 3) (symbolp baz) (symbolp "baz")))' '(true true false false false)' 'symbolp'
lisp_eval_should_be '(progn (and (setq fnord 42) false (setq fnord 86)) fnord)' '42' 'and macro short circuit'
lisp_eval_should_be '(progn (or (setq fnord 42) false (setq fnord 86)) fnord)' '42' 'or macro short circuit'
lisp_eval_should_be '(and true true true true false)' 'false' 'and macro logical result'
lisp_eval_should_be '(and true true true true true 42)' 'true' 'and macro returns true when all truthy'
lisp_eval_should_be '(and true nil true (print "fnord") true true)' 'false' 'and macro returns false for first falsy result'
lisp_eval_should_be '(or false false false 42 false)' '42' 'or macro returns first non-false'
lisp_eval_should_be '(progn (setenv "FNORD" "blat") (getenv "FNORD"))' '"blat"' 'setenv'
export FNORD=zart
lisp_eval_should_be '(getenv "FNORD")' '"zart"' 'getenv'
unset FNORD
lisp_eval_should_be '(as-number "42")' '42' 'as-number'
lisp_eval_should_be '(as-number "xlerb")' '()' 'as-number not number makes error'
lisp_eval_should_be '(as-number true)' '()' 'as-number not string makes error'
# woo, tricky quoting inside this very script, before it gets to glotawk
lisp_eval_should_be_tricky_tricky 'KHN0cmluZy1sZW5ndGggIi5cYS5cYi5cZi5cbi5cci5cdC5cdi5cXC5cIi4iKQ==' 'MTkK' 'string read backslash escapes'
#lisp_eval_should_be '(mapcar (lambda (x) (substr ".\a.\b.\f.\n.\r.\t.\v.\\.\"." x 1)) '\''(2 4 6 8 10 12 14 16 18))' '("\a" "\b" "\f" "\n" "\r" "\t" "\v" "\\" "\"")'
lisp_eval_should_be_tricky_tricky 'KG1hcGNhciAobGFtYmRhICh4KSAoc3Vic3RyICIuXGEuXGIuXGYuXG4uXHIuXHQuXHYuXFwuXCIu
IiB4IDEpKSAocXVvdGUgKDIgNCA2IDggMTAgMTIgMTQgMTYgMTgpKSk=' \
'KCJcYSIgIlxiIiAiXGYiICJcbiIgIlxyIiAiXHQiICJcdiIgIlxcIiAiXCIiKQo=' \
'printing backslash escapes'
#lisp_eval_should_be '"\\.\\\\.\\\\\\\\.\n"' '"\\.\\\\.\\\\\\\\.\n"
# ' 'backslash-escaped backslashes'
lisp_eval_should_be_tricky_tricky 'IlxcLlxcXFwuXFxcXFxcXFwuXG4i' 'IlxcLlxcXFwuXFxcXFxcXFwuXG4iCg==' 'backslash-escaped backslashes'
#lisp_eval_should_be '(string-length "\\.\\\\.\\\\\\\\.\n")' '11' 'backslash-escaped backslashes 2'
lisp_eval_should_be_tricky_tricky 'KHN0cmluZy1sZW5ndGggIlxcLlxcXFwuXFxcXFxcXFwuXG4iKQ==' 'MTEK' 'backslash-escaped backslashes 2'
tap_end