diff options
Diffstat (limited to 't')
| -rwxr-xr-x | t/lib/anydbm.t | 16 | ||||
| -rwxr-xr-x | t/lib/sdbm.t | 23 | ||||
| -rw-r--r-- | t/lib/thread.t | 2 | ||||
| -rw-r--r-- | t/op/nothread.t | 2 | ||||
| -rwxr-xr-x | t/op/tiehandle.t | 137 |
5 files changed, 163 insertions, 17 deletions
diff --git a/t/lib/anydbm.t b/t/lib/anydbm.t index ce3003e5b7..3ab609cecc 100755 --- a/t/lib/anydbm.t +++ b/t/lib/anydbm.t @@ -12,15 +12,15 @@ use Fcntl; print "1..12\n"; -unlink <Op.dbmx*>; +unlink <Op_dbmx.*>; umask(0); -print (tie(%h,AnyDBM_File,'Op.dbmx', O_RDWR|O_CREAT, 0640) +print (tie(%h,AnyDBM_File,'Op_dbmx', O_RDWR|O_CREAT, 0640) ? "ok 1\n" : "not ok 1\n"); -$Dfile = "Op.dbmx.pag"; +$Dfile = "Op_dbmx.pag"; if (! -e $Dfile) { - ($Dfile) = <Op.dbmx*>; + ($Dfile) = <Op_dbmx.*>; } if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos') { print "ok 2 # Skipped: different file permission semantics\n"; @@ -55,7 +55,7 @@ $h{'goner2'} = 'snork'; delete $h{'goner2'}; untie(%h); -print (tie(%h,AnyDBM_File,'Op.dbmx', O_RDWR, 0640) ? "ok 4\n" : "not ok 4\n"); +print (tie(%h,AnyDBM_File,'Op_dbmx', O_RDWR, 0640) ? "ok 4\n" : "not ok 4\n"); $h{'j'} = 'J'; $h{'k'} = 'K'; @@ -118,4 +118,8 @@ print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n"); print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n"); untie %h; -unlink 'Op.dbmx.dir', $Dfile; +if ($^O eq 'VMS') { + unlink 'Op_dbmx.sdbm_dir', $Dfile; +} else { + unlink 'Op_dbmx.dir', $Dfile; +} diff --git a/t/lib/sdbm.t b/t/lib/sdbm.t index c2952ecf68..591fe14c60 100755 --- a/t/lib/sdbm.t +++ b/t/lib/sdbm.t @@ -6,7 +6,7 @@ BEGIN { chdir 't' if -d 't'; @INC = '../lib'; require Config; import Config; - if ($Config{'extensions'} !~ /\bSDBM_File\b/) { + if (($Config{'extensions'} !~ /\bSDBM_File\b/) && ($^O ne 'VMS')){ print "1..0\n"; exit 0; } @@ -17,15 +17,15 @@ use Fcntl; print "1..18\n"; -unlink <Op.dbmx*>; +unlink <Op_dbmx.*>; umask(0); -print (tie(%h,SDBM_File,'Op.dbmx', O_RDWR|O_CREAT, 0640) +print (tie(%h,SDBM_File,'Op_dbmx', O_RDWR|O_CREAT, 0640) ? "ok 1\n" : "not ok 1\n"); -$Dfile = "Op.dbmx.pag"; +$Dfile = "Op_dbmx.pag"; if (! -e $Dfile) { - ($Dfile) = <Op.dbmx*>; + ($Dfile) = <Op_dbmx.*>; } if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos') { print "ok 2 # Skipped: different file permission semantics\n"; @@ -60,7 +60,7 @@ $h{'goner2'} = 'snork'; delete $h{'goner2'}; untie(%h); -print (tie(%h,SDBM_File,'Op.dbmx', O_RDWR, 0640) ? "ok 4\n" : "not ok 4\n"); +print (tie(%h,SDBM_File,'Op_dbmx', O_RDWR, 0640) ? "ok 4\n" : "not ok 4\n"); $h{'j'} = 'J'; $h{'k'} = 'K'; @@ -123,7 +123,12 @@ print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n"); print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n"); untie %h; -unlink 'Op.dbmx.dir', $Dfile; +if ($^O eq 'VMS') { + unlink 'Op_dbmx.sdbm_dir', $Dfile; +} else { + unlink 'Op_dbmx.dir', $Dfile; +} + sub ok { @@ -187,7 +192,7 @@ EOM my %h ; my $X ; eval ' - $X = tie(%h, "SubDB","dbhash.tmp", O_RDWR|O_CREAT, 0640 ); + $X = tie(%h, "SubDB","dbhash_tmp", O_RDWR|O_CREAT, 0640 ); ' ; main::ok(14, $@ eq "") ; @@ -202,6 +207,6 @@ EOM undef $X; untie(%h); - unlink "SubDB.pm", <dbhash.tmp*> ; + unlink "SubDB.pm", <dbhash_tmp.*> ; } diff --git a/t/lib/thread.t b/t/lib/thread.t index 9810ae48d9..b8e1b387ba 100644 --- a/t/lib/thread.t +++ b/t/lib/thread.t @@ -4,7 +4,7 @@ BEGIN { chdir 't' if -d 't'; @INC = '../lib'; require Config; import Config; - if ($Config{'ccflags'} !~ /USE_THREADS\b/) { + if (! $Config{'usethreads'}) { print "1..0\n"; exit 0; } diff --git a/t/op/nothread.t b/t/op/nothread.t index 7d42d276c8..a0d444d90b 100644 --- a/t/op/nothread.t +++ b/t/op/nothread.t @@ -9,7 +9,7 @@ BEGIN @INC = "../lib"; require Config; import Config; - if ($Config{'ccflags'} =~ /USE_THREADS\b/) + if ($Config{'usethreads'}) { print "1..0\n"; exit 0; diff --git a/t/op/tiehandle.t b/t/op/tiehandle.t new file mode 100755 index 0000000000..e3d24723a9 --- /dev/null +++ b/t/op/tiehandle.t @@ -0,0 +1,137 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; +} + +my @expect; +my $data = ""; +my @data = (); +my $test = 1; + +sub ok { print "not " unless shift; print "ok ",$test++,"\n"; } + +package Implement; + +BEGIN { *ok = \*main::ok } + +sub compare { + return unless @expect; + return ok(0) unless(@_ == @expect); + + my $i; + for($i = 0 ; $i < @_ ; $i++) { + next if $_[$i] eq $expect[$i]; + return ok(0); + } + + ok(1); +} + +sub TIEHANDLE { + compare(TIEHANDLE => @_); + my ($class,@val) = @_; + return bless \@val,$class; +} + +sub PRINT { + compare(PRINT => @_); + 1; +} + +sub PRINTF { + compare(PRINTF => @_); + 2; +} + +sub READLINE { + compare(READLINE => @_); + wantarray ? @data : shift @data; +} + +sub GETC { + compare(GETC => @_); + substr($data,0,1); +} + +sub READ { + compare(READ => @_); + substr($_[1],$_[3] || 0) = substr($data,0,$_[2]); + 3; +} + +sub WRITE { + compare(WRITE => @_); + $data = substr($_[1],$_[3] || 0, $_[2]); + 4; +} + +sub CLOSE { + compare(CLOSE => @_); + + 5; +} + +package main; + +use Symbol; + +print "1..23\n"; + +my $fh = gensym; + +@expect = (TIEHANDLE => 'Implement'); +my $ob = tie *$fh,'Implement'; +ok(ref($ob) eq 'Implement'); +ok(tied(*$fh) == $ob); + +@expect = (PRINT => $ob,"some","text"); +$r = print $fh @expect[2,3]; +ok($r == 1); + +@expect = (PRINTF => $ob,"%s","text"); +$r = printf $fh @expect[2,3]; +ok($r == 2); + +$text = (@data = ("the line\n"))[0]; +@expect = (READLINE => $ob); +$ln = <$fh>; +ok($ln eq $text); + +@expect = (); +@in = @data = qw(a line at a time); +@line = <$fh>; +@expect = @in; +Implement::compare(@line); + +@expect = (GETC => $ob); +$data = "abc"; +$ch = getc $fh; +ok($ch eq "a"); + +$buf = "xyz"; +@expect = (READ => $ob, $buf, 3); +$data = "abc"; +$r = read $fh,$buf,3; +ok($r == 3); +ok($buf eq "abc"); + + +$buf = "xyzasd"; +@expect = (READ => $ob, $buf, 3,3); +$data = "abc"; +$r = sysread $fh,$buf,3,3; +ok($r == 3); +ok($buf eq "xyzabc"); + +$buf = "qwerty"; +@expect = (WRITE => $ob, $buf, 4,1); +$data = ""; +$r = syswrite $fh,$buf,4,1; +ok($r == 4); +ok($data eq "wert"); + +@expect = (CLOSE => $ob); +$r = close $fh; +ok($r == 5); |