;;;;
;;;; 215.stk		-- Implementation tests for SRFI-215
;;;;
;;;; Copyright © 2020 Jeronimo Pellegrini - <j_p@aleph0.info>
;;;;
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 3 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
;;;;
;;;; This file is a derivative work from the  implementation of
;;;; this SRFI by Göran Weinholt, it is copyrighted as:
;;;;;;
;;;;;; © 2020 Göran Weinholt
;;;;;;
;;;;;; Permission is hereby granted, free of charge, to any person
;;;;;; obtaining a copy of this software and associated documentation files
;;;;;; (the "Software"), to deal in the Software without restriction,
;;;;;; including without limitation the rights to use, copy, modify, merge,
;;;;;; publish, distribute, sublicense, and/or sell copies of the Software,
;;;;;; and to permit persons to whom the Software is furnished to do so,
;;;;;; subject to the following conditions:
;;;;;;
;;;;;; The above copyright notice and this permission notice (including the
;;;;;; next paragraph) shall be included in all copies or substantial
;;;;;; portions of the Software.
;;;;;;
;;;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;;;;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
;;;;;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
;;;;;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
;;;;;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
;;;;;; SOFTWARE.
;;;;
;;;;           Author: Jeronimo Pellegrini [j_p@aleph0.info]
;;;;    Creation date: 16-Mar-2021 16:11 (jpellegrini)
;;;;

(current-log-fields '(FACILITY 1))

(define (find proc list)
  (if (null? list)
      #f
      (if (proc (car list))
          #t
          (find proc (cdr list)))))

;; This log message should be buffered until the callback is set
(send-log DEBUG "first message")

(let ((msgs '()))
  (parameterize ((current-log-callback
                  (lambda (msg)
                    (set! msgs (cons msg msgs)))))

    ;; This should should also be handled by the callback
    (send-log INFO "second message" 'FOO 'bar)
    
    (test "find first message"
          #t
          (find (lambda (msg)
                  (and (eqv? 7 (cdr (assq 'SEVERITY msg)))
                       (string=? "first message"
                                 (cdr (assq 'MESSAGE msg)))))
                msgs))
    
    (test "find second message"
          #t
          (find (lambda (msg)
                  (and (eqv? 6 (cdr (assq 'SEVERITY msg)))
                       (string=? "second message"
                                 (cdr (assq 'MESSAGE msg)))
                       (equal? "bar"
                               (cond ((assq 'FOO msg) => cdr)
                                     (else #f)))))
                msgs))
    (test/error "bad number" (send-log "bad number" "third message"))
    (test/error "bad string" (send-log "bad number" 'bad-string))))


;; Check that the example from the document works
(define s (open-output-string))

(current-log-callback
 (lambda (msg)
   (display "<" s)
   (display (cdr (assq 'SEVERITY msg)) s)
   (display ">" s)
   (display (cdr (assq 'MESSAGE msg)) s)
   (newline s)))



(send-log DEBUG "Log callback configured")

(test "example from SRFI document"
      "<7>Log callback configured\n"
      (get-output-string s))

(close-port s)


