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

Test with new funcs "assert-*"

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/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
./arcana-lisp
test: $(TEST_OUTS)
$(DIFF_Q) tests/arithm_ops.txt tests/arithm_ops.out
$(DIFF_Q) tests/basic_data_structs.txt tests/basic_data_structs.out
$(DIFF_Q) tests/hello.txt tests/hello.out
$(DIFF_Q) tests/arcana.txt tests/arcana.out
$(DIFF_Q) tests/equiv.txt tests/equiv.out
$(DIFF_Q) tests/logic_ops.txt tests/logic_ops.out
$(DIFF_Q) tests/syntax.txt tests/syntax.out
$(DIFF_Q) tests/type_conv.txt tests/type_conv.out
$(DIFF_Q) tests/type_preds.txt tests/type_preds.out
test: arcana-lisp
$(CAT) tests/arcana.scm | ./arcana-lisp
$(CAT) tests/arithm_ops.scm | ./arcana-lisp
$(CAT) tests/basic_data_structs.scm | ./arcana-lisp
$(CAT) tests/equiv.scm | ./arcana-lisp
$(CAT) tests/logic_ops.scm | ./arcana-lisp
$(CAT) tests/syntax.scm | ./arcana-lisp
$(CAT) tests/type_conv.scm | ./arcana-lisp
$(CAT) tests/type_preds.scm | ./arcana-lisp
clean:
$(RM_F) arcana-lisp $(OBJS) $(TEST_OUTS)
$(RM_F) arcana-lisp $(OBJS)
arcana-lisp: $(OBJS)
$(CC) -o $@ $^ $(CFLAGS)

39
src/builtins.c
View File

@ -11,6 +11,10 @@
#include <stdlib.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
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);
@ -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 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
{ .type = TYPE_PROCEDURE, .procedure = { "arcana/parse", func_arcana_SLASH_parse } },
{ .type = TYPE_PROCEDURE, .procedure = { "arcana/tokenize", func_arcana_SLASH_tokenize } },
@ -96,6 +104,37 @@ struct Object *builtins_get(const char *name)
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 *
*************************/

58
tests/arcana.scm
View File

@ -1,6 +1,6 @@
(begin
(displayln "--- TEST: arcana/parse -----------------------------------------")
(displayln
;;; arcana/parse ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-equal
(arcana/parse
(list
(cons 'TOKEN_ROUND_OPEN "(")
@ -10,22 +10,40 @@
(cons 'TOKEN_NUM "123")
(cons 'TOKEN_NUM "456")
(cons 'TOKEN_ROUND_CLOSE ")")
(cons 'TOKEN_ROUND_CLOSE ")"))))
(newline)
(displayln "--- TEST: arcana/tokenize --------------------------------------")
(displayln (arcana/tokenize "("))
(displayln (arcana/tokenize "#false"))
;(displayln (arcana/tokenize "\"\""))
;(displayln (arcana/tokenize "\"qwe\""))
(displayln (arcana/tokenize "(displayln (list 1))"))
(newline)
(displayln "--- TEST: arcana/typeof ----------------------------------------")
(displayln (arcana/typeof '()))
(displayln (arcana/typeof +))
(displayln (arcana/typeof (cons 123 456)))
(displayln (arcana/typeof #false))
;(displayln (arcana/typeof #\n))
(displayln (arcana/typeof 'foo))
(displayln (arcana/typeof "foo"))
(displayln (arcana/typeof 123))
(cons 'TOKEN_ROUND_CLOSE ")")))
'(displayln (+ 123 456)))
;;; arcana/tokenize ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-equal
(arcana/tokenize "(")
(list (cons 'TOKEN_ROUND_OPEN "(")))
(assert-equal
(arcana/tokenize "#false")
(list (cons 'TOKEN_TAG "false")))
;(assert-equal
; (arcana/tokenize "\"\"")
; (list (cons 'TOKEN_STRING "\"\"")))
;(assert-equal
; (arcana/tokenize "\"qwe\"")
; (list (cons 'TOKEN_STRING "\"qwe\"")))
(assert-equal
(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
(displayln "--- TEST: = ----------------------------------------------------")
(displayln(= 123))
(displayln(= 123 123))
(displayln(= 123 456))
(displayln(= 123 123 123))
(displayln(= 456 123 123))
(displayln(= 123 456 123))
(displayln(= 123 123 456))
(displayln(= 123 123 123 123))
(displayln(= 456 123 123 123))
(displayln(= 123 456 123 123))
(displayln(= 123 123 456 123))
(displayln(= 123 123 123 456))
(newline)
(displayln "--- TEST: + ----------------------------------------------------")
(displayln (+))
(displayln (+ 123))
(displayln (+ 1 10))
(displayln (+ 1 10 100))
(displayln (+ 1 10 100 1000))
(newline)
(displayln "--- TEST: - ----------------------------------------------------")
(displayln (- 0))
(displayln (- 123))
(displayln (- 100 1))
(displayln (- 100 1 2))
(displayln (- 100 1 2 3))
(displayln (- 100 1 2 3 4))
;;; = ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-equal #true (= 123))
(assert-equal #true (= 123 123))
(assert-equal #false (= 123 456))
(assert-equal #true (= 123 123 123))
(assert-equal #false (= 456 123 123))
(assert-equal #false (= 123 456 123))
(assert-equal #false (= 123 123 456))
(assert-equal #true (= 123 123 123 123))
(assert-equal #false (= 456 123 123 123))
(assert-equal #false (= 123 456 123 123))
(assert-equal #false (= 123 123 456 123))
(assert-equal #false (= 123 123 123 456))
;;; + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-equal 0 (+))
(assert-equal 123 (+ 123))
(assert-equal 11 (+ 1 10))
(assert-equal 111 (+ 1 10 100))
(assert-equal 1111 (+ 1 10 100 1000))
;;; - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-equal 0 (- 0))
;(assert-equal -123 (- 123))
(assert-equal 99 (- 100 1))
(assert-equal 97 (- 100 1 2))
(assert-equal 94 (- 100 1 2 3))
(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
(displayln "--- TEST: car --------------------------------------------------")
(displayln (car (cons 123 456)))
(newline)
(displayln "--- TEST: cdr --------------------------------------------------")
(displayln (cdr (cons 123 456)))
(newline)
(displayln "--- TEST: list -------------------------------------------------")
(displayln (list))
(displayln (list 123))
(displayln (list 123 456))
;;; car ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-equal 123 (car (cons 123 456)))
;;; cdr ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-equal 456 (cdr (cons 123 456)))
;;; list ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-equal '() (list))
(assert-equal '(123) (list 123))
(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
(displayln "--- TEST: equal? -----------------------------------------------")
;;; equal? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; No args
(displayln (equal?))
(assert-true (equal?))
; A single arg
(displayln (equal? '()))
(displayln (equal? +))
(displayln (equal? (cons 123 456)))
(displayln (equal? #false))
(displayln (equal? #true))
;(displayln (equal? #\n))
(displayln (equal? 'foo))
(displayln (equal? "foo"))
(displayln (equal? 123))
(assert-true (equal? '()))
(assert-true (equal? +))
(assert-true (equal? (cons 123 456)))
(assert-true (equal? #false))
(assert-true (equal? #true))
;(assert-true (equal? #\n))
(assert-true (equal? 'foo))
(assert-true (equal? "foo"))
(assert-true (equal? 123))
; Two equal args
(displayln (equal? '() '()))
(displayln (equal? + +))
(displayln (equal? (cons 123 456) (cons 123 456)))
(displayln (equal? #false #false))
(displayln (equal? #true #true))
;(displayln (equal? #\n #\n))
(displayln (equal? 'foo 'foo))
(displayln (equal? "foo" "foo"))
(displayln (equal? 123 123))
(assert-true (equal? '() '()))
(assert-true (equal? + +))
(assert-true (equal? (cons 123 456) (cons 123 456)))
(assert-true (equal? #false #false))
(assert-true (equal? #true #true))
;(assert-true (equal? #\n #\n))
(assert-true (equal? 'foo 'foo))
(assert-true (equal? "foo" "foo"))
(assert-true (equal? 123 123))
; Two different args
(displayln (equal? '() '(1)))
(displayln (equal? + -))
(displayln (equal? (cons 123 456) (cons 123 789)))
(displayln (equal? #false #true))
(displayln (equal? #true #false))
;(displayln (equal? #\n #\t))
(displayln (equal? 'foo 'bar))
(displayln (equal? "foo" "bar"))
(displayln (equal? 123 789))
(assert-false (equal? '() '(1)))
(assert-false (equal? + -))
(assert-false (equal? (cons 123 456) (cons 123 789)))
(assert-false (equal? #false #true))
(assert-false (equal? #true #false))
;(assert-false (equal? #\n #\t))
(assert-false (equal? 'foo 'bar))
(assert-false (equal? "foo" "bar"))
(assert-false (equal? 123 789))
; Three equal args
(displayln (equal? '() '() '()))
(displayln (equal? + + +))
(displayln (equal? (cons 123 456) (cons 123 456) (cons 123 456)))
(displayln (equal? #false #false #false))
(displayln (equal? #true #true #true))
;(displayln (equal? #\n #\n #\n))
(displayln (equal? 'foo 'foo 'foo))
(displayln (equal? "foo" "foo" "foo"))
(displayln (equal? 123 123 123))
(assert-true (equal? '() '() '()))
(assert-true (equal? + + +))
(assert-true (equal? (cons 123 456) (cons 123 456) (cons 123 456)))
(assert-true (equal? #false #false #false))
(assert-true (equal? #true #true #true))
;(assert-true (equal? #\n #\n #\n))
(assert-true (equal? 'foo 'foo 'foo))
(assert-true (equal? "foo" "foo" "foo"))
(assert-true (equal? 123 123 123))
; Three different args
(displayln (equal? '() '() '(1)))
(displayln (equal? + + -))
(displayln (equal? (cons 123 456) (cons 123 456) (cons 123 789)))
(displayln (equal? #false #false #true))
(displayln (equal? #true #true #false))
;(displayln (equal? #\n #\n #\t))
(displayln (equal? 'foo 'foo 'bar))
(displayln (equal? "foo" "foo" "bar"))
(displayln (equal? 123 123 789))
(assert-false (equal? '() '() '(1)))
(assert-false (equal? + + -))
(assert-false (equal? (cons 123 456) (cons 123 456) (cons 123 789)))
(assert-false (equal? #false #false #true))
(assert-false (equal? #true #true #false))
;(assert-false (equal? #\n #\n #\t))
(assert-false (equal? 'foo 'foo 'bar))
(assert-false (equal? "foo" "foo" "bar"))
(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
(displayln "--- TEST: not --------------------------------------------------")
(displayln (not '()))
(displayln (not #true))
(displayln (not #false))
;(displayln (not #\n))
(displayln (not 'foo))
(displayln (not "foo"))
(displayln (not 123))
(displayln (not (cons 123 456)))
;; not ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-false (not '()))
(assert-false (not #true))
(assert-true (not #false))
;(assert-false (not #\n))
(assert-false (not 'foo))
(assert-false (not "foo"))
(assert-false (not 123))
(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
(displayln "--- TEST: begin ------------------------------------------------")
(displayln (begin))
(displayln (begin 123))
(displayln (begin 123 456))
(displayln (begin 123 456 789))
(newline)
(displayln "--- TEST: if ---------------------------------------------------")
(displayln (if #true 123 456))
(displayln (if "foo" 123 456))
(displayln (if #false 123 456))
(newline)
(displayln "--- TEST: quote ------------------------------------------------")
(displayln (quote +))
(displayln '+)
(displayln (quote ()))
(displayln '())
(displayln (quote #true))
(displayln '#true)
(displayln (quote #false))
(displayln '#false)
;(displayln (quote #\n))
;(displayln '#\n)
(displayln (quote foo))
(displayln 'foo)
(displayln (quote "foo"))
(displayln '"foo")
(displayln (quote 123))
(displayln '123)
(displayln (quote (cons 123 456)))
(displayln '(cons 123 456))
;;; begin ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-equal '() (begin))
(assert-equal 123 (begin 123))
(assert-equal 456 (begin 123 456))
(assert-equal 789 (begin 123 456 789))
;;; if;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-equal 123 (if #true 123 456))
(assert-equal 123 (if "foo" 123 456))
(assert-equal 456 (if #false 123 456))
;;; quote;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-equal '+ (quote +))
(assert-equal '+ '+)
(assert-equal '() (quote ()))
(assert-equal '() '())
(assert-equal #true (quote #true))
(assert-equal #true '#true)
(assert-equal #false (quote #false))
(assert-equal #false '#false)
;(assert-equal #\n (quote #\n))
;(assert-equal #\n '#\n)
(assert-equal 'foo (quote foo))
(assert-equal 'foo 'foo)
(assert-equal "foo" (quote "foo"))
(assert-equal "foo" '"foo")
(assert-equal 123 (quote 123))
(assert-equal 123 '123)
(assert-equal '(cons 123 456) (quote (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
(displayln "--- TEST: number->string ---------------------------------------")
(displayln (number->string 123))
;(displayln (number->string -123))
(displayln (number->string 123456 16))
(newline)
(displayln "--- TEST: string->symbol ---------------------------------------")
(displayln (string->symbol ""))
(displayln (string->symbol " "))
(displayln (string->symbol "foo"))
(newline)
(displayln "--- TEST: symbol->string ---------------------------------------")
(displayln (symbol->string 'foo))
;;; number->string ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-equal "123" (number->string 123))
;(assert-equal "-123" (number->string -123))
(assert-equal "1e240" (number->string 123456 16))
;;; string->symbol ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;(assert-equal '|| (string->symbol ""))
;(assert-equal '| | (string->symbol " "))
(assert-equal 'foo (string->symbol "foo"))
;;; symbol->string ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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
(displayln "--- TEST: boolean? ---------------------------------------------")
(displayln (boolean? +))
(displayln (boolean? '()))
(displayln (boolean? #true))
(displayln (boolean? #false))
;(displayln (boolean? #\n))
(displayln (boolean? 'foo))
(displayln (boolean? "foo"))
(displayln (boolean? 123))
(displayln (boolean? (cons 123 456)))
(newline)
(displayln "--- TEST: char? ------------------------------------------------")
(displayln (char? +))
(displayln (char? '()))
(displayln (char? #true))
(displayln (char? #false))
;(displayln (char? #\n))
(displayln (char? 'foo))
(displayln (char? "foo"))
(displayln (char? 123))
(displayln (char? (cons 123 456)))
(newline)
(displayln "--- TEST: null? ------------------------------------------------")
(displayln (null? +))
(displayln (null? '()))
(displayln (null? #true))
(displayln (null? #false))
;(displayln (null? #\n))
(displayln (null? 'foo))
(displayln (null? "foo"))
(displayln (null? 123))
(displayln (null? (cons 123 456)))
(newline)
(displayln "--- TEST: number? ----------------------------------------------")
(displayln (number? +))
(displayln (number? '()))
(displayln (number? #true))
(displayln (number? #false))
;(displayln (number? #\n))
(displayln (number? 'foo))
(displayln (number? "foo"))
(displayln (number? 123))
(displayln (number? (cons 123 456)))
(newline)
(displayln "--- TEST: pair? ------------------------------------------------")
(displayln (pair? +))
(displayln (pair? '()))
(displayln (pair? #true))
(displayln (pair? #false))
;(displayln (pair? #\n))
(displayln (pair? 'foo))
(displayln (pair? "foo"))
(displayln (pair? 123))
(displayln (pair? (cons 123 456)))
(newline)
(displayln "--- TEST: procedure? -------------------------------------------")
(displayln (procedure? +))
(displayln (procedure? '()))
(displayln (procedure? #true))
(displayln (procedure? #false))
;(displayln (procedure? #\n))
(displayln (procedure? 'foo))
(displayln (procedure? "foo"))
(displayln (procedure? 123))
(displayln (procedure? (cons 123 456)))
(newline)
(displayln "--- TEST: string? ----------------------------------------------")
(displayln (string? +))
(displayln (string? '()))
(displayln (string? #true))
(displayln (string? #false))
;(displayln (string? #\n))
(displayln (string? 'foo))
(displayln (string? "foo"))
(displayln (string? 123))
(displayln (string? (cons 123 456)))
(newline)
(displayln "--- TEST: symbol? ----------------------------------------------")
(displayln (symbol? +))
(displayln (symbol? '()))
(displayln (symbol? #true))
(displayln (symbol? #false))
;(displayln (symbol? #\n))
(displayln (symbol? 'foo))
(displayln (symbol? "foo"))
(displayln (symbol? 123))
(displayln (symbol? (cons 123 456)))
;;; boolean? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-false (boolean? +))
(assert-false (boolean? '()))
(assert-true (boolean? #true))
(assert-true (boolean? #false))
;(assert-false (boolean? #\n))
(assert-false (boolean? 'foo))
(assert-false (boolean? "foo"))
(assert-false (boolean? 123))
(assert-false (boolean? (cons 123 456)))
;;; char? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-false (char? +))
(assert-false (char? '()))
(assert-false (char? #true))
(assert-false (char? #false))
;(assert-true (char? #\n))
(assert-false (char? 'foo))
(assert-false (char? "foo"))
(assert-false (char? 123))
(assert-false (char? (cons 123 456)))
;;; null? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-false (null? +))
(assert-true (null? '()))
(assert-false (null? #true))
(assert-false (null? #false))
;(assert-false (null? #\n))
(assert-false (null? 'foo))
(assert-false (null? "foo"))
(assert-false (null? 123))
(assert-false (null? (cons 123 456)))
;;; number? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-false (number? +))
(assert-false (number? '()))
(assert-false (number? #true))
(assert-false (number? #false))
;(assert-false (number? #\n))
(assert-false (number? 'foo))
(assert-false (number? "foo"))
(assert-true (number? 123))
(assert-false (number? (cons 123 456)))
;;; pair? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-false (pair? +))
(assert-false (pair? '()))
(assert-false (pair? #true))
(assert-false (pair? #false))
;(assert-false (pair? #\n))
(assert-false (pair? 'foo))
(assert-false (pair? "foo"))
(assert-false (pair? 123))
(assert-true (pair? (cons 123 456)))
;;; procedure? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-true (procedure? +))
(assert-false (procedure? '()))
(assert-false (procedure? #true))
(assert-false (procedure? #false))
;(assert-false (procedure? #\n))
(assert-false (procedure? 'foo))
(assert-false (procedure? "foo"))
(assert-false (procedure? 123))
(assert-false (procedure? (cons 123 456)))
;;; string? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-false (string? +))
(assert-false (string? '()))
(assert-false (string? #true))
(assert-false (string? #false))
;(assert-false (string? #\n))
(assert-false (string? 'foo))
(assert-true (string? "foo"))
(assert-false (string? 123))
(assert-false (string? (cons 123 456)))
;;; symbol? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-false (symbol? +))
(assert-false (symbol? '()))
(assert-false (symbol? #true))
(assert-false (symbol? #false))
;(assert-false (symbol? #\n))
(assert-true (symbol? 'foo))
(assert-false (symbol? "foo"))
(assert-false (symbol? 123))
(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