From b720211b7b3bcd866be24d3105444191d55f96d9 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Thu, 26 Feb 2026 21:14:39 +0000 Subject: [PATCH] Made the string returned by `c_type` null-character terminated. Fixes #6. This is probably the wrong fix; probably I should have fixed read_string so that it did not create null-character terminated strings, but it will do for now. Probably will revisit. --- docs/Home.md | 4 +- lisp/scratchpad.lisp | 4 + src/init.c | 2 +- src/io/io.c | 2 +- src/memory/consspaceobject.c | 16 ++- unit-tests/equal.sh | 206 +++++++++++++++++++++++++++++++++++ 6 files changed, 225 insertions(+), 9 deletions(-) create mode 100644 unit-tests/equal.sh diff --git a/docs/Home.md b/docs/Home.md index ec470e5..e76a525 100644 --- a/docs/Home.md +++ b/docs/Home.md @@ -115,7 +115,7 @@ The following functions are provided as of release 0.0.6: | not | FUNC | `(not arg)`: Return`t` only if `arg` is `nil`, else `nil`. | | nλ | SPFM | `(nlamda arg-list forms...)`: Construct an interpretable special form. When the form is interpreted, arguments specified in the `arg-list` will not be evaluated. | | oblist | FUNC | `(oblist)`: Return the current top-level symbol bindings, as a map. | -| open | FUNC | `(open url read?)`: Open a stream to this `url`. If `read` is present and is non-nil, open it for reading, else writing. | +| open | FUNC | `(open url write?)`: Open a stream to this `url`. If `write?` is present and is non-nil, open it for writing, else reading. | | or | FUNC | `(or args...)`: Return a logical `or` of all the arguments and return `t` if any is truthy, else `nil`. | | print | FUNC | `(print object stream)`: Print `object` to `stream`, if specified, else to `*out*`. | | progn | SPFM | `(progn forms...)`: Evaluate these `forms` sequentially, and return the value of the last. | @@ -129,7 +129,7 @@ The following functions are provided as of release 0.0.6: | reverse | FUNC | `(reverse sequence)` Returns a sequence of the top level elements of this `sequence`, which may be a list or a string, in the reverse order. | | set | FUNC | null | | set! | SPFM | null | -| slurp | FUNC | null | +| slurp | FUNC | `(slurp read-stream)` Read all the characters from `read-stream` to the end of stream, and return them as a string. | | source | FUNC | `(source object)`: If `object` is an interpreted function or interpreted special form, returns the source code; else nil. Once we get a compiler working, will also return the source code of compiled functions and special forms. | | subtract | FUNC | `(- a b)`: Subtracts `b` from `a` and returns the result. Expects both arguments to be numbers. | | throw | FUNC | null | diff --git a/lisp/scratchpad.lisp b/lisp/scratchpad.lisp index 0474099..4d82164 100644 --- a/lisp/scratchpad.lisp +++ b/lisp/scratchpad.lisp @@ -46,3 +46,7 @@ "This blows up: 10^37, which is a three cell bignum." (inspect (set! final (+ z z z z z z z z z z))) + +(mapcar (lambda (n) (list (:name (meta n)) (:documentation (meta n)))) (keys (oblist))) + +((keys "`(keys store)`: Return a list of all keys in this `store`.") (set nil) (let nil) (quote nil) (nil nil) (read nil) (nil nil) (nil nil) (oblist "`(oblist)`: Return the current symbol bindings, as a map.") (cons "`(cons a b)`: Return a cons cell whose `car` is `a` and whose `cdr` is `b`.") (source nil) (cond nil) (nil nil) (eq? "`(eq? args...)`: Return `t` if all args are the exact same object, else `nil`.") (close "`(close stream)`: If `stream` is a stream, close that stream.") (meta "`(meta symbol)`: If the binding of `symbol` has metadata, return that metadata, else `nil`.") (nil nil) (not "`(not arg)`: Return`t` only if `arg` is `nil`, else `nil`.") (mapcar "`(mapcar function sequence)`: Apply `function` to each element of `sequence` in turn, and return a sequence of the results.") (negative? "`(negative? n)`: Return `t` if `n` is a negative number, else `nil`.") (open "`(open url read?)`: Open a stream to this `url`. If `read` is present and is non-nil, open it for reading, else writing.") (subtract nil) (nil nil) (nil nil) (nil nil) (or "`(or args...)`: Return a logical `or` of all the arguments and return `t` if any is truthy, else `nil`.") (nil nil) (and "`(and args...)`: Return a logical `and` of all the arguments and return `t` only if all are truthy, else `nil`.") (count "`(count s)`: Return the number of items in the sequence `s`.") (eval nil) (nλ nil) (nil nil) (nil nil) (nil nil) (nil nil) (cdr "`(cdr arg)`: If `arg` is a sequence, return the remainder of that sequence with the first item removed.") (equal? "`(equal? args...)`: Return `t` if all args have logically equivalent value, else `nil`.") (set! nil) (nil nil) (nil nil) (reverse nil) (slurp nil) (try nil) (assoc "`(assoc key store)`: Return the value associated with this `key` in this `store`.") (nil nil) (add "`(+ args...)`: If `args` are all numbers, return the sum of those numbers.") (list "`(list args...): Return a list of these `args`.") (time nil) (car "`(car arg)`: If `arg` is a sequence, return the item which is the head of that sequence.") (nil nil) (nil nil) (nil nil) (absolute "`(absolute arg)`: If `arg` is a number, return the absolute value of that number, else `nil`.") (append "`(append args...)`: If args are all collections, return the concatenation of those collections.") (apply "`(apply f args)`: If `f` is usable as a function, and `args` is a collection, apply `f` to `args` and return the value.") (divide "`(/ a b)`: If `a` and `b` are both numbers, return the numeric result of dividing `a` by `b`.") (exception "`(exception message)`: Return (throw) an exception with this `message`.") (get-hash "`(get-hash arg)`: returns the natural number hash value of `arg`.") (hashmap "`(hashmap n-buckets hashfn store acl)`: Return a new hashmap, with `n-buckets` buckets and this `hashfn`, containing the content of this `store`.") (inspect "`(inspect object ouput-stream)`: Print details of this `object` to this `output-stream` or `*out*`.") (metadata "`(metadata symbol)`: If the binding of `symbol` has metadata, return that metadata, else `nil`.") (multiply "`(* args...)` Multiply these `args`, all of which should be numbers.") (print "`(print object stream)`: Print `object` to `stream`, if specified, else to `*out*`.") (put! nil) (put-all! nil) (ratio->real "`(ratio->real r)`: If `r` is a rational number, return the real number equivalent.") (read-char nil) (repl nil) (throw nil) (type nil) (+ "`(+ args...)`: If `args` are all numbers, return the sum of those numbers.") (* nil) (- nil) (/ nil) (= "`(equal? args...)`: Return `t` if all args have logically equivalent value, else `nil`.") (lambda nil) (λ nil) (nlambda nil) (progn nil) (nil nil) (nil nil) (nil nil) (nil nil) (nil nil) (nil nil) (nil nil) (nil nil) (nil nil) (nil nil)) diff --git a/src/init.c b/src/init.c index 13c939f..aec65c7 100644 --- a/src/init.c +++ b/src/init.c @@ -387,7 +387,7 @@ int main( int argc, char *argv[] ) { L"`(not arg)`: Return`t` only if `arg` is `nil`, else `nil`.", &lisp_not); bind_function( L"oblist", L"`(oblist)`: Return the current symbol bindings, as a map.", &lisp_oblist ); - bind_function( L"open", L"`(open url read?)`: Open a stream to this `url`. If `read` is present and is non-nil, open it for reading, else writing.", &lisp_open ); + bind_function( L"open", L"`(open url write?)`: Open a stream to this `url`. If `write?` is present and is non-nil, open it for writing, else reading.", &lisp_open ); bind_function( L"or", L"`(or args...)`: Return a logical `or` of all the arguments and return `t` if any is truthy, else `nil`.", &lisp_or); diff --git a/src/io/io.c b/src/io/io.c index aa960f0..51a05cc 100644 --- a/src/io/io.c +++ b/src/io/io.c @@ -420,7 +420,7 @@ struct cons_pointer get_default_stream( bool inputp, struct cons_pointer env ) { /** * Function: return a stream open on the URL indicated by the first argument; - * if a second argument is present and is non-nil, open it for reading. At + * if a second argument is present and is non-nil, open it for writing. At * present, further arguments are ignored and there is no mechanism to open * to append, or error if the URL is faulty or indicates an unavailable * resource. diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c index 0bd0b90..d0ece0f 100644 --- a/src/memory/consspaceobject.c +++ b/src/memory/consspaceobject.c @@ -114,11 +114,15 @@ struct cons_pointer dec_ref( struct cons_pointer pointer ) { * @return As a Lisp string, the tag of the object which is at that pointer. */ struct cons_pointer c_type( struct cons_pointer pointer ) { - struct cons_pointer result = NIL; - struct cons_space_object cell = pointer2cell( pointer ); + /* Strings read by `read` have the null character termination. This means + * that for the same printable string, the hashcode is different from + * strings made with NIL termination. The question is which should be + * fixed, and actually that's probably strings read by `read`. However, + * for now, it was easier to add a null character here. */ + struct cons_pointer result = make_string( (wchar_t) 0, NIL); + struct cons_space_object * cell = &pointer2cell( pointer ); - if ( strncmp( ( char * ) &cell.tag.bytes, VECTORPOINTTAG, TAGLENGTH ) == - 0 ) { + if ( cell->tag.value == VECTORPOINTTV ) { struct vector_space_object *vec = pointer_to_vso( pointer ); for ( int i = TAGLENGTH - 1; i >= 0; i-- ) { @@ -127,7 +131,7 @@ struct cons_pointer c_type( struct cons_pointer pointer ) { } } else { for ( int i = TAGLENGTH - 1; i >= 0; i-- ) { - result = make_string( ( wchar_t ) cell.tag.bytes[i], result ); + result = make_string( ( wchar_t ) cell->tag.bytes[i], result ); } } @@ -333,6 +337,8 @@ struct cons_pointer make_string_like_thing( wint_t c, struct cons_pointer tail, cell->payload.string.cdr = tail; cell->payload.string.hash = calculate_hash( c, tail ); + debug_dump_object( pointer, DEBUG_ALLOC); + debug_println( DEBUG_ALLOC); } else { // \todo should throw an exception! debug_printf( DEBUG_ALLOC, diff --git a/unit-tests/equal.sh b/unit-tests/equal.sh new file mode 100644 index 0000000..815988b --- /dev/null +++ b/unit-tests/equal.sh @@ -0,0 +1,206 @@ +#!/bin/bash + +# Tests for equality. + +result=0 + +echo -n "$0: integers... " + +expected="t" +actual=`echo "(= 5 5)" | target/psse 2>/dev/null | tail -1` + +if [ "${expected}" = "${actual}" ] +then + echo "OK" +else + echo "Fail: expected '${expected}', got '${actual}'" + result=`echo "${result} + 1" | bc` +fi + +echo -n "$0: different integers... " + +expected="nil" +actual=`echo "(= 4 5)" | target/psse 2>/dev/null | tail -1` + +if [ "${expected}" = "${actual}" ] +then + echo "OK" +else + echo "Fail: expected '${expected}', got '${actual}'" + result=`echo "${result} + 1" | bc` +fi + + +echo -n "$0: reals... " + +expected="t" +actual=`echo "(= 5.001 5.001)" | target/psse 2>/dev/null | tail -1` + +if [ "${expected}" = "${actual}" ] +then + echo "OK" +else + echo "Fail: expected '${expected}', got '${actual}'" + result=`echo "${result} + 1" | bc` +fi + + +echo -n "$0: different reals... " + +expected="nil" +actual=`echo "(= 5.001 5.002)" | target/psse 2>/dev/null | tail -1` + +if [ "${expected}" = "${actual}" ] +then + echo "OK" +else + echo "Fail: expected '${expected}', got '${actual}'" + result=`echo "${result} + 1" | bc` +fi + +echo -n "$0: ratios... " + +expected="t" +actual=`echo "(= 4/5 4/5)" | target/psse 2>/dev/null | tail -1` + +if [ "${expected}" = "${actual}" ] +then + echo "OK" +else + echo "Fail: expected '${expected}', got '${actual}'" + result=`echo "${result} + 1" | bc` +fi + + +echo -n "$0: equivalent ratios... " + +expected="t" +actual=`echo "(= 4/5 12/15)" | target/psse 2>/dev/null | tail -1` + +if [ "${expected}" = "${actual}" ] +then + echo "OK" +else + echo "Fail: expected '${expected}', got '${actual}'" + result=`echo "${result} + 1" | bc` +fi + + +echo -n "$0: different ratios... " + +expected="nil" +actual=`echo "(= 4/5 5/5)" | target/psse 2>/dev/null | tail -1` + +if [ "${expected}" = "${actual}" ] +then + echo "OK" +else + echo "Fail: expected '${expected}', got '${actual}'" + result=`echo "${result} + 1" | bc` +fi + +echo -n "$0: atoms... " + +expected="t" +actual=`echo "(= 'foo 'foo)" | target/psse 2>/dev/null | tail -1` + +if [ "${expected}" = "${actual}" ] +then + echo "OK" +else + echo "Fail: expected '${expected}', got '${actual}'" + result=`echo "${result} + 1" | bc` +fi + +echo -n "$0: different atoms... " + +expected="nil" +actual=`echo "(= 'foo 'bar)" | target/psse 2>/dev/null | tail -1` + +if [ "${expected}" = "${actual}" ] +then + echo "OK" +else + echo "Fail: expected '${expected}', got '${actual}'" + result=`echo "${result} + 1" | bc` +fi + +echo -n "$0: keywords... " + +expected="t" +actual=`echo "(= :foo :foo)" | target/psse 2>/dev/null | tail -1` + +if [ "${expected}" = "${actual}" ] +then + echo "OK" +else + echo "Fail: expected '${expected}', got '${actual}'" + result=`echo "${result} + 1" | bc` +fi + +echo -n "$0: different keywords... " + +expected="nil" +actual=`echo "(= :foo :bar)" | target/psse 2>/dev/null | tail -1` + +if [ "${expected}" = "${actual}" ] +then + echo "OK" +else + echo "Fail: expected '${expected}', got '${actual}'" + result=`echo "${result} + 1" | bc` +fi + +echo -n "$0: strings... " + +expected="t" +actual=`echo '(= "foo" "foo")' | target/psse 2>/dev/null | tail -1` + +if [ "${expected}" = "${actual}" ] +then + echo "OK" +else + echo "Fail: expected '${expected}', got '${actual}'" + result=`echo "${result} + 1" | bc` +fi + +echo -n "$0: different strings... " + +expected="nil" +actual=`echo '(= "foo" "bar")' | target/psse 2>/dev/null | tail -1` + +if [ "${expected}" = "${actual}" ] +then + echo "OK" +else + echo "Fail: expected '${expected}', got '${actual}'" + result=`echo "${result} + 1" | bc` +fi + +echo -n "$0: maps... " + +expected="t" +actual=`echo '(= {:foo 1 :bar 2} {:bar 2 :foo 1})' | target/psse 2>/dev/null | tail -1` + +if [ "${expected}" = "${actual}" ] +then + echo "OK" +else + echo "Fail: expected '${expected}', got '${actual}'" + result=`echo "${result} + 1" | bc` +fi + +echo -n "$0: different maps... " + +expected="nil" +actual=`echo '(= {:foo 1 :bar 2} {:bar 1 :foo 2})' | target/psse 2>/dev/null | tail -1` + +if [ "${expected}" = "${actual}" ] +then + echo "OK" +else + echo "Fail: expected '${expected}', got '${actual}'" + result=`echo "${result} + 1" | bc` +fi + +exit ${result}