From: Nick Ing-Simmons Date: Sun, 20 Jan 2002 20:34:36 +0000 (+0000) Subject: Integrate mainline X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2bc69dc436cd7865c8739d78d00640e6d7154cd2;p=p5sagit%2Fp5-mst-13.2.git Integrate mainline p4raw-id: //depot/perlio@14362 --- diff --git a/Configure b/Configure index fbeaa0b..59ef5eb 100755 --- a/Configure +++ b/Configure @@ -20,7 +20,7 @@ # $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $ # -# Generated on Fri Jan 18 01:06:38 EET 2002 [metaconfig 3.0 PL70] +# Generated on Sat Jan 19 05:47:21 EET 2002 [metaconfig 3.0 PL70] # (with additional metaconfig patches by perlbug@perl.org) cat >c1$$ <catdir('$(PERL_INC)',$Config{libperl}); } 1; diff --git a/lib/Pod/t/Usage.t b/lib/Pod/t/Usage.t new file mode 100644 index 0000000..4afbe5d --- /dev/null +++ b/lib/Pod/t/Usage.t @@ -0,0 +1,125 @@ +#!perl +use strict; +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; +} + +use File::Basename; +use File::Spec; +use Test::More; +plan tests => 8; + +use_ok( 'Pod::Usage' ); + +# Test verbose level 0 +my $vbl_0 = << 'EOMSG'; +Usage: + The SYNOPSIS section is displayed with -verbose >= 0. + +EOMSG +my $fake_out = tie *FAKEOUT, 'CatchOut'; +pod2usage({ -verbose => 0, -exit => 'noexit', -output => \*FAKEOUT }); +is( $$fake_out, $vbl_0, 'Verbose level 0' ); + +my $msg = "Prefix message for pod2usage()"; +$$fake_out = ''; +pod2usage({ -verbose => 0, -exit => 'noexit', -output => \*FAKEOUT, + -message => $msg }); +is( $$fake_out, "$msg\n$vbl_0", '-message parameter' ); + +SKIP: { + my( $file, $path ) = fileparse( $0 ); + skip( 'File in current directory', 2 ) if -e $file; + $$fake_out = ''; + eval { + pod2usage({ -verbose => 0, -exit => 'noexit', + -output => \*FAKEOUT, -input => $file }); + }; + like( $@, qr/^Can't open $file for reading:/, + 'File not found without -pathlist' ); + + eval { + pod2usage({ -verbose => 0, -exit => 'noexit', + -output => \*FAKEOUT, -input => $file, + -pathlist => $path }); + }; + is( $$fake_out, $vbl_0, '-pathlist parameter' ); +} + +{ # Test exit status from pod2usage() + my $exit = 42; + my $dev_null = File::Spec->devnull; + my $args = join ", ", ( + "-verbose => 0", + "-exit => $exit", + "-output => q[$dev_null]", + "-input => q[$0]", + ); + my $prg = qq[pod2usage({ $args })]; + my @cmd = ( $^X, '-I../lib', '-MPod::Usage', '-e', $prg ); + + is( system( @cmd ) >> 8, $exit, 'Exit status of pod2usage()' ); +} + +# Test verbose level 1 +my $vbl_1 = << 'EOMSG'; +Usage: + The SYNOPSIS section is displayed with -verbose >= 0. + +Options: + The OPTIONS section is displayed with -verbose >= 1. + +Arguments: + The ARGUMENTS section is displayed with -verbose >= 1. + +EOMSG +$$fake_out = ''; +pod2usage( { -verbose => 1, -exit => 'noexit', -output => \*FAKEOUT } ); +is( $$fake_out, $vbl_1, 'Verbose level 1' ); + +# Test verbose level 2 +$$fake_out = ''; +require Pod::Text; # Pod::Usage->isa( 'Pod::Text' ) + +( my $p2tp = new Pod::Text )->parse_from_file( $0, \*FAKEOUT ); +my $pod2text = $$fake_out; + +$$fake_out = ''; +pod2usage( { -verbose => 2, -exit => 'noexit', -output => \*FAKEOUT } ); +my $pod2usage = $$fake_out; + +is( $pod2usage, $pod2text, 'Verbose level >= 2 eq pod2text' ); + + +package CatchOut; +sub TIEHANDLE { bless \( my $self ), shift } +sub PRINT { my $self = shift; $$self .= $_[0] } + +__END__ + +=head1 NAME + +Usage.t - Tests for Pod::Usage + +=head1 SYNOPSIS + +The B section is displayed with -verbose >= 0. + +=head1 DESCRIPTION + +Testing Pod::Usage. This section is not displayed with -verbose < 2. + +=head1 OPTIONS + +The B section is displayed with -verbose >= 1. + +=head1 ARGUMENTS + +The B section is displayed with -verbose >= 1. + +=head1 AUTHOR + +20020105 Abe Timmerman + +=cut diff --git a/pod/perl5004delta.pod b/pod/perl5004delta.pod index 429cba9..35abf68 100644 --- a/pod/perl5004delta.pod +++ b/pod/perl5004delta.pod @@ -1,6 +1,6 @@ =head1 NAME -perldelta - what's new for perl5.004 +perl5004delta - what's new for perl5.004 =head1 DESCRIPTION diff --git a/pod/perl5005delta.pod b/pod/perl5005delta.pod index e689b84..69c3274 100644 --- a/pod/perl5005delta.pod +++ b/pod/perl5005delta.pod @@ -1,6 +1,6 @@ =head1 NAME -perldelta - what's new for perl5.005 +perl5005delta - what's new for perl5.005 =head1 DESCRIPTION diff --git a/pod/perl561delta.pod b/pod/perl561delta.pod index 652ff7f..1b9d7bb 100644 --- a/pod/perl561delta.pod +++ b/pod/perl561delta.pod @@ -1,6 +1,6 @@ =head1 NAME -perldelta - what's new for perl v5.6.x +perl561delta - what's new for perl v5.6.x =head1 DESCRIPTION diff --git a/pod/perl56delta.pod b/pod/perl56delta.pod index d525725..5d07c14 100644 --- a/pod/perl56delta.pod +++ b/pod/perl56delta.pod @@ -1,6 +1,6 @@ =head1 NAME -perldelta - what's new for perl v5.6.0 +perl56delta - what's new for perl v5.6.0 =head1 DESCRIPTION diff --git a/pod/perlfaq1.pod b/pod/perlfaq1.pod index d8e4f97..92c28f0 100644 --- a/pod/perlfaq1.pod +++ b/pod/perlfaq1.pod @@ -1,6 +1,6 @@ =head1 NAME -perlfaq1 - General Questions About Perl ($Revision: 1.3 $, $Date: 2002/01/11 02:31:20 $) +perlfaq1 - General Questions About Perl ($Revision: 1.4 $, $Date: 2002/01/18 21:00:17 $) =head1 DESCRIPTION @@ -38,7 +38,7 @@ producing better software for free than you could hope to purchase for money. You may snoop on pending developments via the archives at http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/ and http://archive.develooper.com/perl5-porters@perl.org/ -or the news gateway news://nntp.perl.org/perl.perl5.porters or +or the news gateway nntp://nntp.perl.org/perl.perl5.porters or its web interface at http://nntp.perl.org/group/perl.perl5.porters , or read the faq at http://perlhacker.org/p5p-faq, or you can subscribe to the mailing list by sending diff --git a/pod/perlfaq2.pod b/pod/perlfaq2.pod index 3ef958f..c183d18 100644 --- a/pod/perlfaq2.pod +++ b/pod/perlfaq2.pod @@ -1,6 +1,6 @@ =head1 NAME -perlfaq2 - Obtaining and Learning about Perl ($Revision: 1.4 $, $Date: 2002/01/11 02:31:20 $) +perlfaq2 - Obtaining and Learning about Perl ($Revision: 1.5 $, $Date: 2002/01/18 21:00:17 $) =head1 DESCRIPTION @@ -185,7 +185,7 @@ following groups: There is also Usenet gateway to the mailing list used by the crack Perl development team (perl5-porters) at -news://nntp.perl.org/perl.perl5.porters or its web interface at +nntp://nntp.perl.org/perl.perl5.porters or its web interface at http://nntp.perl.org/group/perl.perl5.porters . =head2 Where should I post source code? @@ -518,7 +518,6 @@ and there are many other sub-domains for special topics, such as http://bugs.perl.org/ http://history.perl.org/ http://lists.perl.org/ - http://news.perl.org/ http://use.perl.org/ http://www.cpan.org/ is the Comprehensive Perl Archive Network, diff --git a/pod/perltoc.pod b/pod/perltoc.pod index 3a43909..c1b4eb4 100644 --- a/pod/perltoc.pod +++ b/pod/perltoc.pod @@ -101,8 +101,8 @@ Parentheses for capturing, Other regexp features =back -=head2 perlfaq - frequently asked questions about Perl ($Date: 2001/11/19 -17:09:37 $) +=head2 perlfaq - frequently asked questions about Perl ($Date: 2002/01/11 +02:31:20 $) =over 4 @@ -2714,8 +2714,8 @@ tarball, Announce to the modules list, Announce to clpa, Fix bugs! =back -=head2 perlfaq1 - General Questions About Perl ($Revision: 1.2 $, $Date: -2001/11/09 08:06:04 $) +=head2 perlfaq1 - General Questions About Perl ($Revision: 1.4 $, $Date: +2002/01/18 21:00:17 $) =over 4 @@ -2761,8 +2761,8 @@ Scheme, or Tcl? =back -=head2 perlfaq2 - Obtaining and Learning about Perl ($Revision: 1.3 $, -$Date: 2001/11/09 08:06:04 $) +=head2 perlfaq2 - Obtaining and Learning about Perl ($Revision: 1.5 $, +$Date: 2002/01/18 21:00:17 $) =over 4 @@ -2817,8 +2817,8 @@ References, Tutorials, Task-Oriented, Special Topics =back -=head2 perlfaq3 - Programming Tools ($Revision: 1.10 $, $Date: 2001/11/19 -17:09:37 $) +=head2 perlfaq3 - Programming Tools ($Revision: 1.11 $, $Date: 2002/01/11 +02:31:20 $) =over 4 @@ -2903,8 +2903,8 @@ mean? =back -=head2 perlfaq4 - Data Manipulation ($Revision: 1.10 $, $Date: 2002/01/01 -22:26:45 $) +=head2 perlfaq4 - Data Manipulation ($Revision: 1.11 $, $Date: 2002/01/11 +02:31:20 $) =over 4 @@ -3118,8 +3118,8 @@ array of hashes or arrays? =back -=head2 perlfaq5 - Files and Formats ($Revision: 1.6 $, $Date: 2001/12/19 -18:17:00 $) +=head2 perlfaq5 - Files and Formats ($Revision: 1.7 $, $Date: 2002/01/11 +02:31:20 $) =over 4 @@ -3356,8 +3356,8 @@ is in scope? =back -=head2 perlfaq8 - System Interaction ($Revision: 1.4 $, $Date: 2001/11/09 -08:06:04 $) +=head2 perlfaq8 - System Interaction ($Revision: 1.5 $, $Date: 2002/01/11 +02:31:20 $) =over 4 @@ -4436,26 +4436,9 @@ croak, warn =item DESCRIPTION -=item Global Variables - -PL_DBsingle, PL_DBsub, PL_DBtrace, PL_dowarn, PL_last_in_gv, PL_ofs_sv, -PL_rs - -=item GV Functions - -is_gv_magical - -=item IO Functions - -start_glob - -=item Stack Manipulation Macros - -djSP, LVRET - -=item SV Manipulation Functions - -report_uninit, sv_add_arena, sv_clean_all, sv_clean_objs, sv_free_arenas +djSP, is_gv_magical, LVRET, PL_DBsingle, PL_DBsub, PL_DBtrace, PL_dowarn, +PL_last_in_gv, PL_ofs_sv, PL_rs, report_uninit, start_glob, sv_add_arena, +sv_clean_all, sv_clean_objs, sv_free_arenas =item AUTHORS @@ -4633,7 +4616,7 @@ PerlIO_apply_layers(f,mode,layers), PerlIO_binmode(f,ptype,imode,layers), =item Security audit shipped utilities -=item Custom opcodes +=item Sort out the uid-setting mess =item DLL Versioning @@ -4777,8 +4760,6 @@ PerlIO_apply_layers(f,mode,layers), PerlIO_binmode(f,ptype,imode,layers), =item Attach/detach debugger from running program -=item Alternative RE syntax module - =item GUI::Native =item foreach(reverse ...) @@ -4805,6 +4786,8 @@ PerlIO_apply_layers(f,mode,layers), PerlIO_binmode(f,ptype,imode,layers), =over 4 +=item Alternative RE syntax module + =item Safe signal handling =item Tie Modules @@ -5098,7 +5081,7 @@ I =item IEEE-format Floating Point Default on OpenVMS Alpha -=item Different Definition of the Unicode Character Classes \p{In...} +=item New Unicode Properties =item Perl Parser Stress Tested @@ -5120,7 +5103,7 @@ I =item Understanding of Numbers -=item Miscellaneous Enhancements +=item Miscellaneous Changes =back @@ -5566,7 +5549,7 @@ d_strtoq, d_u32align, d_ualarm, d_usleep =back -=head2 perl561delta, perldelta - what's new for perl v5.6.x +=head2 perl561delta - what's new for perl v5.6.x =over 4 @@ -5986,7 +5969,7 @@ to mean "${$}" is deprecated =back -=head2 perl56delta, perldelta - what's new for perl v5.6.0 +=head2 perl56delta - what's new for perl v5.6.0 =over 4 @@ -6371,7 +6354,7 @@ to mean "${$}" is deprecated =back -=head2 perl5005delta, perldelta - what's new for perl5.005 +=head2 perl5005delta - what's new for perl5.005 =over 4 @@ -6547,7 +6530,7 @@ temporary file, regexp too big =back -=head2 perl5004delta, perldelta - what's new for perl5.004 +=head2 perl5004delta - what's new for perl5.004 =over 4 @@ -8858,7 +8841,7 @@ RV =item B::PV METHODS -PV, PVX +PV, RV, PVX =item B::PVMG METHODS @@ -8866,7 +8849,7 @@ MAGIC, SvSTASH =item B::MAGIC METHODS -MOREMAGIC, PRIVATE, TYPE, FLAGS, OBJ, PTR +MOREMAGIC, precomp, PRIVATE, TYPE, FLAGS, OBJ, PTR, REGEX =item B::PVLV METHODS @@ -8884,7 +8867,7 @@ LINE, FILE, FILEGV, GvREFCNT, FLAGS =item B::IO METHODS LINES, PAGE, PAGE_LEN, LINES_LEFT, TOP_NAME, TOP_GV, FMT_NAME, FMT_GV, -BOTTOM_NAME, BOTTOM_GV, SUBPROCESS, IoTYPE, IoFLAGS +BOTTOM_NAME, BOTTOM_GV, SUBPROCESS, IoTYPE, IoFLAGS, IsSTD =item B::AV METHODS @@ -8923,7 +8906,8 @@ children =item B::PMOP METHODS -pmreplroot, pmreplstart, pmnext, pmregexp, pmflags, pmpermflags, precomp +pmreplroot, pmreplstart, pmnext, pmregexp, pmflags, pmdynflags, +pmpermflags, precomp, pmoffet =item B::SVOP METHOD @@ -8949,11 +8933,11 @@ label, stash, file, cop_seq, arybase, line =item FUNCTIONS EXPORTED BY C -main_cv, init_av, main_root, main_start, comppadlist, sv_undef, sv_yes, -sv_no, amagic_generation, walkoptree(OP, METHOD), walkoptree_debug(DEBUG), -walksymtable(SYMREF, METHOD, RECURSE, PREFIX), svref_2object(SV), -ppname(OPNUM), hash(STR), cast_I32(I), minus_c, cstring(STR), class(OBJ), -threadsv_names +main_cv, init_av, begin_av, end_av, main_root, main_start, comppadlist, +regex_padav, sv_undef, sv_yes, sv_no, amagic_generation, walkoptree(OP, +METHOD), walkoptree_debug(DEBUG), walksymtable(SYMREF, METHOD, RECURSE, +PREFIX), svref_2object(SV), ppname(OPNUM), hash(STR), cast_I32(I), minus_c, +cstring(STR), class(OBJ), threadsv_names =item AUTHOR @@ -9040,7 +9024,8 @@ B<-Db>, B<-Da>, B<-DC>, B<-S>, B<-upackage> B<-ofilename>, B<-v>, B<-->, B<-uPackname>, B<-D>, B<-Do>, B<-Dc>, B<-DA>, B<-DC>, B<-DM>, B<-f>, B<-fcog>, B<-fsave-data>, B<-fppaddr>, B<-fwarn-sv>, -B<-fuse-script-name>, B<-fsave-sig-hash>, B<-On>, B<-llimit> +B<-fuse-script-name>, B<-fsave-sig-hash>, B<-On>, B<-O0>, B<-O1>, B<-O2>, +B<-llimit> =item EXAMPLES @@ -9429,7 +9414,7 @@ B<-Db>, B<-Da>, B<-DC>, B<-S>, B<-upackage> =item USING THE FUNCTION-ORIENTED INTERFACE -B<:cgi>, B<:form>, B<:html2>, B<:html3>, B<:netscape>, B<:html>, +B<:cgi>, B<:form>, B<:html2>, B<:html3>, B<:html4>, B<:netscape>, B<:html>, B<:standard>, B<:all> =item PRAGMAS @@ -9440,9 +9425,9 @@ B<:standard>, B<:all> =item SPECIAL FORMS FOR IMPORTING HTML-TAG FUNCTIONS -1. start_table() (generates a tag), 2. end_table() (generates a -
tag), 3. start_ul() (generates a
    tag), 4. end_ul() (generates -a
tag) +1. start_table() (generates a tag), 2. end_table() (generates a +
tag), 3. start_ul() (generates a
    tag), 4. end_ul() (generates +a
tag) =back @@ -9562,7 +9547,7 @@ B<-name>, B<-value>, B<-path>, B<-domain>, B<-expires>, B<-secure> 1. Create a document, 2. Specify the destination for the document in the HTTP header, 3. Specify the destination for the document in -the
tag +the tag =item LIMITED SUPPORT FOR CASCADING STYLE SHEETS @@ -10980,9 +10965,19 @@ arrays =item Selecting What To Export +=item How to Import + +C, C, C + +=back + +=item Advanced features + +=over 4 + =item Specialised Import Lists -=item Exporting without using Export's import method +=item Exporting without using Exporter's import method =item Module Version Checking @@ -11189,6 +11184,19 @@ For static extensions, For dynamic extensions, For dynamic extensions =back +=head2 ExtUtils::MM_BeOS - methods to override UN*X behaviour in +ExtUtils::MakeMaker + +=over 4 + +=item SYNOPSIS + +=item DESCRIPTION + +=back + +perl_archive + =head2 ExtUtils::MM_Cygwin - methods to override UN*X behaviour in ExtUtils::MakeMaker @@ -11924,7 +11932,7 @@ rmscopy($from,$to[,$date_flag]) =back -=head2 File::Find, find - traverse a file tree +=head2 File::Find - Traverse a directory tree. =over 4 @@ -11932,10 +11940,24 @@ rmscopy($from,$to[,$date_flag]) =item DESCRIPTION +B, B + +=over 4 + +=item %options + C, C, C, C, C, C, C, C, C, C, C, C +=item The wanted function + +C<$File::Find::dir> is the current directory name,, C<$_> is the current +filename within that directory, C<$File::Find::name> is the complete +pathname to the file + +=back + =item WARNINGS =item CAVEAT @@ -13494,6 +13516,8 @@ set ( NAME => VALUE [, NAME => VALUE ...] ), setall ( VALUES ), setval ( N first BLOCK LIST, max LIST, maxstr LIST, min LIST, minstr LIST, reduce BLOCK LIST, shuffle LIST, sum LIST +=item KNOWN BUGS + =item SUGGESTED ADDITIONS =item COPYRIGHT @@ -13512,6 +13536,8 @@ general-utility list subroutines first BLOCK LIST, max LIST, maxstr LIST, min LIST, minstr LIST, reduce BLOCK LIST, shuffle LIST, sum LIST +=item KNOWN BUGS + =item SUGGESTED ADDITIONS =item COPYRIGHT @@ -13530,6 +13556,8 @@ general-utility scalar subroutines blessed EXPR, dualvar NUM, STRING, isweak EXPR, readonly SCALAR, reftype EXPR, tainted EXPR, weaken REF +=item KNOWN BUGS + =item COPYRIGHT =item BLATANT PLUG @@ -16283,6 +16311,8 @@ Memory, CPU, Snooping, Signals, State Changes blessed EXPR, dualvar NUM, STRING, isweak EXPR, readonly SCALAR, reftype EXPR, tainted EXPR, weaken REF +=item KNOWN BUGS + =item COPYRIGHT =item BLATANT PLUG @@ -16365,10 +16395,10 @@ socket.h defines and structure manipulators =item DESCRIPTION inet_aton HOSTNAME, inet_ntoa IP_ADDRESS, INADDR_ANY, INADDR_BROADCAST, -INADDR_LOOPBACK, INADDR_NONE, sockaddr_in PORT, ADDRESS, sockaddr_in -SOCKADDR_IN, pack_sockaddr_in PORT, IP_ADDRESS, unpack_sockaddr_in -SOCKADDR_IN, sockaddr_un PATHNAME, sockaddr_un SOCKADDR_UN, -pack_sockaddr_un PATH, unpack_sockaddr_un SOCKADDR_UN +INADDR_LOOPBACK, INADDR_NONE, sockaddr_family SOCKADDR, sockaddr_in PORT, +ADDRESS, sockaddr_in SOCKADDR_IN, pack_sockaddr_in PORT, IP_ADDRESS, +unpack_sockaddr_in SOCKADDR_IN, sockaddr_un PATHNAME, sockaddr_un +SOCKADDR_UN, pack_sockaddr_un PATH, unpack_sockaddr_un SOCKADDR_UN =back @@ -16410,6 +16440,8 @@ C =back +=item Storable magic + =item EXAMPLES =item WARNING @@ -16722,10 +16754,18 @@ B B, B -B +B, B + +B, B + +B + +B B +B + B =over 4 @@ -16796,9 +16836,15 @@ B<_my_exit> =item The test script output -B<'1..M'>, B<'ok', 'not ok'. Ok?>, B, -B<$Test::Harness::verbose>, B<$Test::Harness::switches>, B, -B, B, B, B +B<'1..M'>, B<'ok', 'not ok'. Ok?>, B, B, +B, B, B, B, B + +=item Taint mode + +=item Configuration variables. + +B<$Test::Harness::verbose>, B<$Test::Harness::switches> =item Failure @@ -16821,6 +16867,8 @@ B<_run_all_tests> B<_mk_leader> +B<_leader_width> + =over 4 =item EXPORT @@ -16850,6 +16898,116 @@ C =back +=head2 Test::Harness::Assert - simple assert + +=over 4 + +=item SYNOPSIS + +=item DESCRIPTION + +=over 4 + +=item Functions + +B + +=back + +=back + +=over 4 + +=item AUTHOR + +=item SEE ALSO + +=back + +=head2 Test::Harness::Iterator - Internal Test::Harness Iterator + +=over 4 + +=item SYNOPSIS + +=item DESCRIPTION + +=back + +=head2 Test::Harness::Straps - detailed analysis of test results + +=over 4 + +=item SYNOPSIS + +=item DESCRIPTION + +=over 4 + +=item Construction + +B + +=back + +=back + +B<_init> + +=over 4 + +=item Analysis + +B + +=back + +B + +B + +B<_switches> + +B<_INC2PERL5LIB> + +B<_filtered_INC> + +B<_restore_PERL5LIB> + +=over 4 + +=item Parsing + +B<_is_comment> + +=back + +B<_is_header> + +B<_is_test> + +B<_is_bail_out> + +B<_reset_file_state> + +=over 4 + +=item Results + +B<_detailize> + +=back + +=over 4 + +=item EXAMPLES + +=item AUTHOR + +=item SEE ALSO + +=back + =head2 Test::More - yet another framework for writing test scripts =over 4 @@ -16880,6 +17038,10 @@ B, B B +B + +B + B B @@ -16888,6 +17050,14 @@ B, B =over 4 +=item Diagnostics + +B + +=back + +=over 4 + =item Module tests B @@ -16904,7 +17074,7 @@ B =back -B +B, B =over 4 @@ -16922,11 +17092,19 @@ B =over 4 +=item Extending and Embedding Test::More + +B + +=back + +=over 4 + =item NOTES =item BUGS and CAVEATS -Making your own ok(), The eq_* family have some caveats, Test::Harness +Making your own ok(), The eq_* family has some caveats, Test::Harness upgrades =item HISTORY @@ -17479,11 +17657,20 @@ Unicode Collation Algorithm - Unicode TR #10, L =item DESCRIPTION +=over 4 + +=item Normalization Forms + C<$string_NFD = NFD($raw_string)>, C<$string_NFC = NFC($raw_string)>, C<$string_NFKD = NFKD($raw_string)>, C<$string_NFKC = NFKC($raw_string)>, C<$normalized_string = normalize($form_name, $raw_string)> -=over 4 +=item Character Data + +C<$canonical_decomposed = getCanon($codepoint)>, +C<$compatibility_decomposed = getCompat($codepoint)>, C<$uv_composite = +getComposite($uv_here, $uv_next)>, C<$combining_class = +getCombinClass($codepoint)>, C<$is_exclusion = isExclusion($codepoint)> =item EXPORT @@ -17493,7 +17680,7 @@ C<$normalized_string = normalize($form_name, $raw_string)> =item SEE ALSO -L, http://www.unicode.org/unicode/reports/tr15/ +http://www.unicode.org/unicode/reports/tr15/ =back diff --git a/pp.c b/pp.c index ef0c75e..997e633 100644 --- a/pp.c +++ b/pp.c @@ -2791,8 +2791,18 @@ PP(pp_hex) STRLEN len; NV result_nv; UV result_uv; + SV* sv = POPs; - tmps = (SvPVx(POPs, len)); + tmps = (SvPVx(sv, len)); + if (DO_UTF8(sv)) { + /* If Unicode, try to downgrade + * If not possible, croak. */ + SV* tsv = sv_2mortal(newSVsv(sv)); + + SvUTF8_on(tsv); + sv_utf8_downgrade(tsv, FALSE); + tmps = SvPVX(tsv); + } result_uv = grok_hex (tmps, &len, &flags, &result_nv); if (flags & PERL_SCAN_GREATER_THAN_UV_MAX) { XPUSHn(result_nv); @@ -2811,8 +2821,18 @@ PP(pp_oct) STRLEN len; NV result_nv; UV result_uv; + SV* sv = POPs; - tmps = (SvPVx(POPs, len)); + tmps = (SvPVx(sv, len)); + if (DO_UTF8(sv)) { + /* If Unicode, try to downgrade + * If not possible, croak. */ + SV* tsv = sv_2mortal(newSVsv(sv)); + + SvUTF8_on(tsv); + sv_utf8_downgrade(tsv, FALSE); + tmps = SvPVX(tsv); + } while (*tmps && len && isSPACE(*tmps)) tmps++, len--; if (*tmps == '0') @@ -3178,15 +3198,15 @@ PP(pp_crypt) STRLEN n_a; STRLEN len; char *tmps = SvPV(left, len); + if (DO_UTF8(left)) { - /* If Unicode, try to dowgrade. + /* If Unicode, try to downgrade. * If not possible, croak. * Yes, we made this up. */ SV* tsv = sv_2mortal(newSVsv(left)); - + SvUTF8_on(tsv); - if (!sv_utf8_downgrade(tsv, FALSE)) - Perl_croak(aTHX_ "Wide character in crypt"); + sv_utf8_downgrade(tsv, FALSE); tmps = SvPVX(tsv); } # ifdef FCRYPT diff --git a/t/comp/script.t b/t/comp/script.t index 2dbdaf2..6efffdf 100755 --- a/t/comp/script.t +++ b/t/comp/script.t @@ -3,10 +3,10 @@ BEGIN { chdir 't'; @INC = '../lib'; - require './test.pl'; + require './test.pl'; # for which_perl() etc } -my $Perl = which_perl; +my $Perl = which_perl(); print "1..3\n"; diff --git a/t/op/oct.t b/t/op/oct.t index 06bcf3e..f996b48 100755 --- a/t/op/oct.t +++ b/t/op/oct.t @@ -2,7 +2,7 @@ # tests 51 onwards aren't all warnings clean. (intentionally) -print "1..69\n"; +print "1..71\n"; my $test = 1; @@ -145,3 +145,8 @@ test ('hex', "x3A", 0x3A); test ('hex', "0x4", 4); test ('hex', "x4", 4); +eval '$a = oct "10\x{100}"'; +print $@ =~ /Wide character/ ? "ok $test\n" : "not ok $test\n"; $test++; + +eval '$a = hex "ab\x{100}"'; +print $@ =~ /Wide character/ ? "ok $test\n" : "not ok $test\n"; $test++; diff --git a/t/op/stat.t b/t/op/stat.t index 4857836..1c0d4b2 100755 --- a/t/op/stat.t +++ b/t/op/stat.t @@ -3,7 +3,7 @@ BEGIN { chdir 't' if -d 't'; @INC = '../lib'; - require './test.pl'; + require './test.pl'; # for which_perl() etc } use Config; @@ -11,7 +11,7 @@ use File::Spec; plan tests => 69; -my $Perl = which_perl; +my $Perl = which_perl(); $Is_Amiga = $^O eq 'amigaos'; $Is_Cygwin = $^O eq 'cygwin'; diff --git a/t/run/fresh_perl.t b/t/run/fresh_perl.t index 73680eb..d59d0da 100644 --- a/t/run/fresh_perl.t +++ b/t/run/fresh_perl.t @@ -22,12 +22,12 @@ BEGIN { chdir 't' if -d 't'; @INC = '../lib'; - require './test.pl'; + require './test.pl'; # for which_perl() etc } use strict; -my $Perl = which_perl; +my $Perl = which_perl(); $|=1; diff --git a/util.c b/util.c index 46b9ac1..0d2127b 100644 --- a/util.c +++ b/util.c @@ -4032,7 +4032,11 @@ Perl_new_vstring(pTHX_ char *s, SV *sv) return s; } -#if !defined(HAS_SOCKETPAIR) && defined(HAS_SOCKET) +#if !defined(HAS_SOCKETPAIR) && defined(HAS_SOCKET) && defined(AF_INET) && defined(PF_INET) && defined(SOCK_DGRAM) +# define EMULATE_SOCKETPAIR_UDP +#endif + +#ifdef EMULATE_SOCKETPAIR_UDP static int S_socketpair_udp (int fd[2]) { dTHX; @@ -4198,8 +4202,10 @@ Perl_my_socketpair (int family, int type, int protocol, int fd[2]) { return -1; } +#ifdef EMULATE_SOCKETPAIR_UDP if (type == SOCK_DGRAM) return S_socketpair_udp (fd); +#endif listener = PerlSock_socket (AF_INET, type, 0); if (listener == -1)