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

Merge branch 'defclass-nil' into 'develop'

Browse source 
Fixes for NIL-related conformance problems

Closes #474 und #475

See merge request embeddable-common-lisp/ecl!139
This commit is contained in:
Marius Gerbershagen 2019-02-24 20:16:18 +00:00
commit 41eb59ab46
2 changed files with 15 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

9
src/c/compiler.d
View file

@ -1473,6 +1473,9 @@ asm_function(cl_env_ptr env, cl_object function, int flags) {
static int
c_go(cl_env_ptr env, cl_object args, int flags) {
cl_object tag = pop(&args);
if (Null(tag)) {
tag = ECL_NIL_SYMBOL;
}
cl_object info = c_tag_ref(env, tag, @':tag');
if (Null(info))
FEprogram_error("GO: Unknown tag ~S.", 1, tag);
@ -2060,6 +2063,9 @@ c_tagbody(cl_env_ptr env, cl_object args, int flags)
/* count the tags */
for (nt = 0, body = args; !Null(body); ) {
label = pop(&body);
if (Null(label)) {
label = ECL_NIL_SYMBOL;
}
item_type = ecl_t_of(label);
if (item_type == t_symbol || item_type == t_fixnum ||
item_type == t_bignum) {
@ -2080,6 +2086,9 @@ c_tagbody(cl_env_ptr env, cl_object args, int flags)
for (body = args; !Null(body); ) {
label = pop(&body);
if (Null(label)) {
label = ECL_NIL_SYMBOL;
}
item_type = ecl_t_of(label);
if (item_type == t_symbol || item_type == t_fixnum ||
item_type == t_bignum) {

13
src/clos/standard.lsp
View file

@ -164,7 +164,6 @@
(finalize-inheritance class)))
(defmethod initialize-instance ((class class) &rest initargs &key direct-slots direct-superclasses)
(declare (ignore sealedp))
;; convert the slots from lists to direct slots
(apply #'call-next-method class
:direct-slots
@ -220,7 +219,7 @@
(defmethod shared-initialize ((class std-class) slot-names &rest initargs &key
(optimize-slot-access (list *optimize-slot-access*))
sealedp)
(declare (ignore initargs slot-names))
(declare (ignore slot-names))
(setf (slot-value class 'optimize-slot-access) (first optimize-slot-access)
(slot-value class 'sealedp) (and sealedp t))
(setf class (call-next-method))
@ -632,11 +631,11 @@ because it contains a reference to the undefined class~% ~A"
(do* ((name-loc initargs (cddr name-loc))
(allow-other-keys nil)
(allow-other-keys-found nil)
(unknown-key nil))
(unknown-key-names nil))
((null name-loc)
(when (and (not allow-other-keys) unknown-key)
(simple-program-error "Unknown initialization option ~S for class ~A"
unknown-key class)))
(when (and (not allow-other-keys) unknown-key-names)
(simple-program-error "Unknown initialization options ~S for class ~A."
(nreverse unknown-key-names) class)))
(let ((name (first name-loc)))
(cond ((null (cdr name-loc))
(simple-program-error "No value supplied for the init-name ~S." name))
@ -652,7 +651,7 @@ because it contains a reference to the undefined class~% ~A"
((member name cached-keywords))
((and methods (member name methods :test #'member :key #'method-keywords)))
(t
(setf unknown-key name)))))))
(push name unknown-key-names)))))))
;;; ----------------------------------------------------------------------
;;; Methods