an open source interpreter for the Kernel Programming Language.
git clone http://git.hanabi.in/repos/klisp.git
Log | Files | Refs | README

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)

Msrc/tests/ports.k | 44++++++++++++++++++++++++--------------------
Msrc/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)