Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
argv.t	3.92 KB	-r--r--r--	2014-12-27 11:49
binmode.t	1.02 KB	-r--r--r--	2014-12-27 11:49
bom.t	329 B	-r--r--r--	2014-12-27 11:49
closepid.t	1.26 KB	-r--r--r--	2014-12-27 11:49
crlf.t	2.45 KB	-r--r--r--	2014-12-27 11:49
crlf_through.t	152 B	-r--r--r--	2014-12-27 11:49
data.t	1.5 KB	-r--r--r--	2014-12-27 11:49
defout.t	1.09 KB	-r--r--r--	2014-12-27 11:49
dup.t	3.09 KB	-r--r--r--	2014-12-27 11:49
eintr.t	3.65 KB	-r--r--r--	2015-01-12 20:14
eintr_print.t	2.48 KB	-r--r--r--	2014-12-27 11:49
errno.t	1.12 KB	-r--r--r--	2014-12-27 11:49
errnosig.t	746 B	-r--r--r--	2014-12-27 11:49
fflush.t	3.25 KB	-r--r--r--	2014-12-27 11:49
fs.t	12.97 KB	-r--r--r--	2014-12-27 11:49
inplace.t	1.83 KB	-r--r--r--	2014-12-27 11:49
iofile.t	644 B	-r--r--r--	2014-12-27 11:49
iprefix.t	707 B	-r--r--r--	2014-12-27 11:49
layers.t	6.37 KB	-r--r--r--	2014-12-27 11:49
nargv.t	1.16 KB	-r--r--r--	2014-12-27 11:49
open.t	14.56 KB	-r--r--r--	2014-12-27 11:49
openpid.t	2.39 KB	-r--r--r--	2014-12-27 11:49
perlio.t	5.73 KB	-r--r--r--	2014-12-27 11:49
perlio_fail.t	1.06 KB	-r--r--r--	2014-12-27 11:49
perlio_leaks.t	675 B	-r--r--r--	2014-12-27 11:49
perlio_open.t	756 B	-r--r--r--	2014-12-27 11:49
pipe.t	5.9 KB	-r--r--r--	2014-12-27 11:49
print.t	1.41 KB	-r--r--r--	2014-12-27 11:49
pvbm.t	2.39 KB	-r--r--r--	2014-12-27 11:49
read.t	523 B	-r--r--r--	2014-12-27 11:49
say.t	1.05 KB	-r--r--r--	2014-12-27 11:49
sem.t	1.78 KB	-r--r--r--	2014-12-27 11:49
shm.t	2.56 KB	-r--r--r--	2014-12-27 11:49
socket.t	3.51 KB	-r--r--r--	2014-12-27 11:49
tell.t	4.94 KB	-r--r--r--	2014-12-27 11:49
through.t	4.52 KB	-r--r--r--	2014-12-27 11:49
utf8.t	9.28 KB	-r--r--r--	2014-12-27 11:49

Rename

BEGIN {
	chdir 't' if -d 't';
	@INC = '../lib';
	require Config; import Config;
	require './test.pl';
	skip_all_without_perlio();
}

plan tests => 46;

use_ok('PerlIO');

my $txt = "txt$$";
my $bin = "bin$$";
my $utf = "utf$$";
my $nonexistent = "nex$$";

my $txtfh;
my $binfh;
my $utffh;

ok(open($txtfh, ">:crlf", $txt));

ok(open($binfh, ">:raw",  $bin));

ok(open($utffh, ">:utf8", $utf));

print $txtfh "foo\n";
print $txtfh "bar\n";

ok(close($txtfh));

print $binfh "foo\n";
print $binfh "bar\n";

ok(close($binfh));

print $utffh "foo\x{ff}\n";
print $utffh "bar\x{abcd}\n";

ok(close($utffh));

ok(open($txtfh, "<:crlf", $txt));

ok(open($binfh, "<:raw",  $bin));

ok(open($utffh, "<:utf8", $utf));

is(scalar <$txtfh>, "foo\n");
is(scalar <$txtfh>, "bar\n");

is(scalar <$binfh>, "foo\n");
is(scalar <$binfh>, "bar\n");

is(scalar <$utffh>,  "foo\x{ff}\n");
is(scalar <$utffh>, "bar\x{abcd}\n");

ok(eof($txtfh));;

ok(eof($binfh));

ok(eof($utffh));

ok(close($txtfh));

ok(close($binfh));

ok(close($utffh));

# magic temporary file via 3 arg open with undef
{
    ok( open(my $x,"+<",undef), 'magic temp file via 3 arg open with undef');
    ok( defined fileno($x),     '       fileno' );

select $x;
    ok( (print "ok\n"),         '       print' );

select STDOUT;
    ok( seek($x,0,0),           '       seek' );
    is( scalar <$x>, "ok\n",    '       readline' );
    ok( tell($x) >= 3,          '       tell' );

# test magic temp file over STDOUT
    open OLDOUT, ">&STDOUT" or die "cannot dup STDOUT: $!";
    my $status = open(STDOUT,"+<",undef);
    open STDOUT,  ">&OLDOUT" or die "cannot dup OLDOUT: $!";
    # report after STDOUT is restored
    ok($status, '       re-open STDOUT');
    close OLDOUT;

SKIP: {
      skip("TMPDIR not honored on this platform", 4)
        if !$Config{d_mkstemp}
        || $^O eq 'VMS' || $^O eq 'MSwin32' || $^O eq 'os2';
      local $ENV{TMPDIR} = $nonexistent;

# hardcoded default temp path
      my $perlio_tmp_file_glob = '/tmp/PerlIO_??????';

ok( open(my $x,"+<",undef), 'TMPDIR honored by magic temp file via 3 arg open with undef - works if TMPDIR points to a non-existent dir');

my $filename = find_filename($x, $perlio_tmp_file_glob);
      is($filename, undef, "No tmp files leaked");
      unlink_all $filename if defined $filename;

mkdir $ENV{TMPDIR};
      ok(open(my $x,"+<",undef), 'TMPDIR honored by magic temp file via 3 arg open with undef - works if TMPDIR points to an existent dir');

$filename = find_filename($x, $perlio_tmp_file_glob);
      is($filename, undef, "No tmp files leaked");
      unlink_all $filename if defined $filename;
    }
}

sub find_filename {
    my ($fh, @globs) = @_;
    my ($dev, $inode) = stat $fh;
    die "Can't stat $fh: $!" unless defined $dev;

foreach (@globs) {
	foreach my $file (glob $_) {
	    my ($this_dev, $this_inode) = stat $file;
	    next unless defined $this_dev;
	    return $file if $this_dev == $dev && $this_inode == $inode;
	}
    }
    return;
}

# in-memory open
SKIP: {
    eval { require PerlIO::scalar };
    unless (find PerlIO::Layer 'scalar') {
	skip("PerlIO::scalar not found", 11);
    }
    my $var;
    ok( open(my $x,"+<",\$var), 'magic in-memory file via 3 arg open with \\$var');
    ok( defined fileno($x),     '       fileno' );

select $x;
    ok( (print "ok\n"),         '       print' );

select STDOUT;
    ok( seek($x,0,0),           '       seek' );
    is( scalar <$x>, "ok\n",    '       readline' );
    ok( tell($x) >= 3,          '       tell' );

TODO: {
        local $TODO = "broken";

# test in-memory open over STDOUT
        open OLDOUT, ">&STDOUT" or die "cannot dup STDOUT: $!";
        #close STDOUT;
        my $status = open(STDOUT,">",\$var);
        my $error = "$!" unless $status; # remember the error
	close STDOUT unless $status;
        open STDOUT,  ">&OLDOUT" or die "cannot dup OLDOUT: $!";
        print "# $error\n" unless $status;
        # report after STDOUT is restored
        ok($status, '       open STDOUT into in-memory var');

# test in-memory open over STDERR
        open OLDERR, ">&STDERR" or die "cannot dup STDERR: $!";
        #close STDERR;
        ok( open(STDERR,">",\$var), '       open STDERR into in-memory var');
        open STDERR,  ">&OLDERR" or die "cannot dup OLDERR: $!";
    }

{ local $TODO = 'fails well back into 5.8.x';

sub read_fh_and_return_final_rv {
	my ($fh) = @_;
	my $buf = '';
	my $rv;
	for (1..3) {
		$rv = read($fh, $buf, 1, length($buf));
		next if $rv;
	}
	return $rv
      }

open(my $no_perlio, '<', \'ab') or die; 
      open(my $perlio, '<:crlf', \'ab') or die;

is(read_fh_and_return_final_rv($perlio),
         read_fh_and_return_final_rv($no_perlio),
        "RT#69332 - perlio should return the same value as nonperlio after EOF");

close ($perlio);
      close ($no_perlio);
    }

{ # [perl #92258]
        open my $fh, "<", \(my $f = *f);
        is join("", <$fh>), '*main::f', 'reading from a glob copy';
        is ref \$f, 'GLOB', 'the glob copy is unaffected';
    }

}

{
    # see RT #75722, RT #96008
    fresh_perl_like(<<'EOP',
unshift @INC, sub {
    return undef unless caller eq "main";
    open my $fh, "<", \1;
    $fh;
};
require Symbol; # doesn't matter whether it exists or not
EOP
		    qr/\ARecursive call to Perl_load_module in PerlIO_find_layer at/s,
		    {stderr => 1},
		    'Mutal recursion between Perl_load_module and PerlIO_find_layer croaks');
}

{
    # RT #119287
    $main::PerlIO_code_injection = 0;
    local $SIG{__WARN__} = sub {};
    PerlIO->import('via; $main::PerlIO_code_injection = 1');
    ok !$main::PerlIO_code_injection, "Can't inject code via PerlIO->import";
}

END {
    unlink_all $txt;
    unlink_all $bin;
    unlink_all $utf;
    rmdir $nonexistent;
}