mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-18 07:12:26 -08:00
Code Issues Projects Releases Packages Wiki Activity

FIND-SYMBOL now only accepts strings

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2009-11-09 19:59:36 +01:00
parent 6a94780559
commit b074cd8b36
4 changed files with 13 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

3
src/CHANGELOG
View file

@ -43,6 +43,9 @@ ECL 9.11.1:
- When supplied an error value, (EXT:SAFE-EVAL form env &optional err-value)
never returned the output of the evaluated form.
- FIND-SYMBOL accepted string designators instead of just strings, as
mandated by the ANSI specification.
* Sockets:
- The socket option TCP_NODELAY option has been fixed: it was improperly using

2
src/c/package.d
View file

@ -391,7 +391,7 @@ find_symbol_inner(cl_object name, cl_object p, int *intern_flag)
cl_object
ecl_find_symbol(cl_object n, cl_object p, int *intern_flag)
{
n = cl_string(n);
if (!ECL_STRINGP(n)) FEtype_error_string(n);
p = si_coerce_to_package(p);
return find_symbol_inner(n, p, intern_flag);
}

5
src/c/print.d
View file

@ -855,14 +855,15 @@ write_symbol(cl_object x, cl_object stream)
} else if (package == cl_core.keyword_package) {
write_ch(':', stream);
} else if ((print_package != Cnil && package != print_package)
|| ecl_find_symbol(x, ecl_current_package(), &intern_flag)!=x
|| ecl_find_symbol(ecl_symbol_name(x), ecl_current_package(),
&intern_flag)!=x
|| intern_flag == 0)
{
cl_object name = package->pack.name;
write_symbol_string(name, readtable->readtable.read_case,
print_case, stream,
needs_to_be_escaped(name, readtable, print_case));
if (ecl_find_symbol(x, package, &intern_flag) != x)
if (ecl_find_symbol(ecl_symbol_name(x), package, &intern_flag) != x)
ecl_internal_error("can't print symbol");
if ((print_package != Cnil && package != print_package)
|| intern_flag == INTERNAL) {

6
src/h/object.h
View file

@ -153,6 +153,12 @@ typedef cl_object (*cl_objectfn_fixed)();
#define ARRAY_TYPE(t) (t >= t_array && t <= t_bitvector)
#define ECL_ARRAYP(x) ((IMMEDIATE(x) == 0) && (x)->d.t >= t_array && (x)->d.t <= t_bitvector)
#define ECL_VECTORP(x) ((IMMEDIATE(x) == 0) && (x)->d.t >= t_vector && (x)->d.t <= t_bitvector)
#ifdef ECL_UNICODE
#define ECL_STRINGP(x) ((IMMEDIATE(x) == 0) && \
((x)->d.t == t_base_string || (x)->d.t == t_string))
#else
#define ECL_STRINGP(x) ((IMMEDIATE(x) == 0) && ((x)->d.t == t_base_string))
#endif
#define HEADER int8_t t, m, padding[2]
#define HEADER1(field) int8_t t, m, field, padding