[perl #87708] $tied + $tied

[perl5.git] / t / op / while_readdir.t

#!./perl

BEGIN {
    chdir 't' if -d 't';
    @INC = '../lib';
    require './test.pl';
}

use strict;
use warnings;

plan 10;

# Need to run this in a quiet private directory as it assumes that it can read
# the contents twice and get the same result.
my $tempdir = tempfile;

mkdir $tempdir, 0700 or die "Can't mkdir '$tempdir': $!";
chdir $tempdir or die die "Can't chdir '$tempdir': $!";

my $cleanup = 1;
my %tempfiles;

END {
    if ($cleanup) {
	foreach my $file (keys %tempfiles) {
	    # We only wrote each of these once so 1 delete should work:
	    if (unlink $file) {
		warn "unlink tempfile '$file' passed but it's still there"
		    if -e $file;
	    } else {
		warn "Couldn't unlink tempfile '$file': $!";
	    }
	}
	chdir '..' or die "Couldn't chdir .. for cleanup: $!";
	rmdir $tempdir or die "Couldn't unlink tempdir '$tempdir': $!";
    }
}

# This is intentionally not random (per run), but intentionally will try to
# give different file names for different people running this test.
srand $< * $];

my @chars = ('A' .. 'Z', 'a' .. 'z', 0 .. 9);

sub make_file {
    my $name = shift;

    return if $tempfiles{$name}++;

    print "# Writing to $name in $tempdir\n";

    open my $fh, '>', $name or die "Can't open '$name' for writing: $!\n";
    print $fh <<'FILE0';
This file is here for testing

while(readdir $dir){...}
... while readdir $dir

etc
FILE0
    close $fh or die "Can't close '$name': $!";
}

sub make_some_files {
    for (1..int rand 10) {
	my $name;
	$name .= $chars[rand $#chars] for 1..int(1 + rand 5);
	make_file($name);
    }
}

make_some_files();
make_file('0');
make_some_files();

ok(-f '0', "'0' file is here");

opendir my $dirhandle, '.'
    or die "Failed test: unable to open directory: $!\n";

my @dir = readdir $dirhandle;
rewinddir $dirhandle;

{
    my @list;
    while(readdir $dirhandle){
	push @list, $_;
    }
    ok( eq_array( \@dir, \@list ), 'while(readdir){push}' );
    rewinddir $dirhandle;
}

{
    my @list;
    push @list, $_ while readdir $dirhandle;
    ok( eq_array( \@dir, \@list ), 'push while readdir' );
    rewinddir $dirhandle;
}

{
    my $tmp;
    my @list;
    push @list, $tmp while $tmp = readdir $dirhandle;
    ok( eq_array( \@dir, \@list ), 'push $dir while $dir = readdir' );
    rewinddir $dirhandle;
}

{
    my @list;
    while( my $dir = readdir $dirhandle){
	push @list, $dir;
    }
    ok( eq_array( \@dir, \@list ), 'while($dir=readdir){push}' );
    rewinddir $dirhandle;
}


{
    my @list;
    my $sub = sub{
	push @list, $_;
    };
    $sub->($_) while readdir $dirhandle;
    ok( eq_array( \@dir, \@list ), '$sub->($_) while readdir' );
    rewinddir $dirhandle;
}

{
    my $works = 0;
    while(readdir $dirhandle){
        $_ =~ s/\.$// if defined $_ && $^O eq 'VMS'; # may have zero-length extension
        if( defined $_ && $_ eq '0'){
            $works = 1;
            last;
        }
    }
    ok( $works, 'while(readdir){} with file named "0"' );
    rewinddir $dirhandle;
}

{
    my $works = 0;
    my $sub = sub{
        $_ =~ s/\.$// if defined $_ && $^O eq 'VMS'; # may have zero-length extension
        if( defined $_ && $_ eq '0' ){
            $works = 1;
        }
    };
    $sub->($_) while readdir $dirhandle;
    ok( $works, '$sub->($_) while readdir; with file named "0"' );
    rewinddir $dirhandle;
}

{
    my $works = 0;
    while( my $dir = readdir $dirhandle ){
        $dir =~ s/\.$// if defined $dir && $^O eq 'VMS'; # may have zero-length extension
        if( defined $dir && $dir eq '0'){
            $works = 1;
            last;
        }
    }
    ok( $works, 'while($dir=readdir){} with file named "0"');
    rewinddir $dirhandle;
}

{
    my $tmp;
    my $ok;
    my @list;
    while( $tmp = readdir $dirhandle ){
        $tmp =~ s/\.$// if defined $tmp && $^O eq 'VMS'; # may have zero-length extension
        last if defined($tmp)&& !$tmp && ($ok=1) 
    }
    ok( $ok, '$dir while $dir = readdir; with file named "0"'  );
    rewinddir $dirhandle;
}

closedir $dirhandle;