diff options
author | Jarkko Hietaniemi <jhi@iki.fi> | 2000-06-01 12:52:02 +0000 |
---|---|---|
committer | Jarkko Hietaniemi <jhi@iki.fi> | 2000-06-01 12:52:02 +0000 |
commit | 53fe373b05b06f68094ed67e5c78b4dda7f0d5b8 (patch) | |
tree | 916d54741a1c784c238e29c8b519f79e64a6a5a7 /t | |
parent | e708dd94d433419cc9415d9e2faa486ad23ac459 (diff) | |
parent | 4ebbc97598d793d933009eab4334e3bc88b8de4e (diff) | |
download | perl-53fe373b05b06f68094ed67e5c78b4dda7f0d5b8.tar.gz |
Integrate with Sarathy.
p4raw-id: //depot/cfgperl@6192
Diffstat (limited to 't')
-rwxr-xr-x | t/lib/selfloader.t | 198 | ||||
-rwxr-xr-x | t/op/tr.t | 26 | ||||
-rwxr-xr-x | t/op/vec.t | 12 |
3 files changed, 232 insertions, 4 deletions
diff --git a/t/lib/selfloader.t b/t/lib/selfloader.t new file mode 100755 index 0000000000..9c585a598d --- /dev/null +++ b/t/lib/selfloader.t @@ -0,0 +1,198 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + $dir = "self-$$"; + unshift @INC, ("./$dir", "../lib"); + + print "1..19\n"; + + # First we must set up some selfloader files + mkdir $dir, 0755 or die "Can't mkdir $dir: $!"; + + open(FOO, ">$dir/Foo.pm") or die; + print FOO <<'EOT'; +package Foo; +use SelfLoader; + +sub new { bless {}, shift } +sub foo; +sub bar; +sub bazmarkhianish; +sub a; +sub never; # declared but definition should never be read +1; +__DATA__ + +sub foo { shift; shift || "foo" }; + +sub bar { shift; shift || "bar" } + +sub bazmarkhianish { shift; shift || "baz" } + +package sheep; +sub bleat { shift; shift || "baa" } + +__END__ +sub never { die "D'oh" } +EOT + + close(FOO); + + open(BAR, ">$dir/Bar.pm") or die; + print BAR <<'EOT'; +package Bar; +use SelfLoader; + +@ISA = 'Baz'; + +sub new { bless {}, shift } +sub a; + +1; +__DATA__ + +sub a { 'a Bar'; } +sub b { 'b Bar' } + +__END__ DATA +sub never { die "D'oh" } +EOT + + close(BAR); +}; + + +package Baz; + +sub a { 'a Baz' } +sub b { 'b Baz' } +sub c { 'c Baz' } + + +package main; +use Foo; +use Bar; + +$foo = new Foo; + +print "not " unless $foo->foo eq 'foo'; # selfloaded first time +print "ok 1\n"; + +print "not " unless $foo->foo eq 'foo'; # regular call +print "ok 2\n"; + +# Try an undefined method +eval { + $foo->will_fail; +}; +if ($@ =~ /^Undefined subroutine/) { + print "ok 3\n"; +} else { + print "not ok 3 $@\n"; +} + +# Used to be trouble with this +eval { + my $foo = new Foo; + die "oops"; +}; +if ($@ =~ /oops/) { + print "ok 4\n"; +} else { + print "not ok 4 $@\n"; +} + +# Pass regular expression variable to autoloaded function. This used +# to go wrong in AutoLoader because it used regular expressions to generate +# autoloaded filename. +"foo" =~ /(\w+)/; +print "not " unless $1 eq 'foo'; +print "ok 5\n"; + +print "not " unless $foo->bar($1) eq 'foo'; +print "ok 6\n"; + +print "not " unless $foo->bar($1) eq 'foo'; +print "ok 7\n"; + +print "not " unless $foo->bazmarkhianish($1) eq 'foo'; +print "ok 8\n"; + +print "not " unless $foo->bazmarkhianish($1) eq 'foo'; +print "ok 9\n"; + +# Check nested packages inside __DATA__ +print "not " unless sheep::bleat() eq 'baa'; +print "ok 10\n"; + +# Now check inheritance: + +$bar = new Bar; + +# Before anything is SelfLoaded there is no declaration of Foo::b so we should +# get Baz::b +print "not " unless $bar->b() eq 'b Baz'; +print "ok 11\n"; + +# There is no Bar::c so we should get Baz::c +print "not " unless $bar->c() eq 'c Baz'; +print "ok 12\n"; + +# This selfloads Bar::a because it is stubbed. It also stubs Bar::b as a side +# effect +print "not " unless $bar->a() eq 'a Bar'; +print "ok 13\n"; + +print "not " unless $bar->b() eq 'b Bar'; +print "ok 14\n"; + +print "not " unless $bar->c() eq 'c Baz'; +print "ok 15\n"; + + + +# Check that __END__ is honoured +# Try an subroutine that should never be noticed by selfloader +eval { + $foo->never; +}; +if ($@ =~ /^Undefined subroutine/) { + print "ok 16\n"; +} else { + print "not ok 16 $@\n"; +} + +# Try to read from the data file handle +my $foodata = <Foo::DATA>; +if (defined $foodata) { + print "not ok 17 # $foodata\n"; +} else { + print "ok 17\n"; +} + +# Check that __END__ DATA is honoured +# Try an subroutine that should never be noticed by selfloader +eval { + $bar->never; +}; +if ($@ =~ /^Undefined subroutine/) { + print "ok 18\n"; +} else { + print "not ok 18 $@\n"; +} + +# Try to read from the data file handle +my $bardata = <Bar::DATA>; +if ($bardata ne "sub never { die \"D'oh\" }\n") { + print "not ok 19 # $bardata\n"; +} else { + print "ok 19\n"; +} + +# cleanup +END { +return unless $dir && -d $dir; +unlink "$dir/Foo.pm", "$dir/Bar.pm"; +rmdir "$dir"; +} @@ -5,7 +5,7 @@ BEGIN { unshift @INC, "../lib"; } -print "1..4\n"; +print "1..8\n"; $_ = "abcdefghijklmnopqrstuvwxyz"; @@ -37,3 +37,27 @@ print "ok 3\n"; print "ok 4\n"; } # + +# make sure that tr cancels IOK and NOK +($x = 12) =~ tr/1/3/; +(my $y = 12) =~ tr/1/3/; +($f = 1.5) =~ tr/1/3/; +(my $g = 1.5) =~ tr/1/3/; +print "not " unless $x + $y + $f + $g == 71; +print "ok 5\n"; + +# make sure tr is harmless if not updating - see [ID 20000511.005] +$_ = 'fred'; +/([a-z]{2})/; +$1 =~ tr/A-Z//; +s/^(\s*)f/$1F/; +print "not " if $_ ne 'Fred'; +print "ok 6\n"; + +# check tr handles UTF8 correctly +($x = 256.65.258) =~ tr/a/b/; +print "not " if $x ne 256.65.258 or length $x != 3; +print "ok 7\n"; +$x =~ tr/A/B/; +print "not " if $x ne 256.66.258 or length $x != 3; +print "ok 8\n"; diff --git a/t/op/vec.t b/t/op/vec.t index bf60fc4a08..b8efb8011d 100755 --- a/t/op/vec.t +++ b/t/op/vec.t @@ -1,8 +1,6 @@ #!./perl -# $RCSfile: vec.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:36 $ - -print "1..15\n"; +print "1..18\n"; print vec($foo,0,1) == 0 ? "ok 1\n" : "not ok 1\n"; print length($foo) == 0 ? "ok 2\n" : "not ok 2\n"; @@ -25,3 +23,11 @@ vec($Vec, 0, 32) = 0xbaddacab; print $Vec eq "\xba\xdd\xac\xab" ? "ok 14\n" : "not ok 14\n"; print vec($Vec, 0, 32) == 3135089835 ? "ok 15\n" : "not ok 15\n"; +# ensure vec() handles numericalness correctly +$foo = $bar = $baz = 0; +vec($foo = 0,0,1) = 1; +vec($bar = 0,1,1) = 1; +$baz = $foo | $bar; +print $foo eq "1" && $foo == 1 ? "ok 16\n" : "not ok 16\n"; +print $bar eq "2" && $bar == 2 ? "ok 17\n" : "not ok 17\n"; +print "$foo $bar $baz" eq "1 2 3" ? "ok 18\n" : "not ok 18\n"; |