racket/draw: fix problem with concurrent PNG read and write

Same memory-management mistake as for the JPEG binding.

original commit: 1545ed42c866c65c5ded9590e55add5fc9ce561d

collects/tests/gracket/bitmap-stress.rkt

@@ -0,0 +1,47 @@
+#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)