causa-arcana-misc/lesson-lisp
1
0
Fork 0
Code Activity

Test with new funcs "assert-*"

Browse source
This commit is contained in:
Alex Kotov 2023-05-06 23:13:35 +04:00
parent 555a3d17ac
commit 83369c0ac5
Signed by: kotovalexarian
GPG key ID: 553C0EBBEB5D5F08
20 changed files with 310 additions and 489 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

32
Makefile
View file

@ -18,33 +18,21 @@ OBJS = \
src/syntax.c.o \ src/syntax.c.o \
src/tokens.c.o src/tokens.c.o
TEST_OUTS = \
tests/arithm_ops.out \
tests/basic_data_structs.out \
tests/hello.out \
tests/arcana.out \
tests/equiv.out \
tests/logic_ops.out \
tests/syntax.out \
tests/type_conv.out \
tests/type_preds.out
repl: arcana-lisp repl: arcana-lisp
./arcana-lisp ./arcana-lisp
test: $(TEST_OUTS) test: arcana-lisp
$(DIFF_Q) tests/arithm_ops.txt tests/arithm_ops.out $(CAT) tests/arcana.scm | ./arcana-lisp
$(DIFF_Q) tests/basic_data_structs.txt tests/basic_data_structs.out $(CAT) tests/arithm_ops.scm | ./arcana-lisp
$(DIFF_Q) tests/hello.txt tests/hello.out $(CAT) tests/basic_data_structs.scm | ./arcana-lisp
$(DIFF_Q) tests/arcana.txt tests/arcana.out $(CAT) tests/equiv.scm | ./arcana-lisp
$(DIFF_Q) tests/equiv.txt tests/equiv.out $(CAT) tests/logic_ops.scm | ./arcana-lisp
$(DIFF_Q) tests/logic_ops.txt tests/logic_ops.out $(CAT) tests/syntax.scm | ./arcana-lisp
$(DIFF_Q) tests/syntax.txt tests/syntax.out $(CAT) tests/type_conv.scm | ./arcana-lisp
$(DIFF_Q) tests/type_conv.txt tests/type_conv.out $(CAT) tests/type_preds.scm | ./arcana-lisp
$(DIFF_Q) tests/type_preds.txt tests/type_preds.out
clean: clean:
$(RM_F) arcana-lisp $(OBJS) $(TEST_OUTS) $(RM_F) arcana-lisp $(OBJS)
arcana-lisp: $(OBJS) arcana-lisp: $(OBJS)
$(CC) -o $@ $^ $(CFLAGS) $(CC) -o $@ $^ $(CFLAGS)

39
src/builtins.c
View file

@ -11,6 +11,10 @@
#include <stdlib.h> #include <stdlib.h>
#include <string.h> #include <string.h>
// Assertions
static struct Object *func_assert_equal(size_t args_count, struct Object **args_array);
static struct Object *func_assert_false(size_t args_count, struct Object **args_array);
static struct Object *func_assert_true(size_t args_count, struct Object **args_array);
// Arcana Lisp internals // Arcana Lisp internals
static struct Object *func_arcana_SLASH_parse(size_t args_count, struct Object **args_array); static struct Object *func_arcana_SLASH_parse(size_t args_count, struct Object **args_array);
static struct Object *func_arcana_SLASH_tokenize(size_t args_count, struct Object **args_array); static struct Object *func_arcana_SLASH_tokenize(size_t args_count, struct Object **args_array);
@ -47,6 +51,10 @@ static struct Object *func_displayln(size_t args_count, struct Object **args_arr
static struct Object *func_newline(size_t args_count, struct Object **args_array); static struct Object *func_newline(size_t args_count, struct Object **args_array);
static struct Object builtins[] = { static struct Object builtins[] = {
// Assertions
{ .type = TYPE_PROCEDURE, .procedure = { "assert-equal", func_assert_equal } },
{ .type = TYPE_PROCEDURE, .procedure = { "assert-false", func_assert_false } },
{ .type = TYPE_PROCEDURE, .procedure = { "assert-true", func_assert_true } },
// Arcana Lisp internals // Arcana Lisp internals
{ .type = TYPE_PROCEDURE, .procedure = { "arcana/parse", func_arcana_SLASH_parse } }, { .type = TYPE_PROCEDURE, .procedure = { "arcana/parse", func_arcana_SLASH_parse } },
{ .type = TYPE_PROCEDURE, .procedure = { "arcana/tokenize", func_arcana_SLASH_tokenize } }, { .type = TYPE_PROCEDURE, .procedure = { "arcana/tokenize", func_arcana_SLASH_tokenize } },
@ -96,6 +104,37 @@ struct Object *builtins_get(const char *name)
return NULL; return NULL;
} }
/**************
* Assertions *
**************/
struct Object *func_assert_equal(
size_t args_count,
struct Object **args_array
) {
struct Object *const result = func_equal_QN(args_count, args_array);
if (!Object_is_true(result)) exit(EXIT_FAILURE);
return NULL;
}
struct Object *func_assert_false(
size_t args_count,
struct Object **args_array
) {
assert(args_count == 1);
if (!Object_is_false(args_array[0])) exit(EXIT_FAILURE);
return NULL;
}
struct Object *func_assert_true(
size_t args_count,
struct Object **args_array
) {
assert(args_count == 1);
if (!Object_is_true(args_array[0])) exit(EXIT_FAILURE);
return NULL;
}
/************************* /*************************
* Arcana Lisp internals * * Arcana Lisp internals *
*************************/ *************************/

58
tests/arcana.scm
View file

@ -1,6 +1,6 @@
(begin (begin
(displayln "--- TEST: arcana/parse -----------------------------------------") ;;; arcana/parse ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(displayln (assert-equal
(arcana/parse (arcana/parse
(list (list
(cons 'TOKEN_ROUND_OPEN "(") (cons 'TOKEN_ROUND_OPEN "(")
@ -10,22 +10,40 @@
(cons 'TOKEN_NUM "123") (cons 'TOKEN_NUM "123")
(cons 'TOKEN_NUM "456") (cons 'TOKEN_NUM "456")
(cons 'TOKEN_ROUND_CLOSE ")") (cons 'TOKEN_ROUND_CLOSE ")")
(cons 'TOKEN_ROUND_CLOSE ")")))) (cons 'TOKEN_ROUND_CLOSE ")")))
(newline) '(displayln (+ 123 456)))
(displayln "--- TEST: arcana/tokenize --------------------------------------")
(displayln (arcana/tokenize "(")) ;;; arcana/tokenize ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(displayln (arcana/tokenize "#false")) (assert-equal
;(displayln (arcana/tokenize "\"\"")) (arcana/tokenize "(")
;(displayln (arcana/tokenize "\"qwe\"")) (list (cons 'TOKEN_ROUND_OPEN "(")))
(displayln (arcana/tokenize "(displayln (list 1))")) (assert-equal
(newline) (arcana/tokenize "#false")
(displayln "--- TEST: arcana/typeof ----------------------------------------") (list (cons 'TOKEN_TAG "false")))
(displayln (arcana/typeof '())) ;(assert-equal
(displayln (arcana/typeof +)) ; (arcana/tokenize "\"\"")
(displayln (arcana/typeof (cons 123 456))) ; (list (cons 'TOKEN_STRING "\"\"")))
(displayln (arcana/typeof #false)) ;(assert-equal
;(displayln (arcana/typeof #\n)) ; (arcana/tokenize "\"qwe\"")
(displayln (arcana/typeof 'foo)) ; (list (cons 'TOKEN_STRING "\"qwe\"")))
(displayln (arcana/typeof "foo")) (assert-equal
(displayln (arcana/typeof 123)) (arcana/tokenize "(displayln (list 1))")
(list
(cons 'TOKEN_ROUND_OPEN "(")
(cons 'TOKEN_IDENT "displayln")
(cons 'TOKEN_ROUND_OPEN "(")
(cons 'TOKEN_IDENT "list")
(cons 'TOKEN_NUM "1")
(cons 'TOKEN_ROUND_CLOSE ")")
(cons 'TOKEN_ROUND_CLOSE ")")))
;;; arcana/typeof ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-equal 'null (arcana/typeof '()))
(assert-equal 'procedure (arcana/typeof +))
(assert-equal 'pair (arcana/typeof (cons 123 456)))
(assert-equal 'boolean (arcana/typeof #false))
;(assert-equal 'char (arcana/typeof #\n))
(assert-equal 'symbol (arcana/typeof 'foo))
(assert-equal 'string (arcana/typeof "foo"))
(assert-equal 'number (arcana/typeof 123))
) )

16
tests/arcana.txt
View file

@ -1,16 +0,0 @@
"--- TEST: arcana/parse -----------------------------------------"
(displayln (+ 123 456))
"--- TEST: arcana/tokenize --------------------------------------"
((TOKEN_ROUND_OPEN . "("))
((TOKEN_TAG . "false"))
((TOKEN_ROUND_OPEN . "(") (TOKEN_IDENT . "displayln") (TOKEN_ROUND_OPEN . "(") (TOKEN_IDENT . "list") (TOKEN_NUM . "1") (TOKEN_ROUND_CLOSE . ")") (TOKEN_ROUND_CLOSE . ")"))
"--- TEST: arcana/typeof ----------------------------------------"
null
procedure
pair
boolean
symbol
string
number

56
tests/arithm_ops.scm
View file

@ -1,30 +1,30 @@
(begin (begin
(displayln "--- TEST: = ----------------------------------------------------") ;;; = ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(displayln(= 123)) (assert-equal #true (= 123))
(displayln(= 123 123)) (assert-equal #true (= 123 123))
(displayln(= 123 456)) (assert-equal #false (= 123 456))
(displayln(= 123 123 123)) (assert-equal #true (= 123 123 123))
(displayln(= 456 123 123)) (assert-equal #false (= 456 123 123))
(displayln(= 123 456 123)) (assert-equal #false (= 123 456 123))
(displayln(= 123 123 456)) (assert-equal #false (= 123 123 456))
(displayln(= 123 123 123 123)) (assert-equal #true (= 123 123 123 123))
(displayln(= 456 123 123 123)) (assert-equal #false (= 456 123 123 123))
(displayln(= 123 456 123 123)) (assert-equal #false (= 123 456 123 123))
(displayln(= 123 123 456 123)) (assert-equal #false (= 123 123 456 123))
(displayln(= 123 123 123 456)) (assert-equal #false (= 123 123 123 456))
(newline)
(displayln "--- TEST: + ----------------------------------------------------") ;;; + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(displayln (+)) (assert-equal 0 (+))
(displayln (+ 123)) (assert-equal 123 (+ 123))
(displayln (+ 1 10)) (assert-equal 11 (+ 1 10))
(displayln (+ 1 10 100)) (assert-equal 111 (+ 1 10 100))
(displayln (+ 1 10 100 1000)) (assert-equal 1111 (+ 1 10 100 1000))
(newline)
(displayln "--- TEST: - ----------------------------------------------------") ;;; - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(displayln (- 0)) (assert-equal 0 (- 0))
(displayln (- 123)) ;(assert-equal -123 (- 123))
(displayln (- 100 1)) (assert-equal 99 (- 100 1))
(displayln (- 100 1 2)) (assert-equal 97 (- 100 1 2))
(displayln (- 100 1 2 3)) (assert-equal 94 (- 100 1 2 3))
(displayln (- 100 1 2 3 4)) (assert-equal 90 (- 100 1 2 3 4))
) )

28
tests/arithm_ops.txt
View file

@ -1,28 +0,0 @@
"--- TEST: = ----------------------------------------------------"
#true
#true
#false
#true
#false
#false
#false
#true
#false
#false
#false
#false
"--- TEST: + ----------------------------------------------------"
0
123
11
111
1111
"--- TEST: - ----------------------------------------------------"
0
123
99
97
94
90

20
tests/basic_data_structs.scm
View file

@ -1,12 +1,12 @@
(begin (begin
(displayln "--- TEST: car --------------------------------------------------") ;;; car ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(displayln (car (cons 123 456))) (assert-equal 123 (car (cons 123 456)))
(newline)
(displayln "--- TEST: cdr --------------------------------------------------") ;;; cdr ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(displayln (cdr (cons 123 456))) (assert-equal 456 (cdr (cons 123 456)))
(newline)
(displayln "--- TEST: list -------------------------------------------------") ;;; list ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(displayln (list)) (assert-equal '() (list))
(displayln (list 123)) (assert-equal '(123) (list 123))
(displayln (list 123 456)) (assert-equal '(123 456) (list 123 456))
) )

10
tests/basic_data_structs.txt
View file

@ -1,10 +0,0 @@
"--- TEST: car --------------------------------------------------"
123
"--- TEST: cdr --------------------------------------------------"
456
"--- TEST: list -------------------------------------------------"
()
(123)
(123 456)

94
tests/equiv.scm
View file

@ -1,55 +1,55 @@
(begin (begin
(displayln "--- TEST: equal? -----------------------------------------------") ;;; equal? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; No args ; No args
(displayln (equal?)) (assert-true (equal?))
; A single arg ; A single arg
(displayln (equal? '())) (assert-true (equal? '()))
(displayln (equal? +)) (assert-true (equal? +))
(displayln (equal? (cons 123 456))) (assert-true (equal? (cons 123 456)))
(displayln (equal? #false)) (assert-true (equal? #false))
(displayln (equal? #true)) (assert-true (equal? #true))
;(displayln (equal? #\n)) ;(assert-true (equal? #\n))
(displayln (equal? 'foo)) (assert-true (equal? 'foo))
(displayln (equal? "foo")) (assert-true (equal? "foo"))
(displayln (equal? 123)) (assert-true (equal? 123))
; Two equal args ; Two equal args
(displayln (equal? '() '())) (assert-true (equal? '() '()))
(displayln (equal? + +)) (assert-true (equal? + +))
(displayln (equal? (cons 123 456) (cons 123 456))) (assert-true (equal? (cons 123 456) (cons 123 456)))
(displayln (equal? #false #false)) (assert-true (equal? #false #false))
(displayln (equal? #true #true)) (assert-true (equal? #true #true))
;(displayln (equal? #\n #\n)) ;(assert-true (equal? #\n #\n))
(displayln (equal? 'foo 'foo)) (assert-true (equal? 'foo 'foo))
(displayln (equal? "foo" "foo")) (assert-true (equal? "foo" "foo"))
(displayln (equal? 123 123)) (assert-true (equal? 123 123))
; Two different args ; Two different args
(displayln (equal? '() '(1))) (assert-false (equal? '() '(1)))
(displayln (equal? + -)) (assert-false (equal? + -))
(displayln (equal? (cons 123 456) (cons 123 789))) (assert-false (equal? (cons 123 456) (cons 123 789)))
(displayln (equal? #false #true)) (assert-false (equal? #false #true))
(displayln (equal? #true #false)) (assert-false (equal? #true #false))
;(displayln (equal? #\n #\t)) ;(assert-false (equal? #\n #\t))
(displayln (equal? 'foo 'bar)) (assert-false (equal? 'foo 'bar))
(displayln (equal? "foo" "bar")) (assert-false (equal? "foo" "bar"))
(displayln (equal? 123 789)) (assert-false (equal? 123 789))
; Three equal args ; Three equal args
(displayln (equal? '() '() '())) (assert-true (equal? '() '() '()))
(displayln (equal? + + +)) (assert-true (equal? + + +))
(displayln (equal? (cons 123 456) (cons 123 456) (cons 123 456))) (assert-true (equal? (cons 123 456) (cons 123 456) (cons 123 456)))
(displayln (equal? #false #false #false)) (assert-true (equal? #false #false #false))
(displayln (equal? #true #true #true)) (assert-true (equal? #true #true #true))
;(displayln (equal? #\n #\n #\n)) ;(assert-true (equal? #\n #\n #\n))
(displayln (equal? 'foo 'foo 'foo)) (assert-true (equal? 'foo 'foo 'foo))
(displayln (equal? "foo" "foo" "foo")) (assert-true (equal? "foo" "foo" "foo"))
(displayln (equal? 123 123 123)) (assert-true (equal? 123 123 123))
; Three different args ; Three different args
(displayln (equal? '() '() '(1))) (assert-false (equal? '() '() '(1)))
(displayln (equal? + + -)) (assert-false (equal? + + -))
(displayln (equal? (cons 123 456) (cons 123 456) (cons 123 789))) (assert-false (equal? (cons 123 456) (cons 123 456) (cons 123 789)))
(displayln (equal? #false #false #true)) (assert-false (equal? #false #false #true))
(displayln (equal? #true #true #false)) (assert-false (equal? #true #true #false))
;(displayln (equal? #\n #\n #\t)) ;(assert-false (equal? #\n #\n #\t))
(displayln (equal? 'foo 'foo 'bar)) (assert-false (equal? 'foo 'foo 'bar))
(displayln (equal? "foo" "foo" "bar")) (assert-false (equal? "foo" "foo" "bar"))
(displayln (equal? 123 123 789)) (assert-false (equal? 123 123 789))
) )

42
tests/equiv.txt
View file

@ -1,42 +0,0 @@
"--- TEST: equal? -----------------------------------------------"
#true
#true
#true
#true
#true
#true
#true
#true
#true
#true
#true
#true
#true
#true
#true
#true
#true
#false
#false
#false
#false
#false
#false
#false
#false
#true
#true
#true
#true
#true
#true
#true
#true
#false
#false
#false
#false
#false
#false
#false
#false

1
tests/hello.scm
View file

@ -1 +0,0 @@
(displayln "Hello, World!")

1
tests/hello.txt
View file

@ -1 +0,0 @@
"Hello, World!"

18
tests/logic_ops.scm
View file

@ -1,11 +1,11 @@
(begin (begin
(displayln "--- TEST: not --------------------------------------------------") ;; not ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(displayln (not '())) (assert-false (not '()))
(displayln (not #true)) (assert-false (not #true))
(displayln (not #false)) (assert-true (not #false))
;(displayln (not #\n)) ;(assert-false (not #\n))
(displayln (not 'foo)) (assert-false (not 'foo))
(displayln (not "foo")) (assert-false (not "foo"))
(displayln (not 123)) (assert-false (not 123))
(displayln (not (cons 123 456))) (assert-false (not (cons 123 456)))
) )

8
tests/logic_ops.txt
View file

@ -1,8 +0,0 @@
"--- TEST: not --------------------------------------------------"
#false
#false
#true
#false
#false
#false
#false

60
tests/syntax.scm
View file

@ -1,32 +1,32 @@
(begin (begin
(displayln "--- TEST: begin ------------------------------------------------") ;;; begin ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(displayln (begin)) (assert-equal '() (begin))
(displayln (begin 123)) (assert-equal 123 (begin 123))
(displayln (begin 123 456)) (assert-equal 456 (begin 123 456))
(displayln (begin 123 456 789)) (assert-equal 789 (begin 123 456 789))
(newline)
(displayln "--- TEST: if ---------------------------------------------------") ;;; if;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(displayln (if #true 123 456)) (assert-equal 123 (if #true 123 456))
(displayln (if "foo" 123 456)) (assert-equal 123 (if "foo" 123 456))
(displayln (if #false 123 456)) (assert-equal 456 (if #false 123 456))
(newline)
(displayln "--- TEST: quote ------------------------------------------------") ;;; quote;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(displayln (quote +)) (assert-equal '+ (quote +))
(displayln '+) (assert-equal '+ '+)
(displayln (quote ())) (assert-equal '() (quote ()))
(displayln '()) (assert-equal '() '())
(displayln (quote #true)) (assert-equal #true (quote #true))
(displayln '#true) (assert-equal #true '#true)
(displayln (quote #false)) (assert-equal #false (quote #false))
(displayln '#false) (assert-equal #false '#false)
;(displayln (quote #\n)) ;(assert-equal #\n (quote #\n))
;(displayln '#\n) ;(assert-equal #\n '#\n)
(displayln (quote foo)) (assert-equal 'foo (quote foo))
(displayln 'foo) (assert-equal 'foo 'foo)
(displayln (quote "foo")) (assert-equal "foo" (quote "foo"))
(displayln '"foo") (assert-equal "foo" '"foo")
(displayln (quote 123)) (assert-equal 123 (quote 123))
(displayln '123) (assert-equal 123 '123)
(displayln (quote (cons 123 456))) (assert-equal '(cons 123 456) (quote (cons 123 456)))
(displayln '(cons 123 456)) (assert-equal '(cons 123 456) '(cons 123 456))
) )

28
tests/syntax.txt
View file

@ -1,28 +0,0 @@
"--- TEST: begin ------------------------------------------------"
()
123
456
789
"--- TEST: if ---------------------------------------------------"
123
123
456
"--- TEST: quote ------------------------------------------------"
+
+
()
()
#true
#true
#false
#false
foo
foo
"foo"
"foo"
123
123
(cons 123 456)
(cons 123 456)

24
tests/type_conv.scm
View file

@ -1,14 +1,14 @@
(begin (begin
(displayln "--- TEST: number->string ---------------------------------------") ;;; number->string ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(displayln (number->string 123)) (assert-equal "123" (number->string 123))
;(displayln (number->string -123)) ;(assert-equal "-123" (number->string -123))
(displayln (number->string 123456 16)) (assert-equal "1e240" (number->string 123456 16))
(newline)
(displayln "--- TEST: string->symbol ---------------------------------------") ;;; string->symbol ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(displayln (string->symbol "")) ;(assert-equal '|| (string->symbol ""))
(displayln (string->symbol " ")) ;(assert-equal '| | (string->symbol " "))
(displayln (string->symbol "foo")) (assert-equal 'foo (string->symbol "foo"))
(newline)
(displayln "--- TEST: symbol->string ---------------------------------------") ;;; symbol->string ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(displayln (symbol->string 'foo)) (assert-equal "foo" (symbol->string 'foo))
) )

11
tests/type_conv.txt
View file

@ -1,11 +0,0 @@
"--- TEST: number->string ---------------------------------------"
"123"
"1e240"
"--- TEST: string->symbol ---------------------------------------"
foo
"--- TEST: symbol->string ---------------------------------------"
"foo"

174
tests/type_preds.scm
View file

@ -1,89 +1,89 @@
(begin (begin
(displayln "--- TEST: boolean? ---------------------------------------------") ;;; boolean? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(displayln (boolean? +)) (assert-false (boolean? +))
(displayln (boolean? '())) (assert-false (boolean? '()))
(displayln (boolean? #true)) (assert-true (boolean? #true))
(displayln (boolean? #false)) (assert-true (boolean? #false))
;(displayln (boolean? #\n)) ;(assert-false (boolean? #\n))
(displayln (boolean? 'foo)) (assert-false (boolean? 'foo))
(displayln (boolean? "foo")) (assert-false (boolean? "foo"))
(displayln (boolean? 123)) (assert-false (boolean? 123))
(displayln (boolean? (cons 123 456))) (assert-false (boolean? (cons 123 456)))
(newline)
(displayln "--- TEST: char? ------------------------------------------------") ;;; char? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(displayln (char? +)) (assert-false (char? +))
(displayln (char? '())) (assert-false (char? '()))
(displayln (char? #true)) (assert-false (char? #true))
(displayln (char? #false)) (assert-false (char? #false))
;(displayln (char? #\n)) ;(assert-true (char? #\n))
(displayln (char? 'foo)) (assert-false (char? 'foo))
(displayln (char? "foo")) (assert-false (char? "foo"))
(displayln (char? 123)) (assert-false (char? 123))
(displayln (char? (cons 123 456))) (assert-false (char? (cons 123 456)))
(newline)
(displayln "--- TEST: null? ------------------------------------------------") ;;; null? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(displayln (null? +)) (assert-false (null? +))
(displayln (null? '())) (assert-true (null? '()))
(displayln (null? #true)) (assert-false (null? #true))
(displayln (null? #false)) (assert-false (null? #false))
;(displayln (null? #\n)) ;(assert-false (null? #\n))
(displayln (null? 'foo)) (assert-false (null? 'foo))
(displayln (null? "foo")) (assert-false (null? "foo"))
(displayln (null? 123)) (assert-false (null? 123))
(displayln (null? (cons 123 456))) (assert-false (null? (cons 123 456)))
(newline)
(displayln "--- TEST: number? ----------------------------------------------") ;;; number? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(displayln (number? +)) (assert-false (number? +))
(displayln (number? '())) (assert-false (number? '()))
(displayln (number? #true)) (assert-false (number? #true))
(displayln (number? #false)) (assert-false (number? #false))
;(displayln (number? #\n)) ;(assert-false (number? #\n))
(displayln (number? 'foo)) (assert-false (number? 'foo))
(displayln (number? "foo")) (assert-false (number? "foo"))
(displayln (number? 123)) (assert-true (number? 123))
(displayln (number? (cons 123 456))) (assert-false (number? (cons 123 456)))
(newline)
(displayln "--- TEST: pair? ------------------------------------------------") ;;; pair? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(displayln (pair? +)) (assert-false (pair? +))
(displayln (pair? '())) (assert-false (pair? '()))
(displayln (pair? #true)) (assert-false (pair? #true))
(displayln (pair? #false)) (assert-false (pair? #false))
;(displayln (pair? #\n)) ;(assert-false (pair? #\n))
(displayln (pair? 'foo)) (assert-false (pair? 'foo))
(displayln (pair? "foo")) (assert-false (pair? "foo"))
(displayln (pair? 123)) (assert-false (pair? 123))
(displayln (pair? (cons 123 456))) (assert-true (pair? (cons 123 456)))
(newline)
(displayln "--- TEST: procedure? -------------------------------------------") ;;; procedure? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(displayln (procedure? +)) (assert-true (procedure? +))
(displayln (procedure? '())) (assert-false (procedure? '()))
(displayln (procedure? #true)) (assert-false (procedure? #true))
(displayln (procedure? #false)) (assert-false (procedure? #false))
;(displayln (procedure? #\n)) ;(assert-false (procedure? #\n))
(displayln (procedure? 'foo)) (assert-false (procedure? 'foo))
(displayln (procedure? "foo")) (assert-false (procedure? "foo"))
(displayln (procedure? 123)) (assert-false (procedure? 123))
(displayln (procedure? (cons 123 456))) (assert-false (procedure? (cons 123 456)))
(newline)
(displayln "--- TEST: string? ----------------------------------------------") ;;; string? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(displayln (string? +)) (assert-false (string? +))
(displayln (string? '())) (assert-false (string? '()))
(displayln (string? #true)) (assert-false (string? #true))
(displayln (string? #false)) (assert-false (string? #false))
;(displayln (string? #\n)) ;(assert-false (string? #\n))
(displayln (string? 'foo)) (assert-false (string? 'foo))
(displayln (string? "foo")) (assert-true (string? "foo"))
(displayln (string? 123)) (assert-false (string? 123))
(displayln (string? (cons 123 456))) (assert-false (string? (cons 123 456)))
(newline)
(displayln "--- TEST: symbol? ----------------------------------------------") ;;; symbol? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(displayln (symbol? +)) (assert-false (symbol? +))
(displayln (symbol? '())) (assert-false (symbol? '()))
(displayln (symbol? #true)) (assert-false (symbol? #true))
(displayln (symbol? #false)) (assert-false (symbol? #false))
;(displayln (symbol? #\n)) ;(assert-false (symbol? #\n))
(displayln (symbol? 'foo)) (assert-true (symbol? 'foo))
(displayln (symbol? "foo")) (assert-false (symbol? "foo"))
(displayln (symbol? 123)) (assert-false (symbol? 123))
(displayln (symbol? (cons 123 456))) (assert-false (symbol? (cons 123 456)))
) )

79
tests/type_preds.txt
View file

@ -1,79 +0,0 @@
"--- TEST: boolean? ---------------------------------------------"
#false
#false
#true
#true
#false
#false
#false
#false
"--- TEST: char? ------------------------------------------------"
#false
#false
#false
#false
#false
#false
#false
#false
"--- TEST: null? ------------------------------------------------"
#false
#true
#false
#false
#false
#false
#false
#false
"--- TEST: number? ----------------------------------------------"
#false
#false
#false
#false
#false
#false
#true
#false
"--- TEST: pair? ------------------------------------------------"
#false
#false
#false
#false
#false
#false
#false
#true
"--- TEST: procedure? -------------------------------------------"
#true
#false
#false
#false
#false
#false
#false
#false
"--- TEST: string? ----------------------------------------------"
#false
#false
#false
#false
#false
#true
#false
#false
"--- TEST: symbol? ----------------------------------------------"
#false
#false
#false
#false
#true
#false
#false
#false