mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 04:10:18 +02:00
Code Activity

Move r6rs-hex-escape tests into reader.test

Browse source 
* 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
This commit is contained in:
Michael Gran 2010-01-12 21:27:30 -08:00
parent dea901d66e
commit 2e85d145fc
3 changed files with 117 additions and 142 deletions
Download patch file Download diff file Expand all files Collapse all files

44
test-suite/tests/chars.test
View file

@ -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")))

119
test-suite/tests/reader.test
View file

@ -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))

96
test-suite/tests/strings.test
View file

@ -2,24 +2,23 @@
;;;; Jim Blandy <jimb@red-bean.com> --- 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?
;;