[perl5.git] / t / io / open.t

#!./perl

# $RCSfile$    
$|  = 1;
$^W = 1;
$Is_VMS = $^O eq 'VMS';

print "1..66\n";

my $test = 1;

sub ok { print "ok $test\n"; $test++ }

# my $file tests

# 1..9
{
    unlink("afile") if -f "afile";     
    print "$!\nnot " unless open(my $f,"+>afile");
    ok;
    binmode $f;
    print "not " unless -f "afile";     
    ok;
    print "not " unless print $f "SomeData\n";
    ok;
    print "not " unless tell($f) == 9;
    ok;
    print "not " unless seek($f,0,0);
    ok;
    $b = <$f>;
    print "not " unless $b eq "SomeData\n";
    ok;
    print "not " unless -f $f;     
    ok;
    eval  { die "Message" };   
    # warn $@;
    print "not " unless $@ =~ /<\$f> line 1/;
    ok;
    print "not " unless close($f);
    ok;
    unlink("afile");     
}

# 10..12
{
    print "# \$!='$!'\nnot " unless open(my $f,'>', 'afile');
    ok;
    print $f "a row\n";
    print "not " unless close($f);
    ok;
    print "not " unless -s 'afile' < 10;
    ok;
}

# 13..15
{
    print "# \$!='$!'\nnot " unless open(my $f,'>>', 'afile');
    ok;
    print $f "a row\n";
    print "not " unless close($f);
    ok;
    print "not " unless -s 'afile' > 10;
    ok;
}

# 16..18
{
    print "# \$!='$!'\nnot " unless open(my $f, '<', 'afile');
    ok;
    @rows = <$f>;
    print "not " unless @rows == 2;
    ok;
    print "not " unless close($f);
    ok;
}

# 19..23
{
    print "not " unless -s 'afile' < 20;
    ok;
    print "# \$!='$!'\nnot " unless open(my $f, '+<', 'afile');
    ok;
    @rows = <$f>;
    print "not " unless @rows == 2;
    ok;
    seek $f, 0, 1;
    print $f "yet another row\n";
    print "not " unless close($f);
    ok;
    print "not " unless -s 'afile' > 20;
    ok;

    unlink("afile");     
}

# 24..26
if ($Is_VMS) {
    for (24..26) { print "ok $_ # skipped: not Unix fork\n"; $test++;}
}
else {
    print "# \$!='$!'\nnot " unless open(my $f, '-|', <<'EOC');
    ./perl -e "print qq(a row\n); print qq(another row\n)"
EOC
    ok;
    @rows = <$f>;
    print "not " unless @rows == 2;
    ok;
    print "not " unless close($f);
    ok;
}

# 27..30
if ($Is_VMS) {
    for (27..30) { print "ok $_ # skipped: not Unix fork\n"; $test++;}
}
else {
    print "# \$!='$!'\nnot " unless open(my $f, '|-', <<'EOC');
    ./perl -pe "s/^not //"
EOC
    ok;
    @rows = <$f>;
    print $f "not ok $test\n"; $test++;
    print $f "not ok $test\n"; $test++;
    print "#\nnot " unless close($f);
    sleep 1;
    ok;
}

# 31..32
eval <<'EOE' and print "not ";
open my $f, '<&', 'afile';
1;
EOE
ok;
$@ =~ /Unknown open\(\) mode \'<&\'/ or print "not ";
ok;

# local $file tests

# 33..41
{
    unlink("afile") if -f "afile";     
    print "$!\nnot " unless open(local $f,"+>afile");
    ok;
    binmode $f;
    print "not " unless -f "afile";     
    ok;
    print "not " unless print $f "SomeData\n";
    ok;
    print "not " unless tell($f) == 9;
    ok;
    print "not " unless seek($f,0,0);
    ok;
    $b = <$f>;
    print "not " unless $b eq "SomeData\n";
    ok;
    print "not " unless -f $f;     
    ok;
    eval  { die "Message" };   
    # warn $@;
    print "not " unless $@ =~ /<\$f> line 1/;
    ok;
    print "not " unless close($f);
    ok;
    unlink("afile");     
}

# 42..44
{
    print "# \$!='$!'\nnot " unless open(local $f,'>', 'afile');
    ok;
    print $f "a row\n";
    print "not " unless close($f);
    ok;
    print "not " unless -s 'afile' < 10;
    ok;
}

# 45..47
{
    print "# \$!='$!'\nnot " unless open(local $f,'>>', 'afile');
    ok;
    print $f "a row\n";
    print "not " unless close($f);
    ok;
    print "not " unless -s 'afile' > 10;
    ok;
}

# 48..50
{
    print "# \$!='$!'\nnot " unless open(local $f, '<', 'afile');
    ok;
    @rows = <$f>;
    print "not " unless @rows == 2;
    ok;
    print "not " unless close($f);
    ok;
}

# 51..55
{
    print "not " unless -s 'afile' < 20;
    ok;
    print "# \$!='$!'\nnot " unless open(local $f, '+<', 'afile');
    ok;
    @rows = <$f>;
    print "not " unless @rows == 2;
    ok;
    seek $f, 0, 1;
    print $f "yet another row\n";
    print "not " unless close($f);
    ok;
    print "not " unless -s 'afile' > 20;
    ok;

    unlink("afile");     
}

# 56..58
if ($Is_VMS) {
    for (56..58) { print "ok $_ # skipped: not Unix fork\n"; $test++;}
}
else {
    print "# \$!='$!'\nnot " unless open(local $f, '-|', <<'EOC');
    ./perl -e "print qq(a row\n); print qq(another row\n)"
EOC
    ok;
    @rows = <$f>;
    print "not " unless @rows == 2;
    ok;
    print "not " unless close($f);
    ok;
}

# 59..62
if ($Is_VMS) {
    for (59..62) { print "ok $_ # skipped: not Unix fork\n"; $test++;}
}
else {
    print "# \$!='$!'\nnot " unless open(local $f, '|-', <<'EOC');
    ./perl -pe "s/^not //"
EOC
    ok;
    @rows = <$f>;
    print $f "not ok $test\n"; $test++;
    print $f "not ok $test\n"; $test++;
    print "#\nnot " unless close($f);
    sleep 1;
    ok;
}

# 63..64
eval <<'EOE' and print "not ";
open local $f, '<&', 'afile';
1;
EOE
ok;
$@ =~ /Unknown open\(\) mode \'<&\'/ or print "not ";
ok;

# 65..66
{
    local *F;
    for (1..2) {
        open(F, "echo #foo|") or print "not ";
	print <F>;
	close F;
    }
    ok;
    for (1..2) {
	open(F, "-|", "echo #foo") or print "not ";
	print <F>;
	close F;
    }
    ok;
}
Commit	Line	Data
3eb568f1 NIS	1	#!./perl
	2
	3	# $RCSfile$
853846ea NIS	4	$\| = 1;
853846ea NIS	5	$^W = 1;
821b8a23	6	$Is_VMS = $^O eq 'VMS';
3eb568f1	7
faecd977	8	print "1..66\n";
2c8ac474 GS	9
	10	my $test = 1;
	11
	12	sub ok { print "ok $test\n"; $test++ }
3eb568f1	13
853846ea NIS	14	# my $file tests
853846ea NIS	15
2c8ac474	16	# 1..9
6170680b	17	{
2c8ac474 GS	18	unlink("afile") if -f "afile";
	19	print "$!\nnot " unless open(my $f,"+>afile");
	20	ok;
	21	binmode $f;
	22	print "not " unless -f "afile";
	23	ok;
	24	print "not " unless print $f "SomeData\n";
	25	ok;
	26	print "not " unless tell($f) == 9;
	27	ok;
	28	print "not " unless seek($f,0,0);
	29	ok;
	30	$b = <$f>;
	31	print "not " unless $b eq "SomeData\n";
	32	ok;
	33	print "not " unless -f $f;
	34	ok;
	35	eval { die "Message" };
	36	# warn $@;
	37	print "not " unless $@ =~ /<\$f> line 1/;
	38	ok;
	39	print "not " unless close($f);
	40	ok;
	41	unlink("afile");
6170680b	42	}
2c8ac474 GS	43
2c8ac474 GS	44	# 10..12
6170680b	45	{
2c8ac474 GS	46	print "# \$!='$!'\nnot " unless open(my $f,'>', 'afile');
	47	ok;
	48	print $f "a row\n";
	49	print "not " unless close($f);
	50	ok;
	51	print "not " unless -s 'afile' < 10;
	52	ok;
6170680b	53	}
2c8ac474 GS	54
2c8ac474 GS	55	# 13..15
6170680b	56	{
2c8ac474 GS	57	print "# \$!='$!'\nnot " unless open(my $f,'>>', 'afile');
	58	ok;
	59	print $f "a row\n";
	60	print "not " unless close($f);
	61	ok;
	62	print "not " unless -s 'afile' > 10;
	63	ok;
6170680b	64	}
2c8ac474 GS	65
2c8ac474 GS	66	# 16..18
6170680b	67	{
2c8ac474 GS	68	print "# \$!='$!'\nnot " unless open(my $f, '<', 'afile');
	69	ok;
	70	@rows = <$f>;
	71	print "not " unless @rows == 2;
	72	ok;
	73	print "not " unless close($f);
	74	ok;
6170680b	75	}
2c8ac474 GS	76
2c8ac474 GS	77	# 19..23
6170680b	78	{
2c8ac474 GS	79	print "not " unless -s 'afile' < 20;
	80	ok;
	81	print "# \$!='$!'\nnot " unless open(my $f, '+<', 'afile');
	82	ok;
	83	@rows = <$f>;
	84	print "not " unless @rows == 2;
	85	ok;
	86	seek $f, 0, 1;
	87	print $f "yet another row\n";
	88	print "not " unless close($f);
	89	ok;
	90	print "not " unless -s 'afile' > 20;
	91	ok;
	92
	93	unlink("afile");
	94	}
	95
	96	# 24..26
	97	if ($Is_VMS) {
f0963acb	98	for (24..26) { print "ok $_ # skipped: not Unix fork\n"; $test++;}
2c8ac474	99	}
821b8a23	100	else {
2c8ac474 GS	101	print "# \$!='$!'\nnot " unless open(my $f, '-\|', <<'EOC');
2c8ac474 GS	102	./perl -e "print qq(a row\n); print qq(another row\n)"
6170680b	103	EOC
2c8ac474 GS	104	ok;
	105	@rows = <$f>;
	106	print "not " unless @rows == 2;
	107	ok;
	108	print "not " unless close($f);
	109	ok;
	110	}
	111
	112	# 27..30
	113	if ($Is_VMS) {
f0963acb	114	for (27..30) { print "ok $_ # skipped: not Unix fork\n"; $test++;}
2c8ac474	115	}
821b8a23	116	else {
2c8ac474 GS	117	print "# \$!='$!'\nnot " unless open(my $f, '\|-', <<'EOC');
2c8ac474 GS	118	./perl -pe "s/^not //"
6170680b	119	EOC
2c8ac474 GS	120	ok;
	121	@rows = <$f>;
	122	print $f "not ok $test\n"; $test++;
	123	print $f "not ok $test\n"; $test++;
	124	print "#\nnot " unless close($f);
	125	sleep 1;
	126	ok;
6170680b	127	}
3eb568f1	128
2c8ac474	129	# 31..32
6170680b IZ	130	eval <<'EOE' and print "not ";
	131	open my $f, '<&', 'afile';
	132	1;
	133	EOE
2c8ac474 GS	134	ok;
	135	$@ =~ /Unknown open\(\) mode \'<&\'/ or print "not ";
	136	ok;
	137
	138	# local $file tests
	139
	140	# 33..41
	141	{
	142	unlink("afile") if -f "afile";
	143	print "$!\nnot " unless open(local $f,"+>afile");
	144	ok;
	145	binmode $f;
	146	print "not " unless -f "afile";
	147	ok;
	148	print "not " unless print $f "SomeData\n";
	149	ok;
	150	print "not " unless tell($f) == 9;
	151	ok;
	152	print "not " unless seek($f,0,0);
	153	ok;
	154	$b = <$f>;
	155	print "not " unless $b eq "SomeData\n";
	156	ok;
	157	print "not " unless -f $f;
	158	ok;
	159	eval { die "Message" };
	160	# warn $@;
	161	print "not " unless $@ =~ /<\$f> line 1/;
	162	ok;
	163	print "not " unless close($f);
	164	ok;
	165	unlink("afile");
	166	}
	167
	168	# 42..44
	169	{
	170	print "# \$!='$!'\nnot " unless open(local $f,'>', 'afile');
	171	ok;
	172	print $f "a row\n";
	173	print "not " unless close($f);
	174	ok;
	175	print "not " unless -s 'afile' < 10;
	176	ok;
	177	}
	178
	179	# 45..47
	180	{
	181	print "# \$!='$!'\nnot " unless open(local $f,'>>', 'afile');
	182	ok;
	183	print $f "a row\n";
	184	print "not " unless close($f);
	185	ok;
	186	print "not " unless -s 'afile' > 10;
	187	ok;
	188	}
	189
	190	# 48..50
	191	{
	192	print "# \$!='$!'\nnot " unless open(local $f, '<', 'afile');
	193	ok;
	194	@rows = <$f>;
	195	print "not " unless @rows == 2;
	196	ok;
	197	print "not " unless close($f);
198	ok;
199	}
200
201	# 51..55
202	{
203	print "not " unless -s 'afile' < 20;
204	ok;
205	print "# \$!='$!'\nnot " unless open(local $f, '+<', 'afile');
206	ok;
207	@rows = <$f>;
208	print "not " unless @rows == 2;
209	ok;
210	seek $f, 0, 1;
211	print $f "yet another row\n";
212	print "not " unless close($f);
213	ok;
214	print "not " unless -s 'afile' > 20;
215	ok;
216
217	unlink("afile");
218	}
219
220	# 56..58
221	if ($Is_VMS) {
f0963acb	222	for (56..58) { print "ok $_ # skipped: not Unix fork\n"; $test++;}
2c8ac474 GS	223	}
	224	else {
	225	print "# \$!='$!'\nnot " unless open(local $f, '-\|', <<'EOC');
	226	./perl -e "print qq(a row\n); print qq(another row\n)"
	227	EOC
	228	ok;
	229	@rows = <$f>;
	230	print "not " unless @rows == 2;
	231	ok;
	232	print "not " unless close($f);
	233	ok;
	234	}
	235
	236	# 59..62
	237	if ($Is_VMS) {
f0963acb	238	for (59..62) { print "ok $_ # skipped: not Unix fork\n"; $test++;}
2c8ac474 GS	239	}
	240	else {
	241	print "# \$!='$!'\nnot " unless open(local $f, '\|-', <<'EOC');
	242	./perl -pe "s/^not //"
	243	EOC
	244	ok;
	245	@rows = <$f>;
	246	print $f "not ok $test\n"; $test++;
	247	print $f "not ok $test\n"; $test++;
	248	print "#\nnot " unless close($f);
	249	sleep 1;
	250	ok;
	251	}
	252
	253	# 63..64
	254	eval <<'EOE' and print "not ";
	255	open local $f, '<&', 'afile';
	256	1;
	257	EOE
	258	ok;
6170680b	259	$@ =~ /Unknown open\(\) mode \'<&\'/ or print "not ";
2c8ac474	260	ok;
faecd977 GS	261
	262	# 65..66
	263	{
	264	local *F;
ed2efe3e GS	265	for (1..2) {
	266	open(F, "echo #foo\|") or print "not ";
	267	print <F>;
	268	close F;
	269	}
	270	ok;
	271	for (1..2) {
	272	open(F, "-\|", "echo #foo") or print "not ";
	273	print <F>;
	274	close F;
	275	}
faecd977 GS	276	ok;
faecd977 GS	277	}