185009909Smillert#!./perl 285009909Smillert 3*b39c5158Smillertprint "1..7\n"; 4*b39c5158Smillertmy $test = 0; 5*b39c5158Smillert 6*b39c5158Smillertsub is { 7*b39c5158Smillert my ($got, $expect, $name) = @_; 8*b39c5158Smillert $test = $test + 1; 9*b39c5158Smillert if (defined $got && $got eq $expect) { 10*b39c5158Smillert print "ok $test - $name\n"; 11*b39c5158Smillert return 1; 1285009909Smillert } 1385009909Smillert 14*b39c5158Smillert print "not ok $test - $name\n"; 15*b39c5158Smillert my @caller = caller(0); 16*b39c5158Smillert print "# Failed test at $caller[1] line $caller[2]\n"; 17*b39c5158Smillert if (defined $got) { 18*b39c5158Smillert print "# Got '$got'\n"; 19*b39c5158Smillert } else { 20*b39c5158Smillert print "# Got undef\n"; 21*b39c5158Smillert } 22*b39c5158Smillert print "# Expected $expect\n"; 23*b39c5158Smillert return; 24*b39c5158Smillert} 2585009909Smillert 2685009909Smillert{ 2785009909Smillert package TieAll; 2885009909Smillert # tie, track, and report what calls are made 2985009909Smillert my @calls; 3085009909Smillert sub AUTOLOAD { 3185009909Smillert for ($AUTOLOAD =~ /TieAll::(.*)/) { 3285009909Smillert if (/TIE/) { return bless {} } 3385009909Smillert elsif (/calls/) { return join ',', splice @calls } 3485009909Smillert else { 3585009909Smillert push @calls, $_; 3685009909Smillert # FETCHSIZE doesn't like undef 3785009909Smillert # if FIRSTKEY, see if NEXTKEY is also called 3885009909Smillert return 1 if /FETCHSIZE|FIRSTKEY/; 3985009909Smillert return; 4085009909Smillert } 4185009909Smillert } 4285009909Smillert } 4385009909Smillert} 4485009909Smillert 4585009909Smillerttie $x, 'TieAll'; 4685009909Smillerttie @x, 'TieAll'; 4785009909Smillerttie %x, 'TieAll'; 4885009909Smillert 4985009909Smillert{our $x;} 5085009909Smillertis(TieAll->calls, '', 'our $x has no runtime effect'); 5185009909Smillert 5285009909Smillert{our ($x);} 5385009909Smillertis(TieAll->calls, '', 'our ($x) has no runtime effect'); 5485009909Smillert 5585009909Smillert{our %x;} 5685009909Smillertis(TieAll->calls, '', 'our %x has no runtime effect'); 5785009909Smillert 5885009909Smillert{our (%x);} 5985009909Smillertis(TieAll->calls, '', 'our (%x) has no runtime effect'); 6085009909Smillert 6185009909Smillert{our @x;} 6285009909Smillertis(TieAll->calls, '', 'our @x has no runtime effect'); 6385009909Smillert 6485009909Smillert{our (@x);} 6585009909Smillertis(TieAll->calls, '', 'our (@x) has no runtime effect'); 6685009909Smillert 6785009909Smillert 6885009909Smillert$y = 1; 6985009909Smillert{ 7085009909Smillert my $y = 2; 7185009909Smillert { 7285009909Smillert our $y = $y; 7385009909Smillert is($y, 2, 'our shouldnt be visible until introduced') 7485009909Smillert } 7585009909Smillert} 76