mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-01 12:20:26 +02:00
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
This commit is contained in:
Michael Gran
parent
dea901d66e
commit
2e85d145fc
3 changed files with 117 additions and 142 deletions
|
|
@ -29,16 +29,6 @@
|
||||||
(cons #t "out-of-range"))
|
(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 "basic char handling"
|
||||||
|
|
||||||
(with-test-prefix "evaluator"
|
(with-test-prefix "evaluator"
|
||||||
|
|
@ -323,37 +313,3 @@
|
||||||
(with-output-to-string (lambda () (write #\soh)))
|
(with-output-to-string (lambda () (write #\soh)))
|
||||||
"#\\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")))
|
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -223,7 +223,114 @@
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(read-string "'abcde")))))
|
(read-string "'abcde")))))
|
||||||
(and (equal? (source-property sexp 'line) 0)
|
(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 "#;"
|
(with-test-prefix "#;"
|
||||||
(for-each
|
(for-each
|
||||||
|
|
|
||||||
|
|
@ -18,8 +18,7 @@
|
||||||
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
||||||
|
|
||||||
(define-module (test-strings)
|
(define-module (test-strings)
|
||||||
#:use-module (test-suite lib)
|
#:use-module (test-suite lib))
|
||||||
#:use-module (srfi srfi-1))
|
|
||||||
|
|
||||||
(define exception:read-only-string
|
(define exception:read-only-string
|
||||||
(cons 'misc-error "^string is read-only"))
|
(cons 'misc-error "^string is read-only"))
|
||||||
|
|
@ -30,16 +29,6 @@
|
||||||
(define exception:wrong-type-arg
|
(define exception:wrong-type-arg
|
||||||
(cons #t "Wrong type"))
|
(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"
|
;; Create a string from integer char values, eg. (string-ints 65) => "A"
|
||||||
(define (string-ints . args)
|
(define (string-ints . args)
|
||||||
(apply string (map integer->char args)))
|
(apply string (map integer->char args)))
|
||||||
|
|
@ -240,83 +229,6 @@
|
||||||
(pass-if "Guile extensions backslash escapes"
|
(pass-if "Guile extensions backslash escapes"
|
||||||
(string=? "\0" (string #\nul))))
|
(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?
|
;; string?
|
||||||
;;
|
;;
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue