48 lines
1.7 KiB
Racket
48 lines
1.7 KiB
Racket
#lang racket/base
|
|
(require racket/class
|
|
racket/draw
|
|
racket/file)
|
|
|
|
;; Check memory-management in the bitmap/PNG/JPEG/etc. library by reading
|
|
;; and writing in many threads at the same time.
|
|
|
|
(define (check src save-type [read-type 'unknown/alpha])
|
|
(define ts
|
|
(for/list ([i (in-range 40)])
|
|
(thread
|
|
(lambda()
|
|
(for ([i (in-range 10)])
|
|
(define bm (read-bitmap (collection-file-path src "icons")))
|
|
(define t (make-temporary-file))
|
|
(send bm save-file t save-type)
|
|
(define bm2 (read-bitmap t read-type))
|
|
(define w (send bm get-width))
|
|
(define h (send bm get-width))
|
|
(define s1 (make-bytes (* w h 4)))
|
|
(define s2 (make-bytes (* w h 4)))
|
|
(send bm get-argb-pixels 0 0 w h s1)
|
|
(send bm2 get-argb-pixels 0 0 w h s2)
|
|
(case save-type
|
|
[(jpeg)
|
|
;; JPEG is lossy, so use a fuzzy compare:
|
|
(define diff (for/sum ([b1 (in-bytes s1)]
|
|
[b2 (in-bytes s2)])
|
|
(- b2 b1)))
|
|
(unless ((abs diff) . < . (* w h 1))
|
|
(error 'bitmap-stress "mismatch for ~s ~s: ~s ~s ~e"
|
|
src save-type
|
|
w h diff))]
|
|
[else
|
|
(unless (equal? s1 s2)
|
|
(error 'bitmap-stress "mismatch for ~s ~s" src save-type))])
|
|
(delete-file t))))))
|
|
|
|
(for ([t (in-list ts)]) (sync t)))
|
|
|
|
(check "PLT-206.png" 'png)
|
|
(check "plt.jpg" 'jpeg)
|
|
(check "htdp-icon.gif" 'png 'unknown)
|
|
(check "help16x16.xpm" 'png 'unknown)
|
|
(check "help16x16.xbm" 'png 'unknown)
|
|
(check "help.bmp" 'png 'unknown)
|