use Test::More tests => 27; # TODO: More tests for disconnection syntax. Make sure the correct things # always get disconnected. More tests for arrays of signal names. my @slot_got = (); my $rc; sub got_slot { push @slot_got, @_; } sub get_got { my $got = join( ' ', sort @slot_got ); @slot_got = (); return $got; } sub get_err { my $err = $@; # Tidy up error message $err =~ s{ \n .* }{}xms; $err =~ s{ \s+ at \s+ \S+ \s+ line \s+ \d+ \s* $ }{}xms; return $err; } package My::Class::One; use Class::Std; use Class::Std::Slots; { signals qw( my_signal other_signal ); sub my_slot { my $self = shift; main::got_slot( 'my_slot' ); } sub other_slot { my $self = shift; main::got_slot( 'other_slot' ); # Guarded with has_slots just to make sure it doesn't # make a difference. Don't do this in real code if the # signal call is computationally cheap. $self->other_signal if $self->has_slots( 'other_signal' ); } sub do_stuff { my $self = shift; $self->my_signal; # send signal } } package My::Class::Two; use Class::Std; use Class::Std::Slots; { signals qw( another_signal ); sub another_slot { my $self = shift; main::got_slot( 'another_slot' ); $self->another_signal; } } package My::Class::Two::More; use base qw(My::Class::Two); use Class::Std; use Class::Std::Slots; { signals qw( unique_to_more ); sub more_slot { my $self = shift; main::got_slot( 'more_slot' ); $self->unique_to_more; } } package main; my $ob1a = My::Class::One->new(); my $ob1b = My::Class::One->new(); my $ob2 = My::Class::Two->new(); my $ob2m = My::Class::Two::More->new(); ok( !$ob1a->has_slots( 'my_signal' ), 'No slots' ); # No signal yet $ob1a->do_stuff; is( get_got, '', 'No slots' ); # Connect to a slot in another class $ob1a->connect( 'my_signal', $ob2, 'another_slot' ); ok( $ob1a->has_slots( 'my_signal' ), 'Has slots' ); ok( !$ob1b->has_slots( 'my_signal' ), 'No slots (2)' ); ok( !$ob1a->has_slots( 'other_signal' ), 'No slots (3)' ); ok( $ob1a->has_slots( [ 'other_signal', 'my_signal' ] ), 'Has multiple slots' ); $ob1a->do_stuff; is( get_got, 'another_slot', 'One slot' ); $ob1a->connect( 'my_signal', sub { got_slot( 'ANON' ); } ); $ob1a->do_stuff; is( get_got, 'ANON another_slot', 'Two slots' ); $ob1b->do_stuff; is( get_got, '', 'No slots, other obj' ); # Delete named connection $ob1a->disconnect( 'my_signal', $ob2, 'another_slot' ); $ob1a->do_stuff; is( get_got, 'ANON', 'Deleted named slot, anon only' ); $ob1a->disconnect(); $ob1a->do_stuff; is( get_got, '', 'Deleted everything' ); # More complex connections $ob1a->connect( ['my_signal'], $ob1b, 'my_signal' ); $ob1b->connect( 'my_signal', $ob2m, 'more_slot' ); $ob1a->my_signal; # Fire directly is( get_got, 'more_slot', 'Chained call' ); # Test some errors eval { $ob1a->connect( 'my_signal', $ob2m, 'bogus_slot' ); }; is( get_err, "Slot 'bogus_slot' not handled by My::Class::Two::More", 'Bad slot name' ); eval { $ob1a->connect( 'my_signal', my $not_an_obj, 'some_slot' ); }; is( get_err, 'Usage: $source->connect($sig_name, $dst_obj, $dst_method [, { options }])', 'Bad object' ); eval { $ob1a->connect( 'my_signal', $ob2 ); }; is( get_err, 'Usage: $source->connect($sig_name, $dst_obj, $dst_method [, { options }])', 'Missing method' ); eval { $ob1a->connect( 'bad signal name', $ob2m, 'more_slot' ); }; is( get_err, "Invalid signal name 'bad signal name'", 'Bad signal name' ); eval { $ob2->connect( 'unique_to_more', $ob1a, 'my_slot' ); }; is( get_err, "Signal 'unique_to_more' undefined", 'Signal only in subclass' ); eval { $ob1a->connect( 'my_signal', $ob2, 'more_slot' ); }; is( get_err, "Slot 'more_slot' not handled by My::Class::Two", 'Slot only in subclass' ); # Make sure this test still works after all those errors $ob1a->my_signal; # Fire directly is( get_got, 'more_slot', 'Still works' ); # Make a simple circular connection $ob2m->connect( 'unique_to_more', $ob2m, 'more_slot' ); eval { $ob2m->unique_to_more; }; is( get_err, "Attempt to re-enter signal 'unique_to_more'", 'Simple circularity' ); is( get_got, 'more_slot', 'Simple circularity results' ); for ( $ob1a, $ob1b, $ob2, $ob2m ) { $_->disconnect(); } # Trigger all the signals... for ( $ob1a, $ob1b ) { $_->my_signal; $_->other_signal; } $ob2->another_signal; $ob2m->unique_to_more; # ...and make sure nothing happened is( get_got, '', 'All disconnected' ); # Make a more complex loop $ob1a->connect( 'my_signal', $ob1b, 'other_slot' ); $ob1b->connect( 'other_signal', $ob2, 'another_slot' ); $ob2->connect( 'another_signal', $ob2m, 'more_slot' ); $ob2m->connect( 'unique_to_more', $ob1a, 'my_signal' ); eval { $ob1a->my_signal; }; is( get_err, "Attempt to re-enter signal 'my_signal'", 'Complex circularity' ); is( get_got, 'another_slot more_slot other_slot', 'Complex circularity results' ); # Check that has_slots can be called on an undeclared signals eval { $rc = $ob1a->has_slots( 'made_up_signal_name' ); }; ok( !$rc, 'has_slots with made up signal name' ); is( get_err, '', 'has_slots with made up signal name - not an error' ); for ( $ob1a, $ob1b, $ob2, $ob2m ) { $_->disconnect(); } $ob1a->connect( 'made_up_signal_name', $ob1b, 'other_slot', { undeclared => 1 } ); $ob1a->emit_signal( 'made_up_signal_name' ); is( get_got, 'other_slot', 'Synthetic signal name' );