#!./perl

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

use strict;
use warnings;
use Test::More;
use Config qw( %Config );

my $file;

BEGIN {
    # Check whether the build is configured with -Dmksymlinks
    our $Dmksymlinks =
        grep { /^config_arg\d+$/ && $Config{$_} eq '-Dmksymlinks' }
        keys %Config;

    # Resolve symlink to ./lib/File/stat.t if this build is configured
    # with -Dmksymlinks
    # Originally we worked with ./TEST, but other test scripts read from
    # that file and modify its access time.
    $file = '../lib/File/stat.t';
    if ( $Dmksymlinks ) {
        $file = readlink $file;
        die "Can't readlink(../lib/File/stat.t): $!" if ! defined $file;
    }
}

# Originally this was done in the BEGIN block, but perl is still
# compiling (and hence reading) the script at that point, which can
# change the file's access time, causing a different in the comparison
# tests if the clock ticked over the second between the stat() and the
# final read.
# At this point all of the reading is done.
our @stat = stat $file; # This is the function stat.
unless (@stat) { plan skip_all => "1..0 # Skip: no file $file"; exit 0 }

require File::stat;

my $stat = File::stat::stat( $file ); # This is the OO stat.
isa_ok($stat, 'File::stat', 'should build a stat object' );

my $i = 0;
foreach ([dev => 'device number'],
         [ino => 'inode number'],
         [mode => 'file mode'],
         [nlink => 'number of links'],
         [uid => 'owner uid'],
         [gid => 'group id'],
         [rdev => 'device identifier'],
         [size => 'file size'],
         [atime => 'last access time'],
         [mtime => 'last modify time'],
         [ctime => 'change time'],
         [blksize => 'IO block size'],
         [blocks => 'number of blocks']) {
    my ($meth, $desc) = @$_;
    # On OS/2 (fake) ino is not constant, it is incremented each time
 SKIP: {
        skip('inode number is not constant on OS/2', 1)
            if $i == 1 && $^O eq 'os2';
        is($stat->$meth, $stat[$i], "$desc in position $i");
    }
    ++$i;
}

for my $op (split //, "rwxoRWXOezsfdlpSbcugkMCA") {
    for my $access ('', 'use filetest "access";') {
        my ($warnings, $awarn, $vwarn, $rv);
        my $desc = $access 
            ? "for -$op under use filetest 'access'" : "for -$op";
        {
            local $SIG{__WARN__} = sub {
                my $w = shift;
                if ($w =~ /^File::stat ignores VMS ACLs/) {
                    ++$vwarn;
                } elsif ($w =~ /^File::stat ignores use filetest 'access'/) {
                    ++$awarn;
                } else {
                    $warnings .= $w;
                }
            };
            $rv = eval "$access; -$op \$stat";
        }
        is($@, '', "Overload succeeds $desc");

        if ($^O eq "VMS" && $op =~ /[rwxRWX]/) {
            is($vwarn, 1, "warning about VMS ACLs $desc");
        } else {
            is($rv, eval "-$op \$file", "correct overload $desc")
                unless $access;
            is($vwarn, undef, "no warnings about VMS ACLs $desc");
        }

        # 111640 - File::stat bogus index check in overload
        if ($access && $op =~ /[rwxRXW]/) {
            # these should all warn with filetest access
            is($awarn, 1,
               "produced the right warning $desc");
        } else {
            # -d and others shouldn't warn
            is($awarn, undef, "should be no warning $desc")
        }

        is($warnings, undef, "no other warnings seen $desc");
    }
}

SKIP: {
    my $file = '../perl';
    -e $file && -x $file or skip "$file is not present and executable", 4;
    $^O eq "VMS" and skip "File::stat ignores VMS ACLs", 4;

    my $stat = File::stat::stat( $file ); # This is the OO stat.
    foreach (qw/x X/) {
    my $rv = eval "-$_ \$stat";
    ok( !$@,                            "-$_ overload succeeds" )
      or diag( $@ );
    is( $rv, eval "-$_ \$file",         "correct -$_ overload" );
  }
}


for (split //, "tTB") {
    eval "-$_ \$stat";
    like( $@, qr/\Q-$_ is not implemented/, "-$_ overload fails" );
}

SKIP: {
	local *STAT;
	skip("Could not open file: $!", 2) unless open(STAT, $file);
	ok( File::stat::stat('STAT'), '... should be able to find filehandle' );

	package foo;
	local *STAT = *main::STAT;
	main::ok( my $stat2 = File::stat::stat('STAT'), 
		'... and filehandle in another package' );
	close STAT;

#	VOS open() updates atime; ignore this error (posix-975).
	my $stat3 = $stat2;
	if ($^O eq 'vos') {
		$$stat3[8] = $$stat[8];
	}

	main::skip("Win32: different stat-info on filehandle", 1) if $^O eq 'MSWin32';
	main::skip("dos: inode number is fake on dos", 1) if $^O eq 'dos';

	main::skip("OS/2: inode number is not constant on os/2", 1) if $^O eq 'os2';

	main::is( "@$stat", "@$stat3", '... and must match normal stat' );
}

SKIP:
{   # RT #111638
    skip "We can't check for FIFOs", 2 unless defined &Fcntl::S_ISFIFO;
    skip "No pipes", 2 unless defined $Config{d_pipe};
    pipe my ($rh, $wh)
      or skip "Couldn't create a pipe: $!", 2;
    skip "Built-in -p doesn't detect a pipe", 2 unless -p $rh;

    my $pstat = File::stat::stat($rh);
    ok(!-p($stat), "-p should be false on a file");
    ok(-p($pstat), "check -p detects a pipe");
}

local $!;
$stat = stat '/notafile';
isnt( $!, '', 'should populate $!, given invalid file' );

# Testing pretty much anything else is unportable.

done_testing;

# Local variables:
# cperl-indent-level: 4
# indent-tabs-mode: nil
# End:
#
# ex: set ts=8 sts=4 sw=4 et: