[uim-commit] r2042 - in branches/r5rs/sigscheme: . test

[yamaken at freedesktop.org]

Author: yamaken
Date: 2005-11-07 00:33:21 -0800 (Mon, 07 Nov 2005)
New Revision: 2042

Modified:
   branches/r5rs/sigscheme/TODO
   branches/r5rs/sigscheme/test/unittest.scm
Log:
* sigscheme/test/unittest.scm
  - (assert-error): Implement
* sigscheme/TODO
  - Update


Modified: branches/r5rs/sigscheme/TODO
===================================================================
--- branches/r5rs/sigscheme/TODO	2005-11-07 08:06:16 UTC (rev 2041)
+++ branches/r5rs/sigscheme/TODO	2005-11-07 08:33:21 UTC (rev 2042)
@@ -82,7 +82,6 @@
 ==============================================================================
 Assigned to YamaKen:
 
-* Implement assert-error in unittest.scm
 * Write tests for SRFI-34
 
 * GCC4-optimization-proof stack protection

Modified: branches/r5rs/sigscheme/test/unittest.scm
===================================================================
--- branches/r5rs/sigscheme/test/unittest.scm	2005-11-07 08:06:16 UTC (rev 2041)
+++ branches/r5rs/sigscheme/test/unittest.scm	2005-11-07 08:33:21 UTC (rev 2042)
@@ -30,6 +30,9 @@
 ;;  NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
 ;;  SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
+(use srfi-23)
+(use srfi-34)
+
 (define total-err-num  0)
 (define total-test-num 0)
 (define test-filename "unspecified")
@@ -97,7 +100,12 @@
 (define (eval-counter n)
   (list 'eval-counter (+ n 1)))
 
-;; dummy definition to eval args for assert-error. real implementation needed.
 (define assert-error
-  (lambda (msg exp)
-    #f))
+  (lambda (test-name proc)
+    (let ((errored (guard (err
+                           (else
+                            #t))
+                     (proc)
+                     #f))
+          (err-msg (string-append "no error has occurred in test " test-name)))
+      (assert err-msg errored))))