Add syntax object testing facility

diff --git a/doc/thales.texi b/doc/thales.texi
index 13cd55171a6a1bbdb1ba458f6d8ccdec53260d00..ec855ce1ebbc6aaa426a067ccf48d5274b177000 100644 (file)
--- a/doc/thales.texi
+++ b/doc/thales.texi
@@ -105,6 +105,21 @@ functions, but maybe you do not not ocassionally change public interface.
 Thales is mainly intended as light-weight solution for pure
 function. Scheme is functional language, after all.
 
+Usually it is not desirable to have hard dependency on GNU Thales.
+As a workaround you can put this snippet at top of file
+@lisp
+(eval-when (compile)
+  (define-syntax sealed (identifier-syntax #f))
+  (let ((thales-module (resolve-module '(thales seal))))
+    (if thales-module
+       (module-define! (current-module) 'sealed
+         (module-ref thales-module 'sealed))
+       (format #t "~a\n~a\n"
+         "Module (thales seal) is not available."
+         "GNU Thales based testing is disabled."))))
+@end lisp
+
+
 For full-fledged solution with test-cases, shared-state, variable
 definition, teardown and initialization, take a look on
 srfi-64(@url{http://srfi.schemers.org/srfi-64/srfi-64.html}) which, at
@@ -135,6 +150,11 @@ expression. Each @code{clause} may be in one of following form:
 matching @code{<args>}. It is okay if exception thrown proviedes more
 arguments, that you specified.
 
+@item
+@code{(<args> ... *#* <val>)} Asserts, that @code{(<tested-function>
+<args> ...)}  return syntax object, simplified with
+@code{syntax->datum}to @code{(quote <val>)}.
+
 @item
 @code{(<form>)} Asserts, that @code{<form>} evaluates to @code{#t}
 @end itemize

diff --git a/src/thales/seal.scm b/src/thales/seal.scm
index ed157c113ae88be06c18e77a2d7a7fa6e75946f7..c488b817723d668a62e51d94760b29c10614ca5d 100644 (file)
--- a/src/thales/seal.scm
+++ b/src/thales/seal.scm
@@ -1,5 +1,5 @@
 (define-module (thales seal)
-    #:export (sealed))
+    #:replace (sealed))
 (use-modules (ice-9 match))
 (use-modules (ice-9 pretty-print))
 (use-modules (srfi srfi-1))
@@ -89,7 +89,7 @@ loaded with this function."
                         (error:handle (cons 'throw throw-args)))))))))
 
 (define-syntax seal-clause
-    (syntax-rules (=> !--> *** *+* *!*)
+    (syntax-rules (=> !--> *** *+* *!* *#*)
        ([_ f <args> ... *** <val>]
         (seal-clause-expect-values (f <args> ...) (<val>)))
        ([_ f <args> ... *+* <val>]
@@ -101,7 +101,9 @@ loaded with this function."
        ([_ f <args> ... *!* <val>]
         (seal-clause-expect-throw (f <args> ...) ('<val>)))
        ([_ f <form>]
-        (seal-clause-expect-values <form> (#t)))))
+        (seal-clause-expect-values <form> (#t)))
+       ([_ f <args> ... *#* <val>]
+        (seal-clause-expect-values (syntax->datum (f <args> ...)) ('<val>)))))
 
 (define-syntax sealed
     (lambda (env)