xref: /openbsd-src/gnu/usr.bin/perl/dist/Tie-File/t/43_synopsis.t (revision de8cc8edbc71bd3e3bc7fbffa27ba0e564c37d8b) 
1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
6# Demonstrate correctness of SYNOPSIS in documentation
7$| = 1;
8my $file = "tf42-$$.txt";
9my $dupe = "ft42-$$.txt";
101 while unlink $file;
111 while unlink $dupe;
12
13print "1..21\n";
14
15my $MAX = 42;
16open my $F, ">", $file or die "Unable to open $file for writing: $!";
17for my $i (0..$MAX) {
18    print $F "PERL-${i}\n";
19}
20close $F or die "Unable to close $file after writing: $!";
21
22my $N = 1;
23use Tie::File;
24print "ok $N - use Tie::File\n"; $N++;
25
26my $desc = 'Tie::File';
27
28my @array;
29my $o = tie @array, 'Tie::File', $file;
30defined ($o)
31    ? print "ok $N - $desc\n"
32    : print "not ok $N - $desc\n";
33$N++;
34
35    $desc = "first element in array corresponds to first line of file";
36    ($array[0] eq "PERL-0")
37        ? print "ok $N - $desc\n"
38        : print "not ok $N - $desc\n";
39    $N++;
40
41    $desc = "last element in array corresponds to last line of file";
42    ($array[$MAX] eq "PERL-$MAX")
43        ? print "ok $N - $desc\n"
44        : print "not ok $N - $desc\n";
45    $N++;
46
47    $desc = "got expected amount of records in file";
48    my $n_recs = @array;
49    ($n_recs == $MAX + 1)
50        ? print "ok $N - $desc\n"
51        : print "not ok $N - $desc\n";
52    $N++;
53
54    my $chop = 2;
55    $#array -= $chop;
56    $desc = "chop records off end of file";
57    $n_recs = @array;
58    ($n_recs == $MAX + 1 - $chop)
59        ? print "ok $N - $desc\n"
60        : print "not ok $N - $desc\n";
61    $N++;
62
63    $desc = "replace PERL with Perl everywhere in the file";
64for (@array) { s/PERL/Perl/g; }
65my $exp = "Perl-" . ($MAX - 2);
66($array[-1] eq $exp)
67    ? print "ok $N - $desc\n"
68    : print "not ok $N - $desc\n";
69$N++;
70
71# push @array, new recs...;
72# my $r1 = pop @array;
73# unshift @array, new recs...;
74# my $r2 = shift @array;
75# @old_recs = splice @array, 3, 7, new recs...;
76# Demonstrate that the tied file has changed in the way we expect
77
78$desc = "push new records onto end of file";
79my @end_recs = (qw| alpha beta gamma |);
80push @array, @end_recs;
81$n_recs = @array;
82($n_recs == $MAX + 1 - $chop + @end_recs)
83    ? print "ok $N - $desc\n"
84    : print "not ok $N - $desc\n";
85$N++;
86
87$desc = "last element in array corresponds to last line of file";
88($array[-1] eq $end_recs[-1])
89    ? print "ok $N - $desc\n"
90    : print "not ok $N - $desc\n";
91$N++;
92
93$desc = "pop last record off";
94my $r1 = pop @array;
95($array[-1] eq $end_recs[-2])
96    ? print "ok $N - $desc\n"
97    : print "not ok $N - $desc\n";
98$N++;
99
100$desc = "unshift new records onto beginning of file";
101my @start_recs = (qw| albemarle beverly cortelyou |);
102unshift @array, @start_recs;
103$n_recs = @array;
104$exp = $MAX + 1 - $chop + @end_recs - 1 + @start_recs;
105($n_recs == $exp)
106    ? print "ok $N - $desc\n"
107    : print "not ok $N - $desc\n";
108$N++;
109
110$desc = "first element in array corresponds to first line of file";
111($array[0] eq $start_recs[0])
112    ? print "ok $N - $desc\n"
113    : print "not ok $N - $desc\n";
114$N++;
115
116$desc = "shift one record off beginning of file";
117my $r2 = shift @array;
118$n_recs = @array;
119$exp = $MAX + 1 - $chop + @end_recs - 1 + @start_recs - 1;
120($n_recs == $exp)
121    ? print "ok $N - $desc\n"
122    : print "not ok $N - $desc\n";
123$N++;
124
125$desc = "new first element in array";
126($array[0] eq $start_recs[1])
127    ? print "ok $N - $desc\n"
128    : print "not ok $N - $desc\n";
129$N++;
130
131my @splice_in = (qw| delta epsilon zeta eta theta |);
132my $offset = 2;
133my $length = 3;
134$desc = "splice out $length elements and splice in " . @splice_in . " new elements";
135my @old_recs = splice @array, $offset, $length, @splice_in;
136$n_recs = @array;
137$exp = $MAX + 1 - $chop + @end_recs - 1 + @start_recs - 1 - 3 + @splice_in;
138($n_recs == $exp)
139    ? print "ok $N - $desc\n"
140    : print "not ok $N - $desc\n";
141$N++;
142
143$desc = "got expected element";
144($array[6] eq $splice_in[4])
145    ? print "ok $N - $desc\n"
146    : print "not ok $N - $desc\n";
147$N++;
148
149$o = undef;  # destroy Tie::File object holding file open
150# Untie the first file
151my $u = untie @array;
152# TODO: perldoc -f untie does not specify return value for untie
153
154open my $G, "<", $file or die "Unable to open $file for reading: $!";
155open my $H, ">", $dupe or die "Unable to open $dupe for writing: $!";
156while (my $l = <$G>) {
157    chomp $l;
158    print $H "$l\n";
159}
160close $H or die "Unable to close $dupe after writing: $!";
161close $G or die "Unable to close $file after reading: $!";
162
163$desc = 'tie to dupe file';
164my @dupe;
165my $p = tie @dupe, 'Tie::File', $file;
166defined ($p)
167    ? print "ok $N - $desc\n"
168    : print "not ok $N - $desc\n";
169$N++;
170
171$desc = "same number of records in dupe file as in original file";
172my $o_recs = @dupe;
173($o_recs == $n_recs)
174    ? print "ok $N - $desc\n"
175    : print "not ok $N - $desc\n";
176$N++;
177
178$desc = "first element in dupe array corresponds to first line of dupe file";
179($dupe[0] eq $start_recs[1])
180    ? print "ok $N - $desc\n"
181    : print "not ok $N - $desc\n";
182$N++;
183
184$exp = $splice_in[4];
185$desc = "got expected element $exp";
186($dupe[6] eq $exp)
187    ? print "ok $N - $desc\n"
188    : print "not ok $N - $desc\n";
189$N++;
190
191$desc = "last element in dupe array corresponds to last line of dupe file";
192($dupe[-1] eq $end_recs[-2])
193    ? print "ok $N - $desc\n"
194    : print "not ok $N - $desc\n";
195$N++;
196
197END {
198    undef $o;
199    undef $p;
200    untie @array;
201    untie @dupe;
202    1 while unlink $file;
203    1 while unlink $dupe;
204}
205
206