guile-ploy/ploy/assert.scm

; Assert macro.
; (c) Daniel Llorens - 2012-2013

; This library 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.

(define-module (ploy assert))

(define (xassert c . args)
  (or c (apply error args)))

(define-syntax assert
  (lambda (x)
    (syntax-case x ()
      (_ (identifier? x) #'xassert)
      ((_ c arg ...) #'(or c (error arg ...))))))

(define-syntax assert-fail
  (syntax-rules ()
    ((_ stat)
      (assert (catch #t (lambda () stat #f)
                        (lambda x #t))))
    ((_ stat fail-msg)
      (assert (catch #t (lambda () stat #f)
                        (lambda x #t))
              fail-msg))
    ((_ stat fail-msg suceed-msg)
      (assert (catch #t (lambda () stat #f)
                        (lambda x (format #t suceed-msg)
                                  (newline)
                                  (force-output) #t))
              fail-msg))))

(export assert assert-fail)