1#!/usr/bin/perl 2 3use Alias qw(alias const attr); 4 5my $TNUM = 0; 6 7sub T { ++$TNUM; my $res = shift; print $res ? "ok $TNUM\n" : "not ok $TNUM\n" }; 8 9print "1..34\n"; 10 11$TEN = ""; 12$ten = 10; 13$TWENTY = 20; 14alias TEN => $ten, TWENTY => \*ten; 15print '#\\$TEN is ', \$TEN, "\n"; 16print '#\\$ten is ', \$ten, "\n"; 17T(\$TEN eq \$ten); 18T($TEN eq $TWENTY); 19 20const _TEN_ => \10; 21 22eval { $_TEN_ = 20 }; 23T($@); 24 25$dyn = "abcd"; 26{ 27 local $dyn; 28 alias dyn => "pqrs"; 29 T($dyn eq "pqrs"); 30} 31T($dyn eq "abcd"); 32 33my($lex) = 'abcd'; 34$closure = sub { return "$lex"; }; 35alias NAMEDCLOSURE => \&$closure; 36$lex = 'pqrs'; 37T(NAMEDCLOSURE() eq "pqrs"); 38 39package Foo; 40 41# "in life", my moma always said, "you gotta pass those tests 42# before you can be o' some use to yerself" :-) 43*T = \&main::T; 44 45use Alias; 46 47sub new { bless { foo => 1, 48 bar => [2,3], 49 buz => { a => 4}, 50 fuz => *easy, 51 privmeth => sub { "private" }, 52 easymeth => sub { die "to recurse or to die, is the question" }, 53 }, 54 $_[0]; 55} 56 57sub easy { "gulp" } 58sub easymeth { 59 my $s = attr shift; # localizes $foo, @bar, and %buz with hash values 60 T(defined($s) and ref($s) eq 'Foo'); 61 T(defined (*fuz) and ref(\*fuz) eq ref(\*easy)); 62 print '#easy() is ', easy(), "\n"; 63 print '#fuz() is ', fuz(), "\n"; 64 T(easy() eq fuz()); 65 eval { $s->easymeth }; # should fail 66 print "#\$\@ is: $@\n"; 67 T($@); 68 join '|', $foo, @bar, %buz, $s->privmeth; 69} 70$foo = 6; 71@bar = (7,8); 72%buz = (b => 9); 73T(Foo->new->easymeth eq '1|2|3|a|4|private'); 74T(join('|', $foo, @bar, %buz) eq '6|7|8|b|9'); 75 76eval { fuz() }; # the local subroutine shouldn't be here now 77print "# after fuz(): $@"; 78T($@); 79 80eval { Foo->new->privmeth }; # private method shouldn't exist either 81print "# after Foo->new->privmeth: $@"; 82T($@); 83 84package Bar; 85*T = \&main::T; 86 87use Alias; 88 89$Alias::KeyFilter = "_"; 90$Alias::AttrPrefix = "s"; 91$Alias::Deref = ""; 92 93sub new { 94 my $s = { _foo => 1, 95 _bar => [2,3], 96 buz => { a => 4}, 97 fuz => *easy, 98 _privmeth => sub { "private" }, 99 _easymeth => sub { "recursion" }, 100 }; 101 $s->{_this} = $s; 102 return bless $s, $_[0]; 103} 104 105sub easy { "gulp" } 106sub s_easymeth { 107 my $s = attr shift; # localizes $s_foo, @s_bar, and %s_buz 108 T($s and ref($s) eq 'Bar'); 109 print "# |$s_this|$s|\n"; 110 T(defined($s_this) and $s_this eq $s); 111 T(not defined &fuz); 112 T(not defined &s_fuz); 113 T(not scalar (keys %s_buz)); 114 T($s->s_easymeth eq "recursion"); 115 join '|', $s_foo, @s_bar, %buz, $s->s_privmeth; 116} 117 118$s_foo = 6; 119@s_bar = (7,8); 120%s_buz = (); 121%buz = (b => 9); 122T(Bar->new->s_easymeth eq '1|2|3|b|9|private'); 123T(join('|', $s_foo, @s_bar) eq '6|7|8'); 124 125{ 126 local $Alias::Deref = 1; 127 my $s = attr(Bar->new); 128 T(!$s_this and \%s_this eq $s); 129} 130 131eval { Bar->new->s_privmeth }; # private method shouldn't exist either 132print "# after Bar->new->s_privmeth: $@"; 133T($@); 134 135package Baz; 136*T = \&main::T; 137 138use Alias; 139 140$Alias::KeyFilter = sub { 141 local $_ = shift; 142 my($r) = (/^_.+_$/ ? 1 : 0); 143 print "# |$_, $r|\n"; 144 return $r 145 }; 146$Alias::AttrPrefix = sub { 147 local $_ = shift; s/^_(.+)_$/$1/; 148 return "s_$_" if /meth$/; 149 return "main::s_$_" 150 }; 151$Alias::Deref = sub { my($n, $v) = @_; ; my $r = $n ne "_this_"; print "# |$n, $v, $r|\n"; return $r}; 152 153sub new { 154 my $s = bless { _foo_ => 1, 155 _bar_ => [2,3], 156 buz_ => { a => 4}, 157 fuz_ => *easy, 158 _privmeth_ => sub { "private" }, 159 _easymeth_ => sub { "recursion" }, 160 }, 161 $_[0]; 162 $s->{_this_} = $s; 163 $s->{_other_} = $s; 164 return $s; 165} 166 167sub easy { "gulp" } 168sub s_easymeth { 169 my $s = attr shift; # localizes $s_foo, @s_bar, and %s_buz 170 print "# |", $::s_this, "|$s|\n"; 171 T($::s_this and $::s_this eq $s); 172 print "# |", join(',', keys %::s_other),"|$s|\n"; 173 T(!$::s_other and \%::s_other eq $s); 174 T(defined($s) and ref($s) eq 'Baz'); 175 T(not defined &::fuz_); 176 T(not defined &::s_fuz); 177 T(not %::s_buz); 178 T($s->s_easymeth eq "recursion"); 179 join '|', $::s_foo, @::s_bar, %::buz_, $s->s_privmeth; 180} 181 182$::s_foo = 6; 183@::s_bar = (7,8); 184%::s_buz = (); 185%::buz_ = (b => 9); 186T(Baz->new->s_easymeth eq '1|2|3|b|9|private'); 187T(join('|', $::s_foo, @::s_bar) eq '6|7|8'); 188 189eval { Baz->new->s_privmeth }; # private method shouldn't exist either 190print "# after Baz->new->s_privmeth: $@"; 191T($@); 192 193 194__END__ 195