Version v5.7.2 Development release working toward v5.8
--------------
____________________________________________________________________________
+[ 14502] By: jhi on 2002/01/30 14:32:25
+ Log: Subject: [PATCH re bug 200713.003] Re: Perlbug - reminder of bug(20010713.003) status
+ From: Robin Barker <rmb1@cise.npl.co.uk>
+ Date: Wed, 30 Jan 2002 11:58:33 GMT
+ Message-Id: <200201301158.LAA14883@tempest.npl.co.uk>
+ Branch: perl
+ ! lib/CPAN.pm
+____________________________________________________________________________
+[ 14501] By: jhi on 2002/01/30 14:20:32
+ Log: Move ext/Encode/lib/Encode.pm to ext/Encode/Encode.pm;
+ re-sort MANIFEST.
+ Branch: perl
+ + ext/Encode/Encode.pm
+ - ext/Encode/lib/Encode.pm
+ ! MANIFEST ext/Encode/Makefile.PL
+____________________________________________________________________________
+[ 14500] By: jhi on 2002/01/30 14:05:13
+ Log: Integrate perlio;
+
+ Collect some stats during compile process.
+ Experiment with effect of bundling all EUC-JP, EUC-CN, EUC-KR
+ as one XS - inconclusive - marginal win?
+ Add some comments to encode.h
+ Branch: perl
+ !> ext/Encode/EUC_JP/Makefile.PL ext/Encode/compile
+ !> ext/Encode/encode.h
+____________________________________________________________________________
+[ 14497] By: jhi on 2002/01/30 04:40:56
+ Log: Subject: [PATCH] perl -V: (was: Re: Inline::C and Perl objects with C API's)
+ From: sthoenna@efn.org (Yitzchak Scott-Thoennes)
+ Date: Tue, 29 Jan 2002 01:13:09 -0800
+ Message-ID: <lemV8gzkgu/K092yn@efn.org>
+ Branch: perl
+ ! configpm
+____________________________________________________________________________
+[ 14496] By: jhi on 2002/01/30 01:55:57
+ Log: Subject: [PATCH t/op/inccode.t] new test
+ From: Rafael Garcia-Suarez <rgarciasuarez@free.fr>
+ Date: Tue, 29 Jan 2002 22:03:45 +0100
+ Message-ID: <20020129220345.A704@rafael>
+ Branch: perl
+ ! t/op/inccode.t
+____________________________________________________________________________
+[ 14495] By: jhi on 2002/01/30 01:01:26
+ Log: EBCDIC: t/op/lc.t now passes.
+ Branch: perl
+ ! t/op/lc.t
+____________________________________________________________________________
+[ 14494] By: jhi on 2002/01/30 00:41:52
+ Log: EBCDIC fix: t/op/lc.t failures 24-25, 29-30, 34-35, 39-40
+ Branch: perl
+ ! utf8.c
+____________________________________________________________________________
+[ 14493] By: jhi on 2002/01/29 22:32:05
+ Log: Must find stuff during build.
+ Branch: perl
+ ! ext/Encode/compile
+____________________________________________________________________________
+[ 14492] By: jhi on 2002/01/29 22:24:54
+ Log: Integrate with perlio;
+
+ Basics of a compiled Encode XS extension
+ Branch: perl
+ +> ext/Encode/EUC_JP/EUC_JP.pm ext/Encode/EUC_JP/Makefile.PL
+ +> ext/Encode/Encode/euc-jp.ucm
+ !> MANIFEST ext/Encode/Encode.xs ext/Encode/compile
+ !> ext/Encode/encode.h
+____________________________________________________________________________
+[ 14491] By: jhi on 2002/01/29 22:23:25
+ Log: EBCDIC tweaks-- no new test passes, but getting closer.
+ Branch: perl
+ ! utf8.c
+____________________________________________________________________________
+[ 14488] By: jhi on 2002/01/29 16:38:58
+ Log: Subject: Re: [PATCH] Attribute::Handlers lexical refcount skew (was Re: lexical with attribute, refcount high)
+ From: Richard Clamp <richardc@unixbeard.net>
+ Date: Mon, 28 Jan 2002 02:17:55 +0000
+ Message-ID: <20020128021755.GA28344@mirth.demon.co.uk>
+ Branch: perl
+ ! lib/Attribute/Handlers.pm lib/Attribute/Handlers/t/multi.t
+____________________________________________________________________________
+[ 14487] By: jhi on 2002/01/29 14:23:03
+ Log: OS/390 seems to do length 0 udp reads, Nicholas says
+ skippage is for now the best cause of action.
+ Branch: perl
+ ! ext/Socket/socketpair.t
+____________________________________________________________________________
+[ 14486] By: jhi on 2002/01/29 14:09:21
+ Log: Encode cleanup from Dan Kogai; reworked even further.
+ Branch: perl
+ + ext/Encode/MANIFEST ext/Encode/README ext/Encode/lib/Encode.pm
+ + ext/Encode/lib/Encode/Encoding.pm
+ + ext/Encode/lib/Encode/Internal.pm ext/Encode/lib/Encode/Tcl.pm
+ + ext/Encode/lib/Encode/Tcl/Escape.pm
+ + ext/Encode/lib/Encode/Tcl/Extended.pm
+ + ext/Encode/lib/Encode/Tcl/HanZi.pm
+ + ext/Encode/lib/Encode/Tcl/Table.pm
+ + ext/Encode/lib/Encode/Unicode.pm ext/Encode/lib/Encode/XS.pm
+ + ext/Encode/lib/Encode/iso10646_1.pm
+ + ext/Encode/lib/Encode/ucs2_le.pm ext/Encode/lib/Encode/utf8.pm
+ + ext/Encode/lib/EncodeFormat.pod ext/Encode/t/Encode.t
+ + ext/Encode/t/Tcl.t
+ - ext/Encode.t ext/Encode/Encode.pm
+ - ext/Encode/Encode/EncodeFormat.pod ext/Encode/Encode/Tcl.pm
+ - ext/Encode/Encode/Tcl.t ext/Encode/Todo
+ ! MANIFEST ext/Encode/Encode/8859-1.ucm
+ ! ext/Encode/Encode/8859-10.ucm ext/Encode/Encode/8859-13.ucm
+ ! ext/Encode/Encode/8859-14.ucm ext/Encode/Encode/8859-15.ucm
+ ! ext/Encode/Encode/8859-16.ucm ext/Encode/Encode/8859-2.ucm
+ ! ext/Encode/Encode/8859-3.ucm ext/Encode/Encode/8859-4.ucm
+ ! ext/Encode/Encode/8859-5.ucm ext/Encode/Encode/8859-6.ucm
+ ! ext/Encode/Encode/8859-7.ucm ext/Encode/Encode/8859-8.ucm
+ ! ext/Encode/Encode/8859-9.ucm ext/Encode/Encode/ascii.ucm
+ ! ext/Encode/Encode/cp1047.ucm ext/Encode/Encode/cp1250.ucm
+ ! ext/Encode/Encode/cp37.ucm ext/Encode/Encode/dingbats.ucm
+ ! ext/Encode/Encode/koi8-r.ucm ext/Encode/Encode/posix-bc.ucm
+ ! ext/Encode/Encode/symbol.ucm ext/Encode/Makefile.PL
+ ! ext/Encode/compile
+____________________________________________________________________________
+[ 14485] By: jhi on 2002/01/28 23:17:20
+ Log: Workaround for DJGPP broken F_GETFL from Laszlo.
+ Branch: perl
+ ! djgpp/djgpp.c perlio.c
+____________________________________________________________________________
+[ 14484] By: jhi on 2002/01/28 23:15:22
+ Log: Prettier printing from Michael Schwern.
+ Branch: perl
+ ! t/test.pl
+____________________________________________________________________________
+[ 14483] By: jhi on 2002/01/28 23:08:27
+ Log: Show also the debug and debugcolor as known pragmas.
+ Branch: perl
+ ! ext/re/re.pm
+____________________________________________________________________________
+[ 14482] By: jhi on 2002/01/28 22:08:38
+ Log: Subject: [PATCH] skip assembler.t when there is no ByteLoader
+ From: "Craig A. Berry" <craigberry@mac.com>
+ Date: Mon, 28 Jan 2002 16:30:30 -0600
+ Message-Id: <5.1.0.14.2.20020128162440.01ae7868@exchi01>
+ Branch: perl
+ ! ext/B/t/assembler.t
+____________________________________________________________________________
+[ 14480] By: jhi on 2002/01/28 21:57:37
+ Log: DJGPP needs to know its exe soon, too.
+ Branch: perl
+ ! Configure
+____________________________________________________________________________
+[ 14479] By: jhi on 2002/01/28 21:36:34
+ Log: Round #2 on EBCDICation.
+ Branch: perl
+ ! t/op/append.t
+____________________________________________________________________________
+[ 14478] By: jhi on 2002/01/28 21:19:40
+ Log: Integrate perlio;
+
+ Set makefile.mk CCHOME etc. for default locations of MinGW and free
+ Borland compilers. (Borland builds one or two oddities.)
+ Branch: perl
+ !> win32/config.bc win32/makefile.mk
+____________________________________________________________________________
+[ 14473] By: jhi on 2002/01/28 17:12:27
+ Log: Misunderstood Merijn's patch.
+ Branch: perl
+ ! hints/hpux.sh
+____________________________________________________________________________
+[ 14472] By: jhi on 2002/01/28 17:11:58
+ Log: Misapplied Merijn's patch.
+ Branch: perl
+ ! Configure
+____________________________________________________________________________
+[ 14471] By: jhi on 2002/01/28 14:51:20
+ Log: Update Changes.
+ Branch: perl
+ ! Changes patchlevel.h
+____________________________________________________________________________
[ 14470] By: jhi on 2002/01/28 14:33:36
Log: BeOS has sockets but not true ones.
Branch: perl
ext/Encode/compile Encode extension
ext/Encode/encengine.c Encode extension
ext/Encode/encode.h Encode extension
+ext/Encode/Encode.pm Encode extension
ext/Encode/Encode.xs Encode extension
ext/Encode/Encode/11643-1.enc Encode table
ext/Encode/Encode/11643-2.enc Encode table
ext/Encode/Encode/symbol.ucm Encode table
ext/Encode/Encode/viscii.enc Encode table
ext/Encode/Encode/viscii.ucm Encode table
+ext/Encode/EUC_JP/EUC_JP.pm Enode module for euc-jp
+ext/Encode/EUC_JP/Makefile.PL Enode module for euc-jp
ext/Encode/Encode.pm Encode extension
ext/Encode/lib/Encode/Encoding.pm Encode extension
ext/Encode/lib/Encode/Internal.pm Encode extension
ext/Encode/README Encode extension
ext/Encode/t/Encode.t Encode extension test
ext/Encode/t/Tcl.t Encode extension test
-ext/Encode/EUC_JP/Makefile.PL Enode module for euc-jp
-ext/Encode/EUC_JP/EUC_JP.pm Enode module for euc-jp
ext/Errno/ChangeLog Errno perl module change log
ext/Errno/Errno.t See if Errno works
ext/Errno/Errno_pm.PL Errno perl module create script
lib/ExtUtils/Command.pm Utilities for Make on non-UNIX platforms
lib/ExtUtils/Constant.pm generate XS code to import C header constants
lib/ExtUtils/Embed.pm Utilities for embedding Perl in C programs
-lib/ExtUtils/instmodsh Give information about installed extensions
lib/ExtUtils/Install.pm Handles 'make install' on extensions
lib/ExtUtils/Installed.pm Information on installed extensions
+lib/ExtUtils/instmodsh Give information about installed extensions
lib/ExtUtils/Liblist.pm Locates libraries
lib/ExtUtils/MakeMaker.pm Write Makefiles for extensions
lib/ExtUtils/Manifest.pm Utilities to write MANIFEST files
lib/ExtUtils/t/Command.t See if ExtUtils::Command works (Win32 only)
lib/ExtUtils/t/Embed.t See if ExtUtils::Embed and embedding works
lib/ExtUtils/t/ExtUtils.t See if extutils work
+lib/ExtUtils/t/hints.t See if hint files are honored.
lib/ExtUtils/t/Installed.t See if ExtUtils::Installed works
lib/ExtUtils/t/Manifest.t See if ExtUtils::Manifest works
lib/ExtUtils/t/Mkbootstrap.t See if ExtUtils::Mkbootstrap works
lib/ExtUtils/t/MM_VMS.t See if ExtUtils::MM_VMS works
lib/ExtUtils/t/MM_Win32.t See if ExtUtils::MM_Win32 works
lib/ExtUtils/t/Packlist.t See if Packlist works
-lib/ExtUtils/t/hints.t See if hint files are honored.
lib/ExtUtils/t/testlib.t Fixes up @INC to use just-built extension
lib/ExtUtils/testlib.pm Fixes up @INC to use just-built extension
lib/ExtUtils/typemap Extension interface types
lib/Unicode/README Explanation what happened to lib/unicode.
lib/Unicode/UCD.pm Unicode character database
lib/Unicode/UCD.t See if Unicode character database works
+lib/unicore/ArabicShaping.txt Unicode character database
lib/unicore/ArabLink.pl Unicode character database
lib/unicore/ArabLnkGrp.pl Unicode character database
-lib/unicore/ArabicShaping.txt Unicode character database
lib/unicore/BidiMirroring.txt Unicode character database
lib/unicore/Bidirectional.pl Unicode character database
lib/unicore/Blocks.pl Unicode character database
sub config_re {
my $re = shift;
- my @matches = ($config_sh =~ /^$re=.*\n/mg);
+ my @matches = grep /^$re=/, split /^/, $config_sh;
@matches ? (print @matches) : print "$re: not found\n";
}
}
else if (DO_UTF8(sv)) {
if (!sv_utf8_downgrade((sv = sv_mortalcopy(sv)), TRUE)
- && ckWARN(WARN_UTF8))
+ && ckWARN_d(WARN_UTF8))
{
Perl_warner(aTHX_ WARN_UTF8, "Wide character in print");
}
_apply_handler_AH_($decl,$gphase)
if $global_phases{$gphase} <= $global_phase;
}
- # if _gen_handler_AH_ is being called after CHECK it's
- # for a lexical, so we don't want to keep a reference
- # around
- push @declarations, $decl
- if $global_phase == 0;
+ if ($global_phase != 0) {
+ # if _gen_handler_AH_ is being called after
+ # CHECK it's for a lexical, so make sure
+ # it didn't want to run anything later
+
+ local $Carp::CarpLevel = 2;
+ carp "Won't be able to apply END handler"
+ if $phase{$handler}{END};
+ }
+ else {
+ push @declarations, $decl
+ }
}
$_ = undef;
}
subroutine ceased to exist between the point it was declared and the point
at which its attribute handler(s) would have been called.
+=item C<Won't be able to apply END handler>
+
+You have defined an END handler for an attribute that is being applied
+to a lexical variable. Since the variable may not be available during END
+this won't happen.
+
=back
=head1 AUTHOR
$applied = 0;
dummy_our(); dummy_our();
ok( $applied == 0, 51 );
+
+sub UNIVERSAL::Stooge :ATTR(END) {};
+eval {
+ local $SIG{__WARN__} = sub { die @_ };
+ my $groucho : Stooge;
+};
+my $match = $@ =~ /^Won't be able to apply END handler/;
+ok( $match, 52 );
1;
}
+# This is a piece of repeated code that is abstracted here for
+# maintainability. RMB
+#
+sub _configpmtest {
+ my($configpmdir, $configpmtest) = @_;
+ if (-w $configpmtest) {
+ return $configpmtest;
+ } elsif (-w $configpmdir) {
+ #_#_# following code dumped core on me with 5.003_11, a.k.
+ my $configpm_bak = "$configpmtest.bak";
+ unlink $configpm_bak if -f $configpm_bak;
+ if( -f $configpmtest ) {
+ if( rename $configpmtest, $configpm_bak ) {
+ $CPAN::Frontend->mywarn(<<END)
+Old configuration file $configpmtest
+ moved to $configpm_bak
+END
+ }
+ }
+ my $fh = FileHandle->new;
+ if ($fh->open(">$configpmtest")) {
+ $fh->print("1;\n");
+ return $configpmtest;
+ } else {
+ # Should never happen
+ Carp::confess("Cannot open >$configpmtest");
+ }
+ } else { return }
+}
+
#-> sub CPAN::Config::load ;
sub load {
my($self) = shift;
my($configpmdir) = File::Spec->catdir($path_to_cpan,"CPAN");
my($configpmtest) = File::Spec->catfile($configpmdir,"Config.pm");
if (-d $configpmdir or File::Path::mkpath($configpmdir)) {
- if (-w $configpmtest) {
- $configpm = $configpmtest;
- } elsif (-w $configpmdir) {
- #_#_# following code dumped core on me with 5.003_11, a.k.
- unlink "$configpmtest.bak" if -f "$configpmtest.bak";
- rename $configpmtest, "$configpmtest.bak" if -f $configpmtest;
- my $fh = FileHandle->new;
- if ($fh->open(">$configpmtest")) {
- $fh->print("1;\n");
- $configpm = $configpmtest;
- } else {
- # Should never happen
- Carp::confess("Cannot open >$configpmtest");
- }
- }
+ $configpm = _configpmtest($configpmdir,$configpmtest);
}
unless ($configpm) {
$configpmdir = File::Spec->catdir($ENV{HOME},".cpan","CPAN");
File::Path::mkpath($configpmdir);
$configpmtest = File::Spec->catfile($configpmdir,"MyConfig.pm");
- if (-w $configpmtest) {
- $configpm = $configpmtest;
- } elsif (-w $configpmdir) {
- #_#_# following code dumped core on me with 5.003_11, a.k.
- my $fh = FileHandle->new;
- if ($fh->open(">$configpmtest")) {
- $fh->print("1;\n");
- $configpm = $configpmtest;
- } else {
- # Should never happen
- Carp::confess("Cannot open >$configpmtest");
- }
- } else {
+ $configpm = _configpmtest($configpmdir,$configpmtest);
+ unless ($configpm) {
Carp::confess(qq{WARNING: CPAN.pm is unable to }.
qq{create a configuration file.});
}
our($VERSION, @ISA, @EXPORT, %EXPORT_TAGS, $Inf);
-$VERSION = 1.32;
+$VERSION = 1.34;
BEGIN {
unless ($^O eq 'unicosmk') {
my $i;
my %LOGN;
+# Regular expression for floating point numbers.
+my $gre = qr'\s*([\+\-]?(?:(?:(?:\d+(?:_\d+)*(?:\.\d*(?:_\d+)*)?|\.\d+(?:_\d+)*)(?:[eE][\+\-]?\d+(?:_\d+)*)?)))';
+
require Exporter;
@ISA = qw(Exporter);
die "@{[(caller(1))[3]]}: Cannot take $_[0] of $_[1].\n";
}
+sub _remake {
+ my $arg = shift;
+ my ($made, $p, $q);
+
+ if ($arg =~ /^(?:$gre)?$gre\s*i\s*$/) {
+ ($p, $q) = ($1 || 0, $2);
+ $made = 'cart';
+ } elsif ($arg =~ /^\s*\[\s*$gre\s*(?:,\s*$gre\s*)?\]\s*$/) {
+ ($p, $q) = ($1, $2 || 0);
+ $made = 'exp';
+ }
+
+ if ($made) {
+ $p =~ s/^\+//;
+ $q =~ s/^\+//;
+ }
+
+ return ($made, $p, $q);
+}
+
#
# ->make
#
sub make {
my $self = bless {}, shift;
my ($re, $im) = @_;
+ if (@_ == 1) {
+ my ($remade, $p, $q) = _remake($re);
+ if ($remade) {
+ if ($remade eq 'cart') {
+ ($re, $im) = ($p, $q);
+ } else {
+ return (ref $self)->emake($p, $q);
+ }
+ }
+ }
my $rre = ref $re;
if ( $rre ) {
if ( $rre eq ref $self ) {
_cannot_make("imaginary part", $rim);
}
}
+ _cannot_make("real part", $re) unless $re =~ /^$gre$/;
+ $im ||= 0;
+ _cannot_make("imaginary part", $im) unless $im =~ /^$gre$/;
$self->{'cartesian'} = [ $re, $im ];
$self->{c_dirty} = 0;
$self->{p_dirty} = 1;
sub emake {
my $self = bless {}, shift;
my ($rho, $theta) = @_;
+ if (@_ == 1) {
+ my ($remade, $p, $q) = _remake($rho);
+ if ($remade) {
+ if ($remade eq 'exp') {
+ ($rho, $theta) = ($p, $q);
+ } else {
+ return (ref $self)->make($p, $q);
+ }
+ }
+ }
my $rrh = ref $rho;
if ( $rrh ) {
if ( $rrh eq ref $self ) {
$rho = -$rho;
$theta = ($theta <= 0) ? $theta + pi() : $theta - pi();
}
+ _cannot_make("rho", $rho) unless $rho =~ /^$gre$/;
+ $theta ||= 0;
+ _cannot_make("theta", $theta) unless $theta =~ /^$gre$/;
$self->{'polar'} = [$rho, $theta];
$self->{p_dirty} = 0;
$self->{c_dirty} = 1;
# This avoids the burden of writing Math::Complex->make(re, im).
#
sub cplx {
- my ($re, $im) = @_;
- return __PACKAGE__->make($re, defined $im ? $im : 0);
+ return __PACKAGE__->make(@_);
}
#
# This avoids the burden of writing Math::Complex->emake(rho, theta).
#
sub cplxe {
- my ($rho, $theta) = @_;
- return __PACKAGE__->emake($rho, defined $theta ? $theta : 0);
+ return __PACKAGE__->emake(@_);
}
#
modulus must be non-negative (it represents the distance to the origin
in the complex plane).
-It is also possible to have a complex number as either argument of
-either the C<make> or C<emake>: the appropriate component of
+It is also possible to have a complex number as either argument of the
+C<make>, C<emake>, C<cplx>, and C<cplxe>: the appropriate component of
the argument will be used.
$z1 = cplx(-2, 1);
$z2 = cplx($z1, 4);
+The C<new>, C<make>, C<emake>, C<cplx>, and C<cplxe> will also
+understand a single (string) argument of the forms
+
+ 2-3i
+ -3i
+ [2,3]
+ [2]
+
+in which case the appropriate cartesian and exponential components
+will be parsed from the string and used to create new complex numbers.
+The imaginary component and the theta, respectively, will default to zero.
+
=head1 STRINGIFICATION
When printed, a complex number is usually shown under its cartesian
=head1 AUTHORS
-Raphael Manfredi <F<Raphael_Manfredi@pobox.com>> and
-Jarkko Hietaniemi <F<jhi@iki.fi>>.
+Daniel S. Lewart <F<d-lewart@uiuc.edu>>
-Extensive patches by Daniel S. Lewart <F<d-lewart@uiuc.edu>>.
+Original authors Raphael Manfredi <F<Raphael_Manfredi@pobox.com>> and
+Jarkko Hietaniemi <F<jhi@iki.fi>>
=cut
use vars qw($VERSION);
-$VERSION = 1.91;
+$VERSION = 1.92;
my ($args, $op, $target, $test, $test_set, $try, $val, $zvalue, @set, @val);
test_display_format();
+sub test_remake {
+ $test++;
+ push @script, <<EOS;
+ print "# remake 2+3i\n";
+ my \$z = cplx('2+3i');
+ print "not " unless \$z == Math::Complex->make(2,3);
+ print "ok $test\n";
+EOS
+
+ $test++;
+ push @script, <<EOS;
+ print "# remake 3i\n";
+ my \$z = Math::Complex->make('3i');
+ print "not " unless \$z == cplx(0,3);
+ print "ok $test\n";
+EOS
+
+ $test++;
+ push @script, <<EOS;
+ print "# remake [2,3]\n";
+ my \$z = cplxe('[2,3]');
+ print "not " unless \$z == Math::Complex->emake(2,3);
+ print "ok $test\n";
+EOS
+
+ $test++;
+ push @script, <<EOS;
+ print "# remake [2]\n";
+ my \$z = Math::Complex->emake('[2]');
+ print "not " unless \$z == cplxe(2);
+ print "ok $test\n";
+EOS
+}
+
+test_remake();
+
print "1..$test\n";
eval join '', @script;
die $@ if $@;
$type = 'IO';
$dscp = ":$1";
} else {
- $dscp = shift(@args);
+ $dscp = shift(@args) || '';
}
my @val;
foreach my $layer (split(/\s+/,$dscp)) {
use open IO => ":encoding(iso-8859-7)";
use open IO => ':locale';
-
+
use open ':utf8';
use open ':locale';
use open ':encoding(iso-8859-7)';
#if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT)
static char *local_patches[] = {
NULL
- ,"DEVEL14470"
+ ,"DEVEL14502"
,NULL
};
to check the return value of your socket() call? See
L<perlfunc/listen>.
-=item lstat() on filehandle %s
-
-(W io) You tried to do an lstat on a filehandle. What did you mean
-by that? lstat() makes sense only on filenames. (Perl did a fstat()
-instead on the filehandle.)
-
=item Lvalue subs returning %s not implemented yet
(F) Due to limitations in the current implementation, array and hash
=item Wide character in %s
-(W utf8) Perl met a wide character (>255) when it wasn't expecting one.
+(W utf8) Perl met a wide character (>255) when it wasn't expecting
+one. This warning is by default on for I/O (like print) but can be
+turned off by C<no warnings 'utf8';>. You are supposed to explicitly
+mark the filehandle with an encoding, see L<open> and L<perlfunc/binmode>.
=item write() on closed filehandle %s
it already went past any symlink you are presumably trying to look for.
Use a filename instead.
+=item You can't use lstat() on a filehandle
+
+(F) You tried to do an lstat on a filehandle. lstat() makes sense only
+on filenames.
+
=item YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!
(F) And you probably never will, because you probably don't have the
structure of the previous file test (or stat operator) is used, saving
a system call. (This doesn't work with C<-t>, and you need to remember
that lstat() and C<-l> will leave values in the stat structure for the
-symbolic link, not the real file.) Example:
+symbolic link, not the real file.) (Also, if the stat buffer was filled by
+a C<lstat> call, C<-T> and C<-B> will reset it with the results of C<stat _>).
+Example:
print "Can do.\n" if -r $a || -w _ || -x _;
0xFF or less, Perl uses the native eight-bit character set.
Otherwise, it uses UTF-8.
-A user of Perl does not normally need to know nor care how Perl happens
-to encodes its internal strings, but it becomes relevant when outputting
-Unicode strings to a stream without a discipline (one with the "default
-default"). In such a case, the raw bytes used internally (the native
-character set or UTF-8, as appropriate for each string) will be used,
-and if warnings are turned on, a "Wide character" warning will be issued
-if those strings contain a character beyond 0x00FF.
+A user of Perl does not normally need to know nor care how Perl
+happens to encodes its internal strings, but it becomes relevant when
+outputting Unicode strings to a stream without a discipline (one with
+the "default default"). In such a case, the raw bytes used internally
+(the native character set or UTF-8, as appropriate for each string)
+will be used, and a "Wide character" warning will be issued if those
+strings contain a character beyond 0x00FF.
For example,
- perl -w -e 'print "\x{DF}\n", "\x{0100}\x{DF}\n"'
+ perl -e 'print "\x{DF}\n", "\x{0100}\x{DF}\n"'
produces a fairly useless mixture of native bytes and UTF-8, as well
as a warning.
produces raw bytes that Perl happens to use to internally encode the
Unicode string (which depends on the system, as well as what
characters happen to be in the string at the time). If any of the
-characters are at code points 0x100 or above, you will get a warning
-if you use C<-w> or C<use warnings>. To ensure that the output is
-explicitly rendered in the encoding you desire (and to avoid the
-warning), open the stream with the desired encoding. Some examples:
+characters are at code points 0x100 or above, you will get a warning.
+To ensure that the output is explicitly rendered in the encoding you
+desire (and to avoid the warning), open the stream with the desired
+encoding. Some examples:
open FH, ">:ucs2", "file"
open FH, ">:utf8", "file";
if (value > 255 && !IN_BYTES) {
SvGROW(TARG, UNISKIP(value)+1);
- tmps = (char*)uvchr_to_utf8_flags((U8*)SvPVX(TARG), value,
- UNICODE_ALLOW_SUPER);
+ tmps = (char*)uvchr_to_utf8_flags((U8*)SvPVX(TARG), value, 0);
SvCUR_set(TARG, tmps - SvPVX(TARG));
*tmps = '\0';
(void)SvPOK_only(TARG);
if (PL_op->op_flags & OPf_REF) {
gv = cGVOP_gv;
if (PL_op->op_type == OP_LSTAT) {
+ if (gv != PL_defgv)
+ Perl_croak(aTHX_ "You can't use lstat() on a filehandle");
if (PL_laststype != OP_LSTAT)
Perl_croak(aTHX_ "The stat preceding lstat() wasn't an lstat");
- if (ckWARN(WARN_IO) && gv != PL_defgv)
- Perl_warner(aTHX_ WARN_IO,
- "lstat() on filehandle %s", GvENAME(gv));
- /* Perl_my_lstat (-l) croak's on filehandle, why warn here? */
}
do_fstat:
really_filename:
PL_statgv = Nullgv;
PL_laststatval = -1;
+ PL_laststype = OP_STAT;
sv_setpv(PL_statname, SvPV(sv, n_a));
if (!(fp = PerlIO_open(SvPVX(PL_statname), "r"))) {
if (ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, n_a), '\n'))
if ( f != c
&& (f == c1 || f == c2)
&& (ln == foldlen ||
- !ibcmp_utf8((char *)foldbuf,
+ !ibcmp_utf8((char *) foldbuf,
(char **)0, foldlen, do_utf8,
m,
(char **)0, ln, UTF))
no utf8; # needed for use utf8 not griping about the raw octets
$| = 1;
-print "1..26\n";
+print "1..31\n";
open(F,"+>:utf8",'a');
print F chr(0x100).'£';
close F;
unlink('a');
-open F, ">a";
+open F, ">:utf8", "a";
@a = map { chr(1 << ($_ << 2)) } 0..5; # 0x1, 0x10, .., 0x100000
unshift @a, chr(0); # ... and a null byte in front just for fun
print F @a;
close F;
print "ok 26\n";
+{
+ # Check that warnings are on on I/O, and that they can be muffled.
+
+ local $SIG{__WARN__} = sub { $@ = shift };
+
+ undef $@;
+ open F, ">a";
+ print F chr(0x100);
+ close(F);
+
+ print $@ =~ /Wide character in print/ ? "ok 27\n" : "not ok 27\n";
+
+ undef $@;
+ open F, ">:utf8", "a";
+ print F chr(0x100);
+ close(F);
+
+ print defined $@ ? "not ok 28\n" : "ok 28\n";
+
+ undef $@;
+ open F, ">a";
+ binmode(F, ":utf8");
+ print F chr(0x100);
+ close(F);
+
+ print defined $@ ? "not ok 29\n" : "ok 29\n";
+
+ no warnings 'utf8';
+
+ undef $@;
+ open F, ">a";
+ print F chr(0x100);
+ close(F);
+
+ print defined $@ ? "not ok 30\n" : "ok 30\n";
+
+ use warnings 'utf8';
+
+ undef $@;
+ open F, ">a";
+ print F chr(0x100);
+ close(F);
+
+ print $@ =~ /Wide character in print/ ? "ok 31\n" : "not ok 31\n";
+}
+
# sysread() and syswrite() tested in lib/open.t since Fnctl is used
END {
1 while unlink "b";
}
-
flock STDIN, 8;
flock $a, 8;
- The stat preceding lstat() wasn't an lstat %s [pp_stat]
- lstat(STDIN);
-
warn(warn_nl, "stat"); [pp_stat]
-T on closed filehandle %s
EXPECT
Unsuccessful stat on filename containing newline at - line 3.
########
-# pp_sys.c [pp_stat]
-use Config;
-BEGIN {
- if ($^O eq 'd_lstat') {
- print <<EOM ;
-SKIPPED
-# lstat not present
-EOM
- exit ;
- }
-}
-use warnings 'io' ;
-lstat(STDIN) ;
-no warnings 'io' ;
-lstat(STDIN) ;
-EXPECT
-The stat preceding lstat() wasn't an lstat at - line 13.
-########
# pp_sys.c [pp_fttext]
use warnings qw(unopened closed) ;
close STDIN ;
Malformed UTF-8 character (unexpected non-continuation byte 0x73, immediately after start byte 0xf8) at - line 14.
########
use warnings 'utf8';
-my $surr = chr(0xD800);
-my $fff3 = chr(0xFFFE);
-my $ffff = chr(0xFFFF);
+my $d7ff = chr(0xD7FF);
+my $d800 = chr(0xD800);
+my $dfff = chr(0xDFFF);
+my $e000 = chr(0xE000);
+my $fffd = chr(0xFFFD);
+my $fffe = chr(0xFFFE);
+my $ffff = chr(0xFFFF);
+my $hex4 = chr(0x10000);
+my $hex5 = chr(0x100000);
+my $max = chr(0x10FFFF);
no warnings 'utf8';
-$surr = chr(0xD800);
-$fffe = chr(0xFFFE);
-$ffff = chr(0xFFFF);
+my $d7ff = chr(0xD7FF);
+my $d800 = chr(0xD800);
+my $dfff = chr(0xDFFF);
+my $e000 = chr(0xE000);
+my $fffd = chr(0xFFFD);
+my $fffe = chr(0xFFFE);
+my $ffff = chr(0xFFFF);
+my $hex4 = chr(0x10000);
+my $hex5 = chr(0x100000);
+my $max = chr(0x10FFFF);
EXPECT
-UTF-16 surrogate 0xd800 at - line 2.
-Unicode character 0xfffe is illegal at - line 3.
-Unicode character 0xffff is illegal at - line 4.
+UTF-16 surrogate 0xd800 at - line 3.
+UTF-16 surrogate 0xdfff at - line 4.
+Unicode character 0xfffe is illegal at - line 7.
+Unicode character 0xffff is illegal at - line 8.
+Unicode character 0x10ffff is illegal at - line 11.
########
+use warnings 'utf8';
+my $d7ff = pack("U", 0xD7FF);
+my $d800 = pack("U", 0xD800);
+my $dfff = pack("U", 0xDFFF);
+my $e000 = pack("U", 0xE000);
+my $fffd = pack("U", 0xFFFD);
+my $fffe = pack("U", 0xFFFE);
+my $ffff = pack("U", 0xFFFF);
+my $hex4 = pack("U", 0x10000);
+my $hex5 = pack("U", 0x100000);
+my $max = pack("U", 0x10FFFF);
+no warnings 'utf8';
+my $d7ff = pack("U", 0xD7FF);
+my $d800 = pack("U", 0xD800);
+my $dfff = pack("U", 0xDFFF);
+my $e000 = pack("U", 0xE000);
+my $fffd = pack("U", 0xFFFD);
+my $fffe = pack("U", 0xFFFE);
+my $ffff = pack("U", 0xFFFF);
+my $hex4 = pack("U", 0x10000);
+my $hex5 = pack("U", 0x100000);
+my $max = pack("U", 0x10FFFF);
+EXPECT
+UTF-16 surrogate 0xd800 at - line 3.
+UTF-16 surrogate 0xdfff at - line 4.
+Unicode character 0xfffe is illegal at - line 7.
+Unicode character 0xffff is illegal at - line 8.
+Unicode character 0x10ffff is illegal at - line 11.
+########
+use warnings 'utf8';
+my $d7ff = "\x{D7FF}";
+my $d800 = "\x{D800}";
+my $dfff = "\x{DFFF}";
+my $e000 = "\x{E000}";
+my $fffd = "\x{FFFD}";
+my $fffe = "\x{FFFE}";
+my $ffff = "\x{FFFF}";
+my $hex4 = "\x{10000}";
+my $hex5 = "\x{100000}";
+my $max = "\x{10FFFF}";
+no warnings 'utf8';
+my $d7ff = "\x{D7FF}";
+my $d800 = "\x{D800}";
+my $dfff = "\x{DFFF}";
+my $e000 = "\x{E000}";
+my $fffd = "\x{FFFD}";
+my $fffe = "\x{FFFE}";
+my $ffff = "\x{FFFF}";
+my $hex4 = "\x{10000}";
+my $hex5 = "\x{100000}";
+my $max = "\x{10FFFF}";
+EXPECT
+UTF-16 surrogate 0xd800 at - line 3.
+UTF-16 surrogate 0xdfff at - line 4.
+Unicode character 0xfffe is illegal at - line 7.
+Unicode character 0xffff is illegal at - line 8.
+Unicode character 0x10ffff is illegal at - line 11.
use File::Spec;
require "test.pl";
-plan(tests => 43);
+plan(tests => 44);
my @tempfiles = ();
is( $INC{'Toto.pm'}, 'xyz', ' val Toto.pm is correct in %INC' );
pop @INC;
+
+my $filename = $^O eq 'MacOS' ? ':Foo:Foo.pm' : './Foo.pm';
+{
+ local @INC;
+ @INC = sub { $filename = 'seen'; return undef; };
+ eval { require $filename; };
+ is( $filename, 'seen', 'the coderef sees fully-qualified pathnames' );
+}
# \x{149} is LATIN SMALL LETTER N PRECEDED BY APOSTROPHE, its uppercase is
# \x{2BC}\x{E4} or MODIFIER LETTER APOSTROPHE and N.
-ok("\U\x{DF}ab\x{149}cd" eq "SSAB\x{2BC}NCD",
- "multicharacter uppercase");
+# In EBCDIC \x{DF} is LATIN SMALL LETTER Y WITH DIAERESIS,
+# and it's uppercase is \x{178}, LATIN CAPITAL LETTER Y WITH DIAERESIS.
+
+if (ord("A") == 193) { # EBCDIC
+ ok("\U\x{DF}aB\x{149}cD" eq "\x{178}AB\x{2BC}NCD",
+ "multicharacter uppercase");
+} elsif (ord("A") == 65) {
+ ok("\U\x{DF}aB\x{149}cD" eq "SSAB\x{2BC}NCD",
+ "multicharacter uppercase");
+} else {
+ ok(0, "what is your encoding?");
+}
# The \x{DF} is its own lowercase, ditto for \x{149}.
# There are no single character -> multiple characters lowercase mappings.
-ok("\L\x{DF}AB\x{149}CD" eq "\x{DF}ab\x{149}cd",
- "multicharacter lowercase");
+if (ord("A") == 193) { # EBCDIC
+ ok("\LaB\x{149}cD" eq "ab\x{149}cd",
+ "multicharacter lowercase");
+} elsif (ord("A") == 65) {
+ ok("\L\x{DF}aB\x{149}cD" eq "\x{DF}ab\x{149}cd",
+ "multicharacter lowercase");
+} else {
+ ok(0, "what is your encoding?");
+}
# titlecase is used for \u / ucfirst.
use Config;
use File::Spec;
-plan tests => 69;
+plan tests => 75;
my $Perl = which_perl();
# Check if you are on a tmpfs of some sort. Building in /tmp sometimes
# has this problem. Also building on the ClearCase VOBS filesystem may
# cause this failure.
+# Darwins UFS doesn't have a ctime concept, and thus is
+# expected to fail this test.
DIAG
}
}
# bug id 20011101.069
my @r = \stat(".");
is(scalar @r, 13, 'stat returns full 13 elements');
+
+SKIP: {
+ skip "No lstat", 2 unless $Config{d_lstat};
+
+ stat $0;
+ eval { lstat _ };
+ like( $@, qr/^The stat preceding lstat\(\) wasn't an lstat/,
+ 'lstat _ croaks after stat' );
+ eval { -l _ };
+ like( $@, qr/^The stat preceding -l _ wasn't an lstat/,
+ '-l _ croaks after stat' );
+
+ eval { lstat STDIN };
+ like( $@, qr/^You can't use lstat\(\) on a filehandle/,
+ 'lstat FILEHANDLE croaks' );
+ eval { -l STDIN };
+ like( $@, qr/^You can't use -l on a filehandle/,
+ '-l FILEHANDLE croaks' );
+
+ # bug id 20020124.004
+ # If we have d_lstat, we should have symlink()
+ my $linkname = 'dolzero';
+ symlink $0, $linkname or die "# Can't symlink $0: $!";
+ lstat $linkname;
+ -T _;
+ eval { lstat _ };
+ like( $@, qr/^The stat preceding lstat\(\) wasn't an lstat/,
+ 'lstat croaks after -T _' );
+ eval { -l _ };
+ like( $@, qr/^The stat preceding -l _ wasn't an lstat/,
+ '-l _ croaks after -T _' );
+ unlink $linkname or print "# unlink $linkname failed: $!\n";
+}
require "./test.pl";
-plan(tests => 14);
+plan(tests => 19);
# due to a bug in VMS's piping which makes it impossible for runperl()
-# to emulate echo -n, these tests almost totally fail.
+# to emulate echo -n (ie. stdin always winds up with a newline), these
+# tests almost totally fail.
$TODO = "runperl() unable to emulate echo -n due to pipe bug" if $^O eq 'VMS';
my $r;
is( $r, '<swtest><foo><bar>', '-m with import parameters' );
push @tmpfiles, $filename;
}
+
+# Tests for -V
+
+{
+ local $TODO = ''; # these ones should work on VMS
+
+ # basic perl -V should generate significant output.
+ # we don't test actual format since it could change
+ like( runperl( switches => ['-V'] ), qr/(\n.*){20}/,
+ '-V generates 20+ lines' );
+
+ # lookup a known config var
+ chomp( $r=runperl( switches => ['-V:osname'] ) );
+ is( $r, "osname='$^O';", 'perl -V:osname');
+
+ # lookup a nonexistent var
+ chomp( $r=runperl( switches => ['-V:this_var_makes_switches_test_fail'] ) );
+ is( $r, "this_var_makes_switches_test_fail='UNKNOWN';",
+ 'perl -V:unknown var');
+
+ # regexp lookup
+ # platforms that don't like this quoting can either skip this test
+ # or fix test.pl _quote_args
+ $r = runperl( switches => ['"-V:i\D+size"'] );
+ # should be unlike( $r, qr/^$|not found|UNKNOWN/ );
+ like( $r, qr/^(?!.*(not found|UNKNOWN))./, 'perl -V:re got a result' );
+
+ # make sure each line we got matches the re
+ ok( !( grep !/^i\D+size=/, split /^/, $r ), '-V:re correct' );
+}
U8 *
Perl_uvuni_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags)
{
- if (ckWARN_d(WARN_UTF8)) {
+ if (ckWARN(WARN_UTF8)) {
if (UNICODE_IS_SURROGATE(uv) &&
!(flags & UNICODE_ALLOW_SURROGATE))
Perl_warner(aTHX_ WARN_UTF8, "UTF-16 surrogate 0x%04"UVxf, uv);
*/
UV
-Perl_to_utf8_case(pTHX_ U8 *p, U8* ustrp, STRLEN *lenp, SV **swashp,char *normal, char *special)
+Perl_to_utf8_case(pTHX_ U8 *p, U8* ustrp, STRLEN *lenp, SV **swashp, char *normal, char *special)
{
UV uv;
if (!*swashp)
*swashp = swash_init("utf8", normal, &PL_sv_undef, 4, 0);
uv = swash_fetch(*swashp, p, TRUE);
- if (uv)
- uv = UNI_TO_NATIVE(uv);
- else {
+ if (!uv) {
HV *hv;
SV *keysv;
HE *he;
SV *val = HeVAL(he);
char *s = SvPV(val, *lenp);
U8 c = *(U8*)s;
+
if (*lenp > 1 || UNI_IS_INVARIANT(c))
Copy(s, ustrp, *lenp, U8);
else {
ustrp[1] = UTF8_EIGHT_BIT_LO(c);
*lenp = 2;
}
+#ifdef EBCDIC
+ {
+ U8 tmpbuf[UTF8_MAXLEN_FOLD+1];
+ U8 *d = tmpbuf;
+ U8 *t, *tend;
+ STRLEN tlen;
+
+ for (t = ustrp, tend = t + *lenp; t < tend; t += tlen) {
+ UV c = utf8_to_uvchr(t, &tlen);
+ d = uvchr_to_utf8(d, UNI_TO_NATIVE(c));
+ }
+ *lenp = d - tmpbuf;
+ Copy(tmpbuf, ustrp, *lenp, U8);
+ }
+#endif
return utf8_to_uvchr(ustrp, 0);
}
+ uv = NATIVE_TO_UNI(uv);
}
if (lenp)
*lenp = UNISKIP(uv);
if ((e1 == 0 && f1 == 0) || (e2 == 0 && f2 == 0) || (f1 == 0 && f2 == 0))
return 1; /* mismatch; possible infinite loop or false positive */
+ if (!u1 || !u2)
+ natbuf[1] = 0; /* Need to terminate the buffer. */
+
while ((e1 == 0 || p1 < e1) &&
(f1 == 0 || p1 < f1) &&
(e2 == 0 || p2 < e2) &&
projects / p5sagit/p5-mst-13.2.git / commitdiff