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