Changeset 13225


Ignore:
Timestamp:
02/17/11 22:47:54 (11 years ago)
Author:
ehuelsmann
Message:

Port DEFINE-METHOD-COMBINATION test from SBCL
(clos.impure.lisp, to be exact).

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/test/lisp/abcl/mop-tests.lisp

    r13062 r13225  
    22;;;
    33;;; Copyright (C) 2010 Matthias Hölzl
     4;;; Copyright (C) 2010 Erik Huelsmann
    45;;;
    56;;; This program is free software; you can redistribute it and/or
     
    301302
    302303
     304
     305;; tests for D-M-C, long form, taken from SBCL
     306
     307;; D-M-C should return the name of the new method combination, nothing else.
     308
     309(deftest dmc-return.1
     310    (define-method-combination dmc-test-return-foo)
     311  'dmc-test-return-foo)
     312
     313(deftest dmc-return.2
     314    (define-method-combination dmc-test-return-bar :operator and)
     315  'dmc-test-return-bar)
     316
     317(deftest dmc-return.3
     318    (define-method-combination dmc-test-return
     319        (&optional (order :most-specific-first))
     320      ((around (:around))
     321       (primary (dmc-test-return) :order order :required t))
     322      (let ((form (if (rest primary)
     323                      `(and ,@(mapcar #'(lambda (method)
     324                                          `(call-method ,method))
     325                                      primary))
     326                      `(call-method ,(first primary)))))
     327        (if around
     328            `(call-method ,(first around)
     329                          (,@(rest around)
     330                             (make-method ,form)))
     331            form)))
     332  'dmc-test-return)
     333
     334;; A method combination which originally failed;
     335;;   for different reasons in SBCL than in ABCL (hence leaving out
     336;;   the original comment)
     337
     338(define-method-combination dmc-test-mc.1
     339    (&optional (order :most-specific-first))
     340  ((around (:around))
     341   (primary (dmc-test-mc) :order order :required t))
     342  (let ((form (if (rest primary)
     343                  `(and ,@(mapcar #'(lambda (method)
     344                                      `(call-method ,method))
     345                                  primary))
     346                  `(call-method ,(first primary)))))
     347    (if around
     348        `(call-method ,(first around)
     349                      (,@(rest around)
     350                         (make-method ,form)))
     351        form)))
     352
     353(defgeneric dmc-test-mc.1 (&key k) (:method-combination dmc-test-mc.1))
     354
     355(defmethod dmc-test-mc.1 dmc-test-mc (&key k)
     356  k)
     357
     358(deftest dmc-test-mc.1
     359    (dmc-test-mc.1 :k 1)
     360  1)
     361
     362
Note: See TracChangeset for help on using the changeset viewer.