[perl-Gtk2] Add more tests for Gtk2::Gdk::Drawable->copy_to_image()

[Torsten Schönfeld <tsch src gnome org>]

commit b3f5c8c72e92fbbe17243a914650b7103a357ea3
Author: Kevin Ryde <user42 zip com au>
Date:   Wed Nov 17 14:01:34 2010 +1100

    Add more tests for Gtk2::Gdk::Drawable->copy_to_image()
    
    Exercise image refcount and target image undef case, similar to get_image().
    
    (Code already ok, this just exercises it.)
    
    https://bugzilla.gnome.org/show_bug.cgi?id=621710

 t/GdkDrawable.t |   28 ++++++++++++++++++++++++++--
 1 files changed, 26 insertions(+), 2 deletions(-)
---
diff --git a/t/GdkDrawable.t b/t/GdkDrawable.t
index 1d8e409..ea47a21 100644
--- a/t/GdkDrawable.t
+++ b/t/GdkDrawable.t
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -w
 use strict;
-use Gtk2::TestHelper tests => 12;
+use Gtk2::TestHelper tests => 15;
 
 # $Id$
 
@@ -102,6 +102,23 @@ SKIP: {
 }
 
 SKIP: {
+  skip("copy_to_image is new in 2.4", 2)
+    unless Gtk2->CHECK_VERSION (2, 4, 0);
+
+  my $image = $win -> copy_to_image(undef, 0, 0, 0, 0, 50, 50);
+  skip ("copy_to_image returned undef", 2)
+    unless (defined($image));
+
+  isa_ok($image, "Gtk2::Gdk::Image",
+	'copy_to_image() creating an image');
+
+  require Scalar::Util;
+  Scalar::Util::weaken ($image);
+  is ($image, undef,
+      'copy_to_image() creating an image - destroyed when unreferenced');
+}
+
+SKIP: {
   skip("copy_to_image is new in 2.4", 1)
     unless Gtk2->CHECK_VERSION (2, 4, 0);
   my $existing_image = $win -> get_image(5, 5, 10, 10);
@@ -113,7 +130,14 @@ SKIP: {
   skip ("copy_to_image returned undef", 1)
     unless (defined($image));
 
-  isa_ok($image, "Gtk2::Gdk::Image");
+  isa_ok($image, "Gtk2::Gdk::Image",
+	 'copy_to_image() to a given target image');
+
+  require Scalar::Util;
+  Scalar::Util::weaken ($image);
+  Scalar::Util::weaken ($existing_image);
+  is ($image, undef,
+      'copy_to_image() to a given target image - destroyed when unreferenced');
 }
 
 __END__