Changeset 15003


Ignore:
Timestamp:
05/15/17 20:37:19 (6 years ago)
Author:
Mark Evenson
Message:

Fix ENSURE-GENERIC-FUNCTION when removing definition

(Olof-Joachim Frahm)

Merges <https://github.com/armedbear/abcl/pull/42>.

Location:
trunk/abcl
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/clos.lisp

    r15002 r15003  
    43144314(defmethod shared-initialize :after ((instance standard-generic-function)
    43154315                                     slot-names
    4316                                      &key lambda-list argument-precedence-order
     4316                                     &key (lambda-list nil lambda-list-p)
     4317                                       (argument-precedence-order nil a-p-o-p)
    43174318                                       (method-combination '(standard))
    43184319                                     &allow-other-keys)
    4319   (let* ((plist (analyze-lambda-list lambda-list))
    4320          (required-args (getf plist ':required-args)))
    4321     (setf (std-slot-value instance 'sys::required-args) required-args)
    4322     (setf (std-slot-value instance 'sys::optional-args)
    4323           (getf plist :optional-args))
    4324     (setf (std-slot-value instance 'sys::argument-precedence-order)
    4325           (or argument-precedence-order required-args)))
     4320  (when lambda-list-p
     4321    (let* ((plist (analyze-lambda-list lambda-list))
     4322           (required-args (getf plist ':required-args)))
     4323      (setf (std-slot-value instance 'sys::required-args) required-args)
     4324      (setf (std-slot-value instance 'sys::optional-args)
     4325            (getf plist :optional-args))
     4326      (setf (std-slot-value instance 'sys::argument-precedence-order)
     4327            (or (and a-p-o-p argument-precedence-order) required-args))))
    43264328  (unless (typep (generic-function-method-combination instance)
    43274329                 'method-combination)
  • trunk/abcl/test/lisp/abcl/mop-tests.lisp

    r15002 r15003  
    310310          (return (equal (princ-to-string error) "foo")))))
    311311  t)
     312
     313;; ensure-generic-function shouldn't kill existing definition
     314(deftest ensure-generic-function.1
     315    (progn
     316      (ensure-generic-function 'mop-test.foo)
     317      (not (null (mop:generic-function-argument-precedence-order #'mop-test.foo))))
     318  t)
Note: See TracChangeset for help on using the changeset viewer.