sjs/sectorlisp
1
0
Fork 0
mirror of https://github.com/samsonjs/sectorlisp.git synced 2026-03-25 09:05:48 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

test files added

Browse source
This commit is contained in:
Alain Greppin 2021-10-03 17:03:58 +02:00
parent b77c74543d
commit cbb4ecc4d5
8 changed files with 153 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
test/.gitignore vendored Normal file
View file

@ -0,0 +1 @@
/tcat

10
test/Makefile Normal file
View file

@ -0,0 +1,10 @@
test1: test1.lisp qemu.sh tcat
sh qemu.sh test1.lisp
eval10: eval10.lisp qemu.sh tcat
sh qemu.sh eval10.lisp
eval15: eval15.lisp qemu.sh tcat
sh qemu.sh eval10.lisp
tcat: tcat.c
$(CC) -o $@ $< -Wall
.PHONY: test1 eval10 eval15

19
test/README.md Normal file
View file

@ -0,0 +1,19 @@
# sectorlisp test scripts
For best results, please resize your terminal to 80x25.
You can launch a test with the following command:
make test1
_This is tested on Linux. The qemu.sh script requires qemu,cc,wc & nc._
## files
- test1.lisp contains basic tests
- eval10.lisp evaluator from [eval.c as of commit 1058c95][1]
- eval15.lisp evaluator from [eval.c as of commit 3b26982 (latest)][2]
[//]: links
[1]: https://github.com/jart/sectorlisp/blob/1058c959d80b7103514cd7e959dbd67b38f4400b/lisp.c
[2]: https://github.com/jart/sectorlisp/blob/3b26982d9c06cd43760604b6364df197a782333e/lisp.c

38
test/eval10.lisp Normal file
View file

@ -0,0 +1,38 @@
((LAMBDA (ASSOC EVCON BIND EVAL)
(EVAL (QUOTE ((LAMBDA (FF X) (FF X))
(QUOTE (LAMBDA (X)
(COND ((ATOM X) X)
((QUOTE T) (FF (CAR X))))))
(QUOTE ((A) B C))))
NIL))
(QUOTE (LAMBDA (X E)
(COND ((EQ E NIL) NIL)
((EQ X (CAR (CAR E))) (CDR (CAR E)))
((QUOTE T) (ASSOC X (CDR E))))))
(QUOTE (LAMBDA (C E)
(COND ((EVAL (CAR (CAR C)) E) (EVAL (CAR (CDR (CAR C))) E))
((QUOTE T) (EVCON (CDR C) E)))))
(QUOTE (LAMBDA (V A E)
(COND ((EQ V NIL) E)
((QUOTE T) (CONS (CONS (CAR V) (EVAL (CAR A) E))
(BIND (CDR V) (CDR A) E))))))
(QUOTE (LAMBDA (E A)
(COND
((ATOM E) (ASSOC E A))
((ATOM (CAR E))
(COND
((EQ (CAR E) NIL) (QUOTE *UNDEFINED))
((EQ (CAR E) (QUOTE QUOTE)) (CAR (CDR E)))
((EQ (CAR E) (QUOTE ATOM)) (ATOM (EVAL (CAR (CDR E)) A)))
((EQ (CAR E) (QUOTE EQ)) (EQ (EVAL (CAR (CDR E)) A)
(EVAL (CAR (CDR (CDR E))) A)))
((EQ (CAR E) (QUOTE CAR)) (CAR (EVAL (CAR (CDR E)) A)))
((EQ (CAR E) (QUOTE CDR)) (CDR (EVAL (CAR (CDR E)) A)))
((EQ (CAR E) (QUOTE CONS)) (CONS (EVAL (CAR (CDR E)) A)
(EVAL (CAR (CDR (CDR E))) A)))
((EQ (CAR E) (QUOTE COND)) (EVCON (CDR E) A))
((EQ (CAR E) (QUOTE LAMBDA)) E)
((QUOTE T) (EVAL (CONS (ASSOC (CAR E) A) (CDR E)) A))))
((EQ (CAR (CAR E)) (QUOTE LAMBDA))
(EVAL (CAR (CDR (CDR (CAR E))))
(BIND (CAR (CDR (CAR E))) (CDR E) A)))))))

40
test/eval15.lisp Normal file
View file

@ -0,0 +1,40 @@
((LAMBDA (ASSOC EVCON PAIRLIS EVLIS APPLY EVAL)
(EVAL (QUOTE ((LAMBDA (FF X) (FF X))
(QUOTE (LAMBDA (X)
(COND ((ATOM X) X)
((QUOTE T) (FF (CAR X))))))
(QUOTE ((A) B C))))
NIL))
(QUOTE (LAMBDA (X E)
(COND ((EQ E NIL) NIL)
((EQ X (CAR (CAR E))) (CDR (CAR E)))
((QUOTE T) (ASSOC X (CDR E))))))
(QUOTE (LAMBDA (C E)
(COND ((EVAL (CAR (CAR C)) E) (EVAL (CAR (CDR (CAR C))) E))
((QUOTE T) (EVCON (CDR C) E)))))
(QUOTE (LAMBDA (X Y A)
(COND ((EQ X NIL) A)
((QUOTE T) (CONS (CONS (CAR X) (CAR Y))
(PAIRLIS (CDR X) (CDR Y) A))))))
(QUOTE (LAMBDA (M A)
(COND ((EQ M NIL) NIL)
((QUOTE T) (CONS (EVAL (CAR M) A) (EVLIS (CDR M) A))))))
(QUOTE (LAMBDA (FN X A)
(COND ((ATOM FN)
(COND ((EQ FN (QUOTE CAR)) (CAR (CAR X)))
((EQ FN (QUOTE CDR)) (CDR (CAR X)))
((EQ FN (QUOTE CONS)) (CONS (CAR X) (CAR (CDR X))))
((EQ FN (QUOTE ATOM)) (ATOM (CAR X)))
((EQ FN (QUOTE EQ)) (EQ (CAR X) (CAR (CDR X))))
((QUOTE T) (APPLY (EVAL FN A) X A))))
((EQ (CAR FN) (QUOTE LAMBDA))
(EVAL (CAR (CDR (CDR FN))) (PAIRLIS (CAR (CDR FN)) X A)))
((QUOTE T) NIL))))
(QUOTE (LAMBDA (E A)
(COND ((ATOM E) (ASSOC E A))
((ATOM (CAR E))
(COND
((EQ (CAR E) (QUOTE QUOTE)) (CAR (CDR E)))
((EQ (CAR E) (QUOTE COND)) (EVCON (CDR E) A))
((QUOTE T) (APPLY (CAR E) (EVLIS (CDR E) A) A))))
((QUOTE T) (APPLY (CAR E) (EVLIS (CDR E) A) A))))))

16
test/qemu.sh Normal file
View file

@ -0,0 +1,16 @@
#!/bin/sh
set -e
FILE=$1
[ -z "$FILE" ] && FILE=test1.lisp
[ -r "$FILE" ] || (echo "cannot read file: $FILE"; exit 1)
SIZE=$(wc -c "$FILE" | cut -d' ' -f1)
QEMU="qemu-system-x86_64"
QIMG="-drive file=../bin/sectorlisp.bin,index=0,if=floppy,format=raw -boot a"
QMON="-monitor tcp:127.0.0.1:55555,server,nowait"
trap 'echo quit | nc -N 127.0.0.1 55555' EXIT
cat "$FILE" | tr '\n' '\r' | ./tcat | \
$QEMU -display curses -net none $QMON $QIMG &
PID=$!
SECS=$((1 + SIZE * 40 / 1000))
sleep $SECS

14
test/tcat.c Normal file
View file

@ -0,0 +1,14 @@
#include <unistd.h>
int main()
{
int ret;
char c;
usleep(350 * 1000);
while ((ret = read(0, &c, 1)) > 0) {
usleep(35 * 1000);
if ((ret = write(1, &c, 1)) <= 0)
break;
}
return ret;
}

15
test/test1.lisp Normal file
View file

@ -0,0 +1,15 @@
(ATOM NIL)
(CONS () ())
(QUOTE ((A) B))
(EQ (QUOTE A) (QUOTE B))
(EQ (QUOTE A) (QUOTE A))
(CONS (QUOTE A) (QUOTE B))
(CONS (QUOTE A) (CONS (QUOTE B) NIL))
(CAR (CONS (QUOTE A) (QUOTE B)))
(CDR (CONS (QUOTE A) (QUOTE B)))
(CDR (CONS (QUOTE A) (CONS (QUOTE B) NIL)))
(COND ((QUOTE T) (QUOTE A)))
(COND ((QUOTE NIL) (QUOTE A)) ((QUOTE T) (QUOTE B)))
(LAMBDA (Z) Z)
((LAMBDA (Z) (CAR Z)) (CONS (QUOTE A) (QUOTE B)))