-For more recent changes, see the Perl Changes* file(s).
+IO 1.22 -- Mon Sep 5 10:29:35 CDT 2005
+
+ * Update with changes made in perl core distribution
Change 173 on 1998/07/14 by <gbarr@pobox.com> (Graham Barr)
use strict;
use warnings;
-our $VERSION = "1.21";
+our $VERSION = "1.22";
XSLoader::load 'IO', $VERSION;
sub import {
#define gv_stashpvn(str,len,flags) gv_stashpv(str,flags)
#endif
+#ifndef __attribute__noreturn__
+# define __attribute__noreturn__
+#endif
+
+#ifndef NORETURN_FUNCTION_END
+# define NORETURN_FUNCTION_END /* NOT REACHED */ return 0
+#endif
+
static int not_here(const char *s) __attribute__noreturn__;
static int
not_here(const char *s)
CODE:
if (handle) {
#ifdef PerlIO
- ST(0) = sv_2mortal(newSV(0));
+ ST(0) = sv_newmortal();
+#if PERL_VERSION < 8
+ Fpos_t pos;
+ if (PerlIO_getpos(handle, &pos) != 0) {
+ ST(0) = &PL_sv_undef;
+ }
+ else {
+ sv_setpvn(ST(0), (char *)&pos, sizeof(Fpos_t));
+ }
+#else
if (PerlIO_getpos(handle, ST(0)) != 0) {
ST(0) = &PL_sv_undef;
}
+#endif
#else
+ Fpos_t pos;
if (fgetpos(handle, &pos)) {
ST(0) = &PL_sv_undef;
} else {
- ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t)));
+ ST(0) = sv_2mortal(newSVpvn((char*)&pos, sizeof(Fpos_t)));
}
#endif
}
else {
- ST(0) = &PL_sv_undef;
errno = EINVAL;
+ ST(0) = &PL_sv_undef;
}
SysRet
CODE:
if (handle) {
#ifdef PerlIO
+#if PERL_VERSION < 8
+ char *p;
+ STRLEN len;
+ if (SvOK(pos) && (p = SvPV(pos,len)) && len == sizeof(Fpos_t)) {
+ RETVAL = PerlIO_setpos(handle, (Fpos_t*)p);
+ }
+ else {
+ RETVAL = -1;
+ errno = EINVAL;
+ }
+#else
RETVAL = PerlIO_setpos(handle, pos);
+#endif
#else
char *p;
STRLEN len;
void
new_tmpfile(packname = "IO::File")
- const char * packname
+ char * packname
PREINIT:
OutputStream fp;
GV *gv;
+# This -*- perl -*- script makes the Makefile
+
+require 5.006_001;
use ExtUtils::MakeMaker;
use Config qw(%Config);
+#--- MY package
+
+sub MY::libscan {
+ my($self,$path) = @_;
+
+ return ''
+ if($path =~ m:/(RCS|CVS|SCCS|\.svn)/: ||
+ $path =~ m:[~%]$: ||
+ $path =~ m:\.(orig|rej)$:
+ );
+
+ $path;
+}
+
+
+#--- Attempt to find <poll.h>
+
+my $define = "";
+
+unless (exists $Config{'i_poll'}) {
+ my @inc = split(/\s+/, join(" ",$Config{'usrinc'},$Config{'incpth'},$Config{'locincpth'}));
+ foreach $path (@inc) {
+ if(-f $path . "/poll.h") {
+ $define .= "-DI_POLL ";
+ last;
+ }
+ }
+}
+
+#--- Write the Makefile
+
WriteMakefile(
VERSION_FROM => "IO.pm",
NAME => "IO",
OBJECT => '$(O_FILES)',
- MAN3PODS => {}, # Pods will be built by installman.
+ DEFINE => $define,
+
+ 'clean' => {FILES => join(" ",
+ map { "$_ */$_ */*/$_" }
+ qw(*% *.html *.b[ac]k *.old *.orig))
+ },
+ INSTALLDIRS => 'perl',
);
-This directory contains files from the IO distribution created by
-Graham Barr. It is currently maintained by the Perl Porters as part
-of the Perl source distribution. If you find that you have to modify
-any files in this directory then please forward them a patch at
-<perl5-porters@perl.org>.
+This is the perl5 IO distribution.
+
+This distribution is included in the perl5 core distribution. You should
+only need to install this distribution if it is newer than your perl
+installation.
+
+To install this distribution you will need access rights to the perl
+install ation on your system, as it overwrites your currently installed
+version of IO.
+
+This distribution relies upon the Socket module (version 1.3), which is
+avaliable from CPAN. Although you should not need to get this if your
+version of perl is fairly recent, as Socket is also distributed in the
+core perl distribution.
+
+If you do not have the required modules, you will see a warning when
+the Makefile is built.
+
+To build, test and install this distribution type:
+
+ perl Makefile.PL
+ make test
+ make install
+
+Share and Enjoy!
+Graham Barr <gbarr@pobox.com>
+
use File::Spec;
@ISA = qw(Tie::Hash Exporter);
-$VERSION = "1.04";
+$VERSION = "1.05";
$VERSION = eval $VERSION;
@EXPORT_OK = qw(DIR_UNLINK);
@ISA = qw(IO::Handle IO::Seekable Exporter);
-$VERSION = "1.12";
+$VERSION = "1.13";
@EXPORT = @IO::Seekable::EXPORT;
require Exporter;
@ISA = qw(Exporter);
-$VERSION = "1.24";
+$VERSION = "1.25";
$VERSION = eval $VERSION;
@EXPORT_OK = qw(
use Carp;
use Symbol;
-$VERSION = "1.123";
+$VERSION = "1.13";
sub new {
my $type = shift;
our(@ISA, @EXPORT_OK, @EXPORT, $VERSION);
@ISA = qw(Exporter);
-$VERSION = "0.06";
+$VERSION = "0.07";
@EXPORT = qw( POLLIN
POLLOUT
@EXPORT = qw(SEEK_SET SEEK_CUR SEEK_END);
@ISA = qw(Exporter);
-$VERSION = "1.09";
+$VERSION = "1.10";
$VERSION = eval $VERSION;
sub seek {
use vars qw($VERSION @ISA);
require Exporter;
-$VERSION = "1.16";
+$VERSION = "1.17";
@ISA = qw(Exporter); # This is only so we can do version checking
@ISA = qw(IO::Handle);
-$VERSION = "1.28";
+$VERSION = "1.29";
@EXPORT_OK = qw(sockatmark);
use Errno;
@ISA = qw(IO::Socket);
-$VERSION = "1.28";
+$VERSION = "1.29";
my $EINVAL = exists(&Errno::EINVAL) ? Errno::EINVAL() : 1;
use Carp;
@ISA = qw(IO::Socket);
-$VERSION = "1.21";
+$VERSION = "1.22";
$VERSION = eval $VERSION;
IO::Socket::UNIX->register_domain( AF_UNIX );
#!/usr/bin/perl -w
-BEGIN
-{
+BEGIN {
+ unless(grep /blib/, @INC) {
chdir 't' if -d 't';
@INC = '../lib';
+ }
require Config;
if ($Config::Config{'extensions'} !~ /\bSocket\b/) {
print "1..0 # Skip: Socket not built - IO.pm uses Socket";
use strict;
use File::Path;
use File::Spec;
-use Test::More tests => 18;
+require($ENV{PERL_CORE} ? "./test.pl" : "./t/test.pl");
+plan(tests => 18);
{
- local $INC{'XSLoader.pm'} = 1;
- local *XSLoader::load;
+ require XSLoader;
my @load;
- *XSLoader::load = sub {
+ local $^W;
+ local *XSLoader::load = sub {
push @load, \@_;
};
#!./perl -w
-BEGIN { chdir 't' if -d 't'; }
+BEGIN {
+ unless(grep /blib/, @INC) {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ }
+}
use strict;
-use lib '../lib';
-use Test::More tests => ($^O =~ /MSWin32/ ? 9 : 6);
+require($ENV{PERL_CORE} ? "./test.pl" : "./t/test.pl");
+plan(tests => ($^O =~ /MSWin32/ ? 9 : 6));
my $Class = 'IO::File';
my $All_Chars = join '', "\r\n", map( chr, 1..255 ), "zzz\n\r";
my $File;
-BEGIN
-{
- $File = __FILE__;
- if (-d 't')
- {
- chdir 't';
- $File =~ s/^t\W+//; # Remove first directory
- }
- @INC = '../lib';
- require strict; import strict;
+BEGIN {
+ $File = __FILE__;
+ unless(grep /blib/, @INC) {
+ chdir 't' if -d 't';
+ $File =~ s/^t\W+//; # Remove first directory
+ @INC = '../lib';
+ }
+ require strict; import strict;
}
use Test;
#!./perl
+my $perl;
+
BEGIN {
unless(grep /blib/, @INC) {
+ $perl = './perl';
chdir 't' if -d 't';
@INC = '../lib';
}
+ else {
+ $perl = $^X;
+ }
}
use Config;
use IO::Pipe;
-my $perl = './perl';
$| = 1;
print "1..10\n";
-#!./perl
+#!./perl -w
BEGIN {
unless(grep /blib/, @INC) {
# check warnings
$SIG{__WARN__} = sub {
++ $w
- if $_[0] =~ /^Call to deprecated method 'has_error', use 'has_exception'/
+ if $_[0] =~ /^Call to deprecated method 'has_error', use 'has_exception'/ ;
} ;
$w = 0 ;
+{
+no warnings 'IO::Select' ;
IO::Select::has_error();
+}
print "not " unless $w == 0 ;
$w = 0 ;
print "ok 22\n" ;
+{
use warnings 'IO::Select' ;
IO::Select::has_error();
+}
print "not " unless $w == 1 ;
$w = 0 ;
print "ok 23\n" ;
}
}
-my $has_perlio = find PerlIO::Layer 'perlio';
+my $has_perlio = $] >= 5.008 and find PerlIO::Layer 'perlio';
$| = 1;
print "1..26\n";
#!./perl
BEGIN {
- chdir 't' if -d 't';
- @INC = '../lib';
- unless (find PerlIO::Layer 'perlio') {
+ unless(grep /blib/, @INC) {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ }
+ unless ($] >= 5.008 and find PerlIO::Layer 'perlio') {
print "1..0 # Skip: not perlio\n";
exit 0;
}
}
-require "./test.pl";
+require($ENV{PERL_CORE} ? "./test.pl" : "./t/test.pl");
plan(tests => 5);
$runperl_args, $name);
}
+sub can_ok ($@) {
+ my($proto, @methods) = @_;
+ my $class = ref $proto || $proto;
+
+ unless( @methods ) {
+ return _ok( 0, _where(), "$class->can(...)" );
+ }
+
+ my @nok = ();
+ foreach my $method (@methods) {
+ local($!, $@); # don't interfere with caller's $@
+ # eval sometimes resets $!
+ eval { $proto->can($method) } || push @nok, $method;
+ }
+
+ my $name;
+ $name = @methods == 1 ? "$class->can('$methods[0]')"
+ : "$class->can(...)";
+
+ _ok( !@nok, _where(), $name );
+}
+
+sub isa_ok ($$;$) {
+ my($object, $class, $obj_name) = @_;
+
+ my $diag;
+ $obj_name = 'The object' unless defined $obj_name;
+ my $name = "$obj_name isa $class";
+ if( !defined $object ) {
+ $diag = "$obj_name isn't defined";
+ }
+ elsif( !ref $object ) {
+ $diag = "$obj_name isn't a reference";
+ }
+ else {
+ # We can't use UNIVERSAL::isa because we want to honor isa() overrides
+ local($@, $!); # eval sometimes resets $!
+ my $rslt = eval { $object->isa($class) };
+ if( $@ ) {
+ if( $@ =~ /^Can't call method "isa" on unblessed reference/ ) {
+ if( !UNIVERSAL::isa($object, $class) ) {
+ my $ref = ref $object;
+ $diag = "$obj_name isn't a '$class' it's a '$ref'";
+ }
+ } else {
+ die <<WHOA;
+WHOA! I tried to call ->isa on your object and got some weird error.
+This should never happen. Please contact the author immediately.
+Here's the error.
+$@
+WHOA
+ }
+ }
+ elsif( !$rslt ) {
+ my $ref = ref $object;
+ $diag = "$obj_name isn't a '$class' it's a '$ref'";
+ }
+ }
+
+ _ok( !$diag, _where(), $name );
+}
+
1;
https://perl5.git.perl.org / perl5.git / commitdiff