From milanj at gmail.com  Sat Mar 14 14:52:28 2009
From: milanj at gmail.com (Milan Jovanovic)
Date: Sat, 14 Mar 2009 15:52:28 +0100
Subject: [trivial-timeout-devel] CCL/LW multiple values return fix
Message-ID: <3d8e533e0903140752u141d8665mcf060d46e3528bbd@mail.gmail.com>

On CCL and LW when timeout is specified and form returns more then one value
only one is returned

CL-USER> (trivial-timeout:with-timeout (1)
           (values 1 2 3))
1
CL-USER>


--- with-timeout-orig.lisp 2009-03-14 15:45:54.000000000 +0100
+++ with-timeout.lisp   2009-03-14 15:47:33.000000000 +0100
@@ -81,7 +81,7 @@ or is interrupted."
       (,process (ccl:process-run-function
            ,checker-process
            (lambda ()
-       (setf ,result (progn (,doit-symbol)))))))
+       (setf ,result (multiple-value-list (,doit-symbol)))))))
        (ccl:process-wait-with-timeout
   ,waiting-process
   (* ,seconds-symbol #+(or openmcl ccl)
@@ -91,7 +91,7 @@ 

From milanj at gmail.com  Fri Mar 13 10:17:58 2009
From: milanj at gmail.com (Milan Jovanovic)
Date: Fri, 13 Mar 2009 10:17:58 -0000
Subject: [trivial-timeout-devel] CCL fix
Message-ID: <3d8e533e0903130251m35e20d9g97dc193beb5f6239@mail.gmail.com>

On CCL when timeout is specified and form returns more then one value only
one is returned

CL-USER> (trivial-timeout:with-timeout (1)
           (values 1 2 3))
1
CL-USER>

This fix that
Best,Milan

#+(or digitool openmcl ccl)
(defun generate-platform-specific-code (seconds-symbol doit-symbol)
  (let ((checker-process (format nil "Checker ~S" (gensym)))
   (waiting-process (format nil "Waiter ~S" (gensym)))
   (process (gensym)))
    `(let* ((,process (ccl:process-run-function
           ,checker-process
           (lambda ()
       (progn (,doit-symbol))))))
       (ccl:process-wait-with-timeout
  ,waiting-process
  (* ,seconds-symbol #+(or openmcl ccl)
     ccl:*ticks-per-second* #+digitool 60)
  (lambda ()
    (not (ccl::process-active-p ,process))))
       (when (ccl::process-active-p ,process)
   (ccl:process-kill ,process)
   (cerror "Timeout" 'timeout-error))
       (ccl:join-process ,process))))
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/trivial-timeout-devel/attachments/20090313/67b0bba9/attachment.html>