Stream-based backends can now use a caml channel

* Other fixes

18 files changed, 274 insertions, 113 deletions

diff --git a/ChangeLog b/ChangeLog
index c75fd9f..4618631 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,16 @@
+2005-05-27  Olivier Andrieu  <oliv__a@users.sourceforge.net>
+
+	* src/cairo.ml, src/cairo.mli: remove BAD_NESTING error status
+	
+	* src/cairo_pdf.*, src/cairo_ps.*, src/cairo_png.*: surface
+	creation function take an ocaml channel as argument
+
+	* src/ml_cairo.c: new stream functions for ocaml channels support
+
+	* src/ml_cairo_*.c: adapt, some code cleanups
+
+	* test/basket.ml: adapt, some fixes
+
 2005-05-22  Olivier Andrieu  <oliv__a@users.sourceforge.net>
 
 	* src/*: adjust to big API shakeup. Remove Cairo_channel module,
diff --git a/src/cairo.ml b/src/cairo.ml
index db86429..8a1f849 100644
--- a/src/cairo.ml
+++ b/src/cairo.ml
@@ -20,7 +20,6 @@ type status =
   | WRITE_ERROR
   | SURFACE_FINISHED
   | SURFACE_TYPE_MISMATCH
-  | BAD_NESTING
 exception Error of status
 let init = Callback.register_exception "cairo_status_exn" (Error NULL_POINTER)
 
diff --git a/src/cairo.mli b/src/cairo.mli
index b5c9df6..991f20f 100644
--- a/src/cairo.mli
+++ b/src/cairo.mli
@@ -24,7 +24,6 @@ type status =
   | WRITE_ERROR
   | SURFACE_FINISHED
   | SURFACE_TYPE_MISMATCH
-  | BAD_NESTING
 exception Error of status
 val init : unit
 
diff --git a/src/cairo_pdf.ml b/src/cairo_pdf.ml
index a071c78..f0e8370 100644
--- a/src/cairo_pdf.ml
+++ b/src/cairo_pdf.ml
@@ -8,10 +8,19 @@
 
 type surface = [`Any|`PDF] Cairo.surface
 
-external surface_create : 
-  string -> 
+external surface_create_for_stream_unsafe : 
+  (string -> int -> unit) ->
   width_in_points:float -> 
-  height_in_points:float -> surface = "ml_cairo_pdf_surface_create"
+  height_in_points:float -> surface = "ml_cairo_pdf_surface_create_for_stream_unsafe"
+
+let unsafe_output_string oc s n =
+  for i = 0 to n - 1 do
+    output_char oc (String.unsafe_get s i)
+  done
+
+let surface_create_for_channel oc ~width_in_points ~height_in_points =
+  surface_create_for_stream_unsafe
+    (unsafe_output_string oc) ~width_in_points ~height_in_points
 
 external surface_create_for_stream :
   (string -> unit) ->
diff --git a/src/cairo_pdf.mli b/src/cairo_pdf.mli
index 1ef016f..d17034b 100644
--- a/src/cairo_pdf.mli
+++ b/src/cairo_pdf.mli
@@ -10,10 +10,10 @@
 
 type surface = [`Any|`PDF] Cairo.surface
 
-external surface_create : 
-  string -> 
+val surface_create_for_channel : 
+  out_channel -> 
   width_in_points:float -> 
-  height_in_points:float -> surface = "ml_cairo_pdf_surface_create"
+  height_in_points:float -> surface
 
 external surface_create_for_stream :
   (string -> unit) ->
diff --git a/src/cairo_png.ml b/src/cairo_png.ml
index 62cb1c9..3816d0d 100644
--- a/src/cairo_png.ml
+++ b/src/cairo_png.ml
@@ -6,15 +6,52 @@
 (*  GNU Lesser General Public License version 2.1 (the "LGPL").           *)
 (**************************************************************************)
 
-external image_surface_create_from_file : 
-  string -> Cairo.image_surface = "ml_cairo_image_surface_create_from_png"
+external image_surface_create_from_stream_unsafe : 
+  (string -> int -> unit) -> Cairo.image_surface = "ml_cairo_image_surface_create_from_png_stream_unsafe"
+
+let image_surface_create_from_channel ic =
+  image_surface_create_from_stream_unsafe
+    (fun s n ->
+      for i = 0 to n - 1 do
+	String.unsafe_set s i (input_char ic)
+      done)
+
+let image_surface_create_from_file fname =
+  let ic = open_in fname in
+  try
+    let surf = image_surface_create_from_channel ic in
+    close_in ic ;
+    surf
+  with exn ->
+    close_in_noerr ic ;
+    raise exn
 
 external image_surface_create_from_stream : 
-  (string -> unit) -> Cairo.image_surface = "ml_cairo_image_surface_create_from_stream"
+  (string -> unit) -> Cairo.image_surface = "ml_cairo_image_surface_create_from_png_stream"
+
+
+
+external surface_write_to_stream_unsafe : 
+  'a Cairo.surface -> (string -> int -> unit) -> unit = "ml_cairo_surface_write_to_png_stream_unsafe"
+
+let unsafe_output_string oc s n =
+  for i = 0 to n - 1 do
+    output_char oc (String.unsafe_get s i)
+  done
 
+let surface_write_to_channel surf oc =
+  surface_write_to_stream_unsafe 
+    surf
+    (unsafe_output_string oc)
 
-external surface_write_to_file : 
-  'a Cairo.surface -> string -> unit = "ml_cairo_surface_write_to_png"
+let surface_write_to_file surf fname =
+  let oc = open_out fname in
+  try
+    surface_write_to_channel surf oc ;
+    close_out oc
+  with exn ->
+    close_out_noerr oc ;
+    raise exn
 
 external surface_write_to_stream : 
   'a Cairo.surface -> (string -> unit) -> unit = "ml_cairo_surface_write_to_png_stream"
diff --git a/src/cairo_png.mli b/src/cairo_png.mli
index 260a745..9f474b5 100644
--- a/src/cairo_png.mli
+++ b/src/cairo_png.mli
@@ -8,15 +8,21 @@
 
 (** PNG reading/writing functions *)
 
-external image_surface_create_from_file : 
-  string -> Cairo.image_surface = "ml_cairo_image_surface_create_from_png"
+val image_surface_create_from_channel : 
+  in_channel -> Cairo.image_surface
+
+val image_surface_create_from_file : 
+  string -> Cairo.image_surface
 
 external image_surface_create_from_stream : 
-  (string -> unit) -> Cairo.image_surface = "ml_cairo_image_surface_create_from_stream"
+  (string -> unit) -> Cairo.image_surface = "ml_cairo_image_surface_create_from_png_stream"
+
 
+val surface_write_to_channel : 
+  'a Cairo.surface -> out_channel -> unit
 
-external surface_write_to_file : 
-  'a Cairo.surface -> string -> unit = "ml_cairo_surface_write_to_png"
+val surface_write_to_file : 
+  'a Cairo.surface -> string -> unit
 
 external surface_write_to_stream : 
   'a Cairo.surface -> (string -> unit) -> unit = "ml_cairo_surface_write_to_png_stream"
diff --git a/src/cairo_ps.ml b/src/cairo_ps.ml
index 380c32f..9718257 100644
--- a/src/cairo_ps.ml
+++ b/src/cairo_ps.ml
@@ -8,10 +8,19 @@
 
 type surface = [`Any|`PS] Cairo.surface
 
-external surface_create : 
-  string -> 
+external surface_create_for_stream_unsafe : 
+  (string -> int -> unit) ->
   width_in_points:float -> 
-  height_in_points:float -> surface = "ml_cairo_ps_surface_create"
+  height_in_points:float -> surface = "ml_cairo_ps_surface_create_for_stream_unsafe"
+
+let unsafe_output_string oc s n =
+  for i = 0 to n - 1 do
+    output_char oc (String.unsafe_get s i)
+  done
+
+let surface_create_for_channel oc ~width_in_points ~height_in_points =
+  surface_create_for_stream_unsafe
+    (unsafe_output_string oc) ~width_in_points ~height_in_points
 
 external surface_create_for_stream :
   (string -> unit) ->
diff --git a/src/cairo_ps.mli b/src/cairo_ps.mli
index 7a8eac2..da8b0f0 100644
--- a/src/cairo_ps.mli
+++ b/src/cairo_ps.mli
@@ -10,10 +10,10 @@
 
 type surface = [`Any|`PS] Cairo.surface
 
-external surface_create : 
-  string -> 
+val surface_create_for_channel : 
+  out_channel -> 
   width_in_points:float -> 
-  height_in_points:float -> surface = "ml_cairo_ps_surface_create"
+  height_in_points:float -> surface
 
 external surface_create_for_stream :
   (string -> unit) ->
diff --git a/src/ml_cairo.c b/src/ml_cairo.c
index 6b076cb..42ae6e3 100644
--- a/src/ml_cairo.c
+++ b/src/ml_cairo.c
@@ -509,6 +509,32 @@ ml_cairo_read_func (void *closure, unsigned char *data, unsigned int length)
   return CAIRO_STATUS_SUCCESS;
 }
 
+cairo_status_t
+ml_cairo_unsafe_write_func (void *closure, const unsigned char *data, unsigned int length)
+{
+  value res, *c = closure;
+  res = caml_callback2_exn (Field (*c, 0), Val_bp (data), Val_int (length));
+  if (Is_exception_result (res))
+    {
+      Store_field (*c, 1, res);
+      return CAIRO_STATUS_WRITE_ERROR;
+    }
+  return CAIRO_STATUS_SUCCESS;
+}
+
+cairo_status_t
+ml_cairo_unsafe_read_func (void *closure, unsigned char *data, unsigned int length)
+{
+  value res, *c = closure;
+  res = caml_callback2_exn (Field (*c, 0), Val_bp (data), Val_int (length));
+  if (Is_exception_result (res))
+    {
+      Store_field (*c, 1, res);
+      return CAIRO_STATUS_READ_ERROR;
+    }
+  return CAIRO_STATUS_SUCCESS;
+}
+
 
 
 wML_3(cairo_image_surface_create, cairo_format_t_val, Int_val, Int_val, Val_cairo_surface_t)
diff --git a/src/ml_cairo.h b/src/ml_cairo.h
index e0ec61d..916b5fe 100644
--- a/src/ml_cairo.h
+++ b/src/ml_cairo.h
@@ -70,5 +70,8 @@ value	       *ml_cairo_make_closure	(value);
 value	       *ml_cairo_make_root	(value);
 cairo_status_t	ml_cairo_write_func	(void *, const unsigned char *, unsigned int);
 cairo_status_t	ml_cairo_read_func	(void *, unsigned char *, unsigned int);
+cairo_status_t	ml_cairo_unsafe_write_func	(void *, const unsigned char *, unsigned int);
+cairo_status_t	ml_cairo_unsafe_read_func	(void *, unsigned char *, unsigned int);
 
-void		ml_cairo_surface_set_user_data	(cairo_surface_t *, const cairo_user_data_key_t *, value *);
+void		ml_cairo_surface_set_stream_data	(cairo_surface_t *, value *);
+void		ml_cairo_surface_set_image_data		(cairo_surface_t *, value);
diff --git a/src/ml_cairo_bigarr.c b/src/ml_cairo_bigarr.c
index 8f8b184..7f8e802 100644
--- a/src/ml_cairo_bigarr.c
+++ b/src/ml_cairo_bigarr.c
@@ -38,14 +38,13 @@ ml_bigarray_kind_float (value v)
 CAMLprim value
 ml_cairo_image_surface_create_for_data (value img, value fmt, value w, value h, value stride)
 {
-  static const cairo_user_data_key_t image_data_key;
   cairo_surface_t *surf;
   surf = cairo_image_surface_create_for_data (Data_bigarray_val (img),
 					      cairo_format_t_val (fmt),
 					      Int_val (w),
 					      Int_val (h),
 					      Int_val (stride));
-  ml_cairo_surface_set_user_data (surf, &image_data_key, ml_cairo_make_root (img));
+  ml_cairo_surface_set_image_data (surf, img);
 
   return Val_cairo_surface_t (surf);
 }
diff --git a/src/ml_cairo_lablgtk.c b/src/ml_cairo_lablgtk.c
index 9d3521b..25b0d27 100644
--- a/src/ml_cairo_lablgtk.c
+++ b/src/ml_cairo_lablgtk.c
@@ -23,8 +23,6 @@
 CAMLprim value
 ml_cairo_lablgtk_of_pixbuf (value pb)
 {
-  static const cairo_user_data_key_t pixbuf_key;
-
   GdkPixbuf *pixbuf = GdkPixbuf_val(pb);
   cairo_format_t format;
   gboolean alpha = gdk_pixbuf_get_has_alpha(pixbuf);
@@ -43,7 +41,7 @@ ml_cairo_lablgtk_of_pixbuf (value pb)
 					      gdk_pixbuf_get_height(pixbuf),
 					      gdk_pixbuf_get_rowstride(pixbuf));
 
-  ml_cairo_surface_set_user_data (surf, &pixbuf_key, ml_cairo_make_root (pb));
+  ml_cairo_surface_set_image_data (surf, pb);
 
   return Val_cairo_surface_t (surf);
 }
@@ -83,8 +81,6 @@ ml_cairo_lablgtk_shuffle_pixels (value pb)
 CAMLprim value
 ml_cairo_xlib_surface_create (value d)
 {
-  static const cairo_user_data_key_t drawable_key;
-
   cairo_surface_t *surface;
   gint width, height;
   GdkDrawable *drawable = GdkDrawable_val(d);
@@ -113,7 +109,7 @@ ml_cairo_xlib_surface_create (value d)
   }
 
   if (surface != NULL)
-    ml_cairo_surface_set_user_data (surface, &drawable_key, ml_cairo_make_root (d));
+    ml_cairo_surface_set_image_data (surface, d);
 
   return Val_cairo_surface_t (surface);
 }
diff --git a/src/ml_cairo_pdf.c b/src/ml_cairo_pdf.c
index 8ab2976..23416c4 100644
--- a/src/ml_cairo_pdf.c
+++ b/src/ml_cairo_pdf.c
@@ -11,32 +11,40 @@
 #if CAIRO_HAS_PDF_SURFACE
 # include <cairo-pdf.h>
 
-wML_3(cairo_pdf_surface_create, String_val, Double_val, Double_val, Val_cairo_surface_t)
-
-CAMLprim value
-ml_cairo_pdf_surface_create_for_stream (value f, value w, value h)
+static value
+_ml_cairo_pdf_surface_create_for_stream (value f, value w, value h, cairo_bool_t unsafe)
 {
-  static const cairo_user_data_key_t pdf_stream_key;
-
   CAMLparam3(f, w, h);
   value *c;
   cairo_surface_t *surf;
 
   c = ml_cairo_make_closure (f);
-  surf = cairo_pdf_surface_create_for_stream (ml_cairo_write_func, c, 
-					      Double_val (w), Double_val (h));
+  surf = cairo_pdf_surface_create_for_stream (unsafe ? ml_cairo_unsafe_write_func : ml_cairo_write_func,
+					      c, Double_val (w), Double_val (h));
 
-  ml_cairo_surface_set_user_data (surf, &pdf_stream_key, c);
+  ml_cairo_surface_set_stream_data (surf, c);
 
   CAMLreturn (Val_cairo_surface_t (surf));
 }
 
+CAMLprim value
+ml_cairo_pdf_surface_create_for_stream_unsafe (value f, value w, value h)
+{
+  return _ml_cairo_pdf_surface_create_for_stream (f, w, h, 1);
+}
+
+CAMLprim value
+ml_cairo_pdf_surface_create_for_stream (value f, value w, value h)
+{
+  return _ml_cairo_pdf_surface_create_for_stream (f, w, h, 0);
+}
+
 wML_3(cairo_pdf_surface_set_dpi, cairo_surface_t_val, Double_val, Double_val, Unit)
 
 #else
 
-Cairo_Unsupported(cairo_pdf_surface_create,        		"PDF backend not supported");
-Cairo_Unsupported(cairo_pdf_surface_create_for_stream,	"PDF backend not supported");
+Cairo_Unsupported(cairo_pdf_surface_create_for_stream_unsafe,	"PDF backend not supported");
+Cairo_Unsupported(cairo_pdf_surface_create_for_stream, 		"PDF backend not supported");
 Cairo_Unsupported(cairo_pdf_surface_set_dpi,			"PDF backend not supported");
 
 #endif
diff --git a/src/ml_cairo_png.c b/src/ml_cairo_png.c
index ac0d0d0..284cf93 100644
--- a/src/ml_cairo_png.c
+++ b/src/ml_cairo_png.c
@@ -9,19 +9,18 @@
 #include "ml_cairo.h"
 
 #if CAIRO_HAS_PNG_FUNCTIONS
-wML_1(cairo_image_surface_create_from_png, String_val, Val_cairo_surface_t)
-
-CAMLprim value
-ml_cairo_image_surface_create_from_png_stream (value f)
+static value
+_ml_cairo_image_surface_create_from_png_stream (value f, cairo_bool_t unsafe)
 {
-  CAMLparam0();
+  CAMLparam1(f);
   CAMLlocal1(c);
   cairo_surface_t *surf;
 
   c = caml_alloc_small (2, 0);
   Field (c, 0) = f;
   Field (c, 1) = Val_unit;
-  surf = cairo_image_surface_create_from_png_stream (ml_cairo_read_func, &c);
+  surf = cairo_image_surface_create_from_png_stream (unsafe ? ml_cairo_unsafe_read_func : ml_cairo_read_func, 
+						     &c);
   if (Is_exception_result (Field (c, 1)))
     caml_raise (Extract_exception (Field (c, 1)));
 
@@ -29,18 +28,22 @@ ml_cairo_image_surface_create_from_png_stream (value f)
 }
 
 CAMLprim value
-ml_cairo_surface_write_to_png (value surf, value fname)
+ml_cairo_image_surface_create_from_png_stream_unsafe (value f)
 {
-  cairo_status_t s;
-  s = cairo_surface_write_to_png (cairo_surface_t_val (surf), String_val (fname));
-  cairo_treat_status (s);
-  return Val_unit;
+  return _ml_cairo_image_surface_create_from_png_stream (f, 1);
 }
 
 CAMLprim value
-ml_cairo_surface_write_to_png_stream (value surf, value f)
+ml_cairo_image_surface_create_from_png_stream (value f)
+{
+  return _ml_cairo_image_surface_create_from_png_stream (f, 0);
+}
+
+
+static value
+_ml_cairo_surface_write_to_png_stream (value surf, value f, cairo_bool_t unsafe)
 {
-  CAMLparam1(surf);
+  CAMLparam2(surf, f);
   CAMLlocal1(c);
   cairo_status_t s;
 
@@ -49,7 +52,7 @@ ml_cairo_surface_write_to_png_stream (value surf, value f)
   Field (c, 1) = Val_unit;
 
   s = cairo_surface_write_to_png_stream (cairo_surface_t_val (surf),
-					 ml_cairo_write_func,
+					 unsafe ? ml_cairo_unsafe_write_func : ml_cairo_write_func,
 					 &c);
   if (Is_exception_result (Field (c, 1)))
     caml_raise (Extract_exception (Field (c, 1)));
@@ -58,11 +61,23 @@ ml_cairo_surface_write_to_png_stream (value surf, value f)
   CAMLreturn (Val_unit);
 }
 
+CAMLprim value
+ml_cairo_surface_write_to_png_stream_unsafe (value surf, value f)
+{
+  return _ml_cairo_surface_write_to_png_stream (surf, f, 1);
+}
+
+CAMLprim value
+ml_cairo_surface_write_to_png_stream (value surf, value f)
+{
+  return _ml_cairo_surface_write_to_png_stream (surf, f, 0);
+}
+
 #else
 
-Cairo_Unsupported(cairo_image_surface_create_from_png,        "PNG functions not supported")
-Cairo_Unsupported(cairo_image_surface_create_from_png_stream, "PNG functions not supported")
-Cairo_Unsupported(cairo_surface_write_to_png,        "PNG functions not supported")
-Cairo_Unsupported(cairo_surface_write_to_png_stream, "PNG functions not supported")
+Cairo_Unsupported(cairo_image_surface_create_from_png_stream_unsafe,	"PNG functions not supported")
+Cairo_Unsupported(cairo_image_surface_create_from_png_stream,		"PNG functions not supported")
+Cairo_Unsupported(cairo_surface_write_to_png_stream_unsafe,		"PNG functions not supported")
+Cairo_Unsupported(cairo_surface_write_to_png_stream,			"PNG functions not supported")
 
 #endif
diff --git a/src/ml_cairo_ps.c b/src/ml_cairo_ps.c
index 1b1fe31..26c49ba 100644
--- a/src/ml_cairo_ps.c
+++ b/src/ml_cairo_ps.c
@@ -11,32 +11,40 @@
 #if CAIRO_HAS_PS_SURFACE
 # include <cairo-ps.h>
 
-wML_3(cairo_ps_surface_create, String_val, Double_val, Double_val, Val_cairo_surface_t)
-
-CAMLprim value
-ml_cairo_ps_surface_create_for_stream (value f, value w, value h)
+static value
+_ml_cairo_ps_surface_create_for_stream (value f, value w, value h, cairo_bool_t unsafe)
 {
-  static const cairo_user_data_key_t ps_stream_key;
-
   CAMLparam3(f, w, h);
   value *c;
   cairo_surface_t *surf;
 
   c = ml_cairo_make_closure (f);
-  surf = cairo_ps_surface_create_for_stream (ml_cairo_write_func, c, 
-					     Double_val (w), Double_val (h));
+  surf = cairo_ps_surface_create_for_stream (unsafe ? ml_cairo_unsafe_write_func : ml_cairo_write_func,
+					     c, Double_val (w), Double_val (h));
 
-  ml_cairo_surface_set_user_data (surf, &ps_stream_key, c);
+  ml_cairo_surface_set_stream_data (surf, c);
 
   CAMLreturn (Val_cairo_surface_t (surf));
 }
 
+CAMLprim value
+ml_cairo_ps_surface_create_for_stream_unsafe (value f, value w, value h)
+{
+  return _ml_cairo_ps_surface_create_for_stream (f, w, h, 1);
+}
+
+CAMLprim value
+ml_cairo_ps_surface_create_for_stream (value f, value w, value h)
+{
+  return _ml_cairo_ps_surface_create_for_stream (f, w, h, 0);
+}
+
 /* ML_3(cairo_ps_surface_set_dpi, cairo_surface_t_val, Double_val, Double_val, Unit) */
 
 #else
 
-Cairo_Unsupported(cairo_ps_surface_create,		"PS backend not supported");
-Cairo_Unsupported(cairo_ps_surface_create_for_stream,	"PS backend not supported");
-/* Cairo_Unsupported(cairo_ps_surface_set_dpi,		"PS backend not supported"); */
+Cairo_Unsupported(cairo_ps_surface_create_for_stream_unsafe,	"PS backend not supported");
+Cairo_Unsupported(cairo_ps_surface_create_for_stream,		"PS backend not supported");
+/* Cairo_Unsupported(cairo_ps_surface_set_dpi,			"PS backend not supported"); */
 
 #endif
diff --git a/src/ml_cairo_surface.c b/src/ml_cairo_surface.c
index 34755e5..2ab37ac 100644
--- a/src/ml_cairo_surface.c
+++ b/src/ml_cairo_surface.c
@@ -26,23 +26,48 @@ ml_cairo_surface_finish (value surf)
   return Val_unit;
 }
 
-static void ml_cairo_destroy_user_data (void *data)
+static void
+ml_cairo_destroy_user_data (void *data)
 {
   caml_remove_global_root (data);
   caml_stat_free (data);
 }
 
 void
-ml_cairo_surface_set_user_data (cairo_surface_t *surf, const cairo_user_data_key_t *key, value *v)
+ml_cairo_surface_set_stream_data (cairo_surface_t *surf, value *root)
 {
+  static const cairo_user_data_key_t ml_cairo_stream_data_key;
+
+  cairo_status_t s;
+
+  s = cairo_surface_set_user_data (surf, 
+				   &ml_cairo_stream_data_key, root, 
+				   ml_cairo_destroy_user_data);
+  if (s != CAIRO_STATUS_SUCCESS) 
+    {
+      cairo_surface_destroy (surf);
+      ml_cairo_destroy_user_data (root);
+      cairo_treat_status (s);
+    }
+}
+
+void
+ml_cairo_surface_set_image_data (cairo_surface_t *surf, value v)
+{
+  static const cairo_user_data_key_t ml_cairo_image_data_key;
+
   cairo_status_t s;
-  s = cairo_surface_set_user_data (surf,
-				   key, v,
+  value *root;
+
+  root = ml_cairo_make_root (v);
+
+  s = cairo_surface_set_user_data (surf, 
+				   &ml_cairo_image_data_key, root, 
 				   ml_cairo_destroy_user_data);
   if (s != CAIRO_STATUS_SUCCESS) 
     {
       cairo_surface_destroy (surf);
-      ml_cairo_destroy_user_data (v);
+      ml_cairo_destroy_user_data (root);
       cairo_treat_status (s);
     }
 }
diff --git a/test/basket.ml b/test/basket.ml
index 6c5a63f..a46f5ec 100644
--- a/test/basket.ml
+++ b/test/basket.ml
@@ -43,7 +43,15 @@ let draw ?(print=false) c =
   Cairo.set_source_rgb c 0. 0. 0. ;
   Cairo.stroke c
 
-
+let do_file_out fname f =
+  let oc = open_out fname in
+  try
+    let r = f oc in
+    close_out oc ;
+    r
+  with exn ->
+    close_out_noerr oc ;
+    raise exn
 
 let x_inches = 8.
 let y_inches = 3.
@@ -52,53 +60,54 @@ let main () =
 
   begin
     prerr_endline "PS" ;
-    let s = Cairo_ps.surface_create "basket.ps" (x_inches *. 72.) (y_inches *. 72.) in
-    let c = Cairo.create s in
-    draw ~print:true c ;
-    Cairo.show_page c ;
-    Cairo.surface_finish s
+    do_file_out "basket.ps"
+      (fun oc ->
+	let s = Cairo_ps.surface_create_for_channel oc (x_inches *. 72.) (y_inches *. 72.) in
+	let c = Cairo.create s in
+	draw ~print:true c ;
+	Cairo.show_page c ;
+	Cairo.surface_finish s)
   end ;
 
   begin
     prerr_endline "PDF" ;
-    let s = Cairo_pdf.surface_create "basket.pdf" (x_inches *. 72.) (y_inches *. 72.) in
-    let c = Cairo.create s in
-    draw c ;
-    Cairo.show_page c ;
-    Cairo.surface_finish s
+    do_file_out "basket.pdf"
+      (fun oc ->
+	let s = Cairo_pdf.surface_create_for_channel oc (x_inches *. 72.) (y_inches *. 72.) in
+	let c = Cairo.create s in
+	draw c ;
+	Cairo.show_page c ;
+	Cairo.surface_finish s)
   end ;
 
   begin
-    prerr_endline "Bigarray, PPM and PNG" ;
+    prerr_endline "Bigarray, PPM and PNG (ARGB32) " ;
     let arr = 
-      Bigarray.Array2.create Bigarray.int Bigarray.c_layout
-	(int_of_float x_inches * 72) (int_of_float y_inches * 72) in
-    Bigarray.Array2.fill arr 0xffffff ;
-    let s = Cairo_bigarray.of_bigarr_24 arr in
+      Bigarray.Array2.create Bigarray.int32 Bigarray.c_layout
+	(int_of_float y_inches * 72) (int_of_float x_inches * 72) in
+    Bigarray.Array2.fill arr 0xffffffl ;
+    let s = Cairo_bigarray.of_bigarr_32 ~alpha:true arr in
     let c = Cairo.create s in
     draw c ;
-    begin
-      let oc = open_out "basket.ppm" in
-      Cairo_bigarray.write_ppm_int oc arr ;
-      close_out oc
-    end ;
+    do_file_out "basket.ppm"
+      (fun oc -> Cairo_bigarray.write_ppm_int32 oc arr) ;
     Cairo_png.surface_write_to_file s "basket.png"
   end
 
 (*
-  begin
-    prerr_endline "GdkPixbuf and PNG" ;
-    let pb = GdkPixbuf.create
-	~width:(int_of_float width)
-	~height:(int_of_float height) ~bits:8 ~has_alpha:true () in
-    GdkPixbuf.fill pb (Int32.of_string "0xffffffff") ;
-    let img = Cairo_lablgtk.image_of_pixbuf pb in
-    Cairo.set_target_image c img ;
-    draw c ;
-    Cairo_lablgtk.shuffle_pixels pb ;
-    GdkPixbuf.save ~filename:"basket.png" ~typ:"png" pb
-  end
-*)
+   begin
+   prerr_endline "GdkPixbuf and PNG" ;
+   let pb = GdkPixbuf.create
+   ~width:(int_of_float width)
+   ~height:(int_of_float height) ~bits:8 ~has_alpha:true () in
+   GdkPixbuf.fill pb (Int32.of_string "0xffffffff") ;
+   let img = Cairo_lablgtk.image_of_pixbuf pb in
+   Cairo.set_target_image c img ;
+   draw c ;
+   Cairo_lablgtk.shuffle_pixels pb ;
+   GdkPixbuf.save ~filename:"basket.png" ~typ:"png" pb
+   end
+ *)
 
 let () = 
   try main ()