Changeset 408

Show
Ignore:
Timestamp:
12/25/01 19:02:41
Author:
miyagawa
Message:

deepcopy

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved
  • Class-Trigger/trunk/Changes

    r400 r408  
    44        - renamed to Class::Trigger from Class::Hookable 
    55        * Added object based triggers 
     6        - fixed bug that subclass shares arrayref of triggers with parent 
    67 
    780.02  Tue Dec 25 02:18:27 JST 2001 
     
    12130.01  Mon Dec 24 11:47:13 2001 
    1314        - original version; created by h2xs 1.19 
    14  
  • Class-Trigger/trunk/lib/Class/Trigger.pm

    r407 r408  
    3232    my $proto = shift; 
    3333 
    34     # should be copy of the hash: for inheritance 
    35     my %triggers = %{__fetch_triggers($proto)}
     34    # should be deep copy of the hash: for inheritance 
     35    my %triggers = __deep_dereference(__fetch_triggers($proto))
    3636    while (my($when, $code) = splice @_, 0, 2) { 
    3737        __validate_triggerpoint($proto, $when); 
     
    7979        $proto->__triggers($triggers); 
    8080    } 
     81} 
     82 
     83sub __deep_dereference { 
     84    my $hashref = shift; 
     85    my %copy; 
     86    while (my($key, $arrayref) = each %$hashref) { 
     87        $copy{$key} = [ @$arrayref ]; 
     88    } 
     89    return %copy; 
    8190} 
    8291 
  • Class-Trigger/trunk/t/03_inherit.t

    r400 r408  
    11use strict; 
    2 use Test::More tests => 4
     2use Test::More tests => 5
    33 
    44use IO::Scalar; 
     
    88use Foo::Bar; 
    99 
    10 ok(Foo->add_trigger(before_foo => sub { print "before_foo\n" }), 'add_trigger in Foo'); 
    11 ok(Foo::Bar->add_trigger(after_foo  => sub { print "after_foo\n" }), 'add_trigger in Foo::Bar'); 
     10ok(Foo->add_trigger(before_foo => sub { print "before_foo\n" }), 
     11   'add_trigger in Foo'); 
     12ok(Foo::Bar->add_trigger(after_foo  => sub { print "after_foo\n" }), 
     13   'add_trigger in Foo::Bar'); 
     14ok(Foo::Bar->add_trigger(before_foo  => sub { print "before_foo2\n" }), 
     15   'add_trigger in Foo::Bar'); 
    1216 
    1317my $foo = Foo::Bar->new; 
     
    1721    $foo->foo; 
    1822    untie *STDOUT; 
    19     is $out, "before_foo\nfoo\nafter_foo\n"; 
     23    is $out, "before_foo\nbefore_foo2\nfoo\nafter_foo\n"; 
    2024} 
    2125 
  • Class-Trigger/trunk/t/04_object.t

    r400 r408  
    11use strict; 
    2 use Test::More tests => 4
     2use Test::More tests => 5
    33 
    44use IO::Scalar; 
     
    3636    is $out, "before_foo\nfoo\nafter_foo1\nafter_foo2\n"; 
    3737} 
     38 
     39{ 
     40    my $foo = Foo->new; 
     41    tie *STDOUT, 'IO::Scalar', \my $out; 
     42    $foo->foo; 
     43    untie *STDOUT; 
     44    is $out, "before_foo\nfoo\n"; 
     45} 
     46