diff options
author | Todd Rinaldo <toddr@cpan.org> | 2020-01-30 23:02:51 -0600 |
---|---|---|
committer | Todd Rinaldo <toddr@cpan.org> | 2020-02-10 21:44:31 -0600 |
commit | 5926ffcd2cf97026fabb7ead7fc81676f9ad88a9 (patch) | |
tree | 0218c0280cca0f5e59e0f4b86572efe6dceedde3 /dist/Tie-File | |
parent | 869851bb5b209b40df57189210a6c7666a078793 (diff) | |
download | perl-5926ffcd2cf97026fabb7ead7fc81676f9ad88a9.tar.gz |
Make Tie::File distro conform to strict and warnings.
Fixes #17495
Diffstat (limited to 'dist/Tie-File')
39 files changed, 198 insertions, 161 deletions
diff --git a/dist/Tie-File/lib/Tie/File.pm b/dist/Tie-File/lib/Tie/File.pm index 197a590ede..b2ded8af3e 100644 --- a/dist/Tie-File/lib/Tie/File.pm +++ b/dist/Tie-File/lib/Tie/File.pm @@ -1,13 +1,17 @@ - package Tie::File; + require 5.005; + +use strict; +use warnings; + use Carp ':DEFAULT', 'confess'; use POSIX 'SEEK_SET'; use Fcntl 'O_CREAT', 'O_RDWR', 'LOCK_EX', 'LOCK_SH', 'O_WRONLY', 'O_RDONLY'; sub O_ACCMODE () { O_RDONLY | O_RDWR | O_WRONLY } -$VERSION = "1.06"; +our $VERSION = "1.06"; my $DEFAULT_MEMORY_SIZE = 1<<21; # 2 megabytes my $DEFAULT_AUTODEFER_THRESHHOLD = 3; # 3 records my $DEFAULT_AUTODEFER_FILELEN_THRESHHOLD = 65536; # 16 disk blocksful @@ -16,6 +20,10 @@ my %good_opt = map {$_ => 1, "-$_" => 1} qw(memory dw_size mode recsep discipline autodefer autochomp autodefer_threshhold concurrent); +our $DIAGNOSTIC = 0; +our @OFF; # used as a temporary alias in some subroutines. +our @H; # used as a temporary alias in _annotate_ad_history + sub TIEARRAY { if (@_ % 2 != 0) { croak "usage: tie \@array, $_[0], filename, [option => value]..."; @@ -1991,7 +1999,7 @@ sub _nodes { ($self->[$i], $self->_nodes($i*2), $self->_nodes($i*2+1)); } -"Cogito, ergo sum."; # don't forget to return a true value from the file +1; __END__ diff --git a/dist/Tie-File/t/01_gen.t b/dist/Tie-File/t/01_gen.t index 3c4aefcee6..cee21c0ff8 100644 --- a/dist/Tie-File/t/01_gen.t +++ b/dist/Tie-File/t/01_gen.t @@ -1,5 +1,8 @@ #!/usr/bin/perl +use strict; +use warnings; + $| = 1; my $file = "tf01-$$.txt"; 1 while unlink $file; @@ -10,6 +13,7 @@ my $N = 1; use Tie::File; print "ok $N\n"; $N++; +my @a; my $o = tie @a, 'Tie::File', $file, autochomp => 0, autodefer => 0; print $o ? "ok $N\n" : "not ok $N\n"; $N++; diff --git a/dist/Tie-File/t/02_fetchsize.t b/dist/Tie-File/t/02_fetchsize.t index cfaf9ce4d6..2f688485b3 100644 --- a/dist/Tie-File/t/02_fetchsize.t +++ b/dist/Tie-File/t/02_fetchsize.t @@ -1,5 +1,8 @@ #!/usr/bin/perl +use strict; +use warnings; + my $file = "tf02-$$.txt"; $: = Tie::File::_default_recsep(); my $data = "rec1$:rec2$:rec3$:"; @@ -15,7 +18,7 @@ binmode F; print F $data; close F; - +my @a; my $o = tie @a, 'Tie::File', $file, autochomp => 0; print $o ? "ok $N\n" : "not ok $N\n"; $N++; diff --git a/dist/Tie-File/t/03_longfetch.t b/dist/Tie-File/t/03_longfetch.t index cc6aa028dd..abd497df7f 100644 --- a/dist/Tie-File/t/03_longfetch.t +++ b/dist/Tie-File/t/03_longfetch.t @@ -8,6 +8,9 @@ # (tests _fill_offsets_to() ) # +use strict; +use warnings; + my $file = "tf03-$$.txt"; $: = Tie::File::_default_recsep(); my $data = "rec0$:rec1$:rec2$:"; @@ -23,7 +26,7 @@ binmode F; print F $data; close F; - +my @a; my $o = tie @a, 'Tie::File', $file, autochomp => 0; print $o ? "ok $N\n" : "not ok $N\n"; $N++; diff --git a/dist/Tie-File/t/04_splice.t b/dist/Tie-File/t/04_splice.t index 3577ecf46b..a2073dfd6e 100644 --- a/dist/Tie-File/t/04_splice.t +++ b/dist/Tie-File/t/04_splice.t @@ -12,6 +12,9 @@ # contents. +use strict; +use warnings; + $| = 1; my $file = "tf04-$$.txt"; $: = Tie::File::_default_recsep(); @@ -24,6 +27,7 @@ my $N = 1; use Tie::File; print "ok $N\n"; $N++; # partial credit just for showing up +my @a; my $o = tie @a, 'Tie::File', $file; print $o ? "ok $N\n" : "not ok $N\n"; $N++; diff --git a/dist/Tie-File/t/05_size.t b/dist/Tie-File/t/05_size.t index 74a75bef41..a8df07b42e 100644 --- a/dist/Tie-File/t/05_size.t +++ b/dist/Tie-File/t/05_size.t @@ -4,6 +4,9 @@ # PUSH POP SHIFT UNSHIFT # +use strict; +use warnings; + use POSIX 'SEEK_SET'; my $file = "tf05-$$.txt"; @@ -19,6 +22,8 @@ print "ok $N\n"; $N++; open F, '>', $file or die $!; binmode F; close F; + +my @a; $o = tie @a, 'Tie::File', $file; print $o ? "ok $N\n" : "not ok $N\n"; $N++; diff --git a/dist/Tie-File/t/06_fixrec.t b/dist/Tie-File/t/06_fixrec.t index 50817ca4e0..dc3015c0ec 100644 --- a/dist/Tie-File/t/06_fixrec.t +++ b/dist/Tie-File/t/06_fixrec.t @@ -1,5 +1,8 @@ #!/usr/bin/perl +use strict; +use warnings; + use POSIX 'SEEK_SET'; my $file = "tf06-$$.txt"; $: = Tie::File::_default_recsep(); @@ -10,6 +13,7 @@ my $N = 1; use Tie::File; print "ok $N\n"; $N++; +my @a; my $o = tie @a, 'Tie::File', $file, autodefer => 0; print $o ? "ok $N\n" : "not ok $N\n"; $N++; diff --git a/dist/Tie-File/t/07_rv_splice.t b/dist/Tie-File/t/07_rv_splice.t index 6d0efa88c6..dcd4f4d675 100644 --- a/dist/Tie-File/t/07_rv_splice.t +++ b/dist/Tie-File/t/07_rv_splice.t @@ -4,6 +4,8 @@ # (04_splice.t checks its effect on the file) # +use strict; +use warnings; my $file = "tf07-$$.txt"; $: = Tie::File::_default_recsep(); @@ -17,6 +19,7 @@ print "ok $N\n"; $N++; # partial credit just for showing up init_file($data); +my @a; my $o = tie @a, 'Tie::File', $file, autochomp => 0; print $o ? "ok $N\n" : "not ok $N\n"; $N++; @@ -24,7 +27,7 @@ $N++; my $n; # (3-12) splicing at the beginning -@r = splice(@a, 0, 0, "rec4"); +my @r = splice(@a, 0, 0, "rec4"); check_result(); @r = splice(@a, 0, 1, "rec5"); # same length check_result("rec4"); diff --git a/dist/Tie-File/t/08_ro.t b/dist/Tie-File/t/08_ro.t index bf6a316a15..c212a8b229 100644 --- a/dist/Tie-File/t/08_ro.t +++ b/dist/Tie-File/t/08_ro.t @@ -3,6 +3,9 @@ # Make sure it works to open the file in read-only mode # +use strict; +use warnings; + my $file = "tf08-$$.txt"; $: = Tie::File::_default_recsep(); @@ -16,6 +19,7 @@ print "ok $N\n"; $N++; my @items = qw(Gold Frankincense Myrrh Ivory Apes Peacocks); init_file(join $:, @items, ''); +my @a; my $o = tie @a, 'Tie::File', $file, mode => O_RDONLY, autochomp => 0; print $o ? "ok $N\n" : "not ok $N\n"; $N++; diff --git a/dist/Tie-File/t/09_gen_rs.t b/dist/Tie-File/t/09_gen_rs.t index 272dada226..4d2918e1aa 100644 --- a/dist/Tie-File/t/09_gen_rs.t +++ b/dist/Tie-File/t/09_gen_rs.t @@ -1,5 +1,8 @@ #!/usr/bin/perl +use strict; +use warnings; + my $file = "tf09-$$.txt"; print "1..59\n"; @@ -10,7 +13,9 @@ my $N = 1; use Tie::File; print "ok $N\n"; $N++; -$RECSEP = 'blah'; +my $RECSEP = 'blah'; + +my @a; my $o = tie @a, 'Tie::File', $file, recsep => $RECSEP, autochomp => 0, autodefer => 0; print $o ? "ok $N\n" : "not ok $N\n"; @@ -197,6 +202,7 @@ sub check_contents { # now check FETCH: my $good = 1; + my $msg = ''; for (0.. $#c) { unless ($a[$_] eq "$c[$_]$RECSEP") { $msg = "expected $c[$_]$RECSEP, got $a[$_]"; diff --git a/dist/Tie-File/t/10_splice_rs.t b/dist/Tie-File/t/10_splice_rs.t index 24e81cd34c..e2ad5619ba 100644 --- a/dist/Tie-File/t/10_splice_rs.t +++ b/dist/Tie-File/t/10_splice_rs.t @@ -10,6 +10,9 @@ # Then, it checks the actual contents of the file against the expected # contents. +use strict; +use warnings; + use POSIX 'SEEK_SET'; my $file = "tf10-$$.txt"; @@ -23,6 +26,7 @@ print "ok $N\n"; $N++; # partial credit just for showing up init_file($data); +my @a; my $o = tie @a, 'Tie::File', $file, recsep => 'blah'; print $o ? "ok $N\n" : "not ok $N\n"; $N++; diff --git a/dist/Tie-File/t/11_rv_splice_rs.t b/dist/Tie-File/t/11_rv_splice_rs.t index fd89d83d0c..4cebe1fbfa 100644 --- a/dist/Tie-File/t/11_rv_splice_rs.t +++ b/dist/Tie-File/t/11_rv_splice_rs.t @@ -4,6 +4,9 @@ # (04_splice.t checks its effect on the file) # +use strict; +use warnings; + my $file = "tf11-$$.txt"; my $data = "rec0blahrec1blahrec2blah"; @@ -15,6 +18,7 @@ print "ok $N\n"; $N++; # partial credit just for showing up init_file($data); +my @a; my $o = tie @a, 'Tie::File', $file, autochomp => 0, recsep => 'blah'; print $o ? "ok $N\n" : "not ok $N\n"; $N++; @@ -22,7 +26,7 @@ $N++; my $n; # (3-12) splicing at the beginning -@r = splice(@a, 0, 0, "rec4"); +my @r = splice(@a, 0, 0, "rec4"); check_result(); @r = splice(@a, 0, 1, "rec5"); # same length check_result("rec4"); diff --git a/dist/Tie-File/t/12_longfetch_rs.t b/dist/Tie-File/t/12_longfetch_rs.t index 8f3e79bb26..6fa3298b01 100644 --- a/dist/Tie-File/t/12_longfetch_rs.t +++ b/dist/Tie-File/t/12_longfetch_rs.t @@ -6,6 +6,9 @@ # (tests _fill_offsets_to() ) # +use strict; +use warnings; + my $file = "tf12-$$.txt"; my $data = "rec0blahrec1blahrec2blah"; @@ -20,7 +23,7 @@ binmode F; print F $data; close F; - +my @a; my $o = tie @a, 'Tie::File', $file, autochomp => 0, recsep => 'blah'; print $o ? "ok $N\n" : "not ok $N\n"; $N++; diff --git a/dist/Tie-File/t/13_size_rs.t b/dist/Tie-File/t/13_size_rs.t index 4e4a2680a5..71eff4ee22 100644 --- a/dist/Tie-File/t/13_size_rs.t +++ b/dist/Tie-File/t/13_size_rs.t @@ -4,6 +4,9 @@ # PUSH POP SHIFT UNSHIFT # +use strict; +use warnings; + use POSIX 'SEEK_SET'; my $file = "tf13-$$.txt"; @@ -19,6 +22,8 @@ print "ok $N\n"; $N++; # 2-3 FETCHSIZE 0-length file open F, '>', $file or die $!; close F; + +my @a; $o = tie @a, 'Tie::File', $file, recsep => 'blah'; print $o ? "ok $N\n" : "not ok $N\n"; $N++; diff --git a/dist/Tie-File/t/14_lock.t b/dist/Tie-File/t/14_lock.t index 1979a0e89a..27af9a92f6 100644 --- a/dist/Tie-File/t/14_lock.t +++ b/dist/Tie-File/t/14_lock.t @@ -8,6 +8,9 @@ # portable test for flocking. I checked the Perl core distribution, # and found that Perl doesn't test flock either! +use strict; +use warnings; + BEGIN { eval { flock STDOUT, 0 }; if ($@ && $@ =~ /unimplemented/) { diff --git a/dist/Tie-File/t/15_pushpop.t b/dist/Tie-File/t/15_pushpop.t index ecf4a063ed..9af32926bb 100644 --- a/dist/Tie-File/t/15_pushpop.t +++ b/dist/Tie-File/t/15_pushpop.t @@ -9,6 +9,9 @@ # Then, it checks the actual contents of the file against the expected # contents. +use strict; +use warnings; + use POSIX 'SEEK_SET'; my $file = "tf15-$$.txt"; @@ -22,6 +25,7 @@ my $N = 1; use Tie::File; print "ok $N\n"; $N++; # partial credit just for showing up +my @a; my $o = tie @a, 'Tie::File', $file, autochomp => 0; print $o ? "ok $N\n" : "not ok $N\n"; $N++; diff --git a/dist/Tie-File/t/16_handle.t b/dist/Tie-File/t/16_handle.t index 2c9456fb22..4563c408fa 100644 --- a/dist/Tie-File/t/16_handle.t +++ b/dist/Tie-File/t/16_handle.t @@ -3,6 +3,9 @@ # Basic operation, initializing the object from an already-open handle # instead of from a filename +use strict; +use warnings; + my $file = "tf16-$$.txt"; $: = Tie::File::_default_recsep(); @@ -22,6 +25,7 @@ sysopen F, $file, O_CREAT | O_RDWR or die "Couldn't create temp file $file: $!; aborting"; binmode F; +my @a; my $o = tie @a, 'Tie::File', \*F, autochomp => 0, autodefer => 0; print $o ? "ok $N\n" : "not ok $N\n"; $N++; diff --git a/dist/Tie-File/t/17_misc_meth.t b/dist/Tie-File/t/17_misc_meth.t index 1eaec2c465..e6136fd137 100644 --- a/dist/Tie-File/t/17_misc_meth.t +++ b/dist/Tie-File/t/17_misc_meth.t @@ -4,6 +4,10 @@ # EXTEND, CLEAR, DELETE, EXISTS # +use strict; +use warnings; + + my $file = "tf17-$$.txt"; $: = Tie::File::_default_recsep(); 1 while unlink $file; @@ -14,6 +18,7 @@ my $N = 1; use Tie::File; print "ok $N\n"; $N++; +my @a; my $o = tie @a, 'Tie::File', $file, autodefer => 0; print $o ? "ok $N\n" : "not ok $N\n"; $N++; diff --git a/dist/Tie-File/t/18_rs_fixrec.t b/dist/Tie-File/t/18_rs_fixrec.t index 4e307bd918..001976e758 100644 --- a/dist/Tie-File/t/18_rs_fixrec.t +++ b/dist/Tie-File/t/18_rs_fixrec.t @@ -1,6 +1,10 @@ #!/usr/bin/perl +use strict; +use warnings; + use POSIX 'SEEK_SET'; + my $file = "tf18-$$.txt"; $/ = "blah"; @@ -10,6 +14,7 @@ my $N = 1; use Tie::File; print "ok $N\n"; $N++; +my @a; my $o = tie @a, 'Tie::File', $file, autodefer => 0; print $o ? "ok $N\n" : "not ok $N\n"; $N++; diff --git a/dist/Tie-File/t/19_cache.t b/dist/Tie-File/t/19_cache.t index cfb44ab58b..f91c9d3720 100644 --- a/dist/Tie-File/t/19_cache.t +++ b/dist/Tie-File/t/19_cache.t @@ -1,4 +1,8 @@ #!/usr/bin/perl + +use strict; +use warnings; + # # Tests for various caching errors # @@ -20,6 +24,7 @@ binmode F; print F $data; close F; +my @a; my $o = tie @a, 'Tie::File', $file; print $o ? "ok $N\n" : "not ok $N\n"; $N++; diff --git a/dist/Tie-File/t/20_cache_full.t b/dist/Tie-File/t/20_cache_full.t index b9dd6dc452..4d34a89bb7 100644 --- a/dist/Tie-File/t/20_cache_full.t +++ b/dist/Tie-File/t/20_cache_full.t @@ -1,4 +1,8 @@ #!/usr/bin/perl + +use strict; +use warnings; + # # Tests for various caching errors # @@ -22,6 +26,7 @@ close F; # Limit cache size to 30 bytes my $MAX = 30; # -- that's enough space for 3 records, but not 4, on both \n and \r\n systems +my @a; my $o = tie @a, 'Tie::File', $file, memory => $MAX, autodefer => 0; print $o ? "ok $N\n" : "not ok $N\n"; $N++; diff --git a/dist/Tie-File/t/21_win32.t b/dist/Tie-File/t/21_win32.t index cabb93b53a..6904a8744f 100644 --- a/dist/Tie-File/t/21_win32.t +++ b/dist/Tie-File/t/21_win32.t @@ -1,4 +1,8 @@ #!/usr/bin/perl + +use strict; +use warnings; + # # Formerly, on a Win32 system, Tie::File would create files with # \n-terminated records instead of \r\n-terminated. The tests never @@ -21,6 +25,7 @@ my $N = 1; use Tie::File; print "ok $N\n"; $N++; +my @a; my $o = tie @a, 'Tie::File', $file, autodefer => 0; print $o ? "ok $N\n" : "not ok $N\n"; $N++; diff --git a/dist/Tie-File/t/22_autochomp.t b/dist/Tie-File/t/22_autochomp.t index 18b9461db3..a48de94a72 100644 --- a/dist/Tie-File/t/22_autochomp.t +++ b/dist/Tie-File/t/22_autochomp.t @@ -1,5 +1,8 @@ #!/usr/bin/perl +use strict; +use warnings; + my $file = "tf22-$$.txt"; $: = Tie::File::_default_recsep(); @@ -9,6 +12,7 @@ my $N = 1; use Tie::File; print "ok $N\n"; $N++; +my @a; my $o = tie @a, 'Tie::File', $file, autochomp => 1, autodefer => 0; print $o ? "ok $N\n" : "not ok $N\n"; $N++; @@ -92,8 +96,8 @@ my @sr; expect(join("-", @sr), "Gold-Frankincense"); # (70-71) Didn't you forget that fetch may return an unchomped cached record? -$a1 = $a[0]; # populate cache -$a2 = $a[0]; +my $a1 = $a[0]; # populate cache +my $a2 = $a[0]; expect($a1, "Myrrh"); expect($a2, "Myrrh"); # Actually no, you didn't---_fetch might return such a record, but diff --git a/dist/Tie-File/t/23_rv_ac_splice.t b/dist/Tie-File/t/23_rv_ac_splice.t index fe066e7082..727b3fca66 100644 --- a/dist/Tie-File/t/23_rv_ac_splice.t +++ b/dist/Tie-File/t/23_rv_ac_splice.t @@ -4,6 +4,9 @@ # (07_rv_splice.t checks it aith autochomping off) # +use strict; +use warnings; + my $file = "tf23-$$.txt"; $: = Tie::File::_default_recsep(); my $data = "rec0$:rec1$:rec2$:"; @@ -16,6 +19,7 @@ print "ok $N\n"; $N++; # partial credit just for showing up init_file($data); +my @a; my $o = tie @a, 'Tie::File', $file, autochomp => 1; print $o ? "ok $N\n" : "not ok $N\n"; $N++; @@ -23,7 +27,7 @@ $N++; my $n; # (3-12) splicing at the beginning -@r = splice(@a, 0, 0, "rec4"); +my @r = splice(@a, 0, 0, "rec4"); check_result(); @r = splice(@a, 0, 1, "rec5"); # same length check_result("rec4"); diff --git a/dist/Tie-File/t/24_cache_loop.t b/dist/Tie-File/t/24_cache_loop.t index a6a20bbbe5..f45265d59b 100644 --- a/dist/Tie-File/t/24_cache_loop.t +++ b/dist/Tie-File/t/24_cache_loop.t @@ -3,7 +3,11 @@ # Tests for various caching errors # +use strict; +use warnings; + use Config; + my $file = "tf24-$$.txt"; unless ($Config{d_alarm}) { print "1..0\n"; exit; @@ -27,6 +31,7 @@ close F; # Limit cache size to 30 bytes my $MAX = 30; # -- that's enough space for 3 records, but not 4, on both \n and \r\n systems +my @a; my $o = tie @a, 'Tie::File', $file, memory => $MAX, autodefer => 1; print $o ? "ok $N\n" : "not ok $N\n"; $N++; diff --git a/dist/Tie-File/t/25_gen_nocache.t b/dist/Tie-File/t/25_gen_nocache.t index 9dacf6bfcf..3108c608bb 100644 --- a/dist/Tie-File/t/25_gen_nocache.t +++ b/dist/Tie-File/t/25_gen_nocache.t @@ -1,4 +1,8 @@ #!/usr/bin/perl + +use strict; +use warnings; + # # Regular read-write tests with caching disabled # (Same as 01_gen.t) @@ -11,6 +15,7 @@ my $N = 1; use Tie::File; print "ok $N\n"; $N++; +my @a; my $o = tie @a, 'Tie::File', $file, autochomp => 0, autodefer => 0, memory => 0; print $o ? "ok $N\n" : "not ok $N\n"; $N++; diff --git a/dist/Tie-File/t/26_twrite.t b/dist/Tie-File/t/26_twrite.t index 212522364a..261eb8aaa5 100644 --- a/dist/Tie-File/t/26_twrite.t +++ b/dist/Tie-File/t/26_twrite.t @@ -1,4 +1,8 @@ #!/usr/bin/perl + +use strict; +use warnings; + # # Unit tests of _twrite function # @@ -188,7 +192,7 @@ try( 0, 0, 0); # old=0 , new=0 ; old = new # (115-141) # These tests all take place at the end of the file -$FLEN = 40960; # Force the file to be exactly 40960 bytes long +my $FLEN = 40960; # Force the file to be exactly 40960 bytes long try(32768, 8192, 8192); # old=<x> , new=<x ; old = new try(32768, 8192, 4026); # old=<x> , new=<x ; old > new try(24576, 16384, 1917); # old=<x><x> , new=<x ; old > new @@ -306,54 +310,7 @@ sub try { } - -use POSIX 'SEEK_SET'; -sub check_contents { - my @c = @_; - my $x = join $:, @c, ''; - local *FH = $o->{fh}; - seek FH, 0, SEEK_SET; -# my $open = open FH, '<', $file; - my $a; - { local $/; $a = <FH> } - $a = "" unless defined $a; - if ($a eq $x) { - print "ok $N\n"; - } else { - ctrlfix($a, $x); - print "not ok $N\n# expected <$x>, got <$a>\n"; - } - $N++; - - # now check FETCH: - my $good = 1; - my $msg; - for (0.. $#c) { - my $aa = $a[$_]; - unless ($aa eq "$c[$_]$:") { - $msg = "expected <$c[$_]$:>, got <$aa>"; - ctrlfix($msg); - $good = 0; - } - } - print $good ? "ok $N\n" : "not ok $N # $msg\n"; - $N++; - - print $o->_check_integrity($file, $ENV{INTEGRITY}) - ? "ok $N\n" : "not ok $N\n"; - $N++; -} - -sub ctrlfix { - for (@_) { - s/\n/\\n/g; - s/\r/\\r/g; - } -} - END { - undef $o; - untie @a; 1 while unlink $file; } diff --git a/dist/Tie-File/t/27_iwrite.t b/dist/Tie-File/t/27_iwrite.t index cada89b75c..464f1ea66c 100644 --- a/dist/Tie-File/t/27_iwrite.t +++ b/dist/Tie-File/t/27_iwrite.t @@ -1,4 +1,8 @@ #!/usr/bin/perl + +use strict; +use warnings; + # # Unit tests of _iwrite function # @@ -23,7 +27,7 @@ print "ok $N\n"; $N++; $: = Tie::File::_default_recsep(); -$FLEN = 40970; # Use files of this length +my $FLEN = 40970; # Use files of this length $oldfile = mkrand($FLEN); print "# MOF tests\n"; # (2-85) These were generated by 'gentests.pl' to cover all possible cases diff --git a/dist/Tie-File/t/28_mtwrite.t b/dist/Tie-File/t/28_mtwrite.t index 8d437e643a..ae493cc9c1 100644 --- a/dist/Tie-File/t/28_mtwrite.t +++ b/dist/Tie-File/t/28_mtwrite.t @@ -1,4 +1,8 @@ #!/usr/bin/perl + +use strict; +use warnings; + # # Unit tests of _mtwrite function # @@ -20,7 +24,7 @@ print "ok $N\n"; $N++; $: = Tie::File::_default_recsep(); # Only these are used for the triple-region tests -@BASE_TRIES = ( +my @BASE_TRIES = ( [10, 20, 30], [10, 30, 20], [100, 30, 20], @@ -33,9 +37,9 @@ $: = Tie::File::_default_recsep(); [200, 60, 20], ); -@TRIES = @BASE_TRIES; +my @TRIES = @BASE_TRIES; -$FLEN = 40970; # Use files of this length +my $FLEN = 40970; # Use files of this length $oldfile = mkrand($FLEN); print "# MOF tests\n"; # These were generated by 'gentests.pl' to cover all possible cases diff --git a/dist/Tie-File/t/29_downcopy.t b/dist/Tie-File/t/29_downcopy.t index a85cd69dea..a86d21f8e2 100644 --- a/dist/Tie-File/t/29_downcopy.t +++ b/dist/Tie-File/t/29_downcopy.t @@ -1,4 +1,8 @@ #!/usr/bin/perl + +use strict; +use warnings; + # # Unit tests of _downcopy function # @@ -162,7 +166,7 @@ try( 0, 0, 0); # old=0 , new=0 ; old = new # (224-277) # These tests all take place at the end of the file -$FLEN = 40960; # Force the file to be exactly 40960 bytes long +my $FLEN = 40960; # Force the file to be exactly 40960 bytes long try(32768, 8192, 8192); # old=<x> , new=<x ; old = new try(32768, 8192, 4026); # old=<x> , new=<x ; old > new try(24576, 16384, 1917); # old=<x><x> , new=<x ; old > new @@ -315,54 +319,6 @@ sub try { } } - - -use POSIX 'SEEK_SET'; -sub check_contents { - my @c = @_; - my $x = join $:, @c, ''; - local *FH = $o->{fh}; - seek FH, 0, SEEK_SET; -# my $open = open FH, '<', $file; - my $a; - { local $/; $a = <FH> } - $a = "" unless defined $a; - if ($a eq $x) { - print "ok $N\n"; - } else { - ctrlfix($a, $x); - print "not ok $N\n# expected <$x>, got <$a>\n"; - } - $N++; - - # now check FETCH: - my $good = 1; - my $msg; - for (0.. $#c) { - my $aa = $a[$_]; - unless ($aa eq "$c[$_]$:") { - $msg = "expected <$c[$_]$:>, got <$aa>"; - ctrlfix($msg); - $good = 0; - } - } - print $good ? "ok $N\n" : "not ok $N # $msg\n"; - $N++; - - print $o->_check_integrity($file, $ENV{INTEGRITY}) - ? "ok $N\n" : "not ok $N\n"; - $N++; -} - -sub ctrlfix { - for (@_) { - s/\n/\\n/g; - s/\r/\\r/g; - } -} - END { - undef $o; - untie @a; 1 while unlink $file; } diff --git a/dist/Tie-File/t/29a_upcopy.t b/dist/Tie-File/t/29a_upcopy.t index 73ae3df9c9..2c593f1581 100644 --- a/dist/Tie-File/t/29a_upcopy.t +++ b/dist/Tie-File/t/29a_upcopy.t @@ -1,4 +1,8 @@ #!/usr/bin/perl + +use strict; +use warnings; + # # Unit tests of _upcopy function # @@ -22,7 +26,7 @@ $: = Tie::File::_default_recsep(); my @subtests = qw(x <x x> x><x <x> <x><x x><x> <x><x> <x><x><x> 0); -$FLEN = 40970; # 2410 records of 17 chars each +my $FLEN = 40970; # 2410 records of 17 chars each # (2-7) Trivial non-moves at start of file try(0, 0, 0); @@ -157,45 +161,6 @@ sub try { $N++; } - - -use POSIX 'SEEK_SET'; -sub check_contents { - my @c = @_; - my $x = join $:, @c, ''; - local *FH = $o->{fh}; - seek FH, 0, SEEK_SET; -# my $open = open FH, '<', $file; - my $a; - { local $/; $a = <FH> } - $a = "" unless defined $a; - if ($a eq $x) { - print "ok $N\n"; - } else { - ctrlfix($a, $x); - print "not ok $N\n# expected <$x>, got <$a>\n"; - } - $N++; - - # now check FETCH: - my $good = 1; - my $msg; - for (0.. $#c) { - my $aa = $a[$_]; - unless ($aa eq "$c[$_]$:") { - $msg = "expected <$c[$_]$:>, got <$aa>"; - ctrlfix($msg); - $good = 0; - } - } - print $good ? "ok $N\n" : "not ok $N # $msg\n"; - $N++; - - print $o->_check_integrity($file, $ENV{INTEGRITY}) - ? "ok $N\n" : "not ok $N\n"; - $N++; -} - sub ctrlfix { for (@_) { s/\n/\\n/g; @@ -204,8 +169,6 @@ sub ctrlfix { } END { - undef $o; - untie @a; 1 while unlink $file; } diff --git a/dist/Tie-File/t/30_defer.t b/dist/Tie-File/t/30_defer.t index 78a52657d6..8ef908bdca 100644 --- a/dist/Tie-File/t/30_defer.t +++ b/dist/Tie-File/t/30_defer.t @@ -1,4 +1,8 @@ #!/usr/bin/perl + +use strict; +use warnings; + # # Check ->defer and ->flush methods # @@ -23,6 +27,8 @@ open F, '>', $file or die $!; binmode F; print F $data; close F; + +my @a; $o = tie @a, 'Tie::File', $file; print $o ? "ok $N\n" : "not ok $N\n"; $N++; diff --git a/dist/Tie-File/t/31_autodefer.t b/dist/Tie-File/t/31_autodefer.t index 41d2514f6c..0e8f52cb47 100644 --- a/dist/Tie-File/t/31_autodefer.t +++ b/dist/Tie-File/t/31_autodefer.t @@ -1,4 +1,8 @@ #!/usr/bin/perl + +use strict; +use warnings; + # # Check behavior of 'autodefer' feature # Mostly this isn't implemented yet diff --git a/dist/Tie-File/t/32_defer_misc.t b/dist/Tie-File/t/32_defer_misc.t index ca81c7ca86..940f1b7ac3 100644 --- a/dist/Tie-File/t/32_defer_misc.t +++ b/dist/Tie-File/t/32_defer_misc.t @@ -1,4 +1,8 @@ #!/usr/bin/perl + +use strict; +use warnings; + # # Check interactions of deferred writing # with miscellaneous methods like DELETE, EXISTS, @@ -21,6 +25,8 @@ open F, '>', $file or die $!; binmode F; print F $data; close F; + +my @a; $o = tie @a, 'Tie::File', $file; print $o ? "ok $N\n" : "not ok $N\n"; $N++; diff --git a/dist/Tie-File/t/33_defer_vs.t b/dist/Tie-File/t/33_defer_vs.t index b7f01ce38a..75383457eb 100644 --- a/dist/Tie-File/t/33_defer_vs.t +++ b/dist/Tie-File/t/33_defer_vs.t @@ -1,4 +1,8 @@ #!/usr/bin/perl + +use strict; +use warnings; + # # Deferred caching of varying size records # @@ -25,6 +29,8 @@ open F, '>', $file or die $!; binmode F; print F $data; close F; + +my @a; $o = tie @a, 'Tie::File', $file; print $o ? "ok $N\n" : "not ok $N\n"; $N++; @@ -66,7 +72,7 @@ check_contents("55555$:1$:aaaaaaaaaa$:$:7777777$:"); # (23-26) Now two long batches $o->defer; -%l = qw(0 2 1 3 2 4 4 5 5 4 6 3); +my %l = qw(0 2 1 3 2 4 4 5 5 4 6 3); for (0..2, 4..6) { $a[$_] = $_ x $l{$_}; } diff --git a/dist/Tie-File/t/40_abs_cache.t b/dist/Tie-File/t/40_abs_cache.t index 137c9bb78d..7e9612dde4 100644 --- a/dist/Tie-File/t/40_abs_cache.t +++ b/dist/Tie-File/t/40_abs_cache.t @@ -1,4 +1,8 @@ #!/usr/bin/perl + +use strict; +use warnings; + # # Unit tests for abstract cache implementation # @@ -58,14 +62,14 @@ for (1..10) { for (1..10) { push @R, $h->expire; } -$iota = iota('a',9); +my $iota = iota('a',9); print "@R" eq $iota ? "ok $N\n" : "not ok $N \# expected ($iota), got (@R)\n"; $N++; check($h); # (6-7) Remove from empty heap -$n = $h->expire; +my $n = $h->expire; print ! defined $n ? "ok $N\n" : "not ok $N \# expected UNDEF, got $n"; $N++; check($h); diff --git a/dist/Tie-File/t/41_heap.t b/dist/Tie-File/t/41_heap.t index 9e7ad2516c..0ed3fe7c05 100644 --- a/dist/Tie-File/t/41_heap.t +++ b/dist/Tie-File/t/41_heap.t @@ -1,4 +1,8 @@ #!/usr/bin/perl + +use strict; +use warnings; + # # Unit tests for heap implementation # diff --git a/dist/Tie-File/t/42_offset.t b/dist/Tie-File/t/42_offset.t index 5aa20bf66f..5a76c665dd 100644 --- a/dist/Tie-File/t/42_offset.t +++ b/dist/Tie-File/t/42_offset.t @@ -2,8 +2,10 @@ # 2003-04-09 Tels: test the offset method from 0.94 -use Test::More; use strict; +use warnings; + +use Test::More; use File::Spec; use POSIX 'SEEK_SET'; diff --git a/dist/Tie-File/t/43_synopsis.t b/dist/Tie-File/t/43_synopsis.t index 538a5509d9..f7abde1080 100644 --- a/dist/Tie-File/t/43_synopsis.t +++ b/dist/Tie-File/t/43_synopsis.t @@ -1,4 +1,8 @@ #!/usr/bin/perl + +use strict; +use warnings; + # Demonstrate correctness of SYNOPSIS in documentation $| = 1; my $file = "tf42-$$.txt"; @@ -20,6 +24,8 @@ use Tie::File; print "ok $N - use Tie::File\n"; $N++; my $desc = 'Tie::File'; + +my @array; my $o = tie @array, 'Tie::File', $file; defined ($o) ? print "ok $N - $desc\n" @@ -39,7 +45,7 @@ $N++; $N++; $desc = "got expected amount of records in file"; - $n_recs = @array; + my $n_recs = @array; ($n_recs == $MAX + 1) ? print "ok $N - $desc\n" : print "not ok $N - $desc\n"; @@ -56,7 +62,7 @@ $N++; $desc = "replace PERL with Perl everywhere in the file"; for (@array) { s/PERL/Perl/g; } -$exp = "Perl-" . ($MAX - 2); +my $exp = "Perl-" . ($MAX - 2); ($array[-1] eq $exp) ? print "ok $N - $desc\n" : print "not ok $N - $desc\n"; @@ -154,6 +160,7 @@ my $u = untie @array; # TODO: perldoc -f untie does not specify return value for untie $desc = 'tie to dupe file'; +my @dupe; my $p = tie @dupe, 'Tie::File', $file; defined ($p) ? print "ok $N - $desc\n" |