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