suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

reader: fix number->string case insensitivity

Browse Source 
For example, `1+2I` and `+INF.FI` should parse as numbers.

Closes #2660
This commit is contained in:
Matthew Flatt 2019-05-18 12:17:39 -04:00
parent 236e2768f8
commit 39fe53f5d5
3 changed files with 79 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
pkgs/racket-test-core/tests/racket/read.rktl
View File

@ -269,23 +269,24 @@
(let* ([pair (car l)] (let* ([pair (car l)]
[v (car pair)] [v (car pair)]
[s (cadr pair)]) [s (cadr pair)])
(cond (for ([s (in-list (list s (string-upcase s)))])
[(memq v '(X DBZ NOE)) (cond
(err/rt-test (readstr s) exn:fail:read?) [(memq v '(X DBZ NOE))
(test #f string->number s) (err/rt-test (readstr s) exn:fail:read?)
(test #t string? (string->number s 10 'read))] (test #f string->number s)
[v (test #t string? (string->number s 10 'read))]
(test v readstr s) [v
(test (if (symbol? v) #f v) string->number s) (test v readstr s)
(test (if (symbol? v) #f v) string->number s 10 'read)] (test (if (symbol? v) #f v) string->number s)
[else (test (if (symbol? v) #f v) string->number s 10 'read)]
(test (string->symbol s) readstr s) [else
(test #f string->number s) (test (string->symbol s) readstr s)
(test #f string->number s 10 'read) (test #f string->number s)
(unless (regexp-match "#" s) (test #f string->number s 10 'read)
(err/rt-test (readstr (string-append "#d" s)) exn:fail:read?) (unless (regexp-match "#" s)
(test #f string->number (string-append "#d" s)) (err/rt-test (readstr (string-append "#d" s)) exn:fail:read?)
(test #t string? (string->number (string-append "#d" s) 10 'read)))])) (test #f string->number (string-append "#d" s))
(test #t string? (string->number (string-append "#d" s) 10 'read)))])))
(loop (cdr l)))) (loop (cdr l))))
(define (make-exn:fail:read:eof?/span start span) (define (make-exn:fail:read:eof?/span start span)

25
racket/src/expander/read/number.rkt
View File

@ -403,7 +403,8 @@
(cond (cond
[(eqv? (string-ref s start) #\#) [(eqv? (string-ref s start) #\#)
(trim-number s (fx+ 2 start) end)] (trim-number s (fx+ 2 start) end)]
[(eqv? (string-ref s (fx- end 1)) #\i) [(let ([c (string-ref s (fx- end 1))])
(or (eqv? c #\i) (eqv? c #\I)))
(trim-number s start (fx- end 1))] (trim-number s start (fx- end 1))]
[else (substring s start end)])) [else (substring s start end)]))
@ -519,7 +520,7 @@
(read-imag c sgn (get-n) (if (eqv? c #\+) +1 -1) s (fx+ 1 start) end radix state)] (read-imag c sgn (get-n) (if (eqv? c #\+) +1 -1) s (fx+ 1 start) end radix state)]
[(#\@) [(#\@)
(read-polar sgn (get-n) s (fx+ 1 start) end radix state)] (read-polar sgn (get-n) s (fx+ 1 start) end radix state)]
[(#\i) [(#\i #\I)
(finish-imaginary sgn (get-n) s (fx+ 1 start) end state)] (finish-imaginary sgn (get-n) s (fx+ 1 start) end state)]
[else [else
(bad-digit c s state)])) (bad-digit c s state)]))
@ -564,7 +565,7 @@
(maybe (get-n) (maybe (get-n)
(lambda (n) (lambda (n)
(read-polar sgn n s (fx+ 1 start) end radix state)))] (read-polar sgn n s (fx+ 1 start) end radix state)))]
[(#\i) [(#\i #\I)
(maybe (get-n) (maybe (get-n)
(lambda (n) (lambda (n)
(finish-imaginary sgn n s (fx+ 1 start) end state)))] (finish-imaginary sgn n s (fx+ 1 start) end state)))]
@ -595,7 +596,7 @@
(read-imag c sgn (get-n) (if (eqv? c #\+) +1 -1) s (fx+ 1 start) end radix state)] (read-imag c sgn (get-n) (if (eqv? c #\+) +1 -1) s (fx+ 1 start) end radix state)]
[(#\@) [(#\@)
(read-polar sgn (get-n) s (fx+ 1 start) end radix state)] (read-polar sgn (get-n) s (fx+ 1 start) end radix state)]
[(#\i) [(#\i #\I)
(finish-imaginary sgn (get-n) s (fx+ 1 start) end state)] (finish-imaginary sgn (get-n) s (fx+ 1 start) end state)]
[else [else
(bad-digit c s state)])) (bad-digit c s state)]))
@ -612,7 +613,7 @@
(read-signed-exponent sgn sgn-n exp sgn2 #f s (fx+ 1 start) end radix state)] (read-signed-exponent sgn sgn-n exp sgn2 #f s (fx+ 1 start) end radix state)]
[(#\. #\# #\/ #\e #\E #\d #\D #\l #\L #\f #\F #\s #\S #\t #\T) [(#\. #\# #\/ #\e #\E #\d #\D #\l #\L #\f #\F #\s #\S #\t #\T)
(bad-misplaced c s state)] (bad-misplaced c s state)]
[(#\i) [(#\i #\I)
(if (state-has-first-half? state) (if (state-has-first-half? state)
(fail state "empty exponent `~.a`" s) (fail state "empty exponent `~.a`" s)
(bad-misplaced "i" s state))] (bad-misplaced "i" s state))]
@ -645,7 +646,7 @@
(maybe (get-n) (maybe (get-n)
(lambda (n) (lambda (n)
(read-polar sgn n s (fx+ 1 start) end radix state)))] (read-polar sgn n s (fx+ 1 start) end radix state)))]
[(#\i) [(#\i #\I)
(maybe (get-n) (maybe (get-n)
(lambda (n) (lambda (n)
(finish-imaginary sgn n s (fx+ 1 start) end state)))] (finish-imaginary sgn n s (fx+ 1 start) end state)))]
@ -658,7 +659,7 @@
s start end s start end
[[(#\f #\F) [[(#\f #\F)
(#\.) (#\.)
(#\0 #\f #\t)] (#\0 #\f #\t #\F #\T)]
(define n (if (negative? sgn) -inf.0 +inf.0)) (define n (if (negative? sgn) -inf.0 +inf.0))
(define new-state (set-exactness-by-char state (string-ref s (fx+ start 2)) (define new-state (set-exactness-by-char state (string-ref s (fx+ start 2))
#:override? #t)) #:override? #t))
@ -669,7 +670,7 @@
(read-imag c2 sgn n (if (eqv? c2 #\+) +1 -1) s (fx+ 4 start) end radix new-state)] (read-imag c2 sgn n (if (eqv? c2 #\+) +1 -1) s (fx+ 4 start) end radix new-state)]
[(#\@) [(#\@)
(read-polar sgn n s (fx+ 4 start) end radix new-state)] (read-polar sgn n s (fx+ 4 start) end radix new-state)]
[(#\i) [(#\i #\I)
(finish-imaginary sgn n s (fx+ 4 start) end new-state)] (finish-imaginary sgn n s (fx+ 4 start) end new-state)]
[else [else
(bad-digit c s state)])] (bad-digit c s state)])]
@ -683,7 +684,7 @@
[[(#\a #\A) [[(#\a #\A)
(#\n #\N) (#\n #\N)
(#\.) (#\.)
(#\0 #\f #\t)] (#\0 #\f #\t #\F #\T)]
(define n +nan.0) (define n +nan.0)
(define new-state (set-exactness-by-char state (string-ref s (fx+ start 3)) (define new-state (set-exactness-by-char state (string-ref s (fx+ start 3))
#:override? #t)) #:override? #t))
@ -694,7 +695,7 @@
(read-imag c2 1 n (if (eqv? c2 #\+) +1 -1) s (fx+ 5 start) end radix new-state)] (read-imag c2 1 n (if (eqv? c2 #\+) +1 -1) s (fx+ 5 start) end radix new-state)]
[(#\@) [(#\@)
(read-polar 1 n s (fx+ 5 start) end radix new-state)] (read-polar 1 n s (fx+ 5 start) end radix new-state)]
[(#\i) [(#\i #\I)
(finish-imaginary +1 n s (fx+ 5 start) end new-state)] (finish-imaginary +1 n s (fx+ 5 start) end new-state)]
[else [else
(bad-digit c s state)])] (bad-digit c s state)])]
@ -734,7 +735,7 @@
(maybe (get-n) (maybe (get-n)
(lambda (n) (lambda (n)
(read-polar sgn n s (fx+ 1 start) end radix state)))] (read-polar sgn n s (fx+ 1 start) end radix state)))]
[(#\i) [(#\i #\I)
(maybe (get-n) (maybe (get-n)
(lambda (n) (lambda (n)
(finish-imaginary sgn n s (fx+ 1 start) end state)))] (finish-imaginary sgn n s (fx+ 1 start) end state)))]
@ -759,7 +760,7 @@
(read-imag c sgn (get-n) (if (eqv? c #\+) +1 -1) s (fx+ 1 start) end radix state)] (read-imag c sgn (get-n) (if (eqv? c #\+) +1 -1) s (fx+ 1 start) end radix state)]
[(#\@) [(#\@)
(read-polar sgn (get-n) s (fx+ 1 start) end radix state)] (read-polar sgn (get-n) s (fx+ 1 start) end radix state)]
[(#\i) [(#\i #\I)
(finish-imaginary sgn (get-n) s (fx+ 1 start) end state)] (finish-imaginary sgn (get-n) s (fx+ 1 start) end state)]
[else [else
(bad-digit c s state)])) (bad-digit c s state)]))

60
racket/src/racket/src/startup.inc
View File

@ -54639,7 +54639,8 @@ static const char *startup_source =
"(begin" "(begin"
"(if(eqv?(string-ref s_0 start_0) '#\\#)" "(if(eqv?(string-ref s_0 start_0) '#\\#)"
"(let-values()(trim-number s_0(fx+ 2 start_0) end_0))" "(let-values()(trim-number s_0(fx+ 2 start_0) end_0))"
"(if(eqv?(string-ref s_0(fx- end_0 1)) '#\\i)" "(if(let-values(((c_0)(string-ref s_0(fx- end_0 1))))"
"(let-values(((or-part_0)(eqv? c_0 '#\\i)))(if or-part_0 or-part_0(eqv? c_0 '#\\I))))"
"(let-values()(trim-number s_0 start_0(fx- end_0 1)))" "(let-values()(trim-number s_0 start_0(fx- end_0 1)))"
"(let-values()(substring s_0 start_0 end_0)))))))" "(let-values()(substring s_0 start_0 end_0)))))))"
"(define-values" "(define-values"
@ -54982,7 +54983,10 @@ static const char *startup_source =
" state_0))" " state_0))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\@)))(if or-part_0 or-part_0 #f))" "(if(let-values(((or-part_0)(eqv? c_0 '#\\@)))(if or-part_0 or-part_0 #f))"
"(let-values()(read-polar sgn_0(get-n_0) s_0(fx+ 1 start_0) end_0 radix_0 state_0))" "(let-values()(read-polar sgn_0(get-n_0) s_0(fx+ 1 start_0) end_0 radix_0 state_0))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))(if or-part_0 or-part_0 #f))" "(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))"
"(if or-part_0"
" or-part_0"
"(let-values(((or-part_1)(eqv? c_0 '#\\I)))(if or-part_1 or-part_1 #f))))"
"(let-values()(finish-imaginary sgn_0(get-n_0) s_0(fx+ 1 start_0) end_0 state_0))" "(let-values()(finish-imaginary sgn_0(get-n_0) s_0(fx+ 1 start_0) end_0 state_0))"
"(let-values()(bad-digit c_0 s_0 state_0))))))))))))))))" "(let-values()(bad-digit c_0 s_0 state_0))))))))))))))))"
"(define-values" "(define-values"
@ -55114,7 +55118,10 @@ static const char *startup_source =
"(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))" "(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))"
" v_0" " v_0"
"((lambda(n_1)(read-polar sgn_0 n_1 s_0(fx+ 1 start_0) end_0 radix_0 state_0)) v_0))))" "((lambda(n_1)(read-polar sgn_0 n_1 s_0(fx+ 1 start_0) end_0 radix_0 state_0)) v_0))))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))(if or-part_0 or-part_0 #f))" "(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))"
"(if or-part_0"
" or-part_0"
"(let-values(((or-part_1)(eqv? c_0 '#\\I)))(if or-part_1 or-part_1 #f))))"
"(let-values()" "(let-values()"
"(let-values(((v_0)(get-n_0)))" "(let-values(((v_0)(get-n_0)))"
"(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))" "(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))"
@ -55221,7 +55228,10 @@ static const char *startup_source =
" state_0))" " state_0))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\@)))(if or-part_0 or-part_0 #f))" "(if(let-values(((or-part_0)(eqv? c_0 '#\\@)))(if or-part_0 or-part_0 #f))"
"(let-values()(read-polar sgn_0(get-n_0) s_0(fx+ 1 start_0) end_0 radix_0 state_0))" "(let-values()(read-polar sgn_0(get-n_0) s_0(fx+ 1 start_0) end_0 radix_0 state_0))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))(if or-part_0 or-part_0 #f))" "(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))"
"(if or-part_0"
" or-part_0"
"(let-values(((or-part_1)(eqv? c_0 '#\\I)))(if or-part_1 or-part_1 #f))))"
"(let-values()(finish-imaginary sgn_0(get-n_0) s_0(fx+ 1 start_0) end_0 state_0))" "(let-values()(finish-imaginary sgn_0(get-n_0) s_0(fx+ 1 start_0) end_0 state_0))"
"(let-values()(bad-digit c_0 s_0 state_0))))))))))))))))" "(let-values()(bad-digit c_0 s_0 state_0))))))))))))))))"
"(define-values" "(define-values"
@ -55292,7 +55302,8 @@ static const char *startup_source =
" or-part_14" " or-part_14"
" #f))))))))))))))))))))))))))))))" " #f))))))))))))))))))))))))))))))"
"(let-values()(bad-misplaced c_0 s_0 state_0))" "(let-values()(bad-misplaced c_0 s_0 state_0))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))(if or-part_0 or-part_0 #f))" "(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))"
"(if or-part_0 or-part_0(let-values(((or-part_1)(eqv? c_0 '#\\I)))(if or-part_1 or-part_1 #f))))"
"(let-values()" "(let-values()"
"(if(state-has-first-half? state_0)" "(if(state-has-first-half? state_0)"
"(if(eq?(state->convert-mode state_0) 'must-read)" "(if(eq?(state->convert-mode state_0) 'must-read)"
@ -55410,7 +55421,10 @@ static const char *startup_source =
"(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))" "(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))"
" v_0" " v_0"
"((lambda(n_0)(read-polar sgn_0 n_0 s_0(fx+ 1 start_0) end_0 radix_0 state_0)) v_0))))" "((lambda(n_0)(read-polar sgn_0 n_0 s_0(fx+ 1 start_0) end_0 radix_0 state_0)) v_0))))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))(if or-part_0 or-part_0 #f))" "(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))"
"(if or-part_0"
" or-part_0"
"(let-values(((or-part_1)(eqv? c_0 '#\\I)))(if or-part_1 or-part_1 #f))))"
"(let-values()" "(let-values()"
"(let-values(((v_0)(get-n_0)))" "(let-values(((v_0)(get-n_0)))"
"(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))" "(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))"
@ -55437,7 +55451,13 @@ static const char *startup_source =
"(let-values(((start+n_2)(fx+ start_0(+(+ 0 1) 1))))" "(let-values(((start+n_2)(fx+ start_0(+(+ 0 1) 1))))"
"(let-values(((var_2)(if(fx= start+n_2 end_0) 'eof(string-ref s_0 start+n_2))))" "(let-values(((var_2)(if(fx= start+n_2 end_0) 'eof(string-ref s_0 start+n_2))))"
"(let-values(((tmp_2) var_2))" "(let-values(((tmp_2) var_2))"
"(if(if(equal? tmp_2 '#\\0) #t(if(equal? tmp_2 '#\\f) #t(equal? tmp_2 '#\\t)))" "(if(if(equal? tmp_2 '#\\0)"
" #t"
"(if(equal? tmp_2 '#\\f)"
" #t"
"(if(equal? tmp_2 '#\\t)"
" #t"
"(if(equal? tmp_2 '#\\F) #t(equal? tmp_2 '#\\T)))))"
"(let-values()" "(let-values()"
"(let-values()" "(let-values()"
"(let-values(((n_0)(if(negative? sgn_0) -inf.0 +inf.0)))" "(let-values(((n_0)(if(negative? sgn_0) -inf.0 +inf.0)))"
@ -55490,7 +55510,10 @@ static const char *startup_source =
" radix_0" " radix_0"
" new-state_0))" " new-state_0))"
"(if(let-values(((or-part_0)(eqv? c2_0 '#\\i)))" "(if(let-values(((or-part_0)(eqv? c2_0 '#\\i)))"
"(if or-part_0 or-part_0 #f))" "(if or-part_0"
" or-part_0"
"(let-values(((or-part_1)(eqv? c2_0 '#\\I)))"
"(if or-part_1 or-part_1 #f))))"
"(let-values()" "(let-values()"
"(finish-imaginary" "(finish-imaginary"
" sgn_0" " sgn_0"
@ -55532,7 +55555,11 @@ static const char *startup_source =
"(let-values(((tmp_3) var_3))" "(let-values(((tmp_3) var_3))"
"(if(if(equal? tmp_3 '#\\0)" "(if(if(equal? tmp_3 '#\\0)"
" #t" " #t"
"(if(equal? tmp_3 '#\\f) #t(equal? tmp_3 '#\\t)))" "(if(equal? tmp_3 '#\\f)"
" #t"
"(if(equal? tmp_3 '#\\t)"
" #t"
"(if(equal? tmp_3 '#\\F) #t(equal? tmp_3 '#\\T)))))"
"(let-values()" "(let-values()"
"(let-values()" "(let-values()"
"(let-values(((n_0) +nan.0))" "(let-values(((n_0) +nan.0))"
@ -55594,7 +55621,10 @@ static const char *startup_source =
" radix_0" " radix_0"
" new-state_0))" " new-state_0))"
"(if(let-values(((or-part_0)(eqv? c2_0 '#\\i)))" "(if(let-values(((or-part_0)(eqv? c2_0 '#\\i)))"
"(if or-part_0 or-part_0 #f))" "(if or-part_0"
" or-part_0"
"(let-values(((or-part_1)(eqv? c2_0 '#\\I)))"
"(if or-part_1 or-part_1 #f))))"
"(let-values()" "(let-values()"
"(finish-imaginary" "(finish-imaginary"
" 1" " 1"
@ -55736,7 +55766,10 @@ static const char *startup_source =
"(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))" "(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))"
" v_0" " v_0"
"((lambda(n_0)(read-polar sgn_0 n_0 s_0(fx+ 1 start_0) end_0 radix_0 state_0)) v_0))))" "((lambda(n_0)(read-polar sgn_0 n_0 s_0(fx+ 1 start_0) end_0 radix_0 state_0)) v_0))))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))(if or-part_0 or-part_0 #f))" "(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))"
"(if or-part_0"
" or-part_0"
"(let-values(((or-part_1)(eqv? c_0 '#\\I)))(if or-part_1 or-part_1 #f))))"
"(let-values()" "(let-values()"
"(let-values(((v_0)(get-n_0)))" "(let-values(((v_0)(get-n_0)))"
"(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))" "(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))"
@ -55827,7 +55860,10 @@ static const char *startup_source =
" state_0))" " state_0))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\@)))(if or-part_0 or-part_0 #f))" "(if(let-values(((or-part_0)(eqv? c_0 '#\\@)))(if or-part_0 or-part_0 #f))"
"(let-values()(read-polar sgn_0(get-n_0) s_0(fx+ 1 start_0) end_0 radix_0 state_0))" "(let-values()(read-polar sgn_0(get-n_0) s_0(fx+ 1 start_0) end_0 radix_0 state_0))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))(if or-part_0 or-part_0 #f))" "(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))"
"(if or-part_0"
" or-part_0"
"(let-values(((or-part_1)(eqv? c_0 '#\\I)))(if or-part_1 or-part_1 #f))))"
"(let-values()(finish-imaginary sgn_0(get-n_0) s_0(fx+ 1 start_0) end_0 state_0))" "(let-values()(finish-imaginary sgn_0(get-n_0) s_0(fx+ 1 start_0) end_0 state_0))"
"(let-values()(bad-digit c_0 s_0 state_0)))))))))))))))" "(let-values()(bad-digit c_0 s_0 state_0)))))))))))))))"
"(define-values" "(define-values"