[perl-Gtk3] Test that no double-frees occur for custom Gtk3::Widget subclasses

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

commit 550462a83eb524d16c1a6009aae6f0043844102f
Author: Torsten SchÃnfeld <kaffeetisch gmx de>
Date:   Fri Jan 4 23:41:50 2013 +0100

    Test that no double-frees occur for custom Gtk3::Widget subclasses

 NEWS       |    1 +
 dist.ini   |    2 +-
 t/vfuncs.t |   47 +++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 49 insertions(+), 1 deletions(-)
---
diff --git a/NEWS b/NEWS
index 380bef6..6715910 100644
--- a/NEWS
+++ b/NEWS
@@ -1,6 +1,7 @@
 {{$NEXT}}
 
 * Add overrides for Gtk3::Container.
+* Test that no double-frees occur for custom Gtk3::Widget subclasses.
 
 Overview of changes in Gtk3 0.008 [2012-08-26]
 ==============================================
diff --git a/dist.ini b/dist.ini
index 24b8876..44ce4b0 100644
--- a/dist.ini
+++ b/dist.ini
@@ -16,7 +16,7 @@ copyright_year = 2011
 
 [Prereqs]
 Cairo::GObject = 1.000
-Glib::Object::Introspection = 0.012
+Glib::Object::Introspection = 0.013_001 ; FIXME
 
 [NextRelease]
 filename = NEWS
diff --git a/t/vfuncs.t b/t/vfuncs.t
new file mode 100644
index 0000000..ce0738c
--- /dev/null
+++ b/t/vfuncs.t
@@ -0,0 +1,47 @@
+#!/usr/bin/env perl
+
+BEGIN { require './t/inc/setup.pl' };
+
+use strict;
+use warnings;
+
+plan tests => 2;
+
+# Make sure that we can safely inherit from classes which have a "destroy"
+# vfunc.
+{
+  my $label_destroy_called = 0;
+  my $label_destroy_chain_called = 0;
+
+  package MyLabel;
+  use Glib::Object::Subclass
+    Gtk3::Label::
+    ;
+  # no DESTROY_VFUNC override
+
+  package MyLabelDestroy;
+  use Glib::Object::Subclass
+    Gtk3::Label::
+    ;
+  sub DESTROY_VFUNC {
+    $label_destroy_called++;
+  }
+
+  package MyLabelDestroyChain;
+  use Glib::Object::Subclass
+    Gtk3::Label::
+    ;
+  sub DESTROY_VFUNC {
+    $label_destroy_chain_called++;
+    $_[0]->SUPER::DESTROY_VFUNC ();
+  }
+
+  package main;
+  {
+    my $label = MyLabel->new;
+    my $label_destroy = MyLabelDestroy->new;
+    my $label_destroy_chan = MyLabelDestroyChain->new;
+  }
+  is ($label_destroy_called, 1);
+  is ($label_destroy_chain_called, 1);
+}