view release on metacpan or  search on metacpan

t/7.t  view on Meta::CPAN

   ok($@ eq 'neener neener neener', 18, "$@ is preserved across signals") ||
        diag "# expected 'neener neener neener'\n",
	     "   # got '$@'";
   $tag = 0;

   # that was a single-shot -- the exception handler shouldn't run again.
   {
   local $SIG{__WARN__} = sub {
	   if ($_[0] =~ m/unhandled/m) {
	   	pass(20, "unhandled exception just warns");
	   } elsif ($_[0] =~ m/isn't numeric/m) {
	   	pass(19, "string value isn't numeric");
	   } else {
		fail("got something unexpected in __WARN__: $_[0]\n");
	   }
	};
   $my->test_marshaler (qw/foo bar baz/, $my);
   pass(21);
   }

   use Data::Dumper;
   $my->signal_connect (returner => sub { pass(23); 0.5 });
   # the class closure should be called in between these two
   $my->signal_connect_after (returner => sub { pass(25); 42.0 });
   pass(22);
   my $ret = $my->returner;
   # we should have the return value from the last handler
   ok( $ret == 42.0, 26 ) || diag("expected 42.0, got $ret");

   # now with our special accumulator
   $my->signal_connect (list_returner => sub { pass(28); 10 });
   $my->signal_connect (list_returner => sub { pass(29); '15' });
   $my->signal_connect (list_returner => sub { pass(30); [20] });
   $my->signal_connect (list_returner => sub { pass(31); {thing => 25} });
   # class closure should before the "connect_after" ones,
   # and this one will stop everything by returning the magic value.
   $my->signal_connect_after (list_returner => sub { pass(33, "stopper"); 42 });
   # if this one is called, the accumulator isn't working right
   $my->signal_connect_after (list_returner => sub { fail("shouldn't get here"); 0 });
   pass(27);
   print Dumper( $my->list_returner );


   # Check that a signal_connect() of a non-existant signal name doesn't
   # leak the subr passed to it, ie. doesn't keep it alive forever.
   #
   # Note $subr has to use $x or similar in its containing environment to be
   # a closure.  If not then it's treated as part of the mainline code and
   # won't be gc'ed immediately -- or something like that.
   {
     my $x = 123;
     my $subr = sub { return $x };

     # handler to suppress the warning message from nosuchsignal
     my $logid = Glib::Log->set_handler ('GLib-GObject', ['warning'], sub { });
     my $sigid = $my->signal_connect ('nosuchsignal' => $subr);
     Glib::Log->remove_handler ('GLib-GObject', $logid);

     ok(! $sigid, 34, "'nosuchsignal' not connected");
     require Scalar::Util;
     Scalar::Util::weaken ($subr);
     ok(! defined $subr, 35, "subr gc'ed after bad signal name");
   }
}

pass(36);




__END__

Copyright (C) 2003, 2009 by the gtk2-perl team (see the file AUTHORS for the
full list)

This library is free software; you can redistribute it and/or modify it under
the terms of the GNU Library General Public License as published by the Free
Software Foundation; either version 2.1 of the License, or (at your option) any
later version.

This library is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
PARTICULAR PURPOSE.  See the GNU Library General Public License for more
details.

You should have received a copy of the GNU Library General Public License along
with this library; if not, write to the Free Software Foundation, Inc.,
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.