;;;; F-operator-test.scm
;;;; Kon Lovett, Apr 6 '06

(import utf8)
(import test)

(import (only (chicken format) format) (test-utils gloss))

;;;

(test-begin "Shift/Reset")

(import shift-reset)
(import (chicken sort))
(import (srfi 1))
(import (srfi 18))

(include-relative "shift-reset-test-body")

;;;

(test-end "Shift/Reset")

(test-exit)

#|
;; Overhead

;(parameter) ~ 2.0 times | 10^6 is 0.353 / 0.134 , 10^8 is 37.857 / 19.907
;(global)    ~ 1.5 times | 10^6 is 0.226 / 0.131 , 10^8 is 24.584 / 16.141

(define-constant WAY-LIMIT (expt 10 8))

(test-group (string-append "2 * 2^" (number->string WAY-LIMIT) " list the easy way")
  (test-assert
    (let loop ((i 0) (y '()))
      (if (= i WAY-LIMIT) y
          (loop (add1 i) (cons 'b (cons i y))))))
)

(test-group (string-append "2 * 2^" (number->string WAY-LIMIT) " list the hard way")
  (test-assert
    (reset
      (cons 'b
        (let-values (((x y) (shift k (let loop ((i 0) (y '()))
                                       (if (= i WAY-LIMIT) y
                                           (loop (add1 i) (k i y))))) ) )
          (cons x y)))))
)
|#

#; ;NOTE bad test; works w/ parameter or global! (maybe >> threads?)
(test-group (string-append "simple threads (" (number->string N-THREADS) ")")

  (define (thread-simple id)
    (define (action)
      (test (string-append "thread-simple " (number->string id))
        '(a 1 b 2 b 3)
        (cons 'a
          (reset
            (cons 'b
              (begin
                ;(gloss)
                (let-values (((x y) (shift k (cons 1 (k '2 (k 3 '()))))))
                  ;(gloss id ":" x #\| y)
                  (cons x y))))))) )
    (make-thread action id) )

  (define threads
    (let loop ((i 0) (ts '()))
      (if (= i N-THREADS) ts
          (let ((id (string->symbol (string-append "T" (number->string i)))))
            (loop (add1 i) (cons (thread-simple id) ts)) ) ) ) )

  (for-each thread-start! threads)
  (for-each thread-join! (reverse threads))
)