Compare commits

...

2 commits

Author SHA1 Message Date
222368bf64 Stage one clean up of test files. Some unit tests are still creating temporary files in
the project root directory, which is still to be fixed; and *I think* known-failing
tests which I don't intend to fix immediately should be marked in some way.
2026-02-14 14:04:41 +00:00
5e6363e6ae Fixed the horrendous 'unbound symbol nil' bug. Also work on documentation and
unit tests.
2026-02-14 11:40:52 +00:00
40 changed files with 498 additions and 285 deletions

View file

@ -11,6 +11,8 @@ TESTS := $(shell find unit-tests -name *.sh)
INC_DIRS := $(shell find $(SRC_DIRS) -type d) INC_DIRS := $(shell find $(SRC_DIRS) -type d)
INC_FLAGS := $(addprefix -I,$(INC_DIRS)) INC_FLAGS := $(addprefix -I,$(INC_DIRS))
TMP_DIR ?= ./tmp
INDENT_FLAGS := -nbad -bap -nbc -br -brf -brs -c33 -cd33 -ncdb -ce -ci4 -cli4 \ INDENT_FLAGS := -nbad -bap -nbc -br -brf -brs -c33 -cd33 -ncdb -ce -ci4 -cli4 \
-d0 -di1 -nfc1 -i4 -ip0 -l75 -lp -npcs \ -d0 -di1 -nfc1 -i4 -ip0 -l75 -lp -npcs \
-npsl -nsc -nsob -nss -nut -prs -l79 -ts2 -npsl -nsc -nsob -nss -nut -prs -l79 -ts2
@ -41,7 +43,7 @@ test: $(TESTS) Makefile $(TARGET)
.PHONY: clean .PHONY: clean
clean: clean:
$(RM) $(TARGET) $(OBJS) $(DEPS) $(SRC_DIRS)/*~ $(SRC_DIRS)/*/*~ *~ core $(RM) $(TARGET) $(OBJS) $(DEPS) $(SRC_DIRS)/*~ $(SRC_DIRS)/*/*~ $(TMP_DIR)/* *~ core
repl: repl:
$(TARGET) -p 2> psse.log $(TARGET) -p 2> psse.log

View file

@ -55,7 +55,7 @@ struct cons_pointer small_int_cache[SMALL_INT_LIMIT];
* Low level integer arithmetic, do not use elsewhere. * Low level integer arithmetic, do not use elsewhere.
* *
* @param c a pointer to a cell, assumed to be an integer cell; * @param c a pointer to a cell, assumed to be an integer cell;
* @param op a character representing the operation: expectedto be either * @param op a character representing the operation: expected to be either
* '+' or '*'; behaviour with other values is undefined. * '+' or '*'; behaviour with other values is undefined.
* @param is_first_cell true if this is the first cell in a bignum * @param is_first_cell true if this is the first cell in a bignum
* chain, else false. * chain, else false.
@ -128,8 +128,8 @@ struct cons_pointer make_integer( int64_t value, struct cons_pointer more ) {
struct cons_pointer acquire_integer( int64_t value, struct cons_pointer more ) { struct cons_pointer acquire_integer( int64_t value, struct cons_pointer more ) {
struct cons_pointer result; struct cons_pointer result;
if ( !nilp( more) || value >= SMALL_INT_LIMIT) { if ( !nilp( more) || value < 0 || value >= SMALL_INT_LIMIT) {
debug_print( L"acquire_integer passing to make_integer (too large)\n", DEBUG_ALLOC ); debug_print( L"acquire_integer passing to make_integer (outside small int range)\n", DEBUG_ALLOC );
result = make_integer( value, more); result = make_integer( value, more);
} else { } else {
if ( !small_int_cache_initialised) { if ( !small_int_cache_initialised) {
@ -239,7 +239,7 @@ struct cons_pointer add_integers( struct cons_pointer a,
while ( !nilp( a ) || !nilp( b ) || carry != 0 ) { while ( !nilp( a ) || !nilp( b ) || carry != 0 ) {
__int128_t av = cell_value( a, '+', is_first_cell ); __int128_t av = cell_value( a, '+', is_first_cell );
__int128_t bv = cell_value( b, '+', is_first_cell ); __int128_t bv = cell_value( b, '+', is_first_cell );
__int128_t rv = av + bv + carry; __int128_t rv = (av + bv) + carry;
debug_print( L"add_integers: av = ", DEBUG_ARITH ); debug_print( L"add_integers: av = ", DEBUG_ARITH );
debug_print_128bit( av, DEBUG_ARITH ); debug_print_128bit( av, DEBUG_ARITH );
@ -251,17 +251,22 @@ struct cons_pointer add_integers( struct cons_pointer a,
debug_print_128bit( rv, DEBUG_ARITH ); debug_print_128bit( rv, DEBUG_ARITH );
debug_print( L"\n", DEBUG_ARITH ); debug_print( L"\n", DEBUG_ARITH );
struct cons_pointer new = make_integer( 0, NIL ); if ( carry == 0 && ( rv >= 0 || rv < SMALL_INT_LIMIT)) {
carry = int128_to_integer( rv, cursor, new ); result = acquire_integer( (int64_t)(rv & 0xffffffff), NIL);
cursor = new; break;
} else {
struct cons_pointer new = make_integer( 0, NIL );
carry = int128_to_integer( rv, cursor, new );
cursor = new;
if ( nilp( result ) ) { if ( nilp( result ) ) {
result = cursor; result = cursor;
}
a = pointer2cell( a ).payload.integer.more;
b = pointer2cell( b ).payload.integer.more;
is_first_cell = false;
} }
a = pointer2cell( a ).payload.integer.more;
b = pointer2cell( b ).payload.integer.more;
is_first_cell = false;
} }
} }
@ -407,10 +412,16 @@ struct cons_pointer multiply_integers( struct cons_pointer a,
struct cons_pointer integer_to_string_add_digit( int digit, int digits, struct cons_pointer integer_to_string_add_digit( int digit, int digits,
struct cons_pointer tail ) { struct cons_pointer tail ) {
wint_t character = btowc( hex_digits[digit] ); wint_t character = btowc( hex_digits[digit] );
return ( digits % 3 == 0 ) ? debug_printf( DEBUG_IO, L"integer_to_string_add_digit: digit is %d, digits is %d; returning: ", digit, digits);
struct cons_pointer r = ( digits % 3 == 0 ) ?
make_string( L',', make_string( character, make_string( L',', make_string( character,
tail ) ) : tail ) ) :
make_string( character, tail ); make_string( character, tail );
debug_print_object( r, DEBUG_IO);
debug_println( DEBUG_IO);
return r;
} }
/** /**

View file

@ -45,16 +45,17 @@ int64_t least_common_multiple( int64_t m, int64_t n ) {
struct cons_pointer simplify_ratio( struct cons_pointer pointer ) { struct cons_pointer simplify_ratio( struct cons_pointer pointer ) {
struct cons_pointer result = pointer; struct cons_pointer result = pointer;
struct cons_space_object cell = pointer2cell( pointer );
struct cons_space_object dividend =
pointer2cell( cell.payload.ratio.dividend );
struct cons_space_object divisor =
pointer2cell( cell.payload.ratio.divisor );
if ( divisor.payload.integer.value == 1 ) { if ( ratiop( pointer ) ) {
result = pointer2cell( pointer ).payload.ratio.dividend; struct cons_space_object cell = pointer2cell( pointer );
} else { struct cons_space_object dividend =
if ( ratiop( pointer ) ) { pointer2cell( cell.payload.ratio.dividend );
struct cons_space_object divisor =
pointer2cell( cell.payload.ratio.divisor );
if ( divisor.payload.integer.value == 1 ) {
result = pointer2cell( pointer ).payload.ratio.dividend;
} else {
int64_t ddrv = dividend.payload.integer.value, int64_t ddrv = dividend.payload.integer.value,
drrv = divisor.payload.integer.value, drrv = divisor.payload.integer.value,
gcd = greatest_common_divisor( ddrv, drrv ); gcd = greatest_common_divisor( ddrv, drrv );
@ -63,13 +64,16 @@ struct cons_pointer simplify_ratio( struct cons_pointer pointer ) {
if ( drrv / gcd == 1 ) { if ( drrv / gcd == 1 ) {
result = acquire_integer( ddrv / gcd, NIL ); result = acquire_integer( ddrv / gcd, NIL );
} else { } else {
debug_printf( DEBUG_ARITH,
L"simplify_ratio: %ld/%ld => %ld/%ld\n", ddrv, drrv, ddrv/gcd, drrv/gcd);
result = result =
make_ratio( acquire_integer( ddrv / gcd, NIL ), make_ratio( acquire_integer( ddrv / gcd, NIL ),
acquire_integer( drrv / gcd, NIL ) ); acquire_integer( drrv / gcd, NIL ) );
} }
} }
} }
} }
// TODO: else throw exception?
return result; return result;
@ -311,23 +315,30 @@ struct cons_pointer make_ratio( struct cons_pointer dividend,
if ( integerp( dividend ) && integerp( divisor ) ) { if ( integerp( dividend ) && integerp( divisor ) ) {
inc_ref( dividend ); inc_ref( dividend );
inc_ref( divisor ); inc_ref( divisor );
result = allocate_cell( RATIOTV ); struct cons_pointer unsimplified = allocate_cell( RATIOTV );
struct cons_space_object *cell = &pointer2cell( result ); struct cons_space_object *cell = &pointer2cell( unsimplified );
cell->payload.ratio.dividend = dividend; cell->payload.ratio.dividend = dividend;
cell->payload.ratio.divisor = divisor; cell->payload.ratio.divisor = divisor;
result = simplify_ratio( unsimplified);
if ( !eq( result, unsimplified)) { dec_ref( unsimplified); }
} else { } else {
result = result =
throw_exception( c_string_to_lisp_string throw_exception( c_string_to_lisp_string
( L"Dividend and divisor of a ratio must be integers" ), ( L"Dividend and divisor of a ratio must be integers" ),
NIL ); NIL );
} }
// debug_print( L"make_ratio returning:\n", DEBUG_ARITH);
debug_dump_object( result, DEBUG_ARITH ); debug_dump_object( result, DEBUG_ARITH );
return result; return result;
} }
/** /**
* True if a and be are identical ratios, else false. * True if a and be are identical rationals, else false.
*
* TODO: we need ways of checking whether rationals are equal
* to floats and to integers.
*/ */
bool equal_ratio_ratio( struct cons_pointer a, struct cons_pointer b ) { bool equal_ratio_ratio( struct cons_pointer a, struct cons_pointer b ) {
bool result = false; bool result = false;

View file

@ -1,4 +1,4 @@
/** /*
* debug.c * debug.c
* *
* Better debug log messages. * Better debug log messages.
@ -25,13 +25,17 @@
#include "io/print.h" #include "io/print.h"
/** /**
* the controlling flags for `debug_print`; set in `init.c`, q.v. * @brief the controlling flags for `debug_print`; set in `init.c`, q.v.
*
* Interpreted as a set o binary flags. The values are controlled by macros
* with names 'DEBUG_[A_Z]*' in `debug.h`, q.v.
*/ */
int verbosity = 0; int verbosity = 0;
/** /**
* print this debug `message` to stderr, if `verbosity` matches `level`. * @brief print this debug `message` to stderr, if `verbosity` matches `level`.
* `verbosity is a set of flags, see debug_print.h; so you can *
* `verbosity` is a set of flags, see debug_print.h; so you can
* turn debugging on for only one part of the system. * turn debugging on for only one part of the system.
*/ */
void debug_print( wchar_t *message, int level ) { void debug_print( wchar_t *message, int level ) {
@ -44,6 +48,11 @@ void debug_print( wchar_t *message, int level ) {
} }
/** /**
* @brief print a 128 bit integer value to stderr, if `verbosity` matches `level`.
*
* `verbosity` is a set of flags, see debug_print.h; so you can
* turn debugging on for only one part of the system.
*
* stolen from https://stackoverflow.com/questions/11656241/how-to-print-uint128-t-number-using-gcc * stolen from https://stackoverflow.com/questions/11656241/how-to-print-uint128-t-number-using-gcc
*/ */
void debug_print_128bit( __int128_t n, int level ) { void debug_print_128bit( __int128_t n, int level ) {
@ -68,8 +77,9 @@ void debug_print_128bit( __int128_t n, int level ) {
} }
/** /**
* print a line feed to stderr, if `verbosity` matches `level`. * @brief print a line feed to stderr, if `verbosity` matches `level`.
* `verbosity is a set of flags, see debug_print.h; so you can *
* `verbosity` is a set of flags, see debug_print.h; so you can
* turn debugging on for only one part of the system. * turn debugging on for only one part of the system.
*/ */
void debug_println( int level ) { void debug_println( int level ) {
@ -83,8 +93,10 @@ void debug_println( int level ) {
/** /**
* `wprintf` adapted for the debug logging system. Print to stderr only * @brief `wprintf` adapted for the debug logging system.
* `verbosity` matches `level`. All other arguments as for `wprintf`. *
* Print to stderr only if `verbosity` matches `level`. All other arguments
* as for `wprintf`.
*/ */
void debug_printf( int level, wchar_t *format, ... ) { void debug_printf( int level, wchar_t *format, ... ) {
#ifdef DEBUG #ifdef DEBUG
@ -98,8 +110,10 @@ void debug_printf( int level, wchar_t *format, ... ) {
} }
/** /**
* print the object indicated by this `pointer` to stderr, if `verbosity` * @brief print the object indicated by this `pointer` to stderr, if `verbosity`
* matches `level`.`verbosity is a set of flags, see debug_print.h; so you can * matches `level`.
*
* `verbosity` is a set of flags, see debug_print.h; so you can
* turn debugging on for only one part of the system. * turn debugging on for only one part of the system.
*/ */
void debug_print_object( struct cons_pointer pointer, int level ) { void debug_print_object( struct cons_pointer pointer, int level ) {
@ -114,7 +128,10 @@ void debug_print_object( struct cons_pointer pointer, int level ) {
} }
/** /**
* Like `dump_object`, q.v., but protected by the verbosity mechanism. * @brief Like `dump_object`, q.v., but protected by the verbosity mechanism.
*
* `verbosity` is a set of flags, see debug_print.h; so you can
* turn debugging on for only one part of the system.
*/ */
void debug_dump_object( struct cons_pointer pointer, int level ) { void debug_dump_object( struct cons_pointer pointer, int level ) {
#ifdef DEBUG #ifdef DEBUG

View file

@ -1,4 +1,4 @@
/** /*
* debug.h * debug.h
* *
* Better debug log messages. * Better debug log messages.
@ -13,14 +13,67 @@
#ifndef __debug_print_h #ifndef __debug_print_h
#define __debug_print_h #define __debug_print_h
/**
* @brief Print messages debugging memory allocation.
*
* Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
*/
#define DEBUG_ALLOC 1 #define DEBUG_ALLOC 1
/**
* @brief Print messages debugging arithmetic operations.
*
* Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
*/
#define DEBUG_ARITH 2 #define DEBUG_ARITH 2
/**
* @brief Print messages debugging symbol binding.
*
* Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
*/
#define DEBUG_BIND 4 #define DEBUG_BIND 4
/**
* @brief Print messages debugging bootstrapping and teardown.
*
* Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
*/
#define DEBUG_BOOTSTRAP 8 #define DEBUG_BOOTSTRAP 8
/**
* @brief Print messages debugging evaluation.
*
* Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
*/
#define DEBUG_EVAL 16 #define DEBUG_EVAL 16
/**
* @brief Print messages debugging input/output operations.
*
* Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
*/
#define DEBUG_IO 32 #define DEBUG_IO 32
/**
* @brief Print messages debugging lambda functions (interpretation).
*
* Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
*/
#define DEBUG_LAMBDA 64 #define DEBUG_LAMBDA 64
/**
* @brief Print messages debugging the read eval print loop.
*
* Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
*/
#define DEBUG_REPL 128 #define DEBUG_REPL 128
/**
* @brief Print messages debugging stack operations.
*
* Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
*/
#define DEBUG_STACK 256 #define DEBUG_STACK 256
extern int verbosity; extern int verbosity;

View file

@ -65,6 +65,25 @@ struct cons_pointer check_exception( struct cons_pointer pointer, char * locatio
return result; return result;
} }
struct cons_pointer init_name_symbol = NIL;
struct cons_pointer init_primitive_symbol = NIL;
void maybe_bind_init_symbols() {
if ( nilp( init_name_symbol)) {
init_name_symbol = c_string_to_lisp_keyword( L"name" );
}
if ( nilp( init_primitive_symbol)) {
init_primitive_symbol = c_string_to_lisp_keyword( L"primitive" );
}
if ( nilp( privileged_symbol_nil)) {
privileged_symbol_nil = c_string_to_lisp_symbol( L"nil");
}
}
void free_init_symbols() {
dec_ref( init_name_symbol);
dec_ref( init_primitive_symbol);
}
/** /**
* Bind this compiled `executable` function, as a Lisp function, to * Bind this compiled `executable` function, as a Lisp function, to
@ -73,45 +92,75 @@ struct cons_pointer check_exception( struct cons_pointer pointer, char * locatio
* the name on the source pointer. Would make stack frames potentially * the name on the source pointer. Would make stack frames potentially
* more readable and aid debugging generally. * more readable and aid debugging generally.
*/ */
void bind_function( wchar_t *name, struct cons_pointer ( *executable ) struct cons_pointer bind_function( wchar_t *name, struct cons_pointer ( *executable )
( struct stack_frame *, ( struct stack_frame *,
struct cons_pointer, struct cons_pointer ) ) { struct cons_pointer, struct cons_pointer ) ) {
struct cons_pointer n = c_string_to_lisp_symbol( name ); struct cons_pointer n = c_string_to_lisp_symbol( name );
struct cons_pointer meta = struct cons_pointer meta =
make_cons( make_cons( c_string_to_lisp_keyword( L"primitive" ), TRUE ), make_cons( make_cons( init_primitive_symbol, TRUE ),
make_cons( make_cons( c_string_to_lisp_keyword( L"name" ), make_cons( make_cons( init_name_symbol, n ),
n ),
NIL ) ); NIL ) );
check_exception( deep_bind( n, make_function( meta, executable ) ), struct cons_pointer r = check_exception(
deep_bind( n, make_function( meta, executable ) ),
"bind_function"); "bind_function");
dec_ref( n);
return r;
} }
/** /**
* Bind this compiled `executable` function, as a Lisp special form, to * Bind this compiled `executable` function, as a Lisp special form, to
* this `name` in the `oblist`. * this `name` in the `oblist`.
*/ */
void bind_special( wchar_t *name, struct cons_pointer ( *executable ) struct cons_pointer bind_special( wchar_t *name, struct cons_pointer ( *executable )
( struct stack_frame *, ( struct stack_frame *,
struct cons_pointer, struct cons_pointer ) ) { struct cons_pointer, struct cons_pointer ) ) {
struct cons_pointer n = c_string_to_lisp_symbol( name ); struct cons_pointer n = c_string_to_lisp_symbol( name );
struct cons_pointer meta =
make_cons( make_cons( c_string_to_lisp_keyword( L"primitive" ), TRUE ),
make_cons( make_cons( c_string_to_lisp_keyword( L"name" ),
n ),
NIL ) );
check_exception(deep_bind( n, make_special( meta, executable ) ), struct cons_pointer meta =
make_cons( make_cons( init_primitive_symbol, TRUE ),
make_cons( make_cons( init_name_symbol, n), NIL ) );
struct cons_pointer r =
check_exception(deep_bind( n, make_special( meta, executable ) ),
"bind_special"); "bind_special");
dec_ref( n);
return r;
}
/**
* Bind this `value` to this `symbol` in the `oblist`.
*/
struct cons_pointer
bind_symbol_value( struct cons_pointer symbol, struct cons_pointer value, bool lock) {
struct cons_pointer r = check_exception(
deep_bind( symbol, value ),
"bind_symbol_value");
if ( lock && !exceptionp( r)){
struct cons_space_object * cell = & pointer2cell( r);
cell->count = UINT32_MAX;
}
return r;
} }
/** /**
* Bind this `value` to this `name` in the `oblist`. * Bind this `value` to this `name` in the `oblist`.
*/ */
struct cons_pointer bind_value( wchar_t *name, struct cons_pointer value ) { struct cons_pointer bind_value( wchar_t *name, struct cons_pointer value, bool lock ) {
return check_exception( struct cons_pointer p = c_string_to_lisp_symbol( name );
deep_bind( c_string_to_lisp_symbol( name ), value ),
"bind_value"); struct cons_pointer r = bind_symbol_value( p, value, lock);
dec_ref( p);
return r;
} }
void print_banner( ) { void print_banner( ) {
@ -187,21 +236,15 @@ int main( int argc, char *argv[] ) {
} }
} }
initialise_cons_pages();
maybe_bind_init_symbols();
if ( show_prompt ) { if ( show_prompt ) {
print_banner( ); print_banner( );
} }
initialise_cons_pages( );
// TODO: oblist-as-hashmap (which is what we ultimately need) is failing hooribly.
// What actually goes wrong is:
// 1. the hashmap is created;
// 2. everything bound in init seems to get initialised properly;
// 3. the REPL starts up;
// 4. Anything typed into the REPL (except ctrl-D) results in immediate segfault.
// 5. If ctrl-D is the first thing typed into the REPL, shutdown proceeds normally.
// Hypothesis: binding stuff into a hashmap oblist either isn't happening or
// is wrking ok, but retrieving from a hashmap oblist is failing.
debug_print( L"About to initialise oblist\n", DEBUG_BOOTSTRAP ); debug_print( L"About to initialise oblist\n", DEBUG_BOOTSTRAP );
oblist = make_hashmap( 32, NIL, TRUE ); oblist = make_hashmap( 32, NIL, TRUE );
@ -211,8 +254,8 @@ int main( int argc, char *argv[] ) {
/* /*
* privileged variables (keywords) * privileged variables (keywords)
*/ */
bind_value( L"nil", NIL ); bind_symbol_value( privileged_symbol_nil, NIL, true);
bind_value( L"t", TRUE ); bind_value( L"t", TRUE, true );
/* /*
* standard input, output, error and sink streams * standard input, output, error and sink streams
@ -233,7 +276,7 @@ int main( int argc, char *argv[] ) {
( L"url" ), ( L"url" ),
c_string_to_lisp_string c_string_to_lisp_string
( L"system:standard input" ) ), ( L"system:standard input" ) ),
NIL ) ) ); NIL ) ), false );
lisp_io_out = bind_value( C_IO_OUT, lisp_io_out = bind_value( C_IO_OUT,
make_write_stream( file_to_url_file( stdout ), make_write_stream( file_to_url_file( stdout ),
make_cons( make_cons make_cons( make_cons
@ -241,26 +284,26 @@ int main( int argc, char *argv[] ) {
( L"url" ), ( L"url" ),
c_string_to_lisp_string c_string_to_lisp_string
( L"system:standard output]" ) ), ( L"system:standard output]" ) ),
NIL ) ) ); NIL ) ), false);
bind_value( L"*log*", make_write_stream( file_to_url_file( stderr ), bind_value( L"*log*", make_write_stream( file_to_url_file( stderr ),
make_cons( make_cons make_cons( make_cons
( c_string_to_lisp_keyword ( c_string_to_lisp_keyword
( L"url" ), ( L"url" ),
c_string_to_lisp_string c_string_to_lisp_string
( L"system:standard log" ) ), ( L"system:standard log" ) ),
NIL ) ) ); NIL ) ), false );
bind_value( L"*sink*", make_write_stream( sink, bind_value( L"*sink*", make_write_stream( sink,
make_cons( make_cons make_cons( make_cons
( c_string_to_lisp_keyword ( c_string_to_lisp_keyword
( L"url" ), ( L"url" ),
c_string_to_lisp_string c_string_to_lisp_string
( L"system:standard sink" ) ), ( L"system:standard sink" ) ),
NIL ) ) ); NIL ) ), false );
/* /*
* the default prompt * the default prompt
*/ */
prompt_name = bind_value( L"*prompt*", prompt_name = bind_value( L"*prompt*",
show_prompt ? c_string_to_lisp_symbol( L":: " ) : NIL ); show_prompt ? c_string_to_lisp_symbol( L":: " ) : NIL, false );
/* /*
* primitive function operations * primitive function operations
*/ */
@ -327,13 +370,15 @@ int main( int argc, char *argv[] ) {
repl( show_prompt ); repl( show_prompt );
debug_print( L"Freeing oblist\n", DEBUG_BOOTSTRAP );
dec_ref( oblist );
debug_dump_object( oblist, DEBUG_BOOTSTRAP ); debug_dump_object( oblist, DEBUG_BOOTSTRAP );
if ( dump_at_end ) { if ( dump_at_end ) {
dump_pages( file_to_url_file( stdout ) ); dump_pages( file_to_url_file( stdout ) );
} }
debug_print( L"Freeing oblist\n", DEBUG_BOOTSTRAP );
dec_ref( oblist );
free_init_symbols();
summarise_allocation( ); summarise_allocation( );
curl_global_cleanup( ); curl_global_cleanup( );
return ( 0 ); return ( 0 );

View file

@ -413,12 +413,8 @@ struct cons_pointer get_default_stream( bool inputp, struct cons_pointer env ) {
struct cons_pointer stream_name = struct cons_pointer stream_name =
inputp ? lisp_io_in : lisp_io_out; inputp ? lisp_io_in : lisp_io_out;
inc_ref( stream_name );
result = c_assoc( stream_name, env ); result = c_assoc( stream_name, env );
dec_ref( stream_name );
return result; return result;
} }
@ -430,7 +426,7 @@ struct cons_pointer get_default_stream( bool inputp, struct cons_pointer env ) {
* to append, or error if the URL is faulty or indicates an unavailable * to append, or error if the URL is faulty or indicates an unavailable
* resource. * resource.
* *
* * (read-char stream) * * (open url)
* *
* @param frame my stack_frame. * @param frame my stack_frame.
* @param frame_pointer a pointer to my stack_frame. * @param frame_pointer a pointer to my stack_frame.
@ -524,6 +520,8 @@ lisp_read_char( struct stack_frame *frame, struct cons_pointer frame_pointer,
* Function: return a string representing all characters from the stream * Function: return a string representing all characters from the stream
* indicated by arg 0; further arguments are ignored. * indicated by arg 0; further arguments are ignored.
* *
* TODO: it should be possible to optionally pass a string URL to this function,
*
* * (slurp stream) * * (slurp stream)
* *
* @param frame my stack_frame. * @param frame my stack_frame.

View file

@ -170,13 +170,9 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) {
url_fputwc( L'>', output ); url_fputwc( L'>', output );
break; break;
case INTEGERTV: case INTEGERTV:
if ( nilp( cell.payload.integer.more)) { struct cons_pointer s = integer_to_string( pointer, 10 );
url_fwprintf( output, L"%ld", cell.payload.integer.value); print_string_contents( output, s );
} else { dec_ref( s );
struct cons_pointer s = integer_to_string( pointer, 10 );
print_string_contents( output, s );
dec_ref( s );
}
break; break;
case KEYTV: case KEYTV:
url_fputws( L":", output ); url_fputws( L":", output );

View file

@ -80,7 +80,7 @@ struct cons_pointer inc_ref( struct cons_pointer pointer ) {
struct cons_pointer dec_ref( struct cons_pointer pointer ) { struct cons_pointer dec_ref( struct cons_pointer pointer ) {
struct cons_space_object *cell = &pointer2cell( pointer ); struct cons_space_object *cell = &pointer2cell( pointer );
if ( cell->count > 0 ) { if ( cell->count > 0 && cell->count != UINT32_MAX) {
cell->count--; cell->count--;
if ( cell->count == 0 ) { if ( cell->count == 0 ) {
@ -307,10 +307,6 @@ struct cons_pointer make_string_like_thing( wint_t c, struct cons_pointer tail,
cell->payload.string.character = c; cell->payload.string.character = c;
cell->payload.string.cdr = tail; cell->payload.string.cdr = tail;
/* \todo There's a problem here. Sometimes the offsets on
* strings are quite massively off. Fix is probably
* cell->payload.string.cdr = tail */
//cell->payload.string.cdr.offset = tail.offset;
cell->payload.string.hash = calculate_hash( c, tail ); cell->payload.string.hash = calculate_hash( c, tail );
} else { } else {

View file

@ -94,9 +94,6 @@ struct cons_pointer lisp_make_hashmap( struct stack_frame *frame,
} }
} }
// TODO: I am not sure this is right! We do not inc_ref a string when
// we make it.
inc_ref(result);
return result; return result;
} }
@ -118,9 +115,6 @@ struct cons_pointer lisp_hashmap_put( struct stack_frame *frame,
struct cons_pointer result = hashmap_put( mapp, key, val ); struct cons_pointer result = hashmap_put( mapp, key, val );
struct cons_space_object *cell = &pointer2cell( result); struct cons_space_object *cell = &pointer2cell( result);
// if (cell->count <= 1) {
// inc_ref( result); // TODO: I DO NOT BELIEVE this is the right place!
// }
return result; return result;
// TODO: else clone and return clone. // TODO: else clone and return clone.

View file

@ -36,7 +36,7 @@
// #include "print.h" // #include "print.h"
/** /**
* The global object list/or, to put it differently, the root namespace. * @brief The global object list/or, to put it differently, the root namespace.
* What is added to this during system setup is 'global', that is, * What is added to this during system setup is 'global', that is,
* visible to all sessions/threads. What is added during a session/thread is local to * visible to all sessions/threads. What is added during a session/thread is local to
* that session/thread (because shallow binding). There must be some way for a user to * that session/thread (because shallow binding). There must be some way for a user to
@ -47,6 +47,12 @@
*/ */
struct cons_pointer oblist = NIL; struct cons_pointer oblist = NIL;
/**
* @brief the symbol `NIL`, which is special!
*
*/
struct cons_pointer privileged_symbol_nil = NIL;
/** /**
* Return a hash value for the structure indicated by `ptr` such that if * Return a hash value for the structure indicated by `ptr` such that if
* `x`,`y` are two separate structures whose print representation is the same * `x`,`y` are two separate structures whose print representation is the same
@ -163,7 +169,6 @@ struct cons_pointer hashmap_keys( struct cons_pointer mapp ) {
!nilp( c ); c = c_cdr( c ) ) { !nilp( c ); c = c_cdr( c ) ) {
result = make_cons( c_car( c_car( c ) ), result ); result = make_cons( c_car( c_car( c ) ), result );
} }
} }
} }
@ -260,6 +265,8 @@ struct cons_pointer clone_hashmap( struct cons_pointer ptr ) {
return result; return result;
} }
// (keys set let quote read equal *out* *log* oblist cons source cond close meta mapcar negative? open subtract eval nλ *in* *sink* cdr set! reverse slurp try assoc eq add list time car t *prompt* absolute append apply divide exception get-hash hashmap inspect metadata multiply print put! put-all! read-char repl throw type + * - / = lambda λ nlambda progn)
/** /**
* Implementation of interned? in C. The final implementation if interned? will * Implementation of interned? in C. The final implementation if interned? will
* deal with stores which can be association lists or hashtables or hybrids of * deal with stores which can be association lists or hashtables or hybrids of
@ -294,6 +301,8 @@ internedp( struct cons_pointer key, struct cons_pointer store ) {
// } // }
if (!nilp( c_assoc( key, store))) { if (!nilp( c_assoc( key, store))) {
result = key; result = key;
} else if ( equal( key, privileged_symbol_nil)) {
result = privileged_symbol_nil;
} }
} else { } else {
debug_print( L"`", DEBUG_BIND ); debug_print( L"`", DEBUG_BIND );

View file

@ -20,6 +20,8 @@
#ifndef __intern_h #ifndef __intern_h
#define __intern_h #define __intern_h
extern struct cons_pointer privileged_symbol_nil;
extern struct cons_pointer oblist; extern struct cons_pointer oblist;
uint32_t get_hash( struct cons_pointer ptr ); uint32_t get_hash( struct cons_pointer ptr );

View file

@ -1273,8 +1273,6 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
struct cons_pointer old_oblist = oblist; struct cons_pointer old_oblist = oblist;
struct cons_pointer new_env = env; struct cons_pointer new_env = env;
inc_ref( env );
if (truep(frame->arg[0])) { if (truep(frame->arg[0])) {
new_env = set( prompt_name, frame->arg[0], new_env); new_env = set( prompt_name, frame->arg[0], new_env);
} }
@ -1338,7 +1336,6 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
expr = lisp_read( get_stack_frame( frame_pointer ), frame_pointer, expr = lisp_read( get_stack_frame( frame_pointer ), frame_pointer,
new_env ); new_env );
inc_ref( expr );
if ( exceptionp( expr ) if ( exceptionp( expr )
&& url_feof( pointer2cell( input ).payload.stream.stream ) ) { && url_feof( pointer2cell( input ).payload.stream.stream ) ) {
@ -1356,7 +1353,7 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
dec_ref( input ); dec_ref( input );
dec_ref( output ); dec_ref( output );
dec_ref( prompt_name ); dec_ref( prompt_name );
dec_ref( env ); dec_ref( new_env);
debug_printf(DEBUG_REPL, L"Leaving inner repl\n"); debug_printf(DEBUG_REPL, L"Leaving inner repl\n");

View file

@ -1,79 +1,92 @@
#!/bin/bash #!/bin/bash
result=0;
echo -n "$0: Add two small integers... "
expected='5' expected='5'
actual=`echo "(add 2 3)" | target/psse | tail -1` actual=`echo "(add 2 3)" | target/psse 2>/dev/null | sed -r '/^\s*$/d' | tail -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
exit 1 result=`echo "${result} + 1" | bc`
fi fi
echo -n "$0: Add float to integer... "
expected='5.5' expected='5.5'
actual=`echo "(add 2.5 3)" | target/psse | tail -1` actual=`echo "(add 2.5 3)" | target/psse 2>/dev/null | sed -r '/^\s*$/d' | tail -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then
echo "OK" echo "OK"
exit 0
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
exit 1 result=`echo "${result} + 1" | bc`
fi fi
echo -n "$0: Add two rationals... "
expected='1/4' expected='1/4'
actual=`echo "(+ 3/14 1/28)" | target/psse | tail -1` actual=`echo "(+ 3/14 1/28)" | target/psse 2>/dev/null | sed -r '/^\s*$/d' | tail -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
exit 1 result=`echo "${result} + 1" | bc`
fi fi
echo -n "$0: Add an integer to a rational... "
# (+ integer ratio) should be ratio # (+ integer ratio) should be ratio
expected='25/4' expected='25/4'
actual=`echo "(+ 6 1/4)" | target/psse | tail -1` actual=`echo "(+ 6 1/4)" | target/psse 2>/dev/null | sed -r '/^\s*$/d' | tail -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
exit 1 result=`echo "${result} + 1" | bc`
fi fi
echo -n "$0: Add a rational to an integer... "
# (+ ratio integer) should be ratio # (+ ratio integer) should be ratio
expected='25/4' expected='25/4'
actual=`echo "(+ 1/4 6)" | target/psse | tail -1` actual=`echo "(+ 1/4 6)" | target/psse 2>/dev/null | sed -r '/^\s*$/d' | tail -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
exit 1 result=`echo "${result} + 1" | bc`
fi fi
echo -n "$0: Add a real to a rational... "
# (+ real ratio) should be real # (+ real ratio) should be real
# for this test, trailing zeros can be ignored # for this test, trailing zeros can be ignored
expected='6.25' expected='6.25'
actual=`echo "(+ 6.000000001 1/4)" |\ actual=`echo "(+ 6.000000001 1/4)" |\
target/psse 2> /dev/null |\ target/psse 2> /dev/null |\
sed 's/0*$//' |\ sed -r '/^\s*$/d' |\
head -2 |\ sed 's/0*$//'
tail -1`
outcome=`echo "sqrt((${expected} - ${actual})^2) < 0.0000001" | bc` outcome=`echo "sqrt((${expected} - ${actual})^2) < 0.0000001" | bc`
if [ "${outcome}" = "1" ] if [ "${outcome}" -eq "1" ]
then then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
exit 1 result=`echo "${result} + 1" | bc `
fi fi
exit ${result}

View file

@ -1,24 +1,44 @@
#!/bin/bash #!/bin/bash
return=0;
echo -n "$0: Append two lists... "
expected='(a b c d e f)' expected='(a b c d e f)'
actual=`echo "(append '(a b c) '(d e f))" | target/psse | tail -1` actual=`echo "(append '(a b c) '(d e f))" | target/psse 2>/dev/null | tail -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
exit 1 return=`echo "${return} + 1" | bc`
fi fi
echo -n "$0: Append two strings... "
expected='"hellodere"' expected='"hellodere"'
actual=`echo '(append "hello" "dere")' | target/psse | tail -1` actual=`echo '(append "hello" "dere")' | target/psse 2>/dev/null | tail -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
exit 1 return=`echo "${return} + 1" | bc`
fi fi
echo -n "$0: Append keyword to string should error... "
expected='Exception:'
actual=`echo '(append "hello" :dere)' | target/psse 2>/dev/null | sed -r '/^\s*$/d' | awk '{print $1}'`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
return=`echo "${return} + 1" | bc`
fi
exit ${return}

View file

@ -1,13 +1,29 @@
#!/bin/bash #!/bin/bash
result=1
echo -n "$0: Apply function to one argument... "
expected='1' expected='1'
actual=`echo "(apply 'add '(1))"| target/psse | tail -1` actual=`echo "(apply 'add '(1))"| target/psse 2>/dev/null | tail -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then
echo "OK" echo "OK"
exit 0
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
exit 1 result=`echo "${result} + 1" | bc`
fi fi
echo -n "$0: Apply function to multiple arguments... "
expected='3'
actual=`echo "(apply 'add '(1 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}

View file

@ -9,7 +9,7 @@ a=1152921504606846975
b=1 b=1
c=`echo "$a + $b" | bc` c=`echo "$a + $b" | bc`
expected='t' expected='t'
output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>psse.log` output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
actual=`echo $output |\ actual=`echo $output |\
tail -1` tail -1`
@ -20,17 +20,17 @@ then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
return=1 return=`echo "${return} + 1" | bc`
fi fi
echo -n "checking no bignum was created: " echo -n "$0: checking no bignum was created: "
grep -v 'BIGNUM!' psse.log > /dev/null grep -v 'BIGNUM!' tmp/psse.log > /dev/null
if [ $? -eq "0" ] if [ $? -eq "0" ]
then then
echo "OK" echo "OK"
else else
echo "Fail" echo "Fail"
return=1 return=`echo "${return} + 1" | bc`
fi fi
##################################################################### #####################################################################
@ -40,7 +40,7 @@ a='1152921504606846976'
b=1 b=1
c=`echo "$a + $b" | bc` c=`echo "$a + $b" | bc`
expected='t' expected='t'
output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>psse.log` output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
actual=`echo $output |\ actual=`echo $output |\
tail -1 |\ tail -1 |\
@ -52,17 +52,17 @@ then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
return=1 return=`echo "${return} + 1" | bc`
fi fi
echo -n "$0 => checking a bignum was created: " echo -n "$0 => checking a bignum was created: "
grep 'BIGNUM!' psse.log > /dev/null grep 'BIGNUM!' tmp/psse.log > /dev/null
if [ $? -eq "0" ] if [ $? -eq "0" ]
then then
echo "OK" echo "OK"
else else
echo "Fail" echo "Fail"
return=1 return=`echo "${return} + 1" | bc`
fi fi
@ -73,7 +73,7 @@ a='1152921504606846977'
b=1 b=1
c=`echo "$a + $b" | bc` c=`echo "$a + $b" | bc`
expected='t' expected='t'
output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>psse.log` output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
actual=`echo $output |\ actual=`echo $output |\
tail -1 |\ tail -1 |\
@ -85,17 +85,17 @@ then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
return=1 return=`echo "${return} + 1" | bc`
fi fi
echo -n "$0 => checking a bignum was created: " echo -n "$0 => checking a bignum was created: "
grep 'BIGNUM!' psse.log > /dev/null grep 'BIGNUM!' tmp/psse.log > /dev/null
if [ $? -eq "0" ] if [ $? -eq "0" ]
then then
echo "OK" echo "OK"
else else
echo "Fail" echo "Fail"
return=1 return=`echo "${return} + 1" | bc`
fi fi
##################################################################### #####################################################################
@ -106,7 +106,7 @@ a=1
b=1152921504606846977 b=1152921504606846977
c=`echo "$a + $b" | bc` c=`echo "$a + $b" | bc`
expected='t' expected='t'
output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>psse.log` output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
actual=`echo $output |\ actual=`echo $output |\
tail -1 |\ tail -1 |\
@ -118,17 +118,17 @@ then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
return=1 return=`echo "${return} + 1" | bc`
fi fi
echo -n "checking a bignum was created: " echo -n "$0 => checking a bignum was created: "
grep 'BIGNUM!' psse.log > /dev/null grep 'BIGNUM!' tmp/psse.log > /dev/null
if [ $? -eq "0" ] if [ $? -eq "0" ]
then then
echo "OK" echo "OK"
else else
echo "Fail" echo "Fail"
return=1 return=`echo "${return} + 1" | bc`
fi fi
@ -139,7 +139,7 @@ a=1152921504606846977
c=`echo "$a + $a" | bc` c=`echo "$a + $a" | bc`
echo -n "$0 => adding $a to $a: " echo -n "$0 => adding $a to $a: "
expected='t' expected='t'
output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>psse.log` output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
actual=`echo $output |\ actual=`echo $output |\
tail -1 |\ tail -1 |\
@ -150,7 +150,7 @@ then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
return=1 return=`echo "${return} + 1" | bc`
fi fi
##################################################################### #####################################################################
@ -160,7 +160,7 @@ a=1152921504606846977
c=`echo "$a * 5" | bc` c=`echo "$a * 5" | bc`
echo -n "$0 => adding $a, $a $a, $a, $a: " echo -n "$0 => adding $a, $a $a, $a, $a: "
expected='t' expected='t'
output=`echo "(= (+ $a $a $a $a $a) $c)" | target/psse -v 2 2>psse.log` output=`echo "(= (+ $a $a $a $a $a) $c)" | target/psse -v 2 2>tmp/psse.log`
actual=`echo $output |\ actual=`echo $output |\
tail -1 |\ tail -1 |\
@ -171,7 +171,7 @@ then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
return=1 return=`echo "${return} + 1" | bc`
fi fi
@ -183,7 +183,7 @@ a=10000000000000000000
b=10000000000000000000 b=10000000000000000000
c=`echo "$a + $b" | bc` c=`echo "$a + $b" | bc`
expected='t' expected='t'
output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>psse.log` output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
actual=`echo $output |\ actual=`echo $output |\
tail -1 |\ tail -1 |\
@ -195,17 +195,17 @@ then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
return=1 return=`echo "${return} + 1" | bc`
fi fi
echo -n "$0 => checking a bignum was created: " echo -n "$0 => checking a bignum was created: "
grep 'BIGNUM!' psse.log > /dev/null grep 'BIGNUM!' tmp/psse.log > /dev/null
if [ $? -eq "0" ] if [ $? -eq "0" ]
then then
echo "OK" echo "OK"
else else
echo "Fail" echo "Fail"
return=1 return=`echo "${return} + 1" | bc`
fi fi
@ -216,7 +216,7 @@ a=1
b=1329227995784915872903807060280344576 b=1329227995784915872903807060280344576
c=`echo "$a + $b" | bc` c=`echo "$a + $b" | bc`
expected='t' expected='t'
output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>psse.log` output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
actual=`echo $output |\ actual=`echo $output |\
tail -1 |\ tail -1 |\
@ -228,17 +228,17 @@ then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
return=1 return=`echo "${return} + 1" | bc`
fi fi
echo -n "$0 => checking a bignum was created: " echo -n "$0 => checking a bignum was created: "
grep 'BIGNUM!' psse.log > /dev/null grep 'BIGNUM!' tmp/psse.log > /dev/null
if [ $? -eq "0" ] if [ $? -eq "0" ]
then then
echo "OK" echo "OK"
else else
echo "Fail" echo "Fail"
return=1 return=`echo "${return} + 1" | bc`
fi fi
@ -250,7 +250,7 @@ a=1
b=3064991081731777716716694054300618367237478244367204352 b=3064991081731777716716694054300618367237478244367204352
c=`echo "$a + $b" | bc` c=`echo "$a + $b" | bc`
expected='t' expected='t'
output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>psse.log` output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
actual=`echo $output |\ actual=`echo $output |\
tail -1 |\ tail -1 |\
@ -262,17 +262,17 @@ then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
return=1 return=`echo "${return} + 1" | bc`
fi fi
echo -n "$0 => checking a bignum was created: " echo -n "$0 => checking a bignum was created: "
grep 'BIGNUM!' psse.log > /dev/null grep 'BIGNUM!' tmp/psse.log > /dev/null
if [ $? -eq "0" ] if [ $? -eq "0" ]
then then
echo "OK" echo "OK"
else else
echo "Fail" echo "Fail"
return=1 return=`echo "${return} + 1" | bc`
fi fi
exit ${return} exit ${return}

View file

@ -1,6 +1,6 @@
#!/bin/bash #!/bin/bash
return=0 result=0
##################################################################### #####################################################################
# subtract a smallnum from a smallnum to produce a smallnum # subtract a smallnum from a smallnum to produce a smallnum
@ -20,17 +20,17 @@ then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
return=1 result=`echo "${result} + 1" | bc`
fi fi
echo -n "checking no bignum was created: " echo -n "$0 => checking no bignum was created: "
grep -v 'BIGNUM!' psse.log > /dev/null grep -v 'BIGNUM!' psse.log > /dev/null
if [ $? -eq "0" ] if [ $? -eq "0" ]
then then
echo "OK" echo "OK"
else else
echo "Fail" echo "Fail"
return=1 result=`echo "${result} + 1" | bc`
fi fi
##################################################################### #####################################################################
@ -51,7 +51,7 @@ then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
return=1 result=`echo "${result} + 1" | bc`
fi fi
##################################################################### #####################################################################
@ -71,7 +71,7 @@ then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
return=1 result=`echo "${result} + 1" | bc`
fi fi
@ -93,7 +93,7 @@ then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
return=1 result=`echo "${result} + 1" | bc`
fi fi
##################################################################### #####################################################################
@ -113,7 +113,7 @@ then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
return=1 result=`echo "${result} + 1" | bc`
fi fi
exit ${return} exit ${result}

View file

@ -1,7 +1,7 @@
#!/bin/bash #!/bin/bash
expected='(1 2 3 ("Fred") nil 77,354)' expected='(1 2 3 ("Fred") nil 77,354)'
actual=`echo "'(1 2 3 (\"Fred\") () 77354)" | target/psse | tail -1` actual=`echo "'(1 2 3 (\"Fred\") () 77354)" | target/psse 2>/dev/null | tail -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then

View file

@ -2,26 +2,30 @@
result=0 result=0
echo -n "$0: cond with one clause... "
expected='5' expected='5'
actual=`echo "(cond ((equal 2 2) 5))" | target/psse | tail -1` actual=`echo "(cond ((equal 2 2) 5))" | target/psse 2>/dev/null | tail -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
result=1 result=`echo "${result} + 1" | bc`
fi fi
echo -n "$0: cond with two clauses... "
expected='"should"' expected='"should"'
actual=`echo "(cond ((equal 2 3) \"shouldn't\")(t \"should\"))" | target/psse | tail -1` actual=`echo "(cond ((equal 2 3) \"shouldn't\")(t \"should\"))" | target/psse 2>/dev/null | tail -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
result=1 result=`echo "${result} + 1" | bc`
fi fi
exit ${result} exit ${result}

View file

@ -2,26 +2,28 @@
result=0 result=0
echo -n "$0: let with two bindings, one form in body..."
expected='11' expected='11'
actual=`echo "(let ((a . 5)(b . 6)) (+ a b))" | target/psse | tail -1` actual=`echo "(let ((a . 5)(b . 6)) (+ a b))" | target/psse 2>/dev/null | tail -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then
echo "OK" echo "OK"
else else
echo "Fail: expected '$expected', got '$actual'" echo "Fail: expected '$expected', got '$actual'"
result=1 result=`echo "${result} + 1" | bc`
fi fi
echo -n "$0: let with two bindings, two forms in body..."
expected='1' expected='1'
actual=`echo "(let ((a . 5)(b . 6)) (+ a b) (- b a))" | target/psse | tail -1` actual=`echo "(let ((a . 5)(b . 6)) (+ a b) (- b a))" | target/psse 2>/dev/null | tail -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then
echo "OK" echo "OK"
else else
echo "Fail: expected '$expected', got '$actual'" echo "Fail: expected '$expected', got '$actual'"
result=1 result=`echo "${result} + 1" | bc`
fi fi
exit ${result} exit ${result}

View file

@ -1,42 +0,0 @@
#!/bin/bash
result=0
expected="(0 1 2 3 4 5 6 7 8 9 a b c d e f)"
actual=`echo "(list 0 1 2 3 4 5 6 7 8 9 'a 'b 'c 'd 'e 'f)" | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
else
echo "Fail: expected '$expected', got '$actual'"
result=1
fi
expected="(0 1 2 3 4)"
actual=`echo "(list 0 1 2 3 4)" | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
else
echo "Fail: expected '$expected', got '$actual'"
result=1
fi
expected="(0 1 2 3 4 5 6 7)"
actual=`echo "(list 0 1 2 3 4 5 6 7)" | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
exit 0
else
echo "Fail: expected '$expected', got '$actual'"
result=1
fi
exit ${result}

47
unit-tests/list-test.sh Normal file
View file

@ -0,0 +1,47 @@
#!/bin/bash
result=0
echo -n "$0: flat list with 16 elements... "
expected="(0 1 2 3 4 5 6 7 8 9 a b c d e f)"
actual=`echo "(list 0 1 2 3 4 5 6 7 8 9 'a 'b 'c 'd 'e 'f)" |\
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: flat list with 5 elements... "
expected="(0 1 2 3 4)"
actual=`echo "(list 0 1 2 3 4)" | 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: flat list with 8 elements... "
expected="(0 1 2 3 4 5 6 7)"
actual=`echo "(list 0 1 2 3 4 5 6 7)" | target/psse 2>/dev/null | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
exit 0
else
echo "Fail: expected '$expected', got '$actual'"
result=`echo "${result} + 1" | bc`
fi
exit ${result}

View file

@ -1,28 +1,30 @@
#!/bin/bash #!/bin/bash
result=1 result=0
echo -n "$0: plus with fifteen arguments... "
expected="120" expected="120"
actual=`echo "(+ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)" | target/psse | tail -1` actual=`echo "(+ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)" | target/psse 2>/dev/null | tail -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
result=1 result=`echo "${result} + 1" | bc`
fi fi
# check that all the args are actually being evaluated... echo -n "$0: check that all the args are actually being evaluated... "
expected="120" expected="120"
actual=`echo "(+ (+ 0 1) (+ 0 2) (+ 0 3) (+ 0 4) (+ 0 5) (+ 0 6) (+ 0 7) (+ 0 8) (+ 0 9) (+ 0 10) (+ 0 11) (+ 0 12) (+ 0 13) (+ 0 14 ) (+ 0 15))" | target/psse | tail -1` actual=`echo "(+ (+ 0 1) (+ 0 2) (+ 0 3) (+ 0 4) (+ 0 5) (+ 0 6) (+ 0 7) (+ 0 8) (+ 0 9) (+ 0 10) (+ 0 11) (+ 0 12) (+ 0 13) (+ 0 14 ) (+ 0 15))" | target/psse 2>/dev/null | tail -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
result=1 result=`echo "${result} + 1" | bc`
fi fi
return ${result} exit ${result}

View file

@ -5,9 +5,9 @@ result=0
##################################################################### #####################################################################
# Create an empty map using map notation # Create an empty map using map notation
expected='{}' expected='{}'
actual=`echo "$expected" | target/psse | tail -1` actual=`echo "$expected" | target/psse 2>/dev/null | tail -1`
echo -n "Empty map using compact map notation: " echo -n "$0: Empty map using compact map notation... "
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then
echo "OK" echo "OK"
@ -19,7 +19,7 @@ fi
##################################################################### #####################################################################
# Create an empty map using make-map # Create an empty map using make-map
expected='{}' expected='{}'
actual=`echo "(hashmap)" | target/psse | tail -1` actual=`echo "(hashmap)" | target/psse 2>/dev/null | tail -1`
echo -n "Empty map using (make-map): " echo -n "Empty map using (make-map): "
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
@ -35,9 +35,9 @@ fi
# significant at this stage, but in the long term should be sorted # significant at this stage, but in the long term should be sorted
# alphanumerically # alphanumerically
expected='{:one 1, :two 2, :three 3}' expected='{:one 1, :two 2, :three 3}'
actual=`echo "{:one 1 :two 2 :three 3}" | target/psse | tail -1` actual=`echo "{:one 1 :two 2 :three 3}" | target/psse 2>/dev/null | tail -1`
echo -n "Map using map notation: " echo -n "$0: Map using map notation... "
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then
echo "OK" echo "OK"
@ -51,9 +51,10 @@ fi
# significant at this stage, but in the long term should be sorted # significant at this stage, but in the long term should be sorted
# alphanumerically # alphanumerically
expected='{:one 1, :two 2, :three 3}' expected='{:one 1, :two 2, :three 3}'
actual=`echo "(hashmap nil nil '((:one . 1)(:two . 2)(:three . 3)))" | target/psse | tail -1` actual=`echo "(hashmap nil nil '((:one . 1)(:two . 2)(:three . 3)))" |\
target/psse 2>/dev/null | tail -1`
echo -n "Map using (hashmap): " echo -n "$0: Map using (hashmap) with arguments... "
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then
echo "OK" echo "OK"
@ -65,9 +66,9 @@ fi
##################################################################### #####################################################################
# Keyword in function position # Keyword in function position
expected='2' expected='2'
actual=`echo "(:two {:one 1 :two 2 :three 3})" | target/psse | tail -1` actual=`echo "(:two {:one 1 :two 2 :three 3})" | target/psse 2>/dev/null | tail -1`
echo -n "Keyword in function position: " echo -n "$0: Keyword in function position... "
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then
echo "OK" echo "OK"
@ -80,9 +81,9 @@ fi
##################################################################### #####################################################################
# Map in function position # Map in function position
expected='2' expected='2'
actual=`echo "({:one 1 :two 2 :three 3} :two)" | target/psse | tail -1` actual=`echo "({:one 1 :two 2 :three 3} :two)" | target/psse 2>/dev/null | tail -1`
echo -n "Map in function position: " echo -n "$0: Map in function position... "
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then
echo "OK" echo "OK"

View file

@ -2,26 +2,30 @@
result=0 result=0
echo -n "$0: multiply two integers... "
expected='6' expected='6'
actual=`echo "(multiply 2 3)" | target/psse | tail -1` actual=`echo "(multiply 2 3)" | target/psse 2>/dev/null | tail -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
result=1 result=`echo "${result} + 1" | bc`
fi fi
echo -n "$0: multiply a real by an integer... "
expected='7.5' expected='7.5'
actual=`echo "(multiply 2.5 3)" | target/psse | tail -1` actual=`echo "(multiply 2.5 3)" | target/psse 2>/dev/null | tail -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
result=1 result=`echo "${result} + 1" | bc`
fi fi
exit ${result} exit ${result}

View file

@ -1,7 +1,7 @@
#!/bin/bash #!/bin/bash
expected=nil expected=nil
actual=`echo 'nil' | target/psse | tail -1` actual=`echo 'nil' | target/psse 2>/dev/null | tail -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then

View file

@ -4,8 +4,9 @@ result=0
##################################################################### #####################################################################
# Create a path from root using compact path notation # Create a path from root using compact path notation
echo -n "$0: Create a path from root using compact path notation... "
expected='(-> oblist :users :simon :functions (quote assoc))' expected='(-> oblist :users :simon :functions (quote assoc))'
actual=`echo "'/:users:simon:functions/assoc" | target/psse | tail -1` actual=`echo "'/:users:simon:functions/assoc" | target/psse 2>&1 | tail -1`
echo -n "Path from root (oblist) using compact notation: " echo -n "Path from root (oblist) using compact notation: "
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
@ -13,21 +14,21 @@ then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
result=1 result=`echo "${result} + 1" | bc`
fi fi
##################################################################### #####################################################################
# Create a path from the current session using compact path notation # Create a path from the current session using compact path notation
echo -n "$0: Create a path from the current session using compact path notation... "
expected='(-> session :input-stream)' expected='(-> session :input-stream)'
actual=`echo "'$:input-stream" | target/psse | tail -1` actual=`echo "'$:input-stream" | target/psse 2>/dev/null | tail -1`
echo -n "Path from current session using compact notation: "
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
result=1 result=`echo "${result} + 1" | bc`
fi fi
exit ${result} exit ${result}

View file

@ -2,26 +2,28 @@
result=0 result=0
echo -n "$0: progn with one form... "
expected='5' expected='5'
actual=`echo "(progn (add 2 3))" | target/psse | tail -1` actual=`echo "(progn (add 2 3))" | target/psse 2>/dev/null | tail -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
result=1 result=`echo "${result} + 1" | bc`
fi fi
echo -n "$0: progn with two forms... "
expected='"foo"' expected='"foo"'
actual=`echo "(progn (add 2.5 3) \"foo\")" | target/psse | tail -1` actual=`echo "(progn (add 2.5 3) \"foo\")" | target/psse 2>/dev/null | tail -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
result=1 result=`echo "${result} + 1" | bc`
fi fi
exit ${result} exit ${result}

View file

@ -1,7 +1,7 @@
#!/bin/bash #!/bin/bash
expected='Fred' expected='Fred'
actual=`echo "'Fred" | target/psse | tail -1` actual=`echo "'Fred" | target/psse 2>&1 | tail -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then

View file

@ -1,7 +1,7 @@
#!/bin/bash #!/bin/bash
expected='(123 (4 (5 nil)) Fred)' expected='(123 (4 (5 nil)) Fred)'
actual=`echo "'(123 (4 (5 ())) Fred)" | target/psse | tail -1` actual=`echo "'(123 (4 (5 ())) Fred)" | target/psse 2>&1 | tail -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then

View file

@ -1,7 +1,7 @@
#!/bin/bash #!/bin/bash
expected='1/4' expected='1/4'
actual=`echo "(+ 3/14 1/28)" | target/psse | tail -1` actual=`echo "(+ 3/14 1/28)" | target/psse 2>&1 | tail -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then

View file

@ -2,30 +2,33 @@
result=0 result=0
echo -n "$0: reverse a string... "
expected='"god yzal eht revo depmuj xof nworb kciuq ehT"' expected='"god yzal eht revo depmuj xof nworb kciuq ehT"'
actual=`echo '(reverse "The quick brown fox jumped over the lazy dog")' | target/psse | tail -1` actual=`echo '(reverse "The quick brown fox jumped over the lazy dog")' | target/psse 2>&1 | tail -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
result=1 result=`echo "${result} + 1" | bc`
fi fi
echo -n "$0: reverse a list... "
expected='(1,024 512 256 128 64 32 16 8 4 2)' expected='(1,024 512 256 128 64 32 16 8 4 2)'
actual=`echo "(reverse '(2 4 8 16 32 64 128 256 512 1024))" | target/psse | tail -1` actual=`echo "(reverse '(2 4 8 16 32 64 128 256 512 1024))" | target/psse 2>&1 | tail -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
result=1 result=`echo "${result} + 1" | bc`
fi fi
echo -n "$0: reverse a symbol... "
expected='esrever' expected='esrever'
actual=`echo "(reverse 'reverse)" | target/psse | tail -1` actual=`echo "(reverse 'reverse)" | target/psse 2>&1 | tail -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then
@ -33,8 +36,8 @@ then
exit 0 exit 0
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
result=1 result=`echo "${result} + 1" | bc`
fi fi
echo ${result} exit ${result}

View file

@ -1,7 +1,7 @@
#!/bin/bash #!/bin/bash
expected="(1 2 3)" expected="(1 2 3)"
actual=`echo "'(1 2 3)" | target/psse | tail -1` actual=`echo "'(1 2 3)" | target/psse 2>&1 | tail -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then

View file

@ -1,9 +1,9 @@
#!/bin/bash #!/bin/bash
tmp=hi.$$ tmp=tmp/hi.$$
echo "Hello, there." > ${tmp} echo "Hello, there." > ${tmp}
expected='"Hello, there.' expected='"Hello, there.'
actual=`echo "(slurp (open \"${tmp}\"))" | target/psse | tail -2 | head -1` actual=`echo "(slurp (open \"${tmp}\"))" | target/psse 2>&1 | tail -2 | head -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then

View file

@ -2,28 +2,28 @@
result=0 result=0
# We should be able to cons a single character string onto the front of a string echo -n "$0: We should be able to cons a single character string onto the front of a string... "
expected='"Test"' expected='"Test"'
actual=`echo '(cons "T" "est")' | target/psse | tail -1` actual=`echo '(cons "T" "est")' | target/psse 2>/dev/null | tail -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
result=1 result=`echo "${result} + 1" | bc`
fi fi
# But if the first argument has more than one character, we should get a dotted pair echo -n "$0: But if the first argument has more than one character, we should get a dotted pair... "
expected='("Test" . "pass")' expected='("Test" . "pass")'
actual=`echo '(cons "Test" "pass")' | target/psse | tail -1` actual=`echo '(cons "Test" "pass")' | target/psse 2>&1 | tail -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
result=1 result=`echo "${result} + 1" | bc`
fi fi
exit ${result} exit ${result}

View file

@ -1,7 +1,7 @@
#!/bin/bash #!/bin/bash
expected='"Strings should be able to include spaces (and other stuff)!"' expected='"Strings should be able to include spaces (and other stuff)!"'
actual=`echo ${expected} | target/psse | tail -1` actual=`echo ${expected} | target/psse 2>&1 | tail -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then

View file

@ -1,45 +1,54 @@
#!/bin/bash #!/bin/bash
result=0
echo -n "$0: if the body of a try errors, the last form in the catch block is returned... "
expected=':foo' expected=':foo'
actual=`echo "(try ((+ 2 (/ 1 'a))) (:foo))" | target/psse | tail -1` actual=`echo "(try ((+ 2 (/ 1 'a))) (:foo))" | target/psse 2>&1 | tail -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
exit 1 return=`echo "${return} + 1" | bc`
fi fi
echo -n "$0: if the body of a try errors, the last form in the catch block is evaluated... "
expected='4' expected='4'
actual=`echo "(try ((+ 2 (/ 1 'a))) ((+ 2 2)))" | target/psse | tail -1` actual=`echo "(try ((+ 2 (/ 1 'a))) ((+ 2 2)))" | target/psse 2>&1 | tail -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
exit 1 return=`echo "${return} + 1" | bc`
fi fi
echo -n "$0: body and catch block can optionally be marked with keywords... "
expected='8' expected='8'
actual=`echo "(try (:body (+ 2 (/ 1 'a))) (:catch (* 2 2 2)))" | target/psse | tail -1` actual=`echo "(try (:body (+ 2 (/ 1 'a))) (:catch (* 2 2 2)))" | target/psse 2>&1 | tail -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
exit 1 return=`echo "${return} + 1" | bc`
fi fi
expected='' echo -n "$0: the exception is bound to the symbol \`*exception*\` in the catch environment... "
actual=`echo "(try (:body (+ 2 (/ 1 'a))) (:catch *exception*))" | target/psse | tail -1` expected='Exception: "Cannot divide: not a number"'
actual=`echo "(try (:body (+ 2 (/ 1 'a))) (:catch *exception*))" | target/psse 2>&1 | grep Exception`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then
echo "OK" echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
exit 1 return=`echo "${return} + 1" | bc`
fi fi
exit ${result}

View file

@ -1,7 +1,7 @@
#!/bin/bash #!/bin/bash
expected='(1 2 3 4 5 6 7 8 9 10)' expected='(1 2 3 4 5 6 7 8 9 10)'
actual=`echo "(set! list (lambda l l))(list 1 2 3 4 5 6 7 8 9 10)" |target/psse | tail -1` actual=`echo "(set! list (lambda l l))(list 1 2 3 4 5 6 7 8 9 10)" | target/psse 2>&1 | tail -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then

View file

@ -1,7 +1,7 @@
#!/bin/bash #!/bin/bash
expected='"λάμ(β)δα"' expected='"λάμ(β)δα"'
actual=`echo $expected | target/psse | tail -1` actual=`echo $expected | target/psse 2>&1 | tail -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then