From 3dc84d2c1118a79c618364ffea829436231e33f5 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sat, 22 Dec 2012 08:17:51 -0700
Subject: [PATCH] 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 | 47 ++++++++++++++++++++++++
 1 file changed, 47 insertions(+)
 create mode 100644 collects/tests/gracket/bitmap-stress.rkt

diff --git a/collects/tests/gracket/bitmap-stress.rkt b/collects/tests/gracket/bitmap-stress.rkt
new file mode 100644
index 00000000..1089a3ed
--- /dev/null
+++ b/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)