Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

add safety checks on substring-cursor

Browse source
This commit is contained in:
Alex Shinn 2020-02-06 23:09:33 +08:00
parent fad3413235
commit 507e62c3e1
2 changed files with 17 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
Makefile
View file

@ -297,6 +297,10 @@ test-r7rs: chibi-scheme$(EXE)
test: test-r7rs test: test-r7rs
test-safe-string-cursors: chibi-scheme$(EXE)
$(CHIBI) -Dsafe-string-cursors tests/r7rs-tests.scm
$(CHIBI) -Dsafe-string-cursors tests/lib-tests.scm
test-all: test test-libs test-ffi test-division test-all: test test-libs test-ffi test-division
test-dist: test-all test-memory test-build test-dist: test-all test-memory test-build

22
lib/init-7.scm
View file

@ -440,6 +440,12 @@
(string-cursor-where-set! res where) (string-cursor-where-set! res where)
(string-cursor-size-set! res size) (string-cursor-size-set! res size)
res)) res))
(define (validate-cursor str sc)
(cond
((not (eq? str (string-cursor-string sc)))
(error "attempt to use string cursor on different string" str sc))
((not (= (string-size str) (string-cursor-size sc)))
(error "string has mutated since cursor was created" str sc))))
(define orig-string-cursor-offset string-cursor-offset) (define orig-string-cursor-offset string-cursor-offset)
(define orig-string-cursor->index string-cursor->index) (define orig-string-cursor->index string-cursor->index)
(define orig-string-index->cursor string-index->cursor) (define orig-string-index->cursor string-index->cursor)
@ -456,9 +462,13 @@
(string-size str)))) (string-size str))))
(set! substring-cursor (set! substring-cursor
(lambda (str start . o) (lambda (str start . o)
(if (pair? o) (validate-cursor str start)
(orig-substring-cursor str (string-cursor-where start) (string-cursor-where (car o))) (cond
(orig-substring-cursor str (string-cursor-where start))))) ((pair? o)
(validate-cursor str (car o))
(orig-substring-cursor str (string-cursor-where start) (string-cursor-where (car o))))
(else
(orig-substring-cursor str (string-cursor-where start))))))
(define (string-cursor=? sc1 sc2 . o) (define (string-cursor=? sc1 sc2 . o)
(and (equal? ((values string-cursor-offset) sc1) ((values string-cursor-offset) sc2)) (and (equal? ((values string-cursor-offset) sc1) ((values string-cursor-offset) sc2))
(or (null? o) (apply string-cursor=? sc2 o)))) (or (null? o) (apply string-cursor=? sc2 o))))
@ -483,12 +493,6 @@
(make-string-cursor s end (string-size s))))) (make-string-cursor s end (string-size s)))))
(define (string-size s) (define (string-size s)
(orig-string-cursor-offset (orig-string-cursor-end s))) (orig-string-cursor-offset (orig-string-cursor-end s)))
(define (validate-cursor str sc)
(cond
((not (eq? str (string-cursor-string sc)))
(error "attempt to use string cursor on different string" str sc))
((not (= (string-size str) (string-cursor-size sc)))
(error "string has mutated since cursor was created" str sc))))
(define orig-string-cursor-ref string-cursor-ref) (define orig-string-cursor-ref string-cursor-ref)
(define orig-string-cursor-next string-cursor-next) (define orig-string-cursor-next string-cursor-next)
(define orig-string-cursor-prev string-cursor-prev) (define orig-string-cursor-prev string-cursor-prev)