From: Michael Gran Date: Wed, 13 Jan 2010 05:27:30 +0000 (-0800) Subject: Move r6rs-hex-escape tests into reader.test X-Git-Url: http://git.hcoop.net/bpt/guile.git/commitdiff_plain/2e85d145fc44b49bceaec3ab95da43688f8db0f4 Move r6rs-hex-escape tests into reader.test * test-suite/tests/reader.test (r6rs-hex-escapes): new tests * test-suite/tests/chars.test (R6RS Hex escapes): remove tests by reverting to previous version * test-suite/tests/strings.test (R6RS Hex escapes): remove tests by reverting to previous version --- diff --git a/test-suite/tests/chars.test b/test-suite/tests/chars.test index 25c82e825..509f07066 100644 --- a/test-suite/tests/chars.test +++ b/test-suite/tests/chars.test @@ -29,16 +29,6 @@ (cons #t "out-of-range")) -;; Run THUNK in the context of the reader options OPTS -(define (with-read-options opts thunk) - (let ((saved-options (read-options))) - (dynamic-wind - (lambda () - (read-options opts)) - thunk - (lambda () - (read-options saved-options))))) - (with-test-prefix "basic char handling" (with-test-prefix "evaluator" @@ -323,37 +313,3 @@ (with-output-to-string (lambda () (write #\soh))) "#\\soh")))) -(with-test-prefix "R6RS hex escapes" - - (pass-if "one-digit hex escape" - (eqv? (with-read-options '(r6rs-hex-escapes) - (lambda () - (with-input-from-string "#\\xA" read))) - (integer->char #x0A))) - - (pass-if "two-digit hex escape" - (eqv? (with-read-options '(r6rs-hex-escapes) - (lambda () - (with-input-from-string "#\\xFF" read))) - (integer->char #xFF))) - - (pass-if "four-digit hex escape" - (eqv? (with-read-options '(r6rs-hex-escapes) - (lambda () - (with-input-from-string "#\\x00FF" read))) - (integer->char #xFF))) - - (pass-if "eight-digit hex escape" - (eqv? (with-read-options '(r6rs-hex-escapes) - (lambda () - (with-input-from-string "#\\x00006587" read))) - (integer->char #x6587))) - (pass-if "write R6RS escapes" - (string=? - (with-read-options '(r6rs-hex-escapes) - (lambda () - (with-output-to-string - (lambda () - (write (integer->char #x80)))))) - "#\\x80"))) - diff --git a/test-suite/tests/reader.test b/test-suite/tests/reader.test index b819e63fb..f5af52c43 100644 --- a/test-suite/tests/reader.test +++ b/test-suite/tests/reader.test @@ -7,12 +7,12 @@ ;;;; modify it under the terms of the GNU Lesser General Public ;;;; License as published by the Free Software Foundation; either ;;;; version 3 of the License, or (at your option) any later version. -;;;; +;;;; ;;;; This library is distributed in the hope that it will be useful, ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;;; Lesser General Public License for more details. -;;;; +;;;; ;;;; You should have received a copy of the GNU Lesser General Public ;;;; License along with this library; if not, write to the Free Software ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA @@ -220,10 +220,117 @@ (equal? (source-property sexp 'column) 0)))) (pass-if "positions on quote" (let ((sexp (with-read-options '(positions) - (lambda () + (lambda () (read-string "'abcde"))))) (and (equal? (source-property sexp 'line) 0) - (equal? (source-property sexp 'column) 0))))) + (equal? (source-property sexp 'column) 0)))) + (with-test-prefix "r6rs-hex-escapes" + (pass-if-exception "non-hex char in two-digit hex-escape" + exception:illegal-escape + (with-read-options '(r6rs-hex-escapes) + (lambda () + (with-input-from-string "\"\\x0g;\"" read)))) + + (pass-if-exception "non-hex char in four-digit hex-escape" + exception:illegal-escape + (with-read-options '(r6rs-hex-escapes) + (lambda () + (with-input-from-string "\"\\x000g;\"" read)))) + + (pass-if-exception "non-hex char in six-digit hex-escape" + exception:illegal-escape + (with-read-options '(r6rs-hex-escapes) + (lambda () + (with-input-from-string "\"\\x00000g;\"" read)))) + + (pass-if-exception "no semicolon at termination of one-digit hex-escape" + exception:illegal-escape + (with-read-options '(r6rs-hex-escapes) + (lambda () + (with-input-from-string "\"\\x0\"" read)))) + + (pass-if-exception "no semicolon at termination of three-digit hex-escape" + exception:illegal-escape + (with-read-options '(r6rs-hex-escapes) + (lambda () + (with-input-from-string "\"\\x000\"" read)))) + + (pass-if "two-digit hex escape" + (eqv? + (with-read-options '(r6rs-hex-escapes) + (lambda () + (string-ref (with-input-from-string "\"--\\xff;--\"" read) 2))) + (integer->char #xff))) + + (pass-if "four-digit hex escape" + (eqv? + (with-read-options '(r6rs-hex-escapes) + (lambda () + (string-ref (with-input-from-string "\"--\\x0100;--\"" read) 2))) + (integer->char #x0100))) + + (pass-if "six-digit hex escape" + (eqv? + (with-read-options '(r6rs-hex-escapes) + (lambda () + (string-ref (with-input-from-string "\"--\\x010300;--\"" read) 2))) + (integer->char #x010300))) + + (pass-if "escaped characters match non-escaped ASCII characters" + (string=? + (with-read-options '(r6rs-hex-escapes) + (lambda () + (with-input-from-string "\"\\x41;\\x0042;\\x000043;\"" read))) + "ABC")) + + (pass-if "write R6RS escapes" + + (let* ((s1 (apply string + (map integer->char '(#x8 ; backspace + #x20 ; space + #x30 ; zero + #x40 ; at sign + )))) + (s2 (with-read-options '(r6rs-hex-escapes) + (lambda () + (with-output-to-string + (lambda () (write s1))))))) + (lset= eqv? + (string->list s2) + (list #\" #\\ #\x #\8 #\; #\space #\0 #\@ #\")))) + (pass-if "one-digit hex escape" + (eqv? (with-read-options '(r6rs-hex-escapes) + (lambda () + (with-input-from-string "#\\xA" read))) + (integer->char #x0A))) + + (pass-if "two-digit hex escape" + (eqv? (with-read-options '(r6rs-hex-escapes) + (lambda () + (with-input-from-string "#\\xFF" read))) + (integer->char #xFF))) + + (pass-if "four-digit hex escape" + (eqv? (with-read-options '(r6rs-hex-escapes) + (lambda () + (with-input-from-string "#\\x00FF" read))) + (integer->char #xFF))) + + (pass-if "eight-digit hex escape" + (eqv? (with-read-options '(r6rs-hex-escapes) + (lambda () + (with-input-from-string "#\\x00006587" read))) + (integer->char #x6587))) + (pass-if "write R6RS escapes" + (string=? + (with-read-options '(r6rs-hex-escapes) + (lambda () + (with-output-to-string + (lambda () + (write (integer->char #x80)))))) + "#\\x80")))) + + (with-test-prefix "#;" (for-each @@ -235,10 +342,10 @@ ("#;(10 20 30) foo" . foo) ("#; (10 20 30) foo" . foo) ("#;\n10\n20" . 20))) - + (pass-if "#;foo" (eof-object? (with-input-from-string "#;foo" read))) - + (pass-if-exception "#;" exception:missing-expression (with-input-from-string "#;" read)) diff --git a/test-suite/tests/strings.test b/test-suite/tests/strings.test index 47ae93ae9..e04c0260d 100644 --- a/test-suite/tests/strings.test +++ b/test-suite/tests/strings.test @@ -2,24 +2,23 @@ ;;;; Jim Blandy --- August 1999 ;;;; ;;;; Copyright (C) 1999, 2001, 2004, 2005, 2006, 2008, 2009 Free Software Foundation, Inc. -;;;; +;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public ;;;; License as published by the Free Software Foundation; either ;;;; version 3 of the License, or (at your option) any later version. -;;;; +;;;; ;;;; This library is distributed in the hope that it will be useful, ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;;; Lesser General Public License for more details. -;;;; +;;;; ;;;; You should have received a copy of the GNU Lesser General Public ;;;; License along with this library; if not, write to the Free Software ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA (define-module (test-strings) - #:use-module (test-suite lib) - #:use-module (srfi srfi-1)) + #:use-module (test-suite lib)) (define exception:read-only-string (cons 'misc-error "^string is read-only")) @@ -30,16 +29,6 @@ (define exception:wrong-type-arg (cons #t "Wrong type")) -;; Run THUNK in the context of the reader options OPTS -(define (with-read-options opts thunk) - (let ((saved-options (read-options))) - (dynamic-wind - (lambda () - (read-options opts)) - thunk - (lambda () - (read-options saved-options))))) - ;; Create a string from integer char values, eg. (string-ints 65) => "A" (define (string-ints . args) (apply string (map integer->char args))) @@ -240,83 +229,6 @@ (pass-if "Guile extensions backslash escapes" (string=? "\0" (string #\nul)))) - -(with-test-prefix "R6RS hex escapes" - - (pass-if-exception "non-hex char in two-digit hex-escape" - exception:illegal-escape - (with-read-options '(r6rs-hex-escapes) - (lambda () - (with-input-from-string "\"\\x0g;\"" read)))) - - (pass-if-exception "non-hex char in four-digit hex-escape" - exception:illegal-escape - (with-read-options '(r6rs-hex-escapes) - (lambda () - (with-input-from-string "\"\\x000g;\"" read)))) - - (pass-if-exception "non-hex char in six-digit hex-escape" - exception:illegal-escape - (with-read-options '(r6rs-hex-escapes) - (lambda () - (with-input-from-string "\"\\x00000g;\"" read)))) - - (pass-if-exception "no semicolon at termination of one-digit hex-escape" - exception:illegal-escape - (with-read-options '(r6rs-hex-escapes) - (lambda () - (with-input-from-string "\"\\x0\"" read)))) - - (pass-if-exception "no semicolon at termination of three-digit hex-escape" - exception:illegal-escape - (with-read-options '(r6rs-hex-escapes) - (lambda () - (with-input-from-string "\"\\x000\"" read)))) - - (pass-if "two-digit hex escape" - (eqv? - (with-read-options '(r6rs-hex-escapes) - (lambda () - (string-ref (with-input-from-string "\"--\\xff;--\"" read) 2))) - (integer->char #xff))) - - (pass-if "four-digit hex escape" - (eqv? - (with-read-options '(r6rs-hex-escapes) - (lambda () - (string-ref (with-input-from-string "\"--\\x0100;--\"" read) 2))) - (integer->char #x0100))) - - (pass-if "six-digit hex escape" - (eqv? - (with-read-options '(r6rs-hex-escapes) - (lambda () - (string-ref (with-input-from-string "\"--\\x010300;--\"" read) 2))) - (integer->char #x010300))) - - (pass-if "escaped characters match non-escaped ASCII characters" - (string=? - (with-read-options '(r6rs-hex-escapes) - (lambda () - (with-input-from-string "\"\\x41;\\x0042;\\x000043;\"" read))) - "ABC")) - - (pass-if "write R6RS escapes" - - (let* ((s1 (apply string - (map integer->char '(#x8 ; backspace - #x20 ; space - #x30 ; zero - #x40 ; at sign - )))) - (s2 (with-read-options '(r6rs-hex-escapes) - (lambda () - (with-output-to-string - (lambda () (write s1))))))) - (lset= eqv? - (string->list s2) - (list #\" #\\ #\x #\8 #\; #\space #\0 #\@ #\"))))) - ;; ;; string? ;;