mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-22 04:21:16 -08:00
Code Issues Projects Releases Packages Wiki Activity

Merge branch 'develop' into 'develop'

Browse source 
Inconsistent and missing checks in binding forms

See merge request !74
This commit is contained in:
Daniel Kochmański 2017-06-29 10:16:27 +00:00
commit 8fd53c6470
5 changed files with 24 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

11
src/c/compiler.d
View file

@ -130,7 +130,6 @@ static int c_listA(cl_env_ptr env, cl_object args, int push);
static cl_object ecl_make_lambda(cl_env_ptr env, cl_object name, cl_object lambda);
static void FEillegal_variable_name(cl_object) ecl_attr_noreturn;
static void FEill_formed_input(void) ecl_attr_noreturn;
/* -------------------- SAFE LIST HANDLING -------------------- */
@ -343,12 +342,6 @@ assert_type_symbol(cl_object v)
FEprogram_error_noreturn("Expected a symbol, found ~S.", 1, v);
}
static void
FEillegal_variable_name(cl_object v)
{
FEprogram_error_noreturn("Not a valid variable name ~S.", 1, v);
}
static void
FEill_formed_input()
{
@ -1568,6 +1561,8 @@ c_let_leta(cl_env_ptr env, int op, cl_object args, int flags) {
}
if (!ECL_SYMBOLP(var))
FEillegal_variable_name(var);
if (ecl_symbol_type(var) & ecl_stp_constant)
FEbinding_a_constant(var);
if (op == OP_PBIND) {
compile_form(env, value, FLAG_PUSH);
if (ecl_member_eq(var, vars))
@ -1704,6 +1699,8 @@ c_multiple_value_bind(cl_env_ptr env, cl_object args, int flags)
cl_object var = pop(&vars);
if (!ECL_SYMBOLP(var))
FEillegal_variable_name(var);
if (ecl_symbol_type(var) & ecl_stp_constant)
FEbinding_a_constant(var);
c_vbind(env, var, n, specials);
}
c_declare_specials(env, specials);

12
src/c/error.d
View file

@ -434,12 +434,24 @@ FEinvalid_variable(const char *s, cl_object obj)
FEerror(s, 1, obj);
}
void
FEillegal_variable_name(cl_object v)
{
FEprogram_error("Not a valid variable name ~S.", 1, v);
}
void
FEassignment_to_constant(cl_object v)
{
FEprogram_error("SETQ: Tried to assign a value to the constant ~S.", 1, v);
}
void
FEbinding_a_constant(cl_object v)
{
FEprogram_error("The constant ~S is being bound.", 1, v);
}
void
FEinvalid_function(cl_object obj)
{

4
src/c/stacks.d
View file

@ -198,6 +198,10 @@ ecl_progv(cl_env_ptr env, cl_object vars0, cl_object values0)
return n;
} else {
cl_object var = ECL_CONS_CAR(vars);
if (!ECL_SYMBOLP(var))
FEillegal_variable_name(var);
if (ecl_symbol_type(var) & ecl_stp_constant)
FEbinding_a_constant(var);
if (Null(values)) {
ecl_bds_bind(env, var, OBJNULL);
} else {

2
src/h/external.h
View file

@ -577,7 +577,9 @@ extern ECL_API void FEwrong_index(cl_object function, cl_object a, int which, cl
extern ECL_API void FEunbound_variable(cl_object sym) ecl_attr_noreturn;
extern ECL_API void FEinvalid_macro_call(cl_object obj) ecl_attr_noreturn;
extern ECL_API void FEinvalid_variable(const char *s, cl_object obj) ecl_attr_noreturn;
extern ECL_API void FEillegal_variable_name(cl_object) ecl_attr_noreturn;
extern ECL_API void FEassignment_to_constant(cl_object v) ecl_attr_noreturn;
extern ECL_API void FEbinding_a_constant(cl_object v) ecl_attr_noreturn;
extern ECL_API void FEundefined_function(cl_object fname) ecl_attr_noreturn;
extern ECL_API void FEinvalid_function(cl_object obj) ecl_attr_noreturn;
extern ECL_API void FEinvalid_function_name(cl_object obj) ecl_attr_noreturn;

4
src/tests/normal-tests/compiler.lsp
View file

@ -564,8 +564,8 @@
(let ((warn nil))
(with-dflet ((c::cmpwarn (setf warn t)))
(with-compiler ("aux-compiler.0104.lsp")
'(defconstant foo (list 1 2 3))
'(print foo)))
'(defconstant +foo+ (list 1 2 3))
'(print +foo+)))
(delete-file "aux-compiler.0104.lsp")
(delete-file (compile-file-pathname "aux-compiler.0104.lsp" :type :fas))
warn)))