klisp

commit b57afa7a0e3043ebc9747fce23d926a12b70ae12
parent 566af578b9bf33945bbe397be92427e1386f51b2
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Wed,  9 Nov 2011 13:54:43 -0300

Added error check to delete file in port tests (there's a bug on Windows where the delete fails because seemingly, the file is still open. This causes the rest of the tests to be aborted)

Diffstat:
M
src/tests/ports.k
 | 
44
++++++++++++++++++++++++--------------------
M
src/tests/test-helpers.k
 | 
6
++++++

2 files changed, 30 insertions(+), 20 deletions(-)
diff --git a/src/tests/ports.k b/src/tests/ports.k
@@ -31,7 +31,9 @@
 ($define! prepare-input
   ($lambda (text)
     (with-output-to-file temp-file
-      ($lambda () ($if (string? text) (display text) #inert)))))
+			 ($lambda () ($if (string? text) 
+					  (display text) 
+					  #inert)))))
 
 ($define! read-string-until-eof
   ($lambda ()
@@ -131,23 +133,25 @@
 ;; 15.1.5 open-input-file open-output-file
 ;; 15.1.6 close-input-file close-output-file
 
-($let ((p (open-input-file test-input-file)))
-  ($check-predicate (port? p))
-  ($check-predicate (input-port? p))
-  ($check-not-predicate (equal? p (get-current-input-port)))
-  ($check-not-predicate (equal? p (get-current-output-port)))
-  (close-input-file p)
-  (close-input-file p))
+($check-no-error
+ ($let ((p (open-input-file test-input-file)))
+   ($check-predicate (port? p))
+   ($check-predicate (input-port? p))
+   ($check-not-predicate (equal? p (get-current-input-port)))
+   ($check-not-predicate (equal? p (get-current-output-port)))
+   (close-input-file p)
+   (close-input-file p)))
 
 ($check-error (call-with-closed-output-port close-input-file))
 
-($let ((p (open-output-file temp-file)))
-  ($check-predicate (port? p))
-  ($check-predicate (output-port? p))
-  ($check-not-predicate (equal? p (get-current-input-port)))
-  ($check-not-predicate (equal? p (get-current-output-port)))
-  (close-output-file p)
-  (close-output-file p))
+($check-no-error  
+ ($let ((p (open-output-file temp-file)))
+   ($check-predicate (port? p))
+   ($check-predicate (output-port? p))
+   ($check-not-predicate (equal? p (get-current-input-port)))
+   ($check-not-predicate (equal? p (get-current-output-port)))
+   (close-output-file p)
+   (close-output-file p)))
 
 ($check-error (call-with-closed-input-port close-output-file))
 
@@ -292,20 +296,20 @@
 ($check-not-predicate (file-exists? nonexistent-file))
 ($check-not-predicate (file-exists? invalid-file))
 
-(prepare-input "test")
+($check-no-error (prepare-input "test"))
 ($check-predicate (file-exists? temp-file))
-(delete-file temp-file)
+($check-no-error (delete-file temp-file))
 ($check-not-predicate (file-exists? temp-file))
 ($check-error (delete-file nonexistent-file))
 ($check-error (delete-file invalid-file))
 
-(prepare-input "test")
+($check-no-error (prepare-input "test"))
 ($check-predicate (file-exists? temp-file))
 ($check-not-predicate (file-exists? temp-file-2))
-(rename-file temp-file temp-file-2)
+($check-no-error (rename-file temp-file temp-file-2))
 ($check-predicate (file-exists? temp-file-2))
 ($check-not-predicate (file-exists? temp-file))
-(delete-file temp-file-2)
+($check-no-error (delete-file temp-file-2))
 
 ($check-error (rename-file nonexistent-file temp-file))
 ($check-error (rename-file invalid-file temp-file))
diff --git a/src/tests/test-helpers.k b/src/tests/test-helpers.k
@@ -7,6 +7,12 @@
 ($define! not-equal? ($lambda (x y) (not? (equal? x y))))
 ($define! $check-predicate ($vau (x) denv (eval (list $check eq? x #t) denv)))
 ($define! $check-not-predicate ($vau (x) denv (eval (list $check eq? x #f) denv)))
+($define! $check-no-error ($vau (x) denv 
+			    (eval (list $check 
+					($lambda (#ignore #ignore) #t)
+					x 
+					#inert) 
+				  denv)))
 
 ($define! mutable-pair?
   ($lambda (obj)