Changeset 26904 in project


Ignore:
Timestamp:
06/14/12 13:41:17 (8 years ago)
Author:
felix winkelmann
Message:

coops 1.9: handle multiple values properly (contributed by megane)

Location:
release/4/coops
Files:
6 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/coops/tags/1.9/coops.scm

    r26742 r26904  
    373373                                   (apply %before-method %args))
    374374                                 %applicable-before-methods)
    375                                 (let ((%res
    376                                        (apply
    377                                         (let
    378                                             ((m (car %applicable-primary-methods)))
    379                                           (set! %applicable-primary-methods
    380                                             (cdr %applicable-primary-methods))
    381                                           m)
    382                                         %next-method?
    383                                         %call-next-method
    384                                         %args)))
    385                                   (for-each
    386                                    (lambda (%after-method)
    387                                      (apply %after-method %args))
    388                                    %applicable-after-methods)
    389                                   %res))))))
     375                                (call-with-values
     376                                    (lambda ()
     377                                      (apply
     378                                       (let ((m (car %applicable-primary-methods)))
     379                                         (set! %applicable-primary-methods
     380                                           (cdr %applicable-primary-methods))
     381                                         m)
     382                                       %next-method?
     383                                       %call-next-method
     384                                       %args))
     385                                  (lambda %res
     386                                    (for-each
     387                                     (lambda (%after-method)
     388                                       (apply %after-method %args))
     389                                     %applicable-after-methods)
     390                                    (apply values %res))))))))
    390391                   (%call-next-method))))))
    391392         (cond-expand
  • release/4/coops/tags/1.9/coops.setup

    r26742 r26904  
    1010 '("coops.so" "coops.import.so"
    1111   "coops-primitive-objects.so" "coops-primitive-objects.import.so")
    12  '((version 1.8)))
     12 '((version 1.9)))
  • release/4/coops/tags/1.9/tests/tests.scm

    r24644 r26904  
    424424(test-end)
    425425
     426;; handling of multiple values (#867 - contributed by "megane")
     427
     428(test-begin "multiple values")
     429
     430(define-class <mv> ())
     431
     432(define (mv-foo a)
     433  (values 1 2))
     434
     435(define-method (mv-bar (a <mv>))
     436  (values 1 2))
     437
     438(define-method (mv-baz (a <mv>))
     439  (mv-bar a))
     440
     441(test '(1 2) (receive (mv-foo (make <mv>))))
     442(test '(1 2) (receive (mv-bar (make <mv>))))
     443(test '(1 2) (receive (mv-baz (make <mv>))))
     444
     445(test-end)
     446
    426447(test-exit)
  • release/4/coops/trunk/coops.scm

    r26742 r26904  
    373373                                   (apply %before-method %args))
    374374                                 %applicable-before-methods)
    375                                 (let ((%res
    376                                        (apply
    377                                         (let
    378                                             ((m (car %applicable-primary-methods)))
    379                                           (set! %applicable-primary-methods
    380                                             (cdr %applicable-primary-methods))
    381                                           m)
    382                                         %next-method?
    383                                         %call-next-method
    384                                         %args)))
    385                                   (for-each
    386                                    (lambda (%after-method)
    387                                      (apply %after-method %args))
    388                                    %applicable-after-methods)
    389                                   %res))))))
     375                                (call-with-values
     376                                    (lambda ()
     377                                      (apply
     378                                       (let ((m (car %applicable-primary-methods)))
     379                                         (set! %applicable-primary-methods
     380                                           (cdr %applicable-primary-methods))
     381                                         m)
     382                                       %next-method?
     383                                       %call-next-method
     384                                       %args))
     385                                  (lambda %res
     386                                    (for-each
     387                                     (lambda (%after-method)
     388                                       (apply %after-method %args))
     389                                     %applicable-after-methods)
     390                                    (apply values %res))))))))
    390391                   (%call-next-method))))))
    391392         (cond-expand
  • release/4/coops/trunk/coops.setup

    r26742 r26904  
    1010 '("coops.so" "coops.import.so"
    1111   "coops-primitive-objects.so" "coops-primitive-objects.import.so")
    12  '((version 1.8)))
     12 '((version 1.9)))
  • release/4/coops/trunk/tests/tests.scm

    r24644 r26904  
    424424(test-end)
    425425
     426;; handling of multiple values (#867 - contributed by "megane")
     427
     428(test-begin "multiple values")
     429
     430(define-class <mv> ())
     431
     432(define (mv-foo a)
     433  (values 1 2))
     434
     435(define-method (mv-bar (a <mv>))
     436  (values 1 2))
     437
     438(define-method (mv-baz (a <mv>))
     439  (mv-bar a))
     440
     441(test '(1 2) (receive (mv-foo (make <mv>))))
     442(test '(1 2) (receive (mv-bar (make <mv>))))
     443(test '(1 2) (receive (mv-baz (make <mv>))))
     444
     445(test-end)
     446
    426447(test-exit)
Note: See TracChangeset for help on using the changeset viewer.