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

added textual-output-port checks for record-writer write argument print.ss, record.ms, root-experr*

Browse Source
This commit is contained in:
dyb 2020-08-24 20:51:37 -07:00 committed by Matthew Flatt
parent 14a685af77
commit 416a6790c3
5 changed files with 59 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
racket/src/ChezScheme/LOG
View File

@ -2129,3 +2129,9 @@
- proper unicode handling when retrieving error messages from the OS
on Windows
windows.c
- repair collector handling of an ephemerons that refers to a
younger object during incremental promotion
gc.c, 4.ms
- added textual-output-port checks for record-writer write argument
print.ss,
record.ms, root-experr*

33
racket/src/ChezScheme/mats/record.ms
View File

@ -2840,6 +2840,39 @@
)
(mat record-writer
(equal?
(with-output-to-string
(lambda ()
(define-record-type sp (fields lat))
(record-writer (type-descriptor sp)
(lambda (x p w) (w (sp-lat x) p)))
(pretty-print (list (make-sp 'ugh)))))
"(ugh)\n")
(error? ; 'sp is not an rtd
(with-output-to-string
(lambda ()
(define-record-type sp (fields lat))
(record-writer 'sp
(lambda (x p w) (w (sp-lat x) p))))))
(error? ; "oops" is not a procedure
(with-output-to-string
(lambda ()
(define-record-type sp (fields lat))
(record-writer (type-descriptor sp) "oops"))))
(error? ; ugh is not a textual output port
(with-output-to-string
(lambda ()
(define-record-type sp (fields lat))
(record-writer (type-descriptor sp)
(lambda (x p w) (w p (sp-lat x))))
(pretty-print (list (make-sp 'ugh))))))
(error? ; procedure not a textual output port
(with-output-to-string
(lambda ()
(define-record-type sp (fields lat))
(record-writer (type-descriptor sp)
(lambda (x p w) (w (sp-lat x) w)))
(pretty-print (list (make-sp 'ugh))))))
(begin
(define-record $froz (a b) ([c (+ a b)]))
(define-record $fruz $froz (d))

4
racket/src/ChezScheme/mats/root-experr-compile-0-f-f-f
View File

@ -7819,6 +7819,10 @@ record.mo:Expected error in mat foreign-data: "foreign-set!: invalid value 17 fo
record.mo:Expected error in mat foreign-data: "foreign-set!: invalid value 17 for foreign type single-float".
record.mo:Expected error in mat foreign-data: "foreign-set!: invalid value 17 for foreign type double".
record.mo:Expected error in mat foreign-data: "foreign-set!: invalid value 17 for foreign type double-float".
record.mo:Expected error in mat record-writer: "record-writer: sp is not a record-type descriptor".
record.mo:Expected error in mat record-writer: "record-writer: "oops" is not a procedure".
record.mo:Expected error in mat record-writer: "write: ugh is not a textual output port".
record.mo:Expected error in mat record-writer: "write: #<procedure> is not a textual output port".
record.mo:Expected error in mat record-equal/hash: "record-type-equal-procedure: 7 is not a record-type descriptor".
record.mo:Expected error in mat record-equal/hash: "record-type-equal-procedure: 7 is not a record-type descriptor".
record.mo:Expected error in mat record-equal/hash: "record-type-equal-procedure: 7 is not a procedure or #f".

4
racket/src/ChezScheme/mats/root-experr-compile-2-f-f-f
View File

@ -7379,6 +7379,10 @@ record.mo:Expected error in mat foreign-data: "foreign-set!: invalid value 17 fo
record.mo:Expected error in mat foreign-data: "foreign-set!: invalid value 17 for foreign type single-float".
record.mo:Expected error in mat foreign-data: "foreign-set!: invalid value 17 for foreign type double".
record.mo:Expected error in mat foreign-data: "foreign-set!: invalid value 17 for foreign type double-float".
record.mo:Expected error in mat record-writer: "record-writer: sp is not a record-type descriptor".
record.mo:Expected error in mat record-writer: "record-writer: "oops" is not a procedure".
record.mo:Expected error in mat record-writer: "write: ugh is not a textual output port".
record.mo:Expected error in mat record-writer: "write: #<procedure> is not a textual output port".
record.mo:Expected error in mat record-equal/hash: "record-type-equal-procedure: 7 is not a record-type descriptor".
record.mo:Expected error in mat record-equal/hash: "record-type-equal-procedure: 7 is not a record-type descriptor".
record.mo:Expected error in mat record-equal/hash: "record-type-equal-procedure: 7 is not a procedure or #f".

16
racket/src/ChezScheme/s/print.ss
View File

@ -173,7 +173,9 @@
[(and ($record? x) (not (eq? x #!base-rtd)))
(when (print-record)
((record-writer ($record-type-descriptor x)) x (bit-sink)
(lambda (x p) ; could check for p == (bit-sink)
(lambda (x p)
(unless (and (output-port? p) (textual-port? p))
($oops 'write "~s is not a textual output port" p))
(find-dupls x (decr lev) len))))]
[(box? x) (find-dupls (unbox x) (decr lev) len)]
[(eq? x black-hole) (find-dupls x (decr lev) len)])]
@ -215,7 +217,9 @@
(call/cc
(lambda (k)
((record-writer ($record-type-descriptor x)) x (bit-sink)
(lambda (x p) ; could check for p == (bit-sink)
(lambda (x p)
(unless (and (output-port? p) (textual-port? p))
($oops 'write "~s is not a textual output port" p))
(if (cyclic? x (fx+ curlev 1) 0)
(k #t))))
#f)))))]
@ -308,7 +312,9 @@
(call/cc
(lambda (k)
((record-writer ($record-type-descriptor x)) x (bit-sink)
(lambda (x p) ; could check for p == (bit-sink)
(lambda (x p)
(unless (and (output-port? p) (textual-port? p))
($oops 'write "~s is not a textual output port" p))
(if (down x (fx- xlev 1)) (k #t))))
#f)))]
[(box? x) (down (unbox x) (fx- xlev 1))]
@ -706,7 +712,9 @@ floating point returns with (1 0 -1 ...).
(if (limit? lev)
(display-string "#[...]" p)
((record-writer ($record-type-descriptor x)) x p
(lambda (x p) ; could check for p == old p
(lambda (x p)
(unless (and (output-port? p) (textual-port? p))
($oops 'write "~s is not a textual output port" p))
(wr x r (decr lev) len d? env p))))
(let ([rtd ($record-type-descriptor x)])
(cond ; keep in sync with default-record-writer