#!/bin/sh
exec ${srcdir:-.}/guile-test-env guile ${GUILE_FLAGS} -s "$0" "$@"
!#

(use-modules (gw-test-standard)
             (unit-test)
             (srfi srfi-8))

(define-class <test-standard> (<test-case>))

(define-method (test-default-arguments (self <test-standard>))
  (assert-equal 123 (gw-test-strtol "123"))
  (assert-equal 7 (gw-test-strtol "111" 2)))

(define-method (test-exception (self <test-standard>))
  (assert-true (unspecified? (gw-test-retval-exception 2)))
  (assert-exception (gw-test-retval-exception -1)))

(define-method (test-output-arguments (self <test-standard>))
  (receive (a b c) (gw-test-out-args 123)
    (assert-equal 123 a)
    (assert-equal 15129 b)
    (assert-equal "foobar" c))
  (receive (a b) (gw-test-out+default-args 7)
    (assert-equal 35 a)
    (assert-equal "foo" b))
  (receive (a b) (gw-test-out+default-args 7 9)
    (assert-equal 63 a)
    (assert-equal "foo" b)))
    
(define-method (test-void-type (self <test-standard>))
  (assert-true (unspecified? (gw-test-gw-standard-no-op))))

(define-method (test-scm-type (self <test-standard>))
  (let* ((obj (vector 1 2 3))
         (result (gw-test-gw-standard-echo-scm obj)))
    (assert-true (and (eq? obj result)
                      (= 1 (vector-ref result 0))
                      (= 2 (vector-ref result 1))
                      (= 3 (vector-ref result 2))))))

(define-method (test-bool-type (self <test-standard>))
  (assert-equal #f (gw-test-gw-standard-echo-bool #f))
  (assert-equal #t (gw-test-gw-standard-echo-bool #t))
  (assert-equal #t (gw-test-gw-standard-echo-bool 5))
  (assert-equal #t (gw-test-gw-standard-echo-bool (list 1 2 3))))

(define-method (test-char-type (self <test-standard>))
  (assert-equal #\space (gw-test-gw-standard-echo-char #\space))
  (assert-equal #\a (gw-test-gw-standard-echo-char #\a))
  (assert-equal #\z (gw-test-gw-standard-echo-char #\z)))

;; TODO: check that overflows signal range errors appropriately...
(define (check-integer-type type-sym echo-func min max)
  ;;(for-each display `("checking that " ,type-sym " works as advertized..."))
  (assert-true (and (= min (echo-func min))
                    (zero? (echo-func 0))
                    (= max (echo-func max)))))

(let ((int-min (gw-test-gw-standard-get-int-min))
      (long-min (gw-test-gw-standard-get-long-min)))
  
  (for-each check-integer-type
            (list '<gw:int> '<gw:unsigned-int> '<gw:long> '<gw:unsigned-long>)
            (list gw-test-gw-standard-echo-int
                  gw-test-gw-standard-echo-unsigned-int
                  gw-test-gw-standard-echo-long
                  gw-test-gw-standard-echo-unsigned-long)
            (list int-min
                  0
                  long-min
                  0)
            (list (gw-test-gw-standard-get-int-max)
                  (gw-test-gw-standard-get-uint-max)
                  (gw-test-gw-standard-get-long-max)
                  (gw-test-gw-standard-get-ulong-max))))
  
;; TODO add more demanding checks for <gw:mchars> allocation issues.

(define-method (test-mchars-caller-owned-type (self <test-standard>))
  (let* ((test-str "xyzzy")
         (result-str (gw-test-gw-standard-echo-mchars-caller-owned test-str)))
  (assert-true (and (string? result-str)
                    (string=? test-str result-str)
                    (not (eq? test-str result-str))
                    (not (gw-test-gw-standard-echo-mchars-caller-owned #f))))))


(define-method (test-mchars-const-caller-owned-type (self <test-standard>))
  (let* ((test-str "xyzzy")
         (result-str
          (gw-test-gw-standard-echo-const-mchars-caller-owned test-str)))
    
  (assert-true (and (string? result-str)
                    (string=? test-str result-str)
                    (not (eq? test-str result-str))
                    (not (gw-test-gw-standard-echo-const-mchars-caller-owned #f))))))

(define-method (test-mchars-callee-owned-type (self <test-standard>))
  (let* ((test-str "xyzzy")
         (result-str (gw-test-gw-standard-echo-mchars-callee-owned test-str)))
    (assert-true
     (and (string? result-str)
          (string=? test-str result-str)
          (not (eq? test-str result-str))
          (not (gw-test-gw-standard-echo-mchars-callee-owned #f))))))

(define-method (test-mchars-const-callee-owned-type (self <test-standard>))
  (let* ((test-str "xyzzy")
         (result-str
          (gw-test-gw-standard-echo-const-mchars-callee-owned test-str)))
  (assert-true
   (and (string? result-str)
        (string=? test-str result-str)
        (not (eq? test-str result-str))
        (not (gw-test-gw-standard-echo-const-mchars-callee-owned #f))))))

(define-method (test-wrap-value (self <test-standard>))
  (assert-equal gw-test-gw-standard-foo-value 42)
  (assert-equal gw-test-gw-standard-bar-value "42"))

(define-method (test-generic (self <test-standard>))
  (assert-equal 169 (gw-test-generic 13))
  (assert-equal "foo foo foo " (gw-test-generic "foo " 3))
  (assert-equal #f (gw-test-generic #f))
  (assert-equal "foo" (gw-test-generic "foo"))
  (assert-equal 666.0 (gw-test-generic 666.0))
  (assert-equal #f (gw-test-generic #t))
  (assert-equal #t (gw-test-generic #t #t)))

(exit-with-summary (run-all-defined-test-cases))

;; Local Variables:
;; mode: scheme
;; End: