Changeset 14060


Ignore:
Timestamp:
08/06/12 05:41:30 (8 years ago)
Author:
ehuelsmann
Message:

Fix #202: ENSURE-GENERIC-FUNCTION complains about lambda list congruence
when no lambda list is provided.

Don't change the field when the argument is not provided and
when the argument is not provided, don't check for congruence.

File:
1 edited

Legend:

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

    r14059 r14060  
    17241724                                &rest all-keys
    17251725                                &key
    1726                                 lambda-list
     1726                                (lambda-list nil lambda-list-supplied-p)
    17271727                                (generic-function-class +the-standard-generic-function-class+)
    17281728                                (method-class +the-standard-method-class+)
    17291729                                (method-combination +the-standard-method-combination+ mc-p)
    17301730                                argument-precedence-order
    1731                                 documentation
     1731                                (documentation nil documentation-supplied-p)
    17321732                                &allow-other-keys)
    17331733  (setf all-keys (copy-list all-keys))  ; since we modify it
     
    17361736    (if gf
    17371737        (progn
    1738           (unless (or (null (generic-function-methods gf))
    1739                       (lambda-lists-congruent-p lambda-list (generic-function-lambda-list gf)))
    1740             (error 'simple-error
    1741                    :format-control "The lambda list ~S is incompatible with the existing methods of ~S."
    1742                    :format-arguments (list lambda-list gf)))
    1743           (setf (generic-function-lambda-list gf) lambda-list)
    1744           (setf (generic-function-documentation gf) documentation)
    1745           (let* ((plist (analyze-lambda-list lambda-list))
    1746                  (required-args (getf plist ':required-args)))
    1747             (%set-gf-required-args gf required-args)
    1748             (%set-gf-optional-args gf (getf plist :optional-args))
    1749             (setf (generic-function-argument-precedence-order gf)
    1750                   (or argument-precedence-order required-args))
    1751             (finalize-standard-generic-function gf))
     1738          (when lambda-list-supplied-p
     1739            (unless (or (null (generic-function-methods gf))
     1740                        (lambda-lists-congruent-p lambda-list
     1741                                                  (generic-function-lambda-list gf)))
     1742              (error 'simple-error
     1743                     :format-control "The lambda list ~S is incompatible with the existing methods of ~S."
     1744                     :format-arguments (list lambda-list gf)))
     1745            (setf (generic-function-lambda-list gf) lambda-list)
     1746            (let* ((plist (analyze-lambda-list lambda-list))
     1747                   (required-args (getf plist ':required-args)))
     1748              (%set-gf-required-args gf required-args)
     1749              (%set-gf-optional-args gf (getf plist :optional-args))))
     1750          (setf (generic-function-argument-precedence-order gf)
     1751                (or argument-precedence-order (gf-required-args gf)))
     1752          (when documentation-supplied-p
     1753            (setf (generic-function-documentation gf) documentation))
     1754          (finalize-standard-generic-function gf)
    17521755          gf)
    17531756        (progn
     
    44874490                                                 &allow-other-keys))
    44884491
    4489 (defmethod ensure-generic-function-using-class ((generic-function generic-function)
    4490                                                 function-name
    4491                                                 &rest all-keys
    4492                                                 &key (generic-function-class +the-standard-generic-function-class+)
    4493                                                   lambda-list
    4494                                                   (method-class +the-standard-method-class+)
    4495                                                   (method-combination +the-standard-method-combination+)
    4496                                                 &allow-other-keys)
     4492(defmethod ensure-generic-function-using-class
     4493    ((generic-function generic-function)
     4494     function-name
     4495     &rest all-keys
     4496     &key (generic-function-class +the-standard-generic-function-class+)
     4497     (lambda-list nil lambda-list-supplied-p)
     4498     (method-class +the-standard-method-class+)
     4499     (method-combination +the-standard-method-combination+)
     4500     &allow-other-keys)
    44974501  (setf all-keys (copy-list all-keys))  ; since we modify it
    44984502  (remf all-keys :generic-function-class)
     
    45034507    (error "The class ~S is incompatible with the existing class (~S) of ~S."
    45044508           generic-function-class (class-of generic-function) generic-function))
    4505   (unless (or (null (generic-function-methods generic-function))
    4506               (lambda-lists-congruent-p lambda-list (generic-function-lambda-list generic-function)))
    4507     (error "The lambda list ~S is incompatible with the existing methods of ~S."
    4508            lambda-list generic-function))
     4509  (when lambda-list-supplied-p
     4510    (unless (or (null (generic-function-methods generic-function))
     4511                (lambda-lists-congruent-p lambda-list
     4512                                          (generic-function-lambda-list generic-function)))
     4513      (error "The lambda list ~S is incompatible with the existing methods of ~S."
     4514             lambda-list generic-function)))
    45094515  (unless (or (null (generic-function-methods generic-function))
    45104516              (eq method-class (generic-function-method-class generic-function)))
Note: See TracChangeset for help on using the changeset viewer.