;;;; dynamic-import-test.scm  -*- Scheme -*-
;;;; Kon Lovett, Feb '22

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

(test-begin "Dynamic Import")

;;;

(import dynamic-import)

;; No Dependencies

;(srfi 1)
(define (make-list len elt) ;elt optional but here always provided
  (import (chicken fixnum))
  (do ((i len (fx- i 1))
	     (ans '() (cons elt ans)))
	    ((fx<= i 0) ans)) )

(define (make-list/as df)
  (case-lambda
    (() df)
    ((n)
      (cond ((fixnum? n)
              (make-list n df))
            ((list? n)
              (make-list (length n) df))
            (else
              (error 'make-list/as
                     "invalid length specification" n df)) ) ) ) )

;;

#| ;FIXME catch compile syntax errors
(dynamic-import () foo)
(dynamic-import m1)
(dynamic-import srfi-1 ())
|#

(test-group "\"Catching\" Warnings"
  (define +warns+ '())

  (define mock-ssl-connect* (lambda _ (values #f #f)))
  (define mock-ssl-connect mock-ssl-connect*)

  ;NOTE disable to see warnings during the test
  (enable-warnings #f)
  (dynamic-import-warning (lambda args (set! +warns+ (cons args +warns+))))

  (define falses (make-list/as #f))

  (dynamic-import srfi-1 append-reverse! falses)
  (test-assert (procedure? append-reverse!))

  (dynamic-import (foo bar baz srfi-1) (delete-duplicates delete-duplicates!) falses)
  (test-assert (procedure? delete-duplicates))
  (test-assert (procedure? delete-duplicates!))

  ;+1 +warns+
  (dynamic-import (m1 (srfi 1) (m1 sm1)) foobar (default 23))
  (test 23 foobar)

  ;+1 +warns+
  (dynamic-import not-openssl ssl-connect* (default (lambda _ (values #f #f))))
  (test "uses default literal proc" '(#f #f) (receive (ssl-connect* #:hostname "foo")))

  ;+1 +warns+
  (dynamic-import nosuchssl ssl-connect (default mock-ssl-connect))
  (test "uses default named proc" '(#f #f) (receive (ssl-connect "foo")))

  ;+1 +warns+
  (dynamic-import nosuch (notfound nonefunc)
                  (lambda (ids) (map (cut symbol-append <> '-pooh) ids)))
  (test "uses default identifier proc" 'notfound-pooh (identity notfound))
  (test "uses default identifier proc" 'nonefunc-pooh (identity nonefunc))

  (gloss "warnings" +warns+)
  (test "\"Caught\" warnings" 4 (length +warns+))
)

;needs test
#| ;group|spread md|id [df|(default ...)]
(dynamic-import (?md0 ...) (?id0 ...))
(dynamic-import (?md0 ...) (?id0 ...) (default ?df0 ...))
(dynamic-import (?md0 ...) (?id0 ...) ?df)

(dynamic-import (?md0 ...) ?id)
(dynamic-import ?md ?id)

(dynamic-import ?md0 ?md1 ... (?id0 ...) (default ?df0 ...))
(dynamic-import ?md0 ?md1 ... (?id0 ...) ?df)
(dynamic-import (?md0 ...) ?id0 ?id1 ... ?df)
(dynamic-import ?md ?id0 ?id1 ... ?df)
|#

;;;

(test-end "Dynamic Import")

(test-exit)