Correct misleading entries in SYNOPSIS

Correct documentation as per suggestion from T.E. Hofmann.  Add a new test file demonstrating correctness of the synopsis.

For: GH 17499

Originally reported 2004-03-30 by T.E. Hofmann in Tie-File RT queue:
https://rt.cpan.org/Ticket/Display.html?id=5837

2 files changed, 201 insertions, 4 deletions

diff --git a/dist/Tie-File/lib/Tie/File.pm b/dist/Tie-File/lib/Tie/File.pm
index 011009f9ac..c72092e305 100644
--- a/dist/Tie-File/lib/Tie/File.pm
+++ b/dist/Tie-File/lib/Tie/File.pm
@@ -7,7 +7,7 @@ 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.05";
+$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
@@ -2013,13 +2013,13 @@ Tie::File - Access the lines of a disk file via a Perl array
 
 =head1 SYNOPSIS
 
- # This file documents Tie::File version 0.98
  use Tie::File;
 
  tie @array, 'Tie::File', filename or die ...;
 
- $array[13] = 'blah';     # line 13 of the file is now 'blah'
- print $array[42];        # display line 42 of the file
+ $array[0] = 'blah';      # first line of the file is now 'blah'
+                            # (line numbering starts at 0)
+ print $array[42];        # display line 43 of the file
 
  $n_recs = @array;        # how many records are in the file?
  $#array -= 2;            # chop two records off the end
diff --git a/dist/Tie-File/t/43_synopsis.t b/dist/Tie-File/t/43_synopsis.t
new file mode 100644
index 0000000000..538a5509d9
--- /dev/null
+++ b/dist/Tie-File/t/43_synopsis.t
@@ -0,0 +1,197 @@
+#!/usr/bin/perl
+# Demonstrate correctness of SYNOPSIS in documentation
+$| = 1;
+my $file = "tf42-$$.txt";
+my $dupe = "ft42-$$.txt";
+1 while unlink $file;
+1 while unlink $dupe;
+
+print "1..21\n";
+
+my $MAX = 42;
+open my $F, ">", $file or die "Unable to open $file for writing: $!";
+for my $i (0..$MAX) {
+    print $F "PERL-${i}\n";
+}
+close $F or die "Unable to close $file after writing: $!";
+
+my $N = 1;
+use Tie::File;
+print "ok $N - use Tie::File\n"; $N++;
+
+my $desc = 'Tie::File';
+my $o = tie @array, 'Tie::File', $file;
+defined ($o)
+    ? print "ok $N - $desc\n"
+    : print "not ok $N - $desc\n";
+$N++;
+
+    $desc = "first element in array corresponds to first line of file";
+    ($array[0] eq "PERL-0")
+        ? print "ok $N - $desc\n"
+        : print "not ok $N - $desc\n";
+    $N++;
+
+    $desc = "last element in array corresponds to last line of file";
+    ($array[$MAX] eq "PERL-$MAX")
+        ? print "ok $N - $desc\n"
+        : print "not ok $N - $desc\n";
+    $N++;
+
+    $desc = "got expected amount of records in file";
+    $n_recs = @array;
+    ($n_recs == $MAX + 1)
+        ? print "ok $N - $desc\n"
+        : print "not ok $N - $desc\n";
+    $N++;
+
+    my $chop = 2;
+    $#array -= $chop;
+    $desc = "chop records off end of file";
+    $n_recs = @array;
+    ($n_recs == $MAX + 1 - $chop)
+        ? print "ok $N - $desc\n"
+        : print "not ok $N - $desc\n";
+    $N++;
+
+    $desc = "replace PERL with Perl everywhere in the file";
+for (@array) { s/PERL/Perl/g; }
+$exp = "Perl-" . ($MAX - 2);
+($array[-1] eq $exp)
+    ? print "ok $N - $desc\n"
+    : print "not ok $N - $desc\n";
+$N++;
+
+# push @array, new recs...;
+# my $r1 = pop @array;
+# unshift @array, new recs...;
+# my $r2 = shift @array;
+# @old_recs = splice @array, 3, 7, new recs...;
+# Demonstrate that the tied file has changed in the way we expect
+
+$desc = "push new records onto end of file";
+my @end_recs = (qw| alpha beta gamma |);
+push @array, @end_recs;
+$n_recs = @array;
+($n_recs == $MAX + 1 - $chop + @end_recs)
+    ? print "ok $N - $desc\n"
+    : print "not ok $N - $desc\n";
+$N++;
+
+$desc = "last element in array corresponds to last line of file";
+($array[-1] eq $end_recs[-1])
+    ? print "ok $N - $desc\n"
+    : print "not ok $N - $desc\n";
+$N++;
+
+$desc = "pop last record off";
+my $r1 = pop @array;
+($array[-1] eq $end_recs[-2])
+    ? print "ok $N - $desc\n"
+    : print "not ok $N - $desc\n";
+$N++;
+
+$desc = "unshift new records onto beginning of file";
+my @start_recs = (qw| albemarle beverly cortelyou |);
+unshift @array, @start_recs;
+$n_recs = @array;
+$exp = $MAX + 1 - $chop + @end_recs - 1 + @start_recs;
+($n_recs == $exp)
+    ? print "ok $N - $desc\n"
+    : print "not ok $N - $desc\n";
+$N++;
+
+$desc = "first element in array corresponds to first line of file";
+($array[0] eq $start_recs[0])
+    ? print "ok $N - $desc\n"
+    : print "not ok $N - $desc\n";
+$N++;
+
+$desc = "shift one record off beginning of file";
+my $r2 = shift @array;
+$n_recs = @array;
+$exp = $MAX + 1 - $chop + @end_recs - 1 + @start_recs - 1;
+($n_recs == $exp)
+    ? print "ok $N - $desc\n"
+    : print "not ok $N - $desc\n";
+$N++;
+
+$desc = "new first element in array";
+($array[0] eq $start_recs[1])
+    ? print "ok $N - $desc\n"
+    : print "not ok $N - $desc\n";
+$N++;
+
+my @splice_in = (qw| delta epsilon zeta eta theta |);
+my $offset = 2;
+my $length = 3;
+$desc = "splice out $length elements and splice in " . @splice_in . " new elements";
+my @old_recs = splice @array, $offset, $length, @splice_in;
+$n_recs = @array;
+$exp = $MAX + 1 - $chop + @end_recs - 1 + @start_recs - 1 - 3 + @splice_in;
+($n_recs == $exp)
+    ? print "ok $N - $desc\n"
+    : print "not ok $N - $desc\n";
+$N++;
+
+$desc = "got expected element";
+($array[6] eq $splice_in[4])
+    ? print "ok $N - $desc\n"
+    : print "not ok $N - $desc\n";
+$N++;
+
+open my $G, "<", $file or die "Unable to open $file for reading: $!";
+open my $H, ">", $dupe or die "Unable to open $dupe for writing: $!";
+while (my $l = <$G>) {
+    chomp $l;
+    print $H "$l\n";
+}
+close $H or die "Unable to close $dupe after writing: $!";
+close $G or die "Unable to close $file after reading: $!";
+
+# Untie the first file
+my $u = untie @array; 
+# TODO: perldoc -f untie does not specify return value for untie
+
+$desc = 'tie to dupe file';
+my $p = tie @dupe, 'Tie::File', $file;
+defined ($p)
+    ? print "ok $N - $desc\n"
+    : print "not ok $N - $desc\n";
+$N++;
+
+$desc = "same number of records in dupe file as in original file";
+my $o_recs = @dupe;
+($o_recs == $n_recs)
+    ? print "ok $N - $desc\n"
+    : print "not ok $N - $desc\n";
+$N++;
+
+$desc = "first element in dupe array corresponds to first line of dupe file";
+($dupe[0] eq $start_recs[1])
+    ? print "ok $N - $desc\n"
+    : print "not ok $N - $desc\n";
+$N++;
+
+$exp = $splice_in[4];
+$desc = "got expected element $exp";
+($dupe[6] eq $exp)
+    ? print "ok $N - $desc\n"
+    : print "not ok $N - $desc\n";
+$N++;
+
+$desc = "last element in dupe array corresponds to last line of dupe file";
+($dupe[-1] eq $end_recs[-2])
+    ? print "ok $N - $desc\n"
+    : print "not ok $N - $desc\n";
+$N++;
+
+END {
+    untie @array;
+    untie @dupe;
+    undef $o;
+    undef $p;
+    1 while unlink $file;
+    1 while unlink $dupe;
+}
+