Commit 9bb14300 authored by Chris Müller's avatar Chris Müller
Browse files

Improve error messages in runtime calls

parent 2fda67c6
......@@ -89,7 +89,7 @@ struct value*
core_type(struct environment* env, struct value* args)
{
if(IS_NULL(args))
core_raise(env, string("type functions expects an argument"));
core_raise(env, string("cherry.core/type: type functions expects an argument"));
switch(HEAD(args)->tag) {
case FIXNUM:
......@@ -124,7 +124,7 @@ struct value*
core_cons(struct environment* env, struct value* args)
{
if(IS_NULL(args) || IS_NULL(TAIL(args)) || !IS_NULL(TAIL(TAIL(args))))
core_raise(env, string("cons only accept exactly two parameters"));
core_raise(env, string("cherry.core/cons: only accept exactly two parameters"));
TAIL(args) = HEAD(TAIL(args));
......@@ -143,7 +143,7 @@ struct value*
core_is_null(struct environment* env, struct value* args)
{
if(IS_NULL(args))
core_raise(env, string("null? expects an operand"));
core_raise(env, string("cherry.core/null?: expects an operand"));
return IS_NULL(HEAD(args)) ? True : False;
}
......@@ -154,7 +154,7 @@ struct value*
core_make_list(struct environment* env, struct value* args)
{
if(IS_NULL(args) || !IS_FIXNUM(HEAD(args)) || IS_NULL(TAIL(args)))
core_raise(env, string("make-list expects a length fixnum and an initialization element"));
core_raise(env, string("cherry.core/make-list: expects a length fixnum and an initialization element"));
fixnum_t length = HEAD(args)->fixnum_value;
struct value* element = HEAD(TAIL(args));
......@@ -171,7 +171,7 @@ struct value*
core_head(struct environment* env, struct value* args)
{
if(IS_NULL(args) || !IS_PAIR(HEAD(args)))
core_raise(env, string("no list is given for the first operand"));
core_raise(env, string("cherry.core/head: no list is given for the first operand"));
return HEAD(HEAD(args));
}
......@@ -180,7 +180,7 @@ struct value*
core_tail(struct environment* env, struct value* args)
{
if(IS_NULL(args) || !IS_PAIR(HEAD(args)))
core_raise(env, string("no list is given for the first operand"));
core_raise(env, string("cherry.core/tail: no list is given for the first operand"));
return TAIL(HEAD(args));
}
......@@ -210,7 +210,7 @@ core_length(struct environment* env, struct value* args)
return fixnum(TUPLE_SIZE(value));
default:
core_raise(env, string("length expects a string, tuple or a pair for the first operand"));
core_raise(env, string("cherry.core/length: length expects a string, tuple or a pair for the first operand"));
}
return fixnum(length);
......@@ -221,7 +221,7 @@ struct value*
core_nth(struct environment* env, struct value* args)
{
if(IS_NULL(args) || IS_NULL(TAIL(args)) || !IS_FIXNUM(HEAD(TAIL(args))))
core_raise(env, string("nth expects a value and a following fixnum as index"));
core_raise(env, string("cherry.core/nth: expects a value and a following fixnum as index"));
struct value* value = HEAD(args);
fixnum_t index = HEAD(TAIL(args))->fixnum_value;
......@@ -267,7 +267,7 @@ struct value*
core_map(struct environment* env, struct value* args)
{
if(IS_NULL(args) || IS_NULL(TAIL(args)) || !IS_PROCEDURE(HEAD(args)) || !IS_PAIR(HEAD(TAIL(args))))
core_raise(env, string("map expects a function and a list"));
core_raise(env, string("cherry.core/map: expects a function and a list"));
struct value* result = value_alloc();
struct value* proc = HEAD(args);
......@@ -292,14 +292,14 @@ struct value*
core_list_to_string(struct environment* env, struct value* args)
{
if(IS_NULL(args) || !IS_PAIR(HEAD(args)))
core_raise(env, string("list->string expects a pair for the first operand"));
core_raise(env, string("cherry.core/list->string: expects a pair for the first operand"));
struct value* result = HEAD(args);
size_t size = 0;
while(!IS_NULL(result)) {
if(!IS_CHAR(HEAD(result)))
core_raise(env, string("list->string expects a list of characters"));
core_raise(env, string("cherry.core/list->string: expects a list of characters"));
size += unicode_to_utf8(0, HEAD(result)->char_value);
result = TAIL(result);
}
......@@ -322,7 +322,7 @@ struct value*
core_list_to_tuple(struct environment* env, struct value* args)
{
if(IS_NULL(args) || !IS_PAIR(HEAD(args)))
core_raise(env, string("list->tuple expects a pair for the first operand"));
core_raise(env, string("cherry.core/list->tuple: expects a pair for the first operand"));
struct value* result = HEAD(args);
size_t size = 0;
......@@ -374,7 +374,7 @@ struct value*
core_make_tuple(struct environment* env, struct value* args)
{
if(IS_NULL(args) || !IS_FIXNUM(HEAD(args)) || !IS_NULL(TAIL(args)))
core_raise(env, string("make-list expects a length fixnum and an initialization element"));
core_raise(env, string("cherry.core/make-tuple: expects a length fixnum and an initialization element"));
fixnum_t length = HEAD(args)->fixnum_value;
struct value* element = HEAD(TAIL(args));
......@@ -389,12 +389,21 @@ core_make_tuple(struct environment* env, struct value* args)
}
struct value*
core_is_string(struct environment* env, struct value* args)
{
if(IS_NULL(args))
return False;
return IS_STRING(HEAD(args)) ? True : False;
}
struct value*
core_string_to_list(struct environment* env, struct value* args)
{
if(IS_NULL(args) || !IS_STRING(HEAD(args)))
core_raise(env, string("string->list accepts only one string as argument"));
core_raise(env, string("cherry.core/string->list: accepts only one string as argument"));
const byte_t* p = HEAD(args)->string_value;
struct value* lst = emptylist;
......@@ -414,7 +423,7 @@ struct value*
core_string_to_tuple(struct environment* env, struct value* args)
{
if(IS_NULL(args) || !IS_STRING(HEAD(args)))
core_raise(env, string("string->list accepts only one string as argument"));
core_raise(env, string("cherry.core/string->tuple: accepts only one string as argument"));
const byte_t* p = HEAD(args)->string_value;
size_t size = utf8_len(p);
......@@ -431,10 +440,10 @@ core_string_to_tuple(struct environment* env, struct value* args)
struct value*
core_string_to_fixnum(struct environment* env, struct value* args)
core_string_to_number(struct environment* env, struct value* args)
{
if(IS_NULL(args) || !IS_STRING(HEAD(args)))
core_raise(env, string("string->fixnum accepts only one string as argument"));
core_raise(env, string("cherry.core/string->number: accepts only one string as argument"));
const byte_t* p = HEAD(args)->string_value;
......@@ -445,12 +454,42 @@ core_string_to_fixnum(struct environment* env, struct value* args)
}
struct value*
core_string_to_symbol(struct environment* env, struct value* args)
{
if(IS_NULL(args) || !IS_STRING(HEAD(args)))
core_raise(env, string("cherry.core/string->symbol: accepts only one string as argument"));
return symbol(HEAD(args)->string_value);
}
struct value*
core_is_symbol(struct environment* env, struct value* args)
{
if(IS_NULL(args))
return False;
return IS_SYMBOL(HEAD(args)) ? True : False;
}
struct value*
core_symbol_to_string(struct environment* env, struct value* args)
{
if(IS_NULL(args) || !IS_SYMBOL(HEAD(args)))
core_raise(env, string("cherry.core/symbol->string: accepts only one symbol as argument"));
return string(HEAD(args)->symbol_value);
}
struct value*
core_string_equal(struct environment* env, struct value* args)
{
if(IS_NULL(args) || IS_NULL(TAIL(args)) || !IS_STRING(HEAD(args)) || !IS_STRING(HEAD(TAIL(args))))
core_raise(env, string("string-equal? expects only two strings"));
core_raise(env, string("cherry.core/string-equal?: expects only two strings"));
struct value* a = HEAD(args);
struct value* b = HEAD(TAIL(args));
......@@ -488,7 +527,7 @@ core_add(struct environment* env, struct value* args)
break;
default:
core_raise(env, string("Addition performed with a non-numerical datatype"));
core_raise(env, string("cherry.core/+: Addition performed with a non-numerical datatype"));
}
args = TAIL(args);
......@@ -503,7 +542,7 @@ core_sub(struct environment* env, struct value* args)
if(IS_NULL(args))
return fixnum(0);
else if(!IS_FIXNUM(HEAD(args)) && !IS_FLOAT(HEAD(args)))
core_raise(env, string("First operand in Subtraction is not a numerical datatype"));
core_raise(env, string("cherry.core/-: First operand in Subtraction is not a numerical datatype"));
struct value* v = value_dup(HEAD(args));
args = TAIL(args);
......@@ -529,7 +568,7 @@ core_sub(struct environment* env, struct value* args)
break;
default:
core_raise(env, string("Subtraction performed with a non-numerical datatype"));
core_raise(env, string("cherry.core/-: Subtraction performed with a non-numerical datatype"));
}
args = TAIL(args);
......@@ -564,7 +603,7 @@ core_mul(struct environment* env, struct value* args)
break;
default:
core_raise(env, string("Multiplication performed with a non-numerical datatype"));
core_raise(env, string("cherry.core/*:Multiplication performed with a non-numerical datatype"));
}
args = TAIL(args);
......@@ -580,7 +619,7 @@ core_div(struct environment* env, struct value* args)
if(IS_NULL(args))
return fixnum(0);
else if(!IS_FIXNUM(HEAD(args)) && !IS_FLOAT(HEAD(args)))
core_raise(env, string("First operand in Division is not a numerical datatype"));
core_raise(env, string("cherry.core//:First operand in Division is not a numerical datatype"));
struct value* v = value_dup(HEAD(args));
args = TAIL(args);
......@@ -591,7 +630,7 @@ core_div(struct environment* env, struct value* args)
switch(x->tag) {
case FIXNUM:
if(x->fixnum_value == 0)
core_raise(env, string("Division by Zero"));
core_raise(env, string("cherry.core//: Division by Zero"));
if(IS_FIXNUM(v))
v->fixnum_value /= x->fixnum_value;
......@@ -601,7 +640,7 @@ core_div(struct environment* env, struct value* args)
case FLOAT:
if(x->float_value == 0.0)
core_raise(env, string("Division by Zero"));
core_raise(env, string("cherry.core//: Division by Zero"));
if(IS_FIXNUM(v)) {
v->float_value = v->fixnum_value / x->float_value;
......@@ -612,7 +651,7 @@ core_div(struct environment* env, struct value* args)
break;
default:
core_raise(env, string("Subtraction performed with a non-numerical datatype"));
core_raise(env, string("cherry.core//: Division performed with a non-numerical datatype"));
}
args = TAIL(args);
......@@ -627,7 +666,7 @@ struct value*
core_not(struct environment* env, struct value* args)
{
if(IS_NULL(args) || !IS_BOOLEAN(HEAD(args)))
core_raise(env, string("not operator expects one boolean operand"));
core_raise(env, string("cherry.core/not: operator expects one boolean operand"));
return IS_TRUE(HEAD(args)) ? False : True;
}
......@@ -683,7 +722,7 @@ core_greater(struct environment* env, struct value* args)
break;
default:
core_raise(env, string("> operator expects a number"));
core_raise(env, string("cherry.core/>: operator expects a number"));
}
args = TAIL(args);
}
......@@ -701,12 +740,12 @@ core_greater(struct environment* env, struct value* args)
break;
default:
core_raise(env, string("> operator expects a number"));
core_raise(env, string("cherry.core/>: operator expects a number"));
}
args = TAIL(args);
}
} else
core_raise(env, string("> operator expects a number"));
core_raise(env, string("cherry.core/>: operator expects a number"));
return True;
}
......@@ -734,7 +773,7 @@ core_less(struct environment* env, struct value* args)
break;
default:
core_raise(env, string("> operator expects a number"));
core_raise(env, string("cherry.core/<: operator expects a number"));
}
args = TAIL(args);
}
......@@ -752,12 +791,12 @@ core_less(struct environment* env, struct value* args)
break;
default:
core_raise(env, string("> operator expects a number"));
core_raise(env, string("cherry.core/<: operator expects a number"));
}
args = TAIL(args);
}
} else
core_raise(env, string("> operator expects a number"));
core_raise(env, string("cherry.core/<: operator expects a number"));
return True;
}
......@@ -786,7 +825,7 @@ core_greater_equal(struct environment* env, struct value* args)
break;
default:
core_raise(env, string("> operator expects a number"));
core_raise(env, string("cherry.core/>=: operator expects a number"));
}
args = TAIL(args);
}
......@@ -804,12 +843,12 @@ core_greater_equal(struct environment* env, struct value* args)
break;
default:
core_raise(env, string("> operator expects a number"));
core_raise(env, string("cherry.core/>=: operator expects a number"));
}
args = TAIL(args);
}
} else
core_raise(env, string("> operator expects a number"));
core_raise(env, string("cherry.core/>=: operator expects a number"));
return True;
}
......@@ -839,7 +878,7 @@ core_less_equal(struct environment* env, struct value* args)
break;
default:
core_raise(env, string("> operator expects a number"));
core_raise(env, string("cherry.core/<=: operator expects a number"));
}
args = TAIL(args);
}
......@@ -857,12 +896,12 @@ core_less_equal(struct environment* env, struct value* args)
break;
default:
core_raise(env, string("> operator expects a number"));
core_raise(env, string("cherry.core/<=: operator expects a number"));
}
args = TAIL(args);
}
} else
core_raise(env, string("> operator expects a number"));
core_raise(env, string("cherry.core/<=: operator expects a number"));
return True;
}
......@@ -890,7 +929,7 @@ core_equal(struct environment* env, struct value* args)
break;
default:
core_raise(env, string("> operator expects a number"));
core_raise(env, string("cherry.core/=: operator expects a number"));
}
args = TAIL(args);
}
......@@ -908,12 +947,12 @@ core_equal(struct environment* env, struct value* args)
break;
default:
core_raise(env, string("> operator expects a number"));
core_raise(env, string("cherry.core/=: operator expects a number"));
}
args = TAIL(args);
}
} else
core_raise(env, string("> operator expects a number"));
core_raise(env, string("cherry.core/=: operator expects a number"));
return True;
}
......@@ -966,7 +1005,7 @@ core_exit(struct environment* env, struct value* args)
else if(IS_FIXNUM(HEAD(args)))
exit(HEAD(args)->fixnum_value);
else
core_raise(env, string("Exit is expecting a fixnum for the first argument"));
core_raise(env, string("cherry.core/exit: is expecting a fixnum for the first argument"));
return False;
}
......@@ -990,7 +1029,7 @@ environment(void)
proc_to_env(env, ">", core_greater);
proc_to_env(env, "<", core_less);
proc_to_env(env, ">=", core_greater_equal);
proc_to_env(env, "=<", core_less_equal);
proc_to_env(env, "<=", core_less_equal);
proc_to_env(env, "=", core_equal);
proc_to_env(env, "not", core_not);
proc_to_env(env, "and", core_and);
......@@ -1012,11 +1051,16 @@ environment(void)
proc_to_env(env, "make-list", core_make_list);
proc_to_env(env, "make-tuple", core_make_tuple);
proc_to_env(env, "string?", core_is_string);
proc_to_env(env, "string->list", core_string_to_list);
proc_to_env(env, "string->tuple", core_string_to_tuple);
proc_to_env(env, "string->fixnum", core_string_to_fixnum);
proc_to_env(env, "string->number", core_string_to_number);
proc_to_env(env, "string->symbol", core_string_to_symbol);
proc_to_env(env, "string-equal?", core_string_equal);
proc_to_env(env, "symbol?", core_is_symbol);
proc_to_env(env, "symbol->string", core_symbol_to_string);
proc_to_env(env, "exit", core_exit);
return env;
......
set(TEST_SOURCES
unittest.c
lex.c
runtime.c
main.c)
add_executable(cherry-testsuite ${TEST_SOURCES})
target_link_libraries(cherry-testsuite gc cherry-core)
/*
* Cherry programming language
* Copyright (C) 2013 Christoph Mueller
*
* This program is free software: you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation, either version 3 of the License, or
* (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program. If not, see <http://www.gnu.org/licenses/>.
*/
#include "./unittest.h"
#include <cherry.h>
#include <stdio.h>
#include <string.h>
static void test_lex_fixnum(cy_const_pointer_t data)
{
cy_byte_t* fixnum = "0 5 0xFF 0xFFFF 1000 0777 0b0001 0b00011111";
struct org_cherry_context* c = org_cherry_context_repl(fixnum);
assert(org_cherry_lex(c) == TOK_DEC);
assert(strcmp(org_cherry_token_string(c), "0") == 0);
assert(org_cherry_lex(c) == TOK_DEC);
assert(strcmp(org_cherry_token_string(c), "5") == 0);
assert(org_cherry_lex(c) == TOK_HEX);
assert(strcmp(org_cherry_token_string(c), "0xFF") == 0);
assert(org_cherry_lex(c) == TOK_HEX);
assert(strcmp(org_cherry_token_string(c), "0xFFFF") == 0);
assert(org_cherry_lex(c) == TOK_DEC);
assert(strcmp(org_cherry_token_string(c), "1000") == 0);
assert(org_cherry_lex(c) == TOK_OCT);
assert(strcmp(org_cherry_token_string(c), "0777") == 0);
assert(org_cherry_lex(c) == TOK_BIN);
assert(strcmp(org_cherry_token_string(c), "0b0001") == 0);
assert(org_cherry_lex(c) == TOK_BIN);
assert(strcmp(org_cherry_token_string(c), "0b00011111") == 0);
}
static void test_lex_float(cy_const_pointer_t data)
{
cy_byte_t* fixnum = "1.0 4e+1 5e-10 1.0e20";
struct org_cherry_context* c = org_cherry_context_repl(fixnum);
assert(org_cherry_lex(c) == TOK_FLOAT);
assert(strcmp(org_cherry_token_string(c), "1.0") == 0);
assert(org_cherry_lex(c) == TOK_FLOAT);
assert(strcmp(org_cherry_token_string(c), "4e+1") == 0);
assert(org_cherry_lex(c) == TOK_FLOAT);
assert(strcmp(org_cherry_token_string(c), "5e-10") == 0);
assert(org_cherry_lex(c) == TOK_FLOAT);
assert(strcmp(org_cherry_token_string(c), "1.0e20") == 0);
}
static void test_lex_string(cy_const_pointer_t data)
{
cy_byte_t* str = " \"asdf\" \"test\\uFFFF\\UFFFFFFFF\\n\" ";
struct org_cherry_context* c = org_cherry_context_repl(str);
assert(org_cherry_lex(c) == TOK_STRING);
assert(strcmp(org_cherry_token_string(c), "asdf") == 0);
assert(org_cherry_lex(c) == TOK_STRING);
assert(strcmp(org_cherry_token_string(c), "test\\uFFFF\\UFFFFFFFF\\n") == 0);
}
static void test_lex_comment(cy_const_pointer_t data)
{
cy_byte_t* comment = "; comment\n";
struct org_cherry_context* c = org_cherry_context(comment, 0, CY_DEFAULT);
assert(org_cherry_lex(c) == TOK_COMMENT);
assert(strcmp(org_cherry_token_string(c), "; comment") == 0);
}
static void test_lex_symbols(cy_const_pointer_t data)
{
cy_byte_t* str = " true false null? + - ";
struct org_cherry_context* c = org_cherry_context_repl(str);
assert(org_cherry_lex(c) == TOK_TRUE);
assert(org_cherry_lex(c) == TOK_FALSE);
assert(org_cherry_lex(c) == TOK_SYMBOL);
assert(strcmp(org_cherry_token_string(c), "null?") == 0);
assert(org_cherry_lex(c) == TOK_SYMBOL);
assert(strcmp(org_cherry_token_string(c), "+") == 0);
assert(org_cherry_lex(c) == TOK_SYMBOL);
assert(strcmp(org_cherry_token_string(c), "-") == 0);
}
static void test_lex_characters(cy_const_pointer_t data)
{
cy_byte_t* str = " \\a \\A \\uFFFF \\newline \\space ";
struct org_cherry_context* c = org_cherry_context_repl(str);
assert(org_cherry_lex(c) == TOK_CHAR);
assert(strcmp(org_cherry_token_string(c), "\\a") == 0);
assert(org_cherry_lex(c) == TOK_CHAR);
assert(strcmp(org_cherry_token_string(c), "\\A") == 0);
assert(org_cherry_lex(c) == TOK_CHAR);
assert(strcmp(org_cherry_token_string(c), "\\uFFFF") == 0);
assert(org_cherry_lex(c) == TOK_CHAR);
assert(strcmp(org_cherry_token_string(c), "\\newline") == 0);
assert(org_cherry_lex(c) == TOK_CHAR);
assert(strcmp(org_cherry_token_string(c), "\\space") == 0);
}
static void test_lex_core(cy_const_pointer_t data)
{
cy_byte_t* str = " [ ] ( ) . ' ";
struct org_cherry_context* c = org_cherry_context_repl(str);
assert(org_cherry_lex(c) == TOK_SQUARELEFTBRACE);
assert(org_cherry_lex(c) == TOK_SQUARERIGHTBRACE);
assert(org_cherry_lex(c) == TOK_ROUNDLEFTBRACE);
assert(org_cherry_lex(c) == TOK_ROUNDRIGHTBRACE);
assert(org_cherry_lex(c) == TOK_DOT);
assert(org_cherry_lex(c) == TOK_QUOTE);
assert(org_cherry_lex(c) == TOK_EOF);
}
static void test_lex_rewind(cy_const_pointer_t data)
{
cy_byte_t* str = " [ ] ( ) . ' ";
struct org_cherry_context* c = org_cherry_context_repl(str);
assert(org_cherry_lex(c) == TOK_SQUARELEFTBRACE);
const cy_byte_t* position = org_cherry_pos(c);
assert(org_cherry_lex(c) == TOK_SQUARERIGHTBRACE);
assert(org_cherry_lex(c) == TOK_ROUNDLEFTBRACE);
assert(org_cherry_lex(c) == TOK_ROUNDRIGHTBRACE);
org_cherry_rewind(c, position);
assert(org_cherry_lex(c) == TOK_SQUARERIGHTBRACE);
assert(org_cherry_lex(c) == TOK_ROUNDLEFTBRACE);
assert(org_cherry_lex(c) == TOK_ROUNDRIGHTBRACE);
assert(org_cherry_lex(c) == TOK_DOT);
assert(org_cherry_lex(c) == TOK_QUOTE);
assert(org_cherry_lex(c) == TOK_EOF);
}
void test_suite_lex()
{
unittest_run("org.cherry.parser/lex_core", test_lex_core, 0, 100);
unittest_run("org.cherry.parser/lex_rewind", test_lex_rewind, 0, 100);
unittest_run("org.cherry.parser/lex_fixnum", test_lex_fixnum, 0, 100);
unittest_run("org.cherry.parser/lex_float", test_lex_float, 0, 100);
unittest_run("org.cherry.parser/lex_string", test_lex_string, 0, 100);
unittest_run("org.cherry.parser/lex_comment", test_lex_comment, 0, 100);
unittest_run("org.cherry.parser/lex_symbols", test_lex_symbols, 0, 100);
unittest_run("org.cherry.parser/lex_characters", test_lex_characters, 0, 100);
}