fix some ancient method-combination bugs

lp#309084 (a) i. and ii.

src/pcl/defcombin.lisp

@@ -84,16 +84,18 @@
 ;;;; and runs the same rule.
 
 (defun expand-short-defcombin (whole)
- (let* ((type-name (cadr whole))
- (documentation
- (getf (cddr whole) :documentation))
- (identity-with-one-arg
- (getf (cddr whole) :identity-with-one-argument nil))
+ (let* ((canary (cons nil nil))
+ (type-name (cadr whole))
+ (documentation (getf (cddr whole) :documentation canary))
+ (ioa (getf (cddr whole) :identity-with-one-argument nil))
  (operator
- (getf (cddr whole) :operator type-name)))
+ (getf (cddr whole) :operator type-name)))
+ (unless (eql documentation canary)
+ (unless (stringp documentation)
+ (%program-error "~@<~S argument to the short form of ~S must be a string.~:>"
+ :documentation 'define-method-combination)))
  `(load-short-defcombin
- ',type-name ',operator ',identity-with-one-arg ',documentation
- (sb-c:source-location))))
+ ',type-name ',operator ',ioa ',documentation (sb-c:source-location))))
 
 (defun load-short-defcombin (type-name operator ioa doc source-location)
  (let ((info (make-method-combination-info

tests/clos-1.impure.lisp

@@ -194,3 +194,10 @@
  (defmethod foo ((x t)) 3)
  (assert (= (foo t) 3))
  (assert (= (foo 3) 2)))
+
+(with-test (:name :bug-309084-a-i)
+ (assert-error (eval '(define-method-combination bug-309084-a-i :documentation :operator))
+ program-error))
+(with-test (:name :bug-309084-a-ii)
+ (assert-error (eval '(define-method-combination bug-309084-a-ii :documentation nil))
+ program-error))