diff options
-rw-r--r-- | eval.c | 45 | ||||
-rw-r--r-- | lib.c | 7 | ||||
-rw-r--r-- | lib.h | 1 | ||||
-rw-r--r-- | txr.1 | 35 |
4 files changed, 88 insertions, 0 deletions
@@ -5222,6 +5222,48 @@ static val me_l1_setq(val form, val menv) } } +static val rt_assert_fail(val file, val line, val expr, + val fmt, struct args *args) +{ + val str_stream = make_string_output_stream(); + + if (!missingp(fmt)) { + if (line && file) { + format(str_stream, lit("assertion ~s failed in ~a:~a: "), + expr, file, line, nao); + } else { + format(str_stream, lit("assertion ~s failed: "), expr, nao); + } + formatv(str_stream, fmt, args); + } else { + if (line && file) { + format(str_stream, lit("assertion ~s failed in ~a:~a\n"), + expr, file, line, nao); + } else { + format(str_stream, lit("assertion ~s failed"), expr, nao); + } + } + + uw_throw(assert_s, get_string_from_stream(str_stream)); + return nil; +} + +static val me_assert(val form, val menv) +{ + cons_bind (line, file, source_loc(form)); + val extra_args = cddr(form); + val rt_assert_fail = intern(lit("rt-assert-fail"), system_package); + + (void) menv; + + return list(or_s, cadr(form), + apply_frob_args(list(rt_assert_fail, file, line, + list(quote_s, cadr(form), nao), + extra_args, nao)), + nao); +} + + static val return_star(val name, val retval) { uw_block_return(name, retval); @@ -6466,6 +6508,7 @@ void eval_init(void) reg_mac(intern(lit("mlet"), user_package), func_n2(me_mlet)); reg_mac(load_time_s, func_n2(me_load_time)); reg_mac(intern(lit("load-for"), user_package), func_n2(me_load_for)); + reg_mac(intern(lit("assert"), user_package), func_n2(me_assert)); reg_fun(cons_s, func_n2(cons)); reg_fun(intern(lit("make-lazy-cons"), user_package), @@ -7037,6 +7080,8 @@ void eval_init(void) reg_fun(intern(lit("rt-pprof"), system_package), func_n1(rt_pprof)); reg_fun(intern(lit("rt-load-for"), system_package), func_n0v(rt_load_for)); + reg_fun(intern(lit("rt-assert-fail"), system_package), func_n4ov(rt_assert_fail, 3)); + eval_error_s = intern(lit("eval-error"), user_package); uw_register_subtype(eval_error_s, error_s); @@ -6265,6 +6265,13 @@ val func_n3ov(val (*fun)(val, val, val, varg), int reqargs) return obj; } +val func_n4ov(val (*fun)(val, val, val, val, varg), int reqargs) +{ + val obj = func_n4v(fun); + obj->f.optargs = 4 - reqargs; + return obj; +} + val func_interp(val env, val form) { val obj = make_obj(); @@ -979,6 +979,7 @@ val func_n8o(val (*fun)(val, val, val, val, val, val, val, val), int reqargs); val func_n1ov(val (*fun)(val, varg), int reqargs); val func_n2ov(val (*fun)(val, val, varg), int reqargs); val func_n3ov(val (*fun)(val, val, val, varg), int reqargs); +val func_n4ov(val (*fun)(val, val, val, val, varg), int reqargs); val func_interp(val env, val form); val func_vm(val closure, val desc, int fixparam, int reqargs, int variadic); val copy_fun(val ofun); @@ -42594,6 +42594,41 @@ The frame receives control even if it it is not otherwise eligible for catching the exception type denoted by .metn symbol . +.coNP Macro @ assert +.synb +.mets (assert < expr >> [ format-string << format-arg *]) +.syne +.desc +The +.code assert +macro evaluates +.metn expr . +If +.meta expr +yields any true value, then +.code assert +terminates normally, and that value is returned. + +If instead +.meta expr +yields +.codn nil , +then +.code assert +throws an exception of type +.codn assert . +The exception carries an informative character string that contains +a diagnostic detailing the expression which yielded +.codn nil , +and the source location of that expression, if available. + +If the +.meta format-string +and possibly additional format arguments are given to +.code assert +then those arguments are used to format additional text which is appended to +the diagnostic message after a separating character such as a colon. + .SS* Static Error Diagnosis This section describes a number of features related to the diagnosis |