[perl5.git] / dist / Tie-File / t / 30_defer.t

#!/usr/bin/perl
#
# Check ->defer and ->flush methods
#
# This is the old version, which you used in the past when
# there was a defer buffer separate from the read cache.  
# There isn't any longer.
#

use POSIX 'SEEK_SET';
my $file = "tf$$.txt";
$: = Tie::File::_default_recsep();
my $data = "rec0$:rec1$:rec2$:";
my ($o, $n);

print "1..79\n";

my $N = 1;
use Tie::File;
print "ok $N\n"; $N++;

open F, "> $file" or die $!;
binmode F;
print F $data;
close F;
$o = tie @a, 'Tie::File', $file;
print $o ? "ok $N\n" : "not ok $N\n";
$N++;

# (3-6) Deferred storage
$o->defer;
$a[3] = "rec3";
check_contents($data);          # nothing written yet
$a[4] = "rec4";
check_contents($data);          # nothing written yet

# (7-8) Flush
$o->flush;
check_contents($data . "rec3$:rec4$:");          # now it's written

# (9-12) Deferred writing disabled?
$a[3] = "rec9";
check_contents("${data}rec9$:rec4$:");
$a[4] = "rec8";
check_contents("${data}rec9$:rec8$:");

# (13-18) Now let's try two batches of records
$#a = 2;
$o->defer;
$a[0] = "record0";
check_contents($data);          # nothing written yet
$a[2] = "record2";
check_contents($data);          # nothing written yet
$o->flush;
check_contents("record0$:rec1$:record2$:");

# (19-22) Deferred writing past the end of the file
$o->defer;
$a[4] = "record4";
check_contents("record0$:rec1$:record2$:");
$o->flush;
check_contents("record0$:rec1$:record2$:$:record4$:");


# (23-26) Now two long batches
$o->defer;
for (0..2, 4..6) {
  $a[$_] = "r$_";
}
check_contents("record0$:rec1$:record2$:$:record4$:");
$o->flush;
check_contents(join $:, "r0".."r2", "", "r4".."r6", "");

# (27-30) Now let's make sure that discarded writes are really discarded
# We have a 2Mib buffer here, so we can be sure that we aren't accidentally
# filling it up
$o->defer;
for (0, 3, 7) {
  $a[$_] = "discarded$_";
}
check_contents(join $:, "r0".."r2", "", "r4".."r6", "");
$o->discard;
check_contents(join $:, "r0".."r2", "", "r4".."r6", "");

################################################################
#
# Now we're going to test the results of a small memory limit
#
# 
undef $o;  untie @a;
$data = join "$:", map("record$_", 0..7), "";  # records are 8 or 9 bytes long
open F, "> $file" or die $!;
binmode F;
print F $data;
close F;

# Limit cache+buffer size to 47 bytes 
my $MAX = 47;
#  -- that's enough space for 5 records, but not 6, on both \n and \r\n systems
my $BUF = 20;
#  -- that's enough space for 2 records, but not 3, on both \n and \r\n systems
$o = tie @a, 'Tie::File', $file, memory => $MAX, dw_size => $BUF;
print $o ? "ok $N\n" : "not ok $N\n";
$N++;

# (31-32) Fill up the read cache
my @z;
@z = @a;                        
# the cache now contains records 3,4,5,6,7.
check_caches({map(($_ => "record$_$:"), 3..7)}, 
             {});

# (33-44) See if overloading the defer starts by flushing the read cache
# and then flushes out the defer
$o->defer;
$a[0] = "recordA";              # That should flush record 3 from the cache
check_caches({map(($_ => "record$_$:"), 4..7)}, 
             {0 => "recordA$:"});
check_contents($data);

$a[1] = "recordB";              # That should flush record 4 from the cache
check_caches({map(($_ => "record$_$:"), 5..7)}, 
             {0 => "recordA$:",
              1 => "recordB$:"});
check_contents($data);

$a[2] = "recordC";              # That should flush the whole darn defer
# This shouldn't change the cache contents
check_caches({map(($_ => "record$_$:"), 5..7)}, 
             {});               # URRRP
check_contents(join("$:", qw(recordA recordB recordC 
                             record3 record4 record5 record6 record7)) . "$:");

$a[3] = "recordD";         # even though we flushed, deferring is STILL ENABLED
check_caches({map(($_ => "record$_$:"), 5..7)},
             {3 => "recordD$:"}); 
check_contents(join("$:", qw(recordA recordB recordC 
                             record3 record4 record5 record6 record7)) . "$:");

# Check readcache-deferbuffer interactions

# (45-47) This should remove outdated data from the read cache
$a[5] = "recordE";
check_caches({6 => "record6$:", 7 => "record7$:"},
             {3 => "recordD$:", 5 => "recordE$:"}); 
check_contents(join("$:", qw(recordA recordB recordC 
                             record3 record4 record5 record6 record7)) . "$:");

# (48-51) This should read back out of the defer buffer
# without adding anything to the read cache
my $z;
$z = $a[5];
print $z eq "recordE" ? "ok $N\n" : "not ok $N\n";  $N++;
check_caches({6 => "record6$:", 7 => "record7$:"},
             {3 => "recordD$:", 5 => "recordE$:"}); 
check_contents(join("$:", qw(recordA recordB recordC 
                             record3 record4 record5 record6 record7)) . "$:");

# (52-55) This should repopulate the read cache with a new record
$z = $a[0];
print $z eq "recordA" ? "ok $N\n" : "not ok $N\n";  $N++;
check_caches({0 => "recordA$:", 6 => "record6$:", 7 => "record7$:"},
             {3 => "recordD$:", 5 => "recordE$:"}); 
check_contents(join("$:", qw(recordA recordB recordC 
                             record3 record4 record5 record6 record7)) . "$:");

# (56-59) This should flush the LRU record from the read cache
$z = $a[4];
print $z eq "record4" ? "ok $N\n" : "not ok $N\n";  $N++;
check_caches({7 => "record7$:", 0 => "recordA$:", 4 => "record4$:"},
             {3 => "recordD$:", 5 => "recordE$:"}); 
check_contents(join("$:", qw(recordA recordB recordC 
                             record3 record4 record5 record6 record7)) . "$:");

# (60-63) This should FLUSH the deferred buffer
$z = splice @a, 3, 1, "recordZ";
print $z eq "recordD" ? "ok $N\n" : "not ok $N\n";  $N++;
check_caches({7 => "record7$:", 0 => "recordA$:", 4 => "record4$:", 3 => "recordZ$:"},
             {}); 
check_contents(join("$:", qw(recordA recordB recordC 
                             recordZ record4 recordE record6 record7)) . "$:");

# (64-66) We should STILL be in deferred writing mode
$a[5] = "recordX";
check_caches({7 => "record7$:", 0 => "recordA$:", 4 => "record4$:", 3 => "recordZ$:"},
             {5 => "recordX$:"}); 
check_contents(join("$:", qw(recordA recordB recordC 
                             recordZ record4 recordE record6 record7)) . "$:");

# Fill up the defer buffer again
$a[4] = "recordP";
# (67-69) This should OVERWRITE the existing deferred record 
# and NOT flush the buffer
$a[5] = "recordQ";   
check_caches({7 => "record7$:", 0 => "recordA$:", 3 => "recordZ$:"},
             {5 => "recordQ$:", 4 => "recordP$:"}); 
check_contents(join("$:", qw(recordA recordB recordC 
                             recordZ record4 recordE record6 record7)) . "$:");

# (70-72) Discard should just dump the whole deferbuffer
$o->discard;
check_caches({7 => "record7$:", 0 => "recordA$:", 3 => "recordZ$:"},
             {}); 
check_contents(join("$:", qw(recordA recordB recordC 
                             recordZ record4 recordE record6 record7)) . "$:");

# (73-75) NOW we are out of deferred writing mode
$a[0] = "recordF";
check_caches({7 => "record7$:", 0 => "recordF$:", 3 => "recordZ$:"},
             {}); 
check_contents(join("$:", qw(recordF recordB recordC
                             recordZ record4 recordE record6 record7)) . "$:");

# (76-79) Last call--untying the array should flush the deferbuffer
$o->defer;
$a[0] = "flushed";
check_caches({7 => "record7$:",                   3 => "recordZ$:"},
             {0 => "flushed$:" }); 
check_contents(join("$:", qw(recordF recordB recordC
                             recordZ record4 recordE record6 record7)) . "$:");
undef $o;
untie @a;
# (79) We can't use check_contents any more, because the object is dead
open F, "< $file" or die;
binmode F;
{ local $/ ; $z = <F> }
close F;
my $x = join("$:", qw(flushed recordB recordC
                      recordZ record4 recordE record6 record7)) . "$:";
if ($z eq $x) {
  print "ok $N\n";
} else {
  my $msg = ctrlfix("expected <$x>, got <$z>");
  print "not ok $N \# $msg\n";
}
$N++;

################################################################


sub check_caches {
  my ($xcache, $xdefer) = @_;

#  my $integrity = $o->_check_integrity($file, $ENV{INTEGRITY});
#  print $integrity ? "ok $N\n" : "not ok $N\n";
#  $N++;

  my $good = 1;

  # Copy the contents of the cache into a regular hash
  my %cache;
  for my $k ($o->{cache}->ckeys) {
    $cache{$k} = $o->{cache}->_produce($k);
  }

  $good &&= hash_equal(\%cache, $xcache, "true cache", "expected cache");
  $good &&= hash_equal($o->{deferred}, $xdefer, "true defer", "expected defer");
  print $good ? "ok $N\n" : "not ok $N\n";
  $N++;
}

sub hash_equal {
  my ($a, $b, $ha, $hb) = @_;
  $ha = 'first hash'  unless defined $ha;
  $hb = 'second hash' unless defined $hb;

  my $good = 1;
  my %b_seen;

  for my $k (keys %$a) {
    if (! exists $b->{$k}) {
      print ctrlfix("# Key $k is in $ha but not $hb"), "\n";
      $good = 0;
    } elsif ($b->{$k} ne $a->{$k}) {
      print ctrlfix("# Key $k is <$a->{$k}> in $ha but <$b->{$k}> in $hb"), "\n";
      $b_seen{$k} = 1;
      $good = 0;
    } else {
      $b_seen{$k} = 1;
    }
  }

  for my $k (keys %$b) {
    unless ($b_seen{$k}) {
      print ctrlfix("# Key $k is in $hb but not $ha"), "\n";
      $good = 0;
    }
  }

  $good;
}


sub check_contents {
  my $x = shift;

  my $integrity = $o->_check_integrity($file, $ENV{INTEGRITY});
  print $integrity ? "ok $N\n" : "not ok $N\n";
  $N++;

  local *FH = $o->{fh};
  seek FH, 0, SEEK_SET;

  my $a;
  { local $/; $a = <FH> }
  $a = "" unless defined $a;
  if ($a eq $x) {
    print "ok $N\n";
  } else {
    my $msg = ctrlfix("# expected <$x>, got <$a>");
    print "not ok $N\n$msg\n";
  }
  $N++;
}

sub ctrlfix {
  local $_ = shift;
  s/\n/\\n/g;
  s/\r/\\r/g;
  $_;
}

END {
  undef $o;
  untie @a if tied @a;
  1 while unlink $file;
}
Commit	Line	Data
57c7bc08 AMS	1	#!/usr/bin/perl
	2	#
	3	# Check ->defer and ->flush methods
	4	#
6fc0ea7e JH	5	# This is the old version, which you used in the past when
	6	# there was a defer buffer separate from the read cache.
	7	# There isn't any longer.
	8	#
57c7bc08 AMS	9
	10	use POSIX 'SEEK_SET';
	11	my $file = "tf$$.txt";
	12	$: = Tie::File::_default_recsep();
	13	my $data = "rec0$:rec1$:rec2$:";
	14	my ($o, $n);
	15
	16	print "1..79\n";
	17
	18	my $N = 1;
	19	use Tie::File;
	20	print "ok $N\n"; $N++;
	21
	22	open F, "> $file" or die $!;
	23	binmode F;
	24	print F $data;
	25	close F;
	26	$o = tie @a, 'Tie::File', $file;
	27	print $o ? "ok $N\n" : "not ok $N\n";
	28	$N++;
	29
	30	# (3-6) Deferred storage
	31	$o->defer;
	32	$a[3] = "rec3";
	33	check_contents($data); # nothing written yet
	34	$a[4] = "rec4";
	35	check_contents($data); # nothing written yet
	36
	37	# (7-8) Flush
	38	$o->flush;
	39	check_contents($data . "rec3$:rec4$:"); # now it's written
	40
	41	# (9-12) Deferred writing disabled?
	42	$a[3] = "rec9";
	43	check_contents("${data}rec9$:rec4$:");
	44	$a[4] = "rec8";
	45	check_contents("${data}rec9$:rec8$:");
	46
	47	# (13-18) Now let's try two batches of records
	48	$#a = 2;
	49	$o->defer;
	50	$a[0] = "record0";
	51	check_contents($data); # nothing written yet
	52	$a[2] = "record2";
	53	check_contents($data); # nothing written yet
	54	$o->flush;
	55	check_contents("record0$:rec1$:record2$:");
	56
	57	# (19-22) Deferred writing past the end of the file
	58	$o->defer;
	59	$a[4] = "record4";
	60	check_contents("record0$:rec1$:record2$:");
	61	$o->flush;
	62	check_contents("record0$:rec1$:record2$:$:record4$:");
	63
	64
	65	# (23-26) Now two long batches
	66	$o->defer;
	67	for (0..2, 4..6) {
	68	$a[$_] = "r$_";
	69	}
	70	check_contents("record0$:rec1$:record2$:$:record4$:");
	71	$o->flush;
	72	check_contents(join $:, "r0".."r2", "", "r4".."r6", "");
73
74	# (27-30) Now let's make sure that discarded writes are really discarded
75	# We have a 2Mib buffer here, so we can be sure that we aren't accidentally
76	# filling it up
77	$o->defer;
78	for (0, 3, 7) {
79	$a[$_] = "discarded$_";
80	}
81	check_contents(join $:, "r0".."r2", "", "r4".."r6", "");
82	$o->discard;
83	check_contents(join $:, "r0".."r2", "", "r4".."r6", "");
84
85	################################################################
86	#
87	# Now we're going to test the results of a small memory limit
88	#
89	#
90	undef $o; untie @a;
91	$data = join "$:", map("record$_", 0..7), ""; # records are 8 or 9 bytes long
92	open F, "> $file" or die $!;
93	binmode F;
94	print F $data;
95	close F;
96
97	# Limit cache+buffer size to 47 bytes
98	my $MAX = 47;
99	# -- that's enough space for 5 records, but not 6, on both \n and \r\n systems
100	my $BUF = 20;
101	# -- that's enough space for 2 records, but not 3, on both \n and \r\n systems
102	$o = tie @a, 'Tie::File', $file, memory => $MAX, dw_size => $BUF;
103	print $o ? "ok $N\n" : "not ok $N\n";
104	$N++;
105
106	# (31-32) Fill up the read cache
107	my @z;
108	@z = @a;
109	# the cache now contains records 3,4,5,6,7.
110	check_caches({map(($_ => "record$_$:"), 3..7)},
111	{});
112
113	# (33-44) See if overloading the defer starts by flushing the read cache
114	# and then flushes out the defer
115	$o->defer;
116	$a[0] = "recordA"; # That should flush record 3 from the cache
117	check_caches({map(($_ => "record$_$:"), 4..7)},
118	{0 => "recordA$:"});
119	check_contents($data);
120
121	$a[1] = "recordB"; # That should flush record 4 from the cache
122	check_caches({map(($_ => "record$_$:"), 5..7)},
123	{0 => "recordA$:",
124	1 => "recordB$:"});
125	check_contents($data);
126
127	$a[2] = "recordC"; # That should flush the whole darn defer
6ae23f41 JH	128	# This shouldn't change the cache contents
6ae23f41 JH	129	check_caches({map(($_ => "record$_$:"), 5..7)},
57c7bc08 AMS	130	{}); # URRRP
	131	check_contents(join("$:", qw(recordA recordB recordC
	132	record3 record4 record5 record6 record7)) . "$:");
	133
	134	$a[3] = "recordD"; # even though we flushed, deferring is STILL ENABLED
6ae23f41	135	check_caches({map(($_ => "record$_$:"), 5..7)},
57c7bc08 AMS	136	{3 => "recordD$:"});
	137	check_contents(join("$:", qw(recordA recordB recordC
	138	record3 record4 record5 record6 record7)) . "$:");
	139
	140	# Check readcache-deferbuffer interactions
	141
	142	# (45-47) This should remove outdated data from the read cache
6ae23f41 JH	143	$a[5] = "recordE";
	144	check_caches({6 => "record6$:", 7 => "record7$:"},
	145	{3 => "recordD$:", 5 => "recordE$:"});
57c7bc08 AMS	146	check_contents(join("$:", qw(recordA recordB recordC
	147	record3 record4 record5 record6 record7)) . "$:");
	148
6fc0ea7e	149	# (48-51) This should read back out of the defer buffer
57c7bc08 AMS	150	# without adding anything to the read cache
57c7bc08 AMS	151	my $z;
6ae23f41	152	$z = $a[5];
57c7bc08	153	print $z eq "recordE" ? "ok $N\n" : "not ok $N\n"; $N++;
6ae23f41 JH	154	check_caches({6 => "record6$:", 7 => "record7$:"},
6ae23f41 JH	155	{3 => "recordD$:", 5 => "recordE$:"});
57c7bc08 AMS	156	check_contents(join("$:", qw(recordA recordB recordC
	157	record3 record4 record5 record6 record7)) . "$:");
	158
	159	# (52-55) This should repopulate the read cache with a new record
	160	$z = $a[0];
	161	print $z eq "recordA" ? "ok $N\n" : "not ok $N\n"; $N++;
6ae23f41 JH	162	check_caches({0 => "recordA$:", 6 => "record6$:", 7 => "record7$:"},
6ae23f41 JH	163	{3 => "recordD$:", 5 => "recordE$:"});
57c7bc08 AMS	164	check_contents(join("$:", qw(recordA recordB recordC
	165	record3 record4 record5 record6 record7)) . "$:");
	166
	167	# (56-59) This should flush the LRU record from the read cache
6ae23f41 JH	168	$z = $a[4];
	169	print $z eq "record4" ? "ok $N\n" : "not ok $N\n"; $N++;
	170	check_caches({7 => "record7$:", 0 => "recordA$:", 4 => "record4$:"},
	171	{3 => "recordD$:", 5 => "recordE$:"});
57c7bc08 AMS	172	check_contents(join("$:", qw(recordA recordB recordC
	173	record3 record4 record5 record6 record7)) . "$:");
	174
	175	# (60-63) This should FLUSH the deferred buffer
57c7bc08 AMS	176	$z = splice @a, 3, 1, "recordZ";
57c7bc08 AMS	177	print $z eq "recordD" ? "ok $N\n" : "not ok $N\n"; $N++;
6ae23f41	178	check_caches({7 => "record7$:", 0 => "recordA$:", 4 => "record4$:", 3 => "recordZ$:"},
57c7bc08	179	{});
6ae23f41 JH	180	check_contents(join("$:", qw(recordA recordB recordC
6ae23f41 JH	181	recordZ record4 recordE record6 record7)) . "$:");
57c7bc08 AMS	182
	183	# (64-66) We should STILL be in deferred writing mode
	184	$a[5] = "recordX";
6ae23f41	185	check_caches({7 => "record7$:", 0 => "recordA$:", 4 => "record4$:", 3 => "recordZ$:"},
57c7bc08	186	{5 => "recordX$:"});
6ae23f41 JH	187	check_contents(join("$:", qw(recordA recordB recordC
6ae23f41 JH	188	recordZ record4 recordE record6 record7)) . "$:");
57c7bc08 AMS	189
	190	# Fill up the defer buffer again
	191	$a[4] = "recordP";
	192	# (67-69) This should OVERWRITE the existing deferred record
	193	# and NOT flush the buffer
	194	$a[5] = "recordQ";
6ae23f41	195	check_caches({7 => "record7$:", 0 => "recordA$:", 3 => "recordZ$:"},
57c7bc08	196	{5 => "recordQ$:", 4 => "recordP$:"});
6ae23f41 JH	197	check_contents(join("$:", qw(recordA recordB recordC
6ae23f41 JH	198	recordZ record4 recordE record6 record7)) . "$:");
57c7bc08 AMS	199
	200	# (70-72) Discard should just dump the whole deferbuffer
	201	$o->discard;
6ae23f41	202	check_caches({7 => "record7$:", 0 => "recordA$:", 3 => "recordZ$:"},
57c7bc08	203	{});
6ae23f41 JH	204	check_contents(join("$:", qw(recordA recordB recordC
	205	recordZ record4 recordE record6 record7)) . "$:");
	206
57c7bc08 AMS	207	# (73-75) NOW we are out of deferred writing mode
57c7bc08 AMS	208	$a[0] = "recordF";
6ae23f41	209	check_caches({7 => "record7$:", 0 => "recordF$:", 3 => "recordZ$:"},
57c7bc08	210	{});
6ae23f41 JH	211	check_contents(join("$:", qw(recordF recordB recordC
6ae23f41 JH	212	recordZ record4 recordE record6 record7)) . "$:");
57c7bc08 AMS	213
	214	# (76-79) Last call--untying the array should flush the deferbuffer
	215	$o->defer;
	216	$a[0] = "flushed";
6ae23f41	217	check_caches({7 => "record7$:", 3 => "recordZ$:"},
57c7bc08	218	{0 => "flushed$:" });
6ae23f41 JH	219	check_contents(join("$:", qw(recordF recordB recordC
6ae23f41 JH	220	recordZ record4 recordE record6 record7)) . "$:");
57c7bc08 AMS	221	undef $o;
	222	untie @a;
	223	# (79) We can't use check_contents any more, because the object is dead
	224	open F, "< $file" or die;
a4a5e1bc	225	binmode F;
57c7bc08 AMS	226	{ local $/ ; $z = <F> }
57c7bc08 AMS	227	close F;
6ae23f41 JH	228	my $x = join("$:", qw(flushed recordB recordC
6ae23f41 JH	229	recordZ record4 recordE record6 record7)) . "$:";
57c7bc08 AMS	230	if ($z eq $x) {
	231	print "ok $N\n";
	232	} else {
	233	my $msg = ctrlfix("expected <$x>, got <$z>");
	234	print "not ok $N \# $msg\n";
	235	}
	236	$N++;
	237
	238	################################################################
	239
	240
	241	sub check_caches {
	242	my ($xcache, $xdefer) = @_;
	243
	244	# my $integrity = $o->_check_integrity($file, $ENV{INTEGRITY});
	245	# print $integrity ? "ok $N\n" : "not ok $N\n";
	246	# $N++;
	247
	248	my $good = 1;
6fc0ea7e JH	249
	250	# Copy the contents of the cache into a regular hash
	251	my %cache;
bf919750	252	for my $k ($o->{cache}->ckeys) {
6fc0ea7e JH	253	$cache{$k} = $o->{cache}->_produce($k);
	254	}
	255
	256	$good &&= hash_equal(\%cache, $xcache, "true cache", "expected cache");
57c7bc08 AMS	257	$good &&= hash_equal($o->{deferred}, $xdefer, "true defer", "expected defer");
	258	print $good ? "ok $N\n" : "not ok $N\n";
	259	$N++;
	260	}
	261
	262	sub hash_equal {
	263	my ($a, $b, $ha, $hb) = @_;
	264	$ha = 'first hash' unless defined $ha;
	265	$hb = 'second hash' unless defined $hb;
	266
	267	my $good = 1;
	268	my %b_seen;
	269
	270	for my $k (keys %$a) {
	271	if (! exists $b->{$k}) {
	272	print ctrlfix("# Key $k is in $ha but not $hb"), "\n";
	273	$good = 0;
	274	} elsif ($b->{$k} ne $a->{$k}) {
	275	print ctrlfix("# Key $k is <$a->{$k}> in $ha but <$b->{$k}> in $hb"), "\n";
	276	$b_seen{$k} = 1;
	277	$good = 0;
	278	} else {
	279	$b_seen{$k} = 1;
	280	}
	281	}
	282
	283	for my $k (keys %$b) {
	284	unless ($b_seen{$k}) {
	285	print ctrlfix("# Key $k is in $hb but not $ha"), "\n";
	286	$good = 0;
	287	}
	288	}
	289
	290	$good;
	291	}
	292
	293
	294	sub check_contents {
	295	my $x = shift;
	296
	297	my $integrity = $o->_check_integrity($file, $ENV{INTEGRITY});
	298	print $integrity ? "ok $N\n" : "not ok $N\n";
	299	$N++;
	300
	301	local *FH = $o->{fh};
	302	seek FH, 0, SEEK_SET;
	303
	304	my $a;
	305	{ local $/; $a = <FH> }
	306	$a = "" unless defined $a;
	307	if ($a eq $x) {
	308	print "ok $N\n";
	309	} else {
	310	my $msg = ctrlfix("# expected <$x>, got <$a>");
	311	print "not ok $N\n$msg\n";
	312	}
	313	$N++;
	314	}
	315
	316	sub ctrlfix {
	317	local $_ = shift;
	318	s/\n/\\n/g;
	319	s/\r/\\r/g;
	320	$_;
321	}
322
323	END {
6ae23f41 JH	324	undef $o;
6ae23f41 JH	325	untie @a if tied @a;
57c7bc08 AMS	326	1 while unlink $file;
	327	}
	328