ref: 7c57c0393fd368602203e8478817ab03861fc2c5
parent: 15c2b3f58a4fc0238d0ebfd18ed4f8e468897183
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Wed Mar 29 08:41:40 EDT 2023
fix "append", add a unit test for it
--- a/flisp.c
+++ b/flisp.c
@@ -1926,15 +1926,14 @@
BUILTIN("append", append)
{
+ value_t first=NIL, lst, lastcons=NIL;
+ int i;
if (nargs == 0)
return NIL;
- value_t first=NIL, lst, lastcons=NIL;
fl_gc_handle(&first);
fl_gc_handle(&lastcons);
- int i = 0;
- while (1) {
- lst = args[i++];
- if (i >= nargs) break;
+ for (i = 0; i < nargs; i++) {
+ lst = args[i];
if (iscons(lst)) {
lst = copy_list(lst);
if (first == NIL)
@@ -1947,10 +1946,6 @@
type_error("cons", lst);
}
}
- if (first == NIL)
- first = lst;
- else
- cdr_(lastcons) = lst;
fl_free_gc_handles(2);
return first;
}
--- a/test/unittest.lsp
+++ b/test/unittest.lsp
@@ -306,5 +306,13 @@
(assert (equal? `(a `(b c)) '(a (quasiquote (b c)))))
(assert (equal? ````x '```x))
+(assert-fail (eval '(append 1)))
+(assert-fail (eval '(append '() 1)))
+(assert (equal? (append) '()))
+(assert (equal? (append '()) '()))
+(assert (equal? (append '() '()) '()))
+(assert (equal? (append '(1 2)) '(1 2)))
+(assert (equal? (append '(1 2) '(3 4)) '(1 2 3 4)))
+
(princ "all tests pass\n")
#t