Import Upstream version 0.14
This commit is contained in:
denghao
commit
bbff9832e6
|
|
@ -0,0 +1,33 @@
|
|||
0.14 - Add metadata to Makefile.PL.
|
||||
- Define PERL_NO_GET_CONTEXT
|
||||
|
||||
0.13 - Apply patch from Xavier Guimard. (Ticket 80607)
|
||||
|
||||
0.12 - Apply patch from Diab Jerius. (Ticket #79983)
|
||||
|
||||
0.11 - Add copyright notice to the LICENSE section of the pod.
|
||||
|
||||
0.10 - Add is_FH() - which is just a (more intuitively named) alias for
|
||||
is_arg_ok().
|
||||
Various minor adjustments to enable trouble-free building on pre-5.6.
|
||||
|
||||
0.09 - Correct error that prevents the module from building on perl 5.6.0.
|
||||
|
||||
0.08 - Add is_A() function.
|
||||
Rewrite internal functions to reduce (but not completely eradicate) repetition.
|
||||
|
||||
0.05 - (Hopefully) fix problems with Solaris and some other operating
|
||||
systems re testing for readability.
|
||||
|
||||
0.04 - Can now handle filehandles connected to memory objects.
|
||||
|
||||
0.03 - Rewrite the existing functions so that they die if:
|
||||
1) the received argument is not an open filehandle;
|
||||
or
|
||||
2) the received argument is a filehandle connected to a memory object.
|
||||
|
||||
- Add the is_arg_ok() function.
|
||||
|
||||
0.02 - Minor changes for compatibility with pre-5.6 versions of perl, and some tidying up.
|
||||
|
||||
0.01 - ummm ....
|
||||
|
|
@ -0,0 +1,230 @@
|
|||
package FileHandle::Fmode;
|
||||
use Fcntl qw(O_ACCMODE O_RDONLY O_WRONLY O_RDWR O_APPEND F_GETFL);
|
||||
use strict;
|
||||
|
||||
require Exporter;
|
||||
require DynaLoader;
|
||||
|
||||
*is_FH = \&is_arg_ok;
|
||||
|
||||
our $VERSION = '0.14';
|
||||
#$VERSION = eval $VERSION;
|
||||
|
||||
@FileHandle::Fmode::ISA = qw(Exporter DynaLoader);
|
||||
|
||||
@FileHandle::Fmode::EXPORT_OK = qw(is_R is_W is_RO is_WO is_RW is_arg_ok is_A is_FH);
|
||||
|
||||
%FileHandle::Fmode::EXPORT_TAGS = (all => [qw
|
||||
(is_R is_W is_RO is_WO is_RW is_arg_ok is_A is_FH)]);
|
||||
|
||||
bootstrap FileHandle::Fmode $VERSION;
|
||||
|
||||
my $is_win32 = $^O =~ /mswin32/i ? 1 : 0;
|
||||
|
||||
sub is_arg_ok {
|
||||
my $fileno = eval{fileno($_[0])};
|
||||
if($@) {return 0}
|
||||
if(defined($fileno)) {
|
||||
if($fileno == -1) {
|
||||
if($] < 5.007) {return 0}
|
||||
return 1;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub is_RO {
|
||||
my $fileno = fileno($_[0]);
|
||||
if(!defined( $fileno)) {die "Not an open filehandle"}
|
||||
if( $fileno == -1) {
|
||||
if($] < 5.007) {die "Illegal fileno() return"}
|
||||
if(perliol_readable($_[0]) && !perliol_writable($_[0])) {return 1}
|
||||
return 0;
|
||||
}
|
||||
if($is_win32) {
|
||||
if(win32_fmode($_[0]) & 1) {return 1}
|
||||
return 0;
|
||||
}
|
||||
my $fmode = fcntl($_[0], F_GETFL, my $slush = 0);
|
||||
if(defined($fmode) && ($fmode & O_ACCMODE) == O_RDONLY) {return 1}
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub is_WO {
|
||||
my $fileno = fileno($_[0]);
|
||||
if(!defined( $fileno)) {die "Not an open filehandle"}
|
||||
if( $fileno == -1) {
|
||||
if($] < 5.007) {die "Illegal fileno() return"}
|
||||
if(!perliol_readable($_[0]) && perliol_writable($_[0])) {return 1}
|
||||
return 0;
|
||||
}
|
||||
if($is_win32) {
|
||||
if(win32_fmode($_[0]) & 2) {return 1}
|
||||
return 0;
|
||||
}
|
||||
my $fmode = fcntl($_[0], F_GETFL, my $slush = 0);
|
||||
if(defined($fmode) && ($fmode & O_ACCMODE) == O_WRONLY) {return 1}
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub is_W {
|
||||
if(is_WO($_[0]) || is_RW($_[0])) {return 1}
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub is_R {
|
||||
if(is_RO($_[0]) || is_RW($_[0])) {return 1}
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub is_RW {
|
||||
my $fileno = fileno($_[0]);
|
||||
if(!defined( $fileno)) {die "Not an open filehandle"}
|
||||
if( $fileno == -1) {
|
||||
if($] < 5.007) {die "Illegal fileno() return"}
|
||||
if(perliol_readable($_[0]) && perliol_writable($_[0])) {return 1}
|
||||
return 0;
|
||||
}
|
||||
if($is_win32) {
|
||||
if(win32_fmode($_[0]) & 128) {return 1}
|
||||
return 0;
|
||||
}
|
||||
my $fmode = fcntl($_[0], F_GETFL, my $slush = 0);
|
||||
if(defined($fmode) && ($fmode & O_ACCMODE) == O_RDWR) {return 1}
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub is_A {
|
||||
my $fileno = fileno($_[0]);
|
||||
if(!defined( $fileno)) {die "Not an open filehandle"}
|
||||
if( $fileno == -1) {
|
||||
if($] < 5.007) {die "Illegal fileno() return"}
|
||||
return is_appendable($_[0]);
|
||||
}
|
||||
if($is_win32) {
|
||||
if($] < 5.006001) {die "is_A not currently implemented on Win32 for pre-5.6.1 perl"}
|
||||
return is_appendable($_[0]);
|
||||
}
|
||||
my $fmode = fcntl($_[0], F_GETFL, my $slush = 0);
|
||||
if($fmode & O_APPEND) {return 1}
|
||||
return 0;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
|
||||
FileHandle::Fmode - determine whether a filehandle is opened for reading, writing, or both.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
|
||||
use FileHandle::Fmode qw(:all);
|
||||
.
|
||||
.
|
||||
#$fh and FH are open filehandles
|
||||
print is_R($fh), "\n";
|
||||
print is_W(\*FH), "\n";
|
||||
|
||||
=head1 FUNCTIONS
|
||||
|
||||
$bool = is_FH($fh);
|
||||
$bool = is_FH(\*FH);
|
||||
This is just a (more intuitively named) alias for is_arg_ok().
|
||||
Returns 1 if its argument is an open filehandle.
|
||||
Returns 0 if its argument is something other than an open filehandle.
|
||||
|
||||
$bool = is_arg_ok($fh);
|
||||
$bool = is_arg_ok(\*FH);
|
||||
Returns 1 if its argument is an open filehandle.
|
||||
Returns 0 if its argument is something other than an open filehandle.
|
||||
|
||||
Arguments to the following functions must be open filehandles. If
|
||||
any of those functions receive an argument that is not an open
|
||||
filehandle then the function dies with an appropriate error message.
|
||||
To ensure that your script won't suffer such a death, you could first
|
||||
check by passing the argument to is_FH(). Or you could wrap the
|
||||
function call in an eval{} block.
|
||||
|
||||
Note that it may be possible that a filehandle opened for writing may
|
||||
become unwritable - if (eg) the disk becomes full. I don't know how
|
||||
the below functions would be affected by such an event. I suspect
|
||||
that they would be unaware of the change ... but I haven't actually
|
||||
checked.
|
||||
|
||||
$bool = is_R($fh);
|
||||
$bool = is_R(\*FH);
|
||||
Returns true if the filehandle is readable.
|
||||
Else returns false.
|
||||
|
||||
$bool = is_W($fh);
|
||||
$bool = is_W(\*FH);
|
||||
Returns true if the filehandle is writable.
|
||||
Else returns false
|
||||
|
||||
$bool = is_RO($fh);
|
||||
$bool = is_RO(\*FH);
|
||||
Returns true if the filehandle is readable but not writable.
|
||||
Else returns false
|
||||
|
||||
$bool = is_WO($fh);
|
||||
$bool = is_WO(\*FH);
|
||||
Returns true if the filehandle is writable but not readable.
|
||||
Else returns false
|
||||
|
||||
$bool = is_RW($fh);
|
||||
$bool = is_RW(\*FH);
|
||||
Returns true if the filehandle is both readable and writable.
|
||||
Else returns false
|
||||
|
||||
$bool = is_A($fh);
|
||||
$bool = is_A(\*FH);
|
||||
|
||||
Returns true if the filehandle was opened for appending.
|
||||
Else returns false.
|
||||
Not currently implemented on Win32 with pre-5.6.1 versions of perl (and
|
||||
dies with appropriate error message if called on such a platform).
|
||||
|
||||
|
||||
=head1 CREDITS
|
||||
|
||||
|
||||
Inspired (hmmm ... is that the right word ?) by an idea from BrowserUK
|
||||
posted on PerlMonks in response to a question from dragonchild. Win32
|
||||
code (including XS code) provided by BrowserUK. Zaxo presented the idea
|
||||
of using fcntl() in an earlier PerlMonks thread.
|
||||
|
||||
Thanks to dragonchild and BrowserUK for steering this module in
|
||||
the right direction.
|
||||
|
||||
Thanks to attn.steven.kuo for directing me to the perliol routines
|
||||
that enable us to query filehandles attached to memory objects.
|
||||
|
||||
And thanks to Jost Krieger for helping to sort out the test failures that
|
||||
were occurring on Solaris (and some other operating systems too).
|
||||
|
||||
|
||||
=head1 TODO
|
||||
|
||||
I don't know that anyone still runs pre-5.6.1 perl on Win32. However, if
|
||||
someone likes to tell me how is_A() could be made to work on pre-5.6.1
|
||||
Win32 perl, I would be quite happy to implement it.
|
||||
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
|
||||
This program is free software; you may redistribute it and/or
|
||||
modify it under the same terms as Perl itself.
|
||||
Copyright 2006-2008, 2009, 2010, 2012 Sisyphus
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
|
||||
Sisyphus <sisyphus at cpan dot org>
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,121 @@
|
|||
|
||||
#ifdef __MINGW32__
|
||||
#ifndef __USE_MINGW_ANSI_STDIO
|
||||
#define __USE_MINGW_ANSI_STDIO 1
|
||||
#endif
|
||||
#endif
|
||||
|
||||
#define PERL_NO_GET_CONTEXT 1
|
||||
|
||||
#include "EXTERN.h"
|
||||
#include "perl.h"
|
||||
#include "XSUB.h"
|
||||
|
||||
|
||||
SV * win32_fmode(pTHX_ FILE *stream ) {
|
||||
|
||||
#ifdef _WIN32
|
||||
/*
|
||||
* Win32 code supplied by BrowserUK
|
||||
* to work aroumd the MS C runtime library's
|
||||
* lack of a function to retrieve the file mode
|
||||
* used when a file is opened
|
||||
*/
|
||||
return newSViv(stream->_flag);
|
||||
#else
|
||||
croak("win32_fmode function works only with Win32");
|
||||
#endif
|
||||
}
|
||||
|
||||
#ifdef PERL580_OR_LATER
|
||||
|
||||
/*
|
||||
* XS code to deal with filehandles
|
||||
* attached to memory objects supplied
|
||||
* by attn.steven.kuo. (Applies only
|
||||
* to perl 5.8 and later.)
|
||||
*/
|
||||
|
||||
#include <perliol.h>
|
||||
#endif
|
||||
|
||||
SV * perliol_readable(pTHX_ SV * handle) {
|
||||
#ifdef PERL580_OR_LATER
|
||||
IV flags;
|
||||
IO *io;
|
||||
PerlIO *f;
|
||||
io = sv_2io(handle);
|
||||
f = IoIFP(io);
|
||||
if(PerlIOValid(f)){
|
||||
flags = PerlIOBase(f)->flags;
|
||||
if(flags & PERLIO_F_CANREAD) return newSVuv(1);
|
||||
return newSVuv(0);
|
||||
}
|
||||
croak("Couldn't validate the filehandle passed to perliol_readable");
|
||||
#else
|
||||
croak("perliol_readable function works only with perl 5.8 or later");
|
||||
#endif
|
||||
}
|
||||
|
||||
SV * perliol_writable(pTHX_ SV * handle) {
|
||||
#ifdef PERL580_OR_LATER
|
||||
IV flags;
|
||||
IO *io;
|
||||
PerlIO *f;
|
||||
io = sv_2io(handle);
|
||||
f = IoIFP(io);
|
||||
if(PerlIOValid(f)){
|
||||
flags = PerlIOBase(f)->flags;
|
||||
if(flags & PERLIO_F_CANWRITE) return newSVuv(1);
|
||||
return newSVuv(0);
|
||||
}
|
||||
croak("Couldn't validate the filehandle passed to perliol_writable");
|
||||
#else
|
||||
croak("perliol_writable function works only with perl 5.8 or later");
|
||||
#endif
|
||||
}
|
||||
|
||||
SV * is_appendable(pTHX_ SV * handle) {
|
||||
#ifdef PERL561_OR_LATER
|
||||
IO *io;
|
||||
io = sv_2io(handle);
|
||||
if (IoTYPE(io) == IoTYPE_APPEND) return newSVuv(1);
|
||||
return newSVuv(0);
|
||||
#else
|
||||
croak("is_appendable function implemented only with perl 5.6.1 or later");
|
||||
#endif
|
||||
}
|
||||
|
||||
MODULE = FileHandle::Fmode PACKAGE = FileHandle::Fmode
|
||||
|
||||
PROTOTYPES: DISABLE
|
||||
|
||||
|
||||
SV *
|
||||
win32_fmode (stream)
|
||||
FILE * stream
|
||||
CODE:
|
||||
RETVAL = win32_fmode (aTHX_ stream);
|
||||
OUTPUT: RETVAL
|
||||
|
||||
SV *
|
||||
perliol_readable (handle)
|
||||
SV * handle
|
||||
CODE:
|
||||
RETVAL = perliol_readable (aTHX_ handle);
|
||||
OUTPUT: RETVAL
|
||||
|
||||
SV *
|
||||
perliol_writable (handle)
|
||||
SV * handle
|
||||
CODE:
|
||||
RETVAL = perliol_writable (aTHX_ handle);
|
||||
OUTPUT: RETVAL
|
||||
|
||||
SV *
|
||||
is_appendable (handle)
|
||||
SV * handle
|
||||
CODE:
|
||||
RETVAL = is_appendable (aTHX_ handle);
|
||||
OUTPUT: RETVAL
|
||||
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
MANIFEST
|
||||
README
|
||||
CHANGES
|
||||
Makefile.PL
|
||||
Fmode.pm
|
||||
Fmode.xs
|
||||
t/basic.t
|
||||
t/binmode.t
|
||||
t/pod.t
|
||||
META.yml Module YAML meta-data (added by MakeMaker)
|
||||
META.json Module JSON meta-data (added by MakeMaker)
|
||||
|
|
@ -0,0 +1,31 @@
|
|||
{
|
||||
"abstract" : "unknown",
|
||||
"author" : [
|
||||
"unknown"
|
||||
],
|
||||
"dynamic_config" : 1,
|
||||
"generated_by" : "ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120630",
|
||||
"license" : [
|
||||
"perl_5"
|
||||
],
|
||||
"meta-spec" : {
|
||||
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
|
||||
"version" : "2"
|
||||
},
|
||||
"name" : "FileHandle-Fmode",
|
||||
"no_index" : {
|
||||
"directory" : [
|
||||
"t",
|
||||
"inc"
|
||||
]
|
||||
},
|
||||
"release_status" : "stable",
|
||||
"resources" : {
|
||||
"repository" : {
|
||||
"type" : "git",
|
||||
"url" : "https://github.com/sisyphus/filehandle-fmode.git",
|
||||
"web" : "https://github.com/sisyphus/filehandle-fmode"
|
||||
}
|
||||
},
|
||||
"version" : "0.14"
|
||||
}
|
||||
|
|
@ -0,0 +1,19 @@
|
|||
---
|
||||
abstract: unknown
|
||||
author:
|
||||
- unknown
|
||||
build_requires: {}
|
||||
dynamic_config: 1
|
||||
generated_by: 'ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120630'
|
||||
license: perl
|
||||
meta-spec:
|
||||
url: http://module-build.sourceforge.net/META-spec-v1.4.html
|
||||
version: 1.4
|
||||
name: FileHandle-Fmode
|
||||
no_index:
|
||||
directory:
|
||||
- t
|
||||
- inc
|
||||
resources:
|
||||
repository: https://github.com/sisyphus/filehandle-fmode.git
|
||||
version: 0.14
|
||||
|
|
@ -0,0 +1,23 @@
|
|||
use ExtUtils::MakeMaker;
|
||||
|
||||
my %options =
|
||||
(
|
||||
NAME => 'FileHandle::Fmode',
|
||||
VERSION_FROM => 'Fmode.pm',
|
||||
LICENSE => 'perl',
|
||||
DEFINE => $] < 5.008 ? $] < 5.006001 ? '-DOLDPERL' : '-DPERL561_OR_LATER' : '-DPERL580_OR_LATER -DPERL561_OR_LATER',
|
||||
clean => { FILES => 'temp.txt temp2.txt' },
|
||||
META_MERGE => {
|
||||
'meta-spec' => { version => 2 },
|
||||
resources => {
|
||||
repository => {
|
||||
type => 'git',
|
||||
url => 'https://github.com/sisyphus/filehandle-fmode.git',
|
||||
web => 'https://github.com/sisyphus/filehandle-fmode',
|
||||
},
|
||||
},
|
||||
},
|
||||
);
|
||||
|
||||
WriteMakefile(%options);
|
||||
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
Use this module to check whether a filehandle is readable, writable, or
|
||||
readable/writable.
|
||||
|
||||
Build in the usual way:
|
||||
|
||||
perl Makefile.PL
|
||||
make test
|
||||
make install
|
||||
|
||||
Cheers,
|
||||
Rob
|
||||
|
|
@ -0,0 +1,357 @@
|
|||
use strict;
|
||||
use FileHandle::Fmode qw(:all);
|
||||
|
||||
# Same tests as binmode.t - but no binmode() on the handles
|
||||
|
||||
print "1..52\n";
|
||||
|
||||
my $no_skip = ($] < 5.006001 && $^O =~ /mswin32/i) ? 0 : 1;
|
||||
|
||||
my ($rd, $wr, $rw, $one, $undef, $null, $mem, $var);
|
||||
|
||||
open(RD, "Makefile.PL") or die "Can't open Makefile.PL for reading: $!";
|
||||
unless($] < 5.006) {open($rd, "Fmode.pm") or die "Can't open Fmode.pm for reading: $!";}
|
||||
else {$rd = \*RD}
|
||||
|
||||
#binmode(RD);
|
||||
#binmode($rd);
|
||||
|
||||
if(is_FH(\*RD) && is_arg_ok(\*RD) && is_R(\*RD) && is_RO(\*RD) && !is_W(\*RD) && !is_WO(\*RD) && !is_RW(\*RD)) {print "ok 1\n"}
|
||||
else {print "not ok 1\n"}
|
||||
|
||||
if(is_FH($rd) && is_arg_ok($rd) && is_R($rd) && is_RO($rd) && !is_W($rd) && !is_WO($rd) && !is_RW($rd)) {print "ok 2\n"}
|
||||
else {print "not ok 2\n"}
|
||||
|
||||
if($no_skip) {
|
||||
if(!is_A(\*RD) && !is_A($rd)) {print "ok 3\n"}
|
||||
else {print "not ok 3\n"}
|
||||
}
|
||||
else {print "ok 3 - skipped, pre-5.6.1 Win32 perl\n"}
|
||||
|
||||
close(RD) or die "Can't close Makefile.PL after opening for reading: $!";
|
||||
unless($] < 5.006) {close($rd) or die "Can't close Fmode.pm after opening for reading: $!";}
|
||||
|
||||
open(RD, "<Makefile.PL") or die "Can't open makefile.PL for reading: $!";
|
||||
unless($] < 5.006) {open($rd, "<Fmode.pm") or die "Can't open Fmode.pm for reading: $!";}
|
||||
else {$rd = \*RD}
|
||||
|
||||
#binmode(RD);
|
||||
#binmode($rd);
|
||||
|
||||
if(is_FH(\*RD) && is_arg_ok(\*RD) && is_R(\*RD) && is_RO(\*RD) && !is_W(\*RD) && !is_WO(\*RD) && !is_RW(\*RD)) {print "ok 4\n"}
|
||||
else {print "not ok 4\n"}
|
||||
|
||||
if(is_FH($rd) && is_arg_ok($rd) && is_R($rd) && is_RO($rd) && !is_W($rd) && !is_WO($rd) && !is_RW($rd)) {print "ok 5\n"}
|
||||
else {print "not ok 5\n"}
|
||||
|
||||
if($no_skip) {
|
||||
if(!is_A(\*RD) && !is_A($rd)) {print "ok 6\n"}
|
||||
else {print "not ok 6\n"}
|
||||
}
|
||||
else {print "ok 6 - skipped, pre-5.6.1 Win32 perl\n"}
|
||||
|
||||
close(RD) or die "Can't close Makefile.PL after opening for reading: $!";
|
||||
unless($] < 5.006) {close($rd) or die "Can't close Fmode.pm after opening for reading: $!";}
|
||||
|
||||
#####################################################
|
||||
|
||||
open(WR, ">temp.txt") or die "Can't open temp.txt for writing: $!";
|
||||
unless($] < 5.006) {open($wr, ">temp2.txt") or die "Can't open temp2.txt for writing: $!";}
|
||||
else {$wr = \*WR}
|
||||
|
||||
#binmode(WR);
|
||||
#binmode($wr);
|
||||
|
||||
if(is_FH(\*WR) && is_arg_ok(\*WR) && is_W(\*WR) && is_WO(\*WR)) {print "ok 7\n"}
|
||||
else {print "not ok 7\n"}
|
||||
|
||||
if(is_FH($wr) && is_arg_ok($wr) && is_W($wr) && is_WO($wr)) {print "ok 8\n"}
|
||||
else {print "not ok 8\n"}
|
||||
|
||||
if(!is_RO(\*WR) && !is_R(\*WR) && !is_RW(\*WR)) {print "ok 9\n"}
|
||||
else {print "not ok 9\n"}
|
||||
|
||||
if(!is_RO($wr) && !is_R($wr) && !is_RW($wr)) {print "ok 10\n"}
|
||||
else {print "not ok 10\n"}
|
||||
|
||||
if($no_skip) {
|
||||
if(!is_A(\*WR) && !is_A($wr)) {print "ok 11\n"}
|
||||
else {print "not ok 11\n"}
|
||||
}
|
||||
else {print "ok 11 - skipped, pre-5.6.1 Win32 perl\n"}
|
||||
|
||||
#####################################################
|
||||
|
||||
close(WR) or die "Can't close temp.txt after opening for writing: $!";
|
||||
unless($] < 5.006) {close($wr) or die "Can't close temp2.txt after opening for writing: $!";}
|
||||
|
||||
open(WR, ">>temp.txt") or die "Can't open temp.txt for writing: $!";
|
||||
unless($] < 5.006) {open($wr, ">>temp2.txt") or die "Can't open temp2.txt for writing: $!";}
|
||||
else {$wr = \*WR}
|
||||
|
||||
#binmode(WR);
|
||||
#binmode($wr);
|
||||
|
||||
if(is_FH(\*WR) && is_arg_ok(\*WR) && is_W(\*WR) && is_WO(\*WR)) {print "ok 12\n"}
|
||||
else {print "not ok 12\n"}
|
||||
|
||||
if(is_FH($wr) && is_arg_ok($wr) && is_W($wr) && is_WO($wr)) {print "ok 13\n"}
|
||||
else {print "not ok 13\n"}
|
||||
|
||||
if(!is_RO(\*WR) && !is_R(\*WR) && !is_RW(\*WR)) {print "ok 14\n"}
|
||||
else {print "not ok 14\n"}
|
||||
|
||||
if(!is_RO($wr) && !is_R($wr) && !is_RW($wr)) {print "ok 15\n"}
|
||||
else {print "not ok 15\n"}
|
||||
|
||||
if($no_skip) {
|
||||
if(is_A(\*WR) && is_A($wr)) {print "ok 16\n"}
|
||||
else {print "not ok 16\n"}
|
||||
}
|
||||
else {print "ok 16 - skipped, pre-5.6.1 Win32 perl\n"}
|
||||
|
||||
close(WR) or die "Can't close temp.txt after opening for appending: $!";
|
||||
unless($] < 5.006) {close($wr) or die "Can't close temp2.txt after opening for appending: $!";}
|
||||
|
||||
#####################################################
|
||||
|
||||
open(RW, "+>temp.txt") or die "Can't open temp.txt for reading/writing: $!";
|
||||
unless($] < 5.006) {open($rw, "+>temp2.txt") or die "Can't open temp2.txt for reading/writing: $!";}
|
||||
else {$rw = \*RW}
|
||||
|
||||
#binmode(RW);
|
||||
#binmode($rw);
|
||||
|
||||
if(is_FH(\*RW) && is_arg_ok(\*RW) && is_RW(\*RW) && is_W(\*RW) && is_R(\*RW)) {print "ok 17\n"}
|
||||
else {print "not ok 17\n"}
|
||||
|
||||
if(is_FH($rw) && is_arg_ok($rw) && is_RW($rw) && is_W($rw) && is_R($rw)) {print "ok 18\n"}
|
||||
else {print "not ok 18\n"}
|
||||
|
||||
if(!is_RO(\*RW) && !is_WO(\*RW)) {print "ok 19\n"}
|
||||
else {print "not ok 19\n"}
|
||||
|
||||
if(!is_RO($rw) && !is_WO($rw)) {print "ok 20\n"}
|
||||
else {print "not ok 20\n"}
|
||||
|
||||
if($no_skip) {
|
||||
if(!is_A(\*RW) && !is_A($rw)) {print "ok 21\n"}
|
||||
else {print "not ok 21\n"}
|
||||
}
|
||||
else {print "ok 21 - skipped, pre-5.6.1 Win32 perl\n"}
|
||||
|
||||
close(RW) or die "Can't close temp.txt after opening for reading/writing: $!";
|
||||
unless($] < 5.006) {close($rw) or die "Can't close temp2.txt after opening for reading/writing: $!";}
|
||||
|
||||
#####################################################
|
||||
|
||||
open(RW, "+<temp.txt") or die "Can't open temp.txt for reading/writing: $!";
|
||||
unless($] < 5.006) {open($rw, "+<temp2.txt") or die "Can't open temp2.txt for reading/writing: $!";}
|
||||
else {$rw = \*RW}
|
||||
|
||||
#binmode(RW);
|
||||
#binmode($rw);
|
||||
|
||||
if(is_FH(\*RW) && is_arg_ok(\*RW) && is_RW(\*RW) && is_W(\*RW) && is_R(\*RW)) {print "ok 22\n"}
|
||||
else {print "not ok 22\n"}
|
||||
|
||||
if(is_FH($rw) && is_arg_ok($rw) && is_RW($rw) && is_W($rw) && is_R($rw)) {print "ok 23\n"}
|
||||
else {print "not ok 23\n"}
|
||||
|
||||
if(!is_RO(\*RW) && !is_WO(\*RW)) {print "ok 24\n"}
|
||||
else {print "not ok 24\n"}
|
||||
|
||||
if(!is_RO($rw) && !is_WO($rw)) {print "ok 25\n"}
|
||||
else {print "not ok 25\n"}
|
||||
|
||||
if($no_skip) {
|
||||
if(!is_A(\*RW) && !is_A($rw)) {print "ok 26\n"}
|
||||
else {print "not ok 26\n"}
|
||||
}
|
||||
else {print "ok 26 - skipped, pre-5.6.1 Win32 perl\n"}
|
||||
|
||||
close(RW) or die "Can't close temp.txt after opening for reading/writing: $!";
|
||||
unless($] < 5.006) {close($rw) or die "Can't close temp2.txt after opening for reading/writing: $!";}
|
||||
|
||||
#####################################################
|
||||
|
||||
open(RW, "+>>temp.txt") or die "Can't open temp.txt for reading/writing: $!";
|
||||
unless($] < 5.006) {open($rw, "+>>temp2.txt") or die "Can't open temp2.txt for reading/writing: $!";}
|
||||
else {$rw = \*RW}
|
||||
|
||||
#binmode(RW);
|
||||
#binmode($rw);
|
||||
|
||||
if(is_FH(\*RW) && is_arg_ok(\*RW) && is_RW(\*RW) && is_W(\*RW) && is_R(\*RW)) {print "ok 27\n"}
|
||||
else {print "not ok 27\n"}
|
||||
|
||||
if(is_FH($rw) && is_arg_ok($rw) && is_RW($rw) && is_W($rw) && is_R($rw)) {print "ok 28\n"}
|
||||
else {print "not ok 28\n"}
|
||||
|
||||
if(!is_RO(\*RW) && !is_WO(\*RW)){print "ok 29\n"}
|
||||
else {print "not ok 29\n"}
|
||||
|
||||
if(!is_RO($rw) && !is_WO($rw)) {print "ok 30\n"}
|
||||
else {print "not ok 30\n"}
|
||||
|
||||
if($no_skip) {
|
||||
if(is_A(\*RW) && is_A($rw)) {print "ok 31\n"}
|
||||
else {print "not ok 31\n"}
|
||||
}
|
||||
else {print "ok 31 - skipped, pre-5.6.1 Win32 perl\n"}
|
||||
|
||||
close(RW) or die "Can't close temp.txt after opening for reading/writing: $!";
|
||||
unless($] < 5.006) {close($rw) or die "Can't close temp2.txt after opening for reading/writing: $!";}
|
||||
|
||||
eval {is_R($undef)};
|
||||
if($@ && !is_arg_ok($undef)){print "ok 32\n"}
|
||||
else {print "not ok 32\n"}
|
||||
|
||||
eval {is_RO($undef)};
|
||||
if($@){print "ok 33\n"}
|
||||
else {print "not ok 33\n"}
|
||||
|
||||
eval {is_W($undef)};
|
||||
if($@){print "ok 34\n"}
|
||||
else {print "not ok 34\n"}
|
||||
|
||||
eval {is_WO($undef)};
|
||||
if($@){print "ok 35\n"}
|
||||
else {print "not ok 35\n"}
|
||||
|
||||
eval {is_RW($undef)};
|
||||
if($@){print "ok 36\n"}
|
||||
else {print "not ok 36\n"}
|
||||
|
||||
if($no_skip){
|
||||
eval {is_A($undef)};
|
||||
if($@){print "ok 37\n"}
|
||||
else {print "not ok 37\n"}
|
||||
}
|
||||
else {print "ok 37 - skipped, pre-5.6.1 Win32 perl\n"}
|
||||
|
||||
$one = 1;
|
||||
|
||||
eval {is_R($one)};
|
||||
if($@ && !is_arg_ok($one)){print "ok 38\n"}
|
||||
else {print "not ok 38\n"}
|
||||
|
||||
eval {is_RO($one)};
|
||||
if($@){print "ok 39\n"}
|
||||
else {print "not ok 39\n"}
|
||||
|
||||
eval {is_W($one)};
|
||||
if($@){print "ok 40\n"}
|
||||
else {print "not ok 40\n"}
|
||||
|
||||
eval {is_WO($one)};
|
||||
if($@){print "ok 41\n"}
|
||||
else {print "not ok 41\n"}
|
||||
|
||||
eval {is_RW($one)};
|
||||
if($@){print "ok 42\n"}
|
||||
else {print "not ok 42\n"}
|
||||
|
||||
if($no_skip){
|
||||
eval {is_A($one)};
|
||||
if($@){print "ok 43\n"}
|
||||
else {print "not ok 43\n"}
|
||||
}
|
||||
else {print "ok 43 - skipped, pre-5.6.1 Win32 perl\n"}
|
||||
|
||||
if($] >= 5.007) {
|
||||
|
||||
$var = ''; # Avoid "uninitialised" warnings.
|
||||
|
||||
eval q{open($mem, '<', \$var) or die "Can't open memory object: $!";};
|
||||
die $@ if $@;
|
||||
#binmode($mem);
|
||||
if(is_FH($mem) && is_arg_ok($mem) && is_R($mem) && is_RO($mem) && !is_W($mem) && !is_WO($mem) && !is_RW($mem) && !is_A($mem)) {print "ok 44\n"}
|
||||
else {print "not ok 44\n"}
|
||||
close($mem) or die "Can't close memory object: $!";
|
||||
|
||||
eval q{open($mem, '>', \$var) or die "Can't open memory object: $!";};
|
||||
die $@ if $@;
|
||||
#binmode($mem);
|
||||
if(is_arg_ok($mem) && !is_R($mem) && !is_RO($mem) && is_W($mem) && is_WO($mem) && !is_RW($mem) && !is_A($mem)) {print "ok 45\n"}
|
||||
else {print "not ok 45\n"}
|
||||
close($mem) or die "Can't close memory object: $!";
|
||||
|
||||
eval q{open($mem, '>>', \$var) or die "Can't open memory object: $!";};
|
||||
die $@ if $@;
|
||||
#binmode($mem);
|
||||
if(is_FH($mem) && is_arg_ok($mem) && !is_R($mem) && !is_RO($mem) && is_W($mem) && is_WO($mem) && !is_RW($mem) && is_A($mem)) {print "ok 46\n"}
|
||||
else {print "not ok 46\n"}
|
||||
close($mem) or die "Can't close memory object: $!";
|
||||
|
||||
eval q{open($mem, '+>>', \$var) or die "Can't open memory object: $!";};
|
||||
die $@ if $@;
|
||||
#binmode($mem);
|
||||
if(is_arg_ok($mem) && is_R($mem) && !is_RO($mem) && is_W($mem) && !is_WO($mem) && is_RW($mem) && is_A($mem)) {print "ok 47\n"}
|
||||
else {print "not ok 47\n"}
|
||||
close($mem) or die "Can't close memory object: $!";
|
||||
|
||||
|
||||
eval q{open($mem, '+>', \$var) or die "Can't open memory object: $!";};
|
||||
die $@ if $@;
|
||||
#binmode($mem);
|
||||
if(is_FH($mem) && is_arg_ok($mem) && is_R($mem) && !is_RO($mem) && is_W($mem) && !is_WO($mem) && is_RW($mem) && !is_A($mem)) {print "ok 48\n"}
|
||||
else {print "not ok 48\n"}
|
||||
close($mem) or die "Can't close memory object: $!";
|
||||
|
||||
eval q{open($mem, '+<', \$var) or die "Can't open memory object: $!";};
|
||||
die $@ if $@;
|
||||
#binmode($mem);
|
||||
if(is_FH($mem) && is_arg_ok($mem) && is_R($mem) && !is_RO($mem) && is_W($mem) && !is_WO($mem) && is_RW($mem) && !is_A($mem)) {print "ok 49\n"}
|
||||
else {print "not ok 49\n"}
|
||||
close($mem) or die "Can't close memory object: $!";
|
||||
|
||||
}
|
||||
else {
|
||||
print "ok 44 - skipped - pre-5.8 perl\n";
|
||||
print "ok 45 - skipped - pre-5.8 perl\n";
|
||||
print "ok 46 - skipped - pre-5.8 perl\n";
|
||||
print "ok 47 - skipped - pre-5.8 perl\n";
|
||||
print "ok 48 - skipped - pre-5.8 perl\n";
|
||||
print "ok 49 - skipped - pre-5.8 perl\n";
|
||||
}
|
||||
|
||||
open(RD, "Makefile.PL") or die "Can't open Makefile.PL for reading: $!";
|
||||
#binmode(RD);
|
||||
eval{FileHandle::Fmode::perliol_readable(\*RD);};
|
||||
|
||||
if($] < 5.007) {
|
||||
if($@ =~ /perliol_readable/) {print "ok 50\n"}
|
||||
else {print "not ok 50\n"}
|
||||
}
|
||||
else {
|
||||
if($@) {print "not ok 50\n"}
|
||||
else {print "ok 50\n"}
|
||||
}
|
||||
|
||||
close(RD) or die "Can't close Makefile.PL after opening for reading: $!";
|
||||
|
||||
open(WR, ">temp2.txt") or die "Can't open temp2.txt for writing: $!";
|
||||
#binmode(WR);
|
||||
eval{FileHandle::Fmode::perliol_writable(\*WR);};
|
||||
|
||||
if($] < 5.007) {
|
||||
if($@ =~ /perliol_writable/) {print "ok 51\n"}
|
||||
else {print "not ok 51\n"}
|
||||
}
|
||||
else {
|
||||
if($@) {print "not ok 51\n"}
|
||||
else {print "ok 51\n"}
|
||||
}
|
||||
|
||||
eval{FileHandle::Fmode::win32_fmode(\*WR);};
|
||||
if($^O =~ /mswin32/i) {
|
||||
if($@) {print "not ok 52\n"}
|
||||
else {print "ok 52\n"}
|
||||
}
|
||||
else {
|
||||
if($@ =~ /win32_fmode/) {print "ok 52\n"}
|
||||
else {print "not ok 52\n"}
|
||||
}
|
||||
|
||||
close(WR) or die "Can't close temp2.txt after opening for writing: $!";
|
||||
|
|
@ -0,0 +1,357 @@
|
|||
use strict;
|
||||
use FileHandle::Fmode qw(:all);
|
||||
|
||||
# Same tests as basic.t - but binmode() on the handles
|
||||
|
||||
print "1..52\n";
|
||||
|
||||
my $no_skip = ($] < 5.006001 && $^O =~ /mswin32/i) ? 0 : 1;
|
||||
|
||||
my ($rd, $wr, $rw, $one, $undef, $null, $mem, $var);
|
||||
|
||||
open(RD, "Makefile.PL") or die "Can't open Makefile.PL for reading: $!";
|
||||
unless($] < 5.006) {open($rd, "Fmode.pm") or die "Can't open Fmode.pm for reading: $!";}
|
||||
else {$rd = \*RD}
|
||||
|
||||
binmode(RD);
|
||||
binmode($rd);
|
||||
|
||||
if(is_FH(\*RD) && is_arg_ok(\*RD) && is_R(\*RD) && is_RO(\*RD) && !is_W(\*RD) && !is_WO(\*RD) && !is_RW(\*RD)) {print "ok 1\n"}
|
||||
else {print "not ok 1\n"}
|
||||
|
||||
if(is_FH($rd) && is_arg_ok($rd) && is_R($rd) && is_RO($rd) && !is_W($rd) && !is_WO($rd) && !is_RW($rd)) {print "ok 2\n"}
|
||||
else {print "not ok 2\n"}
|
||||
|
||||
if($no_skip) {
|
||||
if(!is_A(\*RD) && !is_A($rd)) {print "ok 3\n"}
|
||||
else {print "not ok 3\n"}
|
||||
}
|
||||
else {print "ok 3 - skipped, pre-5.6.1 Win32 perl\n"}
|
||||
|
||||
close(RD) or die "Can't close Makefile.PL after opening for reading: $!";
|
||||
unless($] < 5.006) {close($rd) or die "Can't close Fmode.pm after opening for reading: $!";}
|
||||
|
||||
open(RD, "<Makefile.PL") or die "Can't open makefile.PL for reading: $!";
|
||||
unless($] < 5.006) {open($rd, "<Fmode.pm") or die "Can't open Fmode.pm for reading: $!";}
|
||||
else {$rd = \*RD}
|
||||
|
||||
binmode(RD);
|
||||
binmode($rd);
|
||||
|
||||
if(is_FH(\*RD) && is_arg_ok(\*RD) && is_R(\*RD) && is_RO(\*RD) && !is_W(\*RD) && !is_WO(\*RD) && !is_RW(\*RD)) {print "ok 4\n"}
|
||||
else {print "not ok 4\n"}
|
||||
|
||||
if(is_FH($rd) && is_arg_ok($rd) && is_R($rd) && is_RO($rd) && !is_W($rd) && !is_WO($rd) && !is_RW($rd)) {print "ok 5\n"}
|
||||
else {print "not ok 5\n"}
|
||||
|
||||
if($no_skip) {
|
||||
if(!is_A(\*RD) && !is_A($rd)) {print "ok 6\n"}
|
||||
else {print "not ok 6\n"}
|
||||
}
|
||||
else {print "ok 6 - skipped, pre-5.6.1 Win32 perl\n"}
|
||||
|
||||
close(RD) or die "Can't close Makefile.PL after opening for reading: $!";
|
||||
unless($] < 5.006) {close($rd) or die "Can't close Fmode.pm after opening for reading: $!";}
|
||||
|
||||
#####################################################
|
||||
|
||||
open(WR, ">temp.txt") or die "Can't open temp.txt for writing: $!";
|
||||
unless($] < 5.006) {open($wr, ">temp2.txt") or die "Can't open temp2.txt for writing: $!";}
|
||||
else {$wr = \*WR}
|
||||
|
||||
binmode(WR);
|
||||
binmode($wr);
|
||||
|
||||
if(is_FH(\*WR) && is_arg_ok(\*WR) && is_W(\*WR) && is_WO(\*WR)) {print "ok 7\n"}
|
||||
else {print "not ok 7\n"}
|
||||
|
||||
if(is_FH($wr) && is_arg_ok($wr) && is_W($wr) && is_WO($wr)) {print "ok 8\n"}
|
||||
else {print "not ok 8\n"}
|
||||
|
||||
if(!is_RO(\*WR) && !is_R(\*WR) && !is_RW(\*WR)) {print "ok 9\n"}
|
||||
else {print "not ok 9\n"}
|
||||
|
||||
if(!is_RO($wr) && !is_R($wr) && !is_RW($wr)) {print "ok 10\n"}
|
||||
else {print "not ok 10\n"}
|
||||
|
||||
if($no_skip) {
|
||||
if(!is_A(\*WR) && !is_A($wr)) {print "ok 11\n"}
|
||||
else {print "not ok 11\n"}
|
||||
}
|
||||
else {print "ok 11 - skipped, pre-5.6.1 Win32 perl\n"}
|
||||
|
||||
#####################################################
|
||||
|
||||
close(WR) or die "Can't close temp.txt after opening for writing: $!";
|
||||
unless($] < 5.006) {close($wr) or die "Can't close temp2.txt after opening for writing: $!";}
|
||||
|
||||
open(WR, ">>temp.txt") or die "Can't open temp.txt for writing: $!";
|
||||
unless($] < 5.006) {open($wr, ">>temp2.txt") or die "Can't open temp2.txt for writing: $!";}
|
||||
else {$wr = \*WR}
|
||||
|
||||
binmode(WR);
|
||||
binmode($wr);
|
||||
|
||||
if(is_FH(\*WR) && is_arg_ok(\*WR) && is_W(\*WR) && is_WO(\*WR)) {print "ok 12\n"}
|
||||
else {print "not ok 12\n"}
|
||||
|
||||
if(is_FH($wr) && is_arg_ok($wr) && is_W($wr) && is_WO($wr)) {print "ok 13\n"}
|
||||
else {print "not ok 13\n"}
|
||||
|
||||
if(!is_RO(\*WR) && !is_R(\*WR) && !is_RW(\*WR)) {print "ok 14\n"}
|
||||
else {print "not ok 14\n"}
|
||||
|
||||
if(!is_RO($wr) && !is_R($wr) && !is_RW($wr)) {print "ok 15\n"}
|
||||
else {print "not ok 15\n"}
|
||||
|
||||
if($no_skip) {
|
||||
if(is_A(\*WR) && is_A($wr)) {print "ok 16\n"}
|
||||
else {print "not ok 16\n"}
|
||||
}
|
||||
else {print "ok 16 - skipped, pre-5.6.1 Win32 perl\n"}
|
||||
|
||||
close(WR) or die "Can't close temp.txt after opening for appending: $!";
|
||||
unless($] < 5.006) {close($wr) or die "Can't close temp2.txt after opening for appending: $!";}
|
||||
|
||||
#####################################################
|
||||
|
||||
open(RW, "+>temp.txt") or die "Can't open temp.txt for reading/writing: $!";
|
||||
unless($] < 5.006) {open($rw, "+>temp2.txt") or die "Can't open temp2.txt for reading/writing: $!";}
|
||||
else {$rw = \*RW}
|
||||
|
||||
binmode(RW);
|
||||
binmode($rw);
|
||||
|
||||
if(is_FH(\*RW) && is_arg_ok(\*RW) && is_RW(\*RW) && is_W(\*RW) && is_R(\*RW)) {print "ok 17\n"}
|
||||
else {print "not ok 17\n"}
|
||||
|
||||
if(is_FH($rw) && is_arg_ok($rw) && is_RW($rw) && is_W($rw) && is_R($rw)) {print "ok 18\n"}
|
||||
else {print "not ok 18\n"}
|
||||
|
||||
if(!is_RO(\*RW) && !is_WO(\*RW)) {print "ok 19\n"}
|
||||
else {print "not ok 19\n"}
|
||||
|
||||
if(!is_RO($rw) && !is_WO($rw)) {print "ok 20\n"}
|
||||
else {print "not ok 20\n"}
|
||||
|
||||
if($no_skip) {
|
||||
if(!is_A(\*RW) && !is_A($rw)) {print "ok 21\n"}
|
||||
else {print "not ok 21\n"}
|
||||
}
|
||||
else {print "ok 21 - skipped, pre-5.6.1 Win32 perl\n"}
|
||||
|
||||
close(RW) or die "Can't close temp.txt after opening for reading/writing: $!";
|
||||
unless($] < 5.006) {close($rw) or die "Can't close temp2.txt after opening for reading/writing: $!";}
|
||||
|
||||
#####################################################
|
||||
|
||||
open(RW, "+<temp.txt") or die "Can't open temp.txt for reading/writing: $!";
|
||||
unless($] < 5.006) {open($rw, "+<temp2.txt") or die "Can't open temp2.txt for reading/writing: $!";}
|
||||
else {$rw = \*RW}
|
||||
|
||||
binmode(RW);
|
||||
binmode($rw);
|
||||
|
||||
if(is_FH(\*RW) && is_arg_ok(\*RW) && is_RW(\*RW) && is_W(\*RW) && is_R(\*RW)) {print "ok 22\n"}
|
||||
else {print "not ok 22\n"}
|
||||
|
||||
if(is_FH($rw) && is_arg_ok($rw) && is_RW($rw) && is_W($rw) && is_R($rw)) {print "ok 23\n"}
|
||||
else {print "not ok 23\n"}
|
||||
|
||||
if(!is_RO(\*RW) && !is_WO(\*RW)) {print "ok 24\n"}
|
||||
else {print "not ok 24\n"}
|
||||
|
||||
if(!is_RO($rw) && !is_WO($rw)) {print "ok 25\n"}
|
||||
else {print "not ok 25\n"}
|
||||
|
||||
if($no_skip) {
|
||||
if(!is_A(\*RW) && !is_A($rw)) {print "ok 26\n"}
|
||||
else {print "not ok 26\n"}
|
||||
}
|
||||
else {print "ok 26 - skipped, pre-5.6.1 Win32 perl\n"}
|
||||
|
||||
close(RW) or die "Can't close temp.txt after opening for reading/writing: $!";
|
||||
unless($] < 5.006) {close($rw) or die "Can't close temp2.txt after opening for reading/writing: $!";}
|
||||
|
||||
#####################################################
|
||||
|
||||
open(RW, "+>>temp.txt") or die "Can't open temp.txt for reading/writing: $!";
|
||||
unless($] < 5.006) {open($rw, "+>>temp2.txt") or die "Can't open temp2.txt for reading/writing: $!";}
|
||||
else {$rw = \*RW}
|
||||
|
||||
binmode(RW);
|
||||
binmode($rw);
|
||||
|
||||
if(is_FH(\*RW) && is_arg_ok(\*RW) && is_RW(\*RW) && is_W(\*RW) && is_R(\*RW)) {print "ok 27\n"}
|
||||
else {print "not ok 27\n"}
|
||||
|
||||
if(is_FH($rw) && is_arg_ok($rw) && is_RW($rw) && is_W($rw) && is_R($rw)) {print "ok 28\n"}
|
||||
else {print "not ok 28\n"}
|
||||
|
||||
if(!is_RO(\*RW) && !is_WO(\*RW)){print "ok 29\n"}
|
||||
else {print "not ok 29\n"}
|
||||
|
||||
if(!is_RO($rw) && !is_WO($rw)) {print "ok 30\n"}
|
||||
else {print "not ok 30\n"}
|
||||
|
||||
if($no_skip) {
|
||||
if(is_A(\*RW) && is_A($rw)) {print "ok 31\n"}
|
||||
else {print "not ok 31\n"}
|
||||
}
|
||||
else {print "ok 31 - skipped, pre-5.6.1 Win32 perl\n"}
|
||||
|
||||
close(RW) or die "Can't close temp.txt after opening for reading/writing: $!";
|
||||
unless($] < 5.006) {close($rw) or die "Can't close temp2.txt after opening for reading/writing: $!";}
|
||||
|
||||
eval {is_R($undef)};
|
||||
if($@ && !is_arg_ok($undef)){print "ok 32\n"}
|
||||
else {print "not ok 32\n"}
|
||||
|
||||
eval {is_RO($undef)};
|
||||
if($@){print "ok 33\n"}
|
||||
else {print "not ok 33\n"}
|
||||
|
||||
eval {is_W($undef)};
|
||||
if($@){print "ok 34\n"}
|
||||
else {print "not ok 34\n"}
|
||||
|
||||
eval {is_WO($undef)};
|
||||
if($@){print "ok 35\n"}
|
||||
else {print "not ok 35\n"}
|
||||
|
||||
eval {is_RW($undef)};
|
||||
if($@){print "ok 36\n"}
|
||||
else {print "not ok 36\n"}
|
||||
|
||||
if($no_skip){
|
||||
eval {is_A($undef)};
|
||||
if($@){print "ok 37\n"}
|
||||
else {print "not ok 37\n"}
|
||||
}
|
||||
else {print "ok 37 - skipped, pre-5.6.1 Win32 perl\n"}
|
||||
|
||||
$one = 1;
|
||||
|
||||
eval {is_R($one)};
|
||||
if($@ && !is_arg_ok($one)){print "ok 38\n"}
|
||||
else {print "not ok 38\n"}
|
||||
|
||||
eval {is_RO($one)};
|
||||
if($@){print "ok 39\n"}
|
||||
else {print "not ok 39\n"}
|
||||
|
||||
eval {is_W($one)};
|
||||
if($@){print "ok 40\n"}
|
||||
else {print "not ok 40\n"}
|
||||
|
||||
eval {is_WO($one)};
|
||||
if($@){print "ok 41\n"}
|
||||
else {print "not ok 41\n"}
|
||||
|
||||
eval {is_RW($one)};
|
||||
if($@){print "ok 42\n"}
|
||||
else {print "not ok 42\n"}
|
||||
|
||||
if($no_skip){
|
||||
eval {is_A($one)};
|
||||
if($@){print "ok 43\n"}
|
||||
else {print "not ok 43\n"}
|
||||
}
|
||||
else {print "ok 43 - skipped, pre-5.6.1 Win32 perl\n"}
|
||||
|
||||
if($] >= 5.007) {
|
||||
|
||||
$var = ''; # Avoid "uninitialised" warnings.
|
||||
|
||||
eval q{open($mem, '<', \$var) or die "Can't open memory object: $!";};
|
||||
die $@ if $@;
|
||||
binmode($mem);
|
||||
if(is_FH($mem) && is_arg_ok($mem) && is_R($mem) && is_RO($mem) && !is_W($mem) && !is_WO($mem) && !is_RW($mem) && !is_A($mem)) {print "ok 44\n"}
|
||||
else {print "not ok 44\n"}
|
||||
close($mem) or die "Can't close memory object: $!";
|
||||
|
||||
eval q{open($mem, '>', \$var) or die "Can't open memory object: $!";};
|
||||
die $@ if $@;
|
||||
binmode($mem);
|
||||
if(is_arg_ok($mem) && !is_R($mem) && !is_RO($mem) && is_W($mem) && is_WO($mem) && !is_RW($mem) && !is_A($mem)) {print "ok 45\n"}
|
||||
else {print "not ok 45\n"}
|
||||
close($mem) or die "Can't close memory object: $!";
|
||||
|
||||
eval q{open($mem, '>>', \$var) or die "Can't open memory object: $!";};
|
||||
die $@ if $@;
|
||||
binmode($mem);
|
||||
if(is_FH($mem) && is_arg_ok($mem) && !is_R($mem) && !is_RO($mem) && is_W($mem) && is_WO($mem) && !is_RW($mem) && is_A($mem)) {print "ok 46\n"}
|
||||
else {print "not ok 46\n"}
|
||||
close($mem) or die "Can't close memory object: $!";
|
||||
|
||||
eval q{open($mem, '+>>', \$var) or die "Can't open memory object: $!";};
|
||||
die $@ if $@;
|
||||
binmode($mem);
|
||||
if(is_arg_ok($mem) && is_R($mem) && !is_RO($mem) && is_W($mem) && !is_WO($mem) && is_RW($mem) && is_A($mem)) {print "ok 47\n"}
|
||||
else {print "not ok 47\n"}
|
||||
close($mem) or die "Can't close memory object: $!";
|
||||
|
||||
|
||||
eval q{open($mem, '+>', \$var) or die "Can't open memory object: $!";};
|
||||
die $@ if $@;
|
||||
binmode($mem);
|
||||
if(is_FH($mem) && is_arg_ok($mem) && is_R($mem) && !is_RO($mem) && is_W($mem) && !is_WO($mem) && is_RW($mem) && !is_A($mem)) {print "ok 48\n"}
|
||||
else {print "not ok 48\n"}
|
||||
close($mem) or die "Can't close memory object: $!";
|
||||
|
||||
eval q{open($mem, '+<', \$var) or die "Can't open memory object: $!";};
|
||||
die $@ if $@;
|
||||
binmode($mem);
|
||||
if(is_FH($mem) && is_arg_ok($mem) && is_R($mem) && !is_RO($mem) && is_W($mem) && !is_WO($mem) && is_RW($mem) && !is_A($mem)) {print "ok 49\n"}
|
||||
else {print "not ok 49\n"}
|
||||
close($mem) or die "Can't close memory object: $!";
|
||||
|
||||
}
|
||||
else {
|
||||
print "ok 44 - skipped - pre-5.8 perl\n";
|
||||
print "ok 45 - skipped - pre-5.8 perl\n";
|
||||
print "ok 46 - skipped - pre-5.8 perl\n";
|
||||
print "ok 47 - skipped - pre-5.8 perl\n";
|
||||
print "ok 48 - skipped - pre-5.8 perl\n";
|
||||
print "ok 49 - skipped - pre-5.8 perl\n";
|
||||
}
|
||||
|
||||
open(RD, "Makefile.PL") or die "Can't open Makefile.PL for reading: $!";
|
||||
binmode(RD);
|
||||
eval{FileHandle::Fmode::perliol_readable(\*RD);};
|
||||
|
||||
if($] < 5.007) {
|
||||
if($@ =~ /perliol_readable/) {print "ok 50\n"}
|
||||
else {print "not ok 50\n"}
|
||||
}
|
||||
else {
|
||||
if($@) {print "not ok 50\n"}
|
||||
else {print "ok 50\n"}
|
||||
}
|
||||
|
||||
close(RD) or die "Can't close Makefile.PL after opening for reading: $!";
|
||||
|
||||
open(WR, ">temp2.txt") or die "Can't open temp2.txt for writing: $!";
|
||||
binmode(WR);
|
||||
eval{FileHandle::Fmode::perliol_writable(\*WR);};
|
||||
|
||||
if($] < 5.007) {
|
||||
if($@ =~ /perliol_writable/) {print "ok 51\n"}
|
||||
else {print "not ok 51\n"}
|
||||
}
|
||||
else {
|
||||
if($@) {print "not ok 51\n"}
|
||||
else {print "ok 51\n"}
|
||||
}
|
||||
|
||||
eval{FileHandle::Fmode::win32_fmode(\*WR);};
|
||||
if($^O =~ /mswin32/i) {
|
||||
if($@) {print "not ok 52\n"}
|
||||
else {print "ok 52\n"}
|
||||
}
|
||||
else {
|
||||
if($@ =~ /win32_fmode/) {print "ok 52\n"}
|
||||
else {print "not ok 52\n"}
|
||||
}
|
||||
|
||||
close(WR) or die "Can't close temp2.txt after opening for writing: $!";
|
||||
|
|
@ -0,0 +1,12 @@
|
|||
eval "use Test::Pod 1.00";
|
||||
|
||||
if($@) {
|
||||
print "1..1\n";
|
||||
print "ok 1 - skipped, no sufficiently recent version of Test::Pod installed \n";
|
||||
}
|
||||
|
||||
else {
|
||||
warn "\nTest::Pod version: $Test::Pod::VERSION\n";
|
||||
warn "\nPod::Simple version: $Pod::Simple::VERSION\n";
|
||||
Test::Pod::all_pod_files_ok();
|
||||
}
|
||||
Loading…
Reference in New Issue