diff options
| author | Rose Hogenson <rhogenson@posteo.net> | 2022-08-05 21:28:34 -0700 |
|---|---|---|
| committer | Rose Hogenson <rhogenson@posteo.net> | 2022-08-05 21:28:34 -0700 |
| commit | 1776abc8e977e4fdf0d518c96286680c841d3d67 (patch) | |
| tree | b7796187aa8e57652f09ee751ef6bdde2e1972e3 /lib/scheme | |
| parent | 83a18a658ac925b589d36e37ae150ec986d5eba8 (diff) | |
| download | chromatopelma-1776abc8e977e4fdf0d518c96286680c841d3d67.tar.zst | |
Check that records are the correct type.
To avoid selecting the wrong field, or reading out of bounds, we
should ensure that a record is the correct type before reading a field.
Diffstat (limited to 'lib/scheme')
| -rw-r--r-- | lib/scheme/base/50-records.csc | 24 |
1 files changed, 15 insertions, 9 deletions
diff --git a/lib/scheme/base/50-records.csc b/lib/scheme/base/50-records.csc index d7fa8d1..2830b3c 100644 --- a/lib/scheme/base/50-records.csc +++ b/lib/scheme/base/50-records.csc @@ -29,17 +29,23 @@ (define-syntax define-selectors (syntax-rules () - ((define-selectors (selectors ...)) + ((define-selectors pred (selectors ...)) (values selectors ...)) - ((define-selectors (selectors ...) (field getter) selector ...) - (define-selectors (selectors ... (lambda (r) - (call-builtin peek r field))) + ((define-selectors pred (selectors ...) (field getter) selector ...) + (define-selectors pred (selectors ... (lambda (r) + (unless (pred r) + (error "unexpected type in getter" r 'getter)) + (call-builtin peek r field))) selector ...)) - ((define-selectors (selectors ...) (field getter setter) selector ...) - (define-selectors (selectors ... (lambda (r) - (call-builtin peek r field)) - (lambda (r val) - (call-builtin poke val r field))) + ((define-selectors pred (selectors ...) (field getter setter) selector ...) + (define-selectors pred (selectors ... (lambda (r) + (unless (pred r) + (error "unexpected type in getter" r 'getter)) + (call-builtin peek r field)) + (lambda (r val) + (unless (pred r) + (error "unexpected type in setter" r 'setter)) + (call-builtin poke val r field))) selector ...)))) |