(use apropos)
(use test)

;;

(define (symbol<? a b) (string<? (symbol->string a) (symbol->string b)))
(define (car-symbol<? a b) (symbol<? (car a) (car b)))

;;;

(test-begin "apropos")

;; build test symbols

(define (foobarproc0) 'foobarproc0)
(define (foobarproc1 a) 'foobarproc1)
(define (foobarproc2 a b) 'foobarproc2)
(define (foobarprocn a b . r) 'foobarprocn)

(define foobarprocx (lambda (a b c) 'foobarprocx))

(define-syntax (foobarmacro1 f r c)
  'foobarmacro1 )

(define-syntax foobarmacro2
  (syntax-rules ()
    ((_) 'foobarmacro1 ) ) )

(define foobarvar1 'foobarvar1)
(define foobarvar2 'foobarvar2)

(define Foobarvar1 'Foobarvar1)
(define Foobarvar2 'Foobarvar2)

#;(define (foocoreinline flag) (##core#inline "C_set_gc_report" flag))
#;(define fooprimitive (##core#primitive "C_get_memory_info"))

(define ##foo#bar1 '##foo#bar1)
(define ##foo#bar2 (lambda () '##foo#bar2))

(define ##bar#foo1 '##bar#foo1)
(define ##bar#foo2 (lambda () '##bar#foo2))

;; test for symbols

(define (apropos-list-test lst val)
  (test "apropos-list" (sort lst symbol<?) (sort val symbol<?)) )

(apropos-list-test
  '(foobarvar2 foobarvar1 foobarprocx foobarprocn foobarproc2 foobarproc1 foobarproc0)
  (apropos-list 'foobar))
(apropos-list-test
  '(foobarvar2 foobarvar1 foobarprocx foobarprocn foobarproc2 foobarproc1 foobarproc0)
  (apropos-list "foobar"))
(apropos-list-test
  '(##bar#foo1 ##bar#foo2 foobarmacro1 foobarmacro2 foobarproc0 foobarproc1 foobarproc2 foobarprocn foobarprocx foobarvar1 foobarvar2)
  (apropos-list 'foo #:macros? #t #:qualified? #t))
(apropos-list-test
  '(foobarvar2 foobarvar1 foobarprocx foobarprocn foobarproc2 foobarproc1 foobarproc0 foobarmacro1 foobarmacro2)
  (apropos-list 'foobar #:macros? #t))
(apropos-list-test
  '(foobarvar2 foobarvar1 foobarprocx foobarprocn foobarproc2 foobarproc1 foobarproc0 Foobarvar2 Foobarvar1)
  (apropos-list 'foobar #:case-insensitive? #t))
(apropos-list-test
  '(foobarvar2 foobarvar1 Foobarvar1 Foobarvar2)
  (apropos-list ''".+barvar[12]"))

(define (apropos-information-list-test lst val)
  (test "apropos-information-list" (sort lst car-symbol<?) (sort val car-symbol<?)) )

(apropos-information-list-test
  '((foobarmacro1 . macro) (foobarmacro2 . macro) (foobarproc0 procedure) (foobarproc1 procedure a) (foobarproc2 procedure a b) (foobarprocn procedure a b . r) (foobarprocx procedure a b c) (foobarvar1 . variable) (foobarvar2 . variable))
  (apropos-information-list 'foobar #:macros? #t #:qualified? #t))
(apropos-information-list-test
  '((foobarprocx procedure a b c) (foobarprocn procedure a b . r) (foobarproc2 procedure a b) (foobarproc1 procedure a) (foobarproc0 procedure))
  (apropos-information-list 'foobarproc #:macros? #t #:qualified? #t))

#| ;UNSUPPORTED
;;

(use environments)

(define tstenv1 (make-environment #t))

(environment-extend! tstenv1 'foobarprocx (lambda (a b c) 'foobarprocx))
(environment-extend! tstenv1 'foobarvar1 'foobarvar1)
(environment-extend! tstenv1 'foobarvar2 'foobarvar2)
(environment-extend! tstenv1 '##bar#foo1 '##bar#foo1)
(environment-extend! tstenv1 '##bar#foo1 (lambda () '##bar#foo1))

;make-environment cannot create a syntax-environment
;apropos always uses the ##sys#macro-environment for macro lookup

(test '(foobarprocx foobarvar2 foobarvar1 ##bar#foo1)
      (apropos-list 'foo tstenv1 #:qualified? #t))
|#

(test-end)

;;;

(test-exit)