conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Fixed some potential bugs in utf8->string.

This commit is contained in:
Abdulaziz Ghuloum 2007-12-03 05:43:53 -05:00
parent d878bd3934
commit b5ab25c1cf
2 changed files with 54 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
scheme/ikarus.unicode-conversion.ss
View File

@ -128,7 +128,12 @@
[($fx< i j) [($fx< i j)
(let ([b1 ($bytevector-u8-ref x i)]) (let ([b1 ($bytevector-u8-ref x i)])
(cond (cond
[($fx= ($fxsra b1 6) #b10) [(and ($fx= ($fxsra b1 6) #b10)
;;; 000080-0007FF
(let ([n (fxlogor (fxsll (fxlogand b0 #x1F) 6)
(fxlogand b1 #x3F))])
(and (fx>= n #x80)
(fx<= n #x7FF))))
(f x ($fxadd1 i) j ($fxadd1 n) mode)] (f x ($fxadd1 i) j ($fxadd1 n) mode)]
[(eq? mode 'ignore) [(eq? mode 'ignore)
(f x i j n mode)] (f x i j n mode)]
@ -147,7 +152,12 @@
(let ([b1 ($bytevector-u8-ref x ($fx+ i 1))] (let ([b1 ($bytevector-u8-ref x ($fx+ i 1))]
[b2 ($bytevector-u8-ref x ($fx+ i 2))]) [b2 ($bytevector-u8-ref x ($fx+ i 2))])
(cond (cond
[($fx= ($fxsra ($fxlogor b1 b2) 6) #b10) [(and ($fx= ($fxsra ($fxlogor b1 b2) 6) #b10)
(let ([n (fx+ (fxsll (fxlogand b0 #xF) 12)
(fx+ (fxsll (fxlogand b1 #x3F) 6)
(fxlogand b2 #x3F)))])
;;; REVIEW LATER ; 000800-00FFFF
(and (fx>= n #x0000800) (fx<= n #x00FFFF))))
(f x ($fx+ i 3) j ($fxadd1 n) mode)] (f x ($fx+ i 3) j ($fxadd1 n) mode)]
[(eq? mode 'ignore) [(eq? mode 'ignore)
(f x ($fxadd1 i) j n mode)] (f x ($fxadd1 i) j n mode)]
@ -164,7 +174,14 @@
[b2 ($bytevector-u8-ref x ($fx+ i 2))] [b2 ($bytevector-u8-ref x ($fx+ i 2))]
[b3 ($bytevector-u8-ref x ($fx+ i 3))]) [b3 ($bytevector-u8-ref x ($fx+ i 3))])
(cond (cond
[($fx= ($fxsra ($fxlogor b1 ($fxlogor b2 b3)) 6) #b10) [(and ($fx= ($fxsra ($fxlogor b1 ($fxlogor b2 b3)) 6) #b10)
(let ([n
($fx+ ($fxlogand b3 #b111111)
($fx+ ($fxsll ($fxlogand b2 #b111111) 6)
($fx+ ($fxsll ($fxlogand b1 #b111111) 12)
($fxsll ($fxlogand b0 #b111) 18))))])
;;; 010000-10FFFF
(and (fx>= n #x10000) (fx<= n #x10FFFF))))
(f x ($fx+ i 4) j ($fxadd1 n) mode)] (f x ($fx+ i 4) j ($fxadd1 n) mode)]
[(eq? mode 'ignore) [(eq? mode 'ignore)
(f x ($fxadd1 i) j n mode)] (f x ($fxadd1 i) j n mode)]
@ -193,12 +210,16 @@
[($fx< i j) [($fx< i j)
(let ([b1 ($bytevector-u8-ref x i)]) (let ([b1 ($bytevector-u8-ref x i)])
(cond (cond
[($fx= ($fxsra b1 6) #b10) [(and ($fx= ($fxsra b1 6) #b10)
($string-set! str n ;;; 000080-0007FF
($fixnum->char (let ([n (fxlogor (fxsll (fxlogand b0 #x1F) 6)
($fx+ ($fxlogand b1 #b111111) (fxlogand b1 #x3F))])
($fxsll ($fxlogand b0 #b11111) 6)))) (and (fx>= n #x80)
(f str x ($fxadd1 i) j ($fxadd1 n) mode)] (fx<= n #x7FF)
($fixnum->char n)))) =>
(lambda (c)
($string-set! str n c)
(f str x ($fxadd1 i) j ($fxadd1 n) mode))]
[(eq? mode 'ignore) [(eq? mode 'ignore)
(f str x i j n mode)] (f str x i j n mode)]
[(eq? mode 'replace) [(eq? mode 'replace)
@ -216,13 +237,16 @@
(let ([b1 ($bytevector-u8-ref x ($fx+ i 1))] (let ([b1 ($bytevector-u8-ref x ($fx+ i 1))]
[b2 ($bytevector-u8-ref x ($fx+ i 2))]) [b2 ($bytevector-u8-ref x ($fx+ i 2))])
(cond (cond
[($fx= ($fxsra ($fxlogor b1 b2) 6) #b10) [(and ($fx= ($fxsra ($fxlogor b1 b2) 6) #b10)
($string-set! str n (let ([n (fx+ (fxsll (fxlogand b0 #xF) 12)
($fixnum->char (fx+ (fxsll (fxlogand b1 #x3F) 6)
($fx+ ($fxlogand b2 #b111111) (fxlogand b2 #x3F)))])
($fx+ ($fxsll ($fxlogand b1 #b111111) 6) ;;; REVIEW LATER ; 000800-00FFFF
($fxsll ($fxlogand b0 #b1111) 12))))) (and (and (fx>= n #x000800) (fx<= n #x00FFFF))
(f str x ($fx+ i 3) j ($fxadd1 n) mode)] ($fixnum->char n)))) =>
(lambda (c)
($string-set! str n c)
(f str x ($fx+ i 3) j ($fxadd1 n) mode))]
[(eq? mode 'ignore) [(eq? mode 'ignore)
(f str x ($fxadd1 i) j n mode)] (f str x ($fxadd1 i) j n mode)]
[(eq? mode 'replace) [(eq? mode 'replace)
@ -241,14 +265,19 @@
[b2 ($bytevector-u8-ref x ($fx+ i 2))] [b2 ($bytevector-u8-ref x ($fx+ i 2))]
[b3 ($bytevector-u8-ref x ($fx+ i 3))]) [b3 ($bytevector-u8-ref x ($fx+ i 3))])
(cond (cond
[($fx= ($fxsra ($fxlogor b1 ($fxlogor b2 b3)) 6) #b10) [(and ($fx= ($fxsra ($fxlogor b1 ($fxlogor b2 b3)) 6) #b10)
($string-set! str n (let ([n
($fixnum->char ($fx+ ($fxlogand b3 #b111111)
($fx+ ($fxlogand b3 #b111111) ($fx+ ($fxsll ($fxlogand b2 #b111111) 6)
($fx+ ($fxsll ($fxlogand b2 #b111111) 6) ($fx+ ($fxsll ($fxlogand b1 #b111111) 12)
($fx+ ($fxsll ($fxlogand b1 #b111111) 12) ($fxsll ($fxlogand b0 #b111) 18))))])
($fxsll ($fxlogand b0 #b111) 18)))))) ;;; 010000-10FFFF
(f str x ($fx+ i 4) j ($fxadd1 n) mode)] (and (fx>= n #x10000)
(fx<= n #x10FFFF)
($fixnum->char n)))) =>
(lambda (c)
($string-set! str n c)
(f str x ($fx+ i 4) j ($fxadd1 n) mode))]
[(eq? mode 'ignore) [(eq? mode 'ignore)
(f str x ($fxadd1 i) j n mode)] (f str x ($fxadd1 i) j n mode)]
[(eq? mode 'replace) [(eq? mode 'replace)

2
scheme/last-revision
View File

@ -1 +1 @@
1178 1179