From: Gurusamy Sarathy Date: Tue, 11 Jul 2000 18:21:19 +0000 (+0000) Subject: integrate cfgperl changes#6242..6249 into mainline X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6662521eef19f96de52b97fb5fa07a85826679ee;p=p5sagit%2Fp5-mst-13.2.git integrate cfgperl changes#6242..6249 into mainline p4raw-link: @6249 on //depot/cfgperl: cab27d238e930b8cddb5b1fb3260355f913b86a6 p4raw-link: @6242 on //depot/cfgperl: 1e72252ad7b8e23d1a1142285b8aa82986bd2491 p4raw-id: //depot/perl@6359 p4raw-integrated: from //depot/cfgperl@6358 'copy in' ext/DynaLoader/DynaLoader_pm.PL (@5953..) t/lib/peek.t (@6086..) t/lib/filefunc.t t/lib/filespec.t (@6230..) pod/perlintern.pod (@6237..) pod/perlapi.pod utf8.c (@6242..) p4raw-integrated: from //depot/cfgperl@6249 'copy in' lib/IPC/Open3.pm (@5937..) p4raw-integrated: from //depot/cfgperl@6248 'copy in' pod/perlfunc.pod (@6206..) p4raw-integrated: from //depot/cfgperl@6247 'ignore' lib/File/Spec.pm (@6230..) p4raw-integrated: from //depot/cfgperl@6244 'copy in' gv.c (@6217..) 'merge in' sv.c (@6196..) p4raw-integrated: from //depot/cfgperl@6243 'copy in' pp_proto.h (@6237..) 'ignore' embedvar.h perlapi.h (@6237..) 'merge in' embed.h objXSUB.h (@6237..) embed.pl perlapi.c proto.h (@6242..) --- diff --git a/embed.h b/embed.h index 15a5020..8562cf4 100644 --- a/embed.h +++ b/embed.h @@ -305,6 +305,7 @@ #define to_uni_title_lc Perl_to_uni_title_lc #define to_uni_lower_lc Perl_to_uni_lower_lc #define is_utf8_char Perl_is_utf8_char +#define is_utf8_string Perl_is_utf8_string #define is_utf8_alnum Perl_is_utf8_alnum #define is_utf8_alnumc Perl_is_utf8_alnumc #define is_utf8_idfirst Perl_is_utf8_idfirst @@ -1759,6 +1760,7 @@ #define to_uni_title_lc(a) Perl_to_uni_title_lc(aTHX_ a) #define to_uni_lower_lc(a) Perl_to_uni_lower_lc(aTHX_ a) #define is_utf8_char(a) Perl_is_utf8_char(aTHX_ a) +#define is_utf8_string(a,b) Perl_is_utf8_string(aTHX_ a,b) #define is_utf8_alnum(a) Perl_is_utf8_alnum(aTHX_ a) #define is_utf8_alnumc(a) Perl_is_utf8_alnumc(aTHX_ a) #define is_utf8_idfirst(a) Perl_is_utf8_idfirst(aTHX_ a) @@ -3447,6 +3449,8 @@ #define to_uni_lower_lc Perl_to_uni_lower_lc #define Perl_is_utf8_char CPerlObj::Perl_is_utf8_char #define is_utf8_char Perl_is_utf8_char +#define Perl_is_utf8_string CPerlObj::Perl_is_utf8_string +#define is_utf8_string Perl_is_utf8_string #define Perl_is_utf8_alnum CPerlObj::Perl_is_utf8_alnum #define is_utf8_alnum Perl_is_utf8_alnum #define Perl_is_utf8_alnumc CPerlObj::Perl_is_utf8_alnumc diff --git a/embed.pl b/embed.pl index 21a21a1..9a45f0f 100755 --- a/embed.pl +++ b/embed.pl @@ -1620,6 +1620,7 @@ Ap |U32 |to_uni_upper_lc|U32 c Ap |U32 |to_uni_title_lc|U32 c Ap |U32 |to_uni_lower_lc|U32 c Ap |int |is_utf8_char |U8 *p +Ap |bool |is_utf8_string |U8 *s|STRLEN len Ap |bool |is_utf8_alnum |U8 *p Ap |bool |is_utf8_alnumc |U8 *p Ap |bool |is_utf8_idfirst|U8 *p @@ -2063,7 +2064,7 @@ Ap |U8* |utf16_to_utf8_reversed|U16* p|U8 *d|I32 bytelen Ap |I32 |utf8_distance |U8 *a|U8 *b Ap |U8* |utf8_hop |U8 *s|I32 off Ap |U8* |utf8_to_bytes |U8 *s|STRLEN len -Ap |U8* |bytes_to_utf8 |U8 *s|STRLEN len +Ap |U8* |bytes_to_utf8 |U8 *s|STRLEN *len Ap |UV |utf8_to_uv |U8 *s|I32* retlen Ap |U8* |uv_to_utf8 |U8 *d|UV uv p |void |vivify_defelem |SV* sv diff --git a/ext/DynaLoader/DynaLoader_pm.PL b/ext/DynaLoader/DynaLoader_pm.PL index 55b8eca..b7b45d8 100644 --- a/ext/DynaLoader/DynaLoader_pm.PL +++ b/ext/DynaLoader/DynaLoader_pm.PL @@ -21,7 +21,7 @@ package DynaLoader; # feast like to keep their secret; for wonder makes the words of # praise louder.' -# (Quote from Tolkien sugested by Anno Siegel.) +# (Quote from Tolkien suggested by Anno Siegel.) # # See pod text at end of file for documentation. # See also ext/DynaLoader/README in source tree for other information. @@ -170,8 +170,8 @@ sub bootstrap { print STDERR "DynaLoader::bootstrap for $module ", ($Is_MacOS - ? "(auto/$modpname/$modfname.$dl_dlext)\n" : - "(:auto:$modpname:$modfname.$dl_dlext)\n") + ? "(:auto:$modpname:$modfname.$dl_dlext)\n" : + "(auto/$modpname/$modfname.$dl_dlext)\n") if $dl_debug; foreach (@INC) { diff --git a/gv.c b/gv.c index 1c3a953..e24fc45 100644 --- a/gv.c +++ b/gv.c @@ -106,7 +106,7 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi) GvFILE(gv) = CopFILE(PL_curcop) ? CopFILE(PL_curcop) : ""; GvCVGEN(gv) = 0; GvEGV(gv) = gv; - sv_magic((SV*)gv, (SV*)gv, '*', name, len); + sv_magic((SV*)gv, (SV*)gv, '*', Nullch, 0); GvSTASH(gv) = (HV*)SvREFCNT_inc(stash); GvNAME(gv) = savepvn(name, len); GvNAMELEN(gv) = len; diff --git a/lib/IPC/Open3.pm b/lib/IPC/Open3.pm index 46ebd68..6d91c81 100644 --- a/lib/IPC/Open3.pm +++ b/lib/IPC/Open3.pm @@ -84,6 +84,7 @@ The order of arguments differs from that of open2(). # fixed for 5.001 by Ulrich Kunitz # ported to Win32 by Ron Schmidt, Merrill Lynch almost ended my career # fixed for autovivving FHs, tchrist again +# allow fd numbers to be used, by Frank Tobin # # $Id: open3.pl,v 1.1 1993/11/23 06:26:15 marc Exp $ # @@ -136,6 +137,16 @@ sub xclose { close $_[0] or croak "$Me: close($_[0]) failed: $!"; } +sub xfileno { + my ($fh) = @_; + return $1 if $fh =~ /^=?(\d+)$/; # deal with $fh just being an fd + return fileno $fh; +} + +sub fh_is_fd { + return $_[0] =~ /^=?\d+$/; +} + my $do_spawn = $^O eq 'os2' || $^O eq 'MSWin32'; sub _open3 { @@ -164,9 +175,9 @@ sub _open3 { $dup_err = ($dad_err =~ s/^[<>]&//); # force unqualified filehandles into caller's package - $dad_wtr = qualify $dad_wtr, $package; - $dad_rdr = qualify $dad_rdr, $package; - $dad_err = qualify $dad_err, $package; + $dad_wtr = qualify $dad_wtr, $package unless fh_is_fd($dad_wtr); + $dad_rdr = qualify $dad_rdr, $package unless fh_is_fd($dad_rdr); + $dad_err = qualify $dad_err, $package unless fh_is_fd($dad_err); my $kid_rdr = gensym; my $kid_wtr = gensym; @@ -181,20 +192,20 @@ sub _open3 { # If she wants to dup the kid's stderr onto her stdout I need to # save a copy of her stdout before I put something else there. if ($dad_rdr ne $dad_err && $dup_err - && fileno($dad_err) == fileno(STDOUT)) { + && xfileno($dad_err) == fileno(STDOUT)) { my $tmp = gensym; xopen($tmp, ">&$dad_err"); $dad_err = $tmp; } if ($dup_wtr) { - xopen \*STDIN, "<&$dad_wtr" if fileno(STDIN) != fileno($dad_wtr); + xopen \*STDIN, "<&$dad_wtr" if fileno(STDIN) != xfileno($dad_wtr); } else { xclose $dad_wtr; xopen \*STDIN, "<&=" . fileno $kid_rdr; } if ($dup_rdr) { - xopen \*STDOUT, ">&$dad_rdr" if fileno(STDOUT) != fileno($dad_rdr); + xopen \*STDOUT, ">&$dad_rdr" if fileno(STDOUT) != xfileno($dad_rdr); } else { xclose $dad_rdr; xopen \*STDOUT, ">&=" . fileno $kid_wtr; @@ -204,8 +215,8 @@ sub _open3 { # I have to use a fileno here because in this one case # I'm doing a dup but the filehandle might be a reference # (from the special case above). - xopen \*STDERR, ">&" . fileno $dad_err - if fileno(STDERR) != fileno($dad_err); + xopen \*STDERR, ">&" . xfileno($dad_err) + if fileno(STDERR) != xfileno($dad_err); } else { xclose $dad_err; xopen \*STDERR, ">&=" . fileno $kid_err; diff --git a/objXSUB.h b/objXSUB.h index d0a4588..84d041e 100644 --- a/objXSUB.h +++ b/objXSUB.h @@ -707,6 +707,10 @@ #define Perl_is_utf8_char pPerl->Perl_is_utf8_char #undef is_utf8_char #define is_utf8_char Perl_is_utf8_char +#undef Perl_is_utf8_string +#define Perl_is_utf8_string pPerl->Perl_is_utf8_string +#undef is_utf8_string +#define is_utf8_string Perl_is_utf8_string #undef Perl_is_utf8_alnum #define Perl_is_utf8_alnum pPerl->Perl_is_utf8_alnum #undef is_utf8_alnum diff --git a/perlapi.c b/perlapi.c index 4086f64..57e1b9c 100644 --- a/perlapi.c +++ b/perlapi.c @@ -1326,6 +1326,13 @@ Perl_is_utf8_char(pTHXo_ U8 *p) return ((CPerlObj*)pPerl)->Perl_is_utf8_char(p); } +#undef Perl_is_utf8_string +bool +Perl_is_utf8_string(pTHXo_ U8 *s, STRLEN len) +{ + return ((CPerlObj*)pPerl)->Perl_is_utf8_string(s, len); +} + #undef Perl_is_utf8_alnum bool Perl_is_utf8_alnum(pTHXo_ U8 *p) @@ -3352,7 +3359,7 @@ Perl_utf8_to_bytes(pTHXo_ U8 *s, STRLEN len) #undef Perl_bytes_to_utf8 U8* -Perl_bytes_to_utf8(pTHXo_ U8 *s, STRLEN len) +Perl_bytes_to_utf8(pTHXo_ U8 *s, STRLEN *len) { return ((CPerlObj*)pPerl)->Perl_bytes_to_utf8(s, len); } diff --git a/pod/perlapi.pod b/pod/perlapi.pod index f274641..86ad5bd 100644 --- a/pod/perlapi.pod +++ b/pod/perlapi.pod @@ -153,9 +153,10 @@ Found in file av.c =item bytes_to_utf8 Converts a string C of length C from ASCII into UTF8 encoding. -Returns a pointer to the newly-created string. +Returns a pointer to the newly-created string, and sets C to +reflect the new length. - U8 * bytes_to_utf8(U8 *s, STRLEN len) + U8 * bytes_to_utf8(U8 *s, STRLEN *len) =for hackers Found in file utf8.c @@ -2281,19 +2282,19 @@ false, defined or undefined. Does not handle 'get' magic. =for hackers Found in file sv.h -=item svtype +=item SvTYPE -An enum of flags for Perl types. These are found in the file B -in the C enum. Test these flags with the C macro. +Returns the type of the SV. See C. + + svtype SvTYPE(SV* sv) =for hackers Found in file sv.h -=item SvTYPE - -Returns the type of the SV. See C. +=item svtype - svtype SvTYPE(SV* sv) +An enum of flags for Perl types. These are found in the file B +in the C enum. Test these flags with the C macro. =for hackers Found in file sv.h @@ -2938,10 +2939,21 @@ Converts the specified character to uppercase. =for hackers Found in file handy.h +=item U8 *s + +Returns true if first C bytes of the given string form valid a UTF8 +string, false otherwise. + + bool_utf8_string U8 *s(STRLEN len) + +=for hackers +Found in file utf8.c + =item utf8_to_bytes Converts a string C of length C from UTF8 into ASCII encoding. Unlike C, this over-writes the original string. +Returns zero on failure after converting as much as possible. U8 * utf8_to_bytes(U8 *s, STRLEN len) diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index ce08134..6b4e971 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -4379,9 +4379,18 @@ L, and L.) =item sprintf FORMAT, LIST -Returns a string formatted by the usual C conventions of the -C library function C. See L or L -on your system for an explanation of the general principles. +Returns a string formatted by the usual C conventions of the C +library function C. See below for more details +and see L or L on your system for an explanation of +the general principles. + +For example: + + # Format number with up to 8 leading zeroes + $result = sprintf("%08d", $number); + + # Round number to 3 digits after decimal point + $rounded = sprintf("%.3f", $number); Perl does its own C formatting--it emulates the C function C, but it doesn't use it (except for floating-point diff --git a/proto.h b/proto.h index db2ae9c..31e2baf 100644 --- a/proto.h +++ b/proto.h @@ -367,6 +367,7 @@ PERL_CALLCONV U32 Perl_to_uni_upper_lc(pTHX_ U32 c); PERL_CALLCONV U32 Perl_to_uni_title_lc(pTHX_ U32 c); PERL_CALLCONV U32 Perl_to_uni_lower_lc(pTHX_ U32 c); PERL_CALLCONV int Perl_is_utf8_char(pTHX_ U8 *p); +PERL_CALLCONV bool Perl_is_utf8_string(pTHX_ U8 *s, STRLEN len); PERL_CALLCONV bool Perl_is_utf8_alnum(pTHX_ U8 *p); PERL_CALLCONV bool Perl_is_utf8_alnumc(pTHX_ U8 *p); PERL_CALLCONV bool Perl_is_utf8_idfirst(pTHX_ U8 *p); @@ -810,7 +811,7 @@ PERL_CALLCONV U8* Perl_utf16_to_utf8_reversed(pTHX_ U16* p, U8 *d, I32 bytelen); PERL_CALLCONV I32 Perl_utf8_distance(pTHX_ U8 *a, U8 *b); PERL_CALLCONV U8* Perl_utf8_hop(pTHX_ U8 *s, I32 off); PERL_CALLCONV U8* Perl_utf8_to_bytes(pTHX_ U8 *s, STRLEN len); -PERL_CALLCONV U8* Perl_bytes_to_utf8(pTHX_ U8 *s, STRLEN len); +PERL_CALLCONV U8* Perl_bytes_to_utf8(pTHX_ U8 *s, STRLEN *len); PERL_CALLCONV UV Perl_utf8_to_uv(pTHX_ U8 *s, I32* retlen); PERL_CALLCONV U8* Perl_uv_to_utf8(pTHX_ U8 *d, UV uv); PERL_CALLCONV void Perl_vivify_defelem(pTHX_ SV* sv); diff --git a/sv.c b/sv.c index df2dce6..5861ca4 100644 --- a/sv.c +++ b/sv.c @@ -2659,7 +2659,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr) char *name = GvNAME(sstr); STRLEN len = GvNAMELEN(sstr); sv_upgrade(dstr, SVt_PVGV); - sv_magic(dstr, dstr, '*', name, len); + sv_magic(dstr, dstr, '*', Nullch, 0); GvSTASH(dstr) = (HV*)SvREFCNT_inc(GvSTASH(sstr)); GvNAME(dstr) = savepvn(name, len); GvNAMELEN(dstr) = len; diff --git a/t/lib/peek.t b/t/lib/peek.t index 255512f..86fd74a 100644 --- a/t/lib/peek.t +++ b/t/lib/peek.t @@ -285,8 +285,6 @@ do_test(17, MG_VIRTUAL = &PL_vtbl_glob MG_TYPE = \'\\*\' MG_OBJ = $ADDR - MG_LEN = 1 - MG_PTR = $ADDR "a" NAME = "a" NAMELEN = 1 GvSTASH = $ADDR\\t"main" diff --git a/utf8.c b/utf8.c index b77cfdc..666ec34 100644 --- a/utf8.c +++ b/utf8.c @@ -134,6 +134,30 @@ Perl_is_utf8_char(pTHX_ U8 *s) return len; } +/* +=for apidoc Am|bool_utf8_string|U8 *s|STRLEN len + +Returns true if first C bytes of the given string form valid a UTF8 +string, false otherwise. + +=cut +*/ + +bool +Perl_is_utf8_string(pTHX_ U8 *s, STRLEN len) +{ + U8* x=s; + U8* send=s+len; + int c; + while (x < send) { + c = is_utf8_char(x); + x += c; + if (!c || x > send) + return 0; + } + return 1; +} + UV Perl_utf8_to_uv(pTHX_ U8* s, I32* retlen) { @@ -227,6 +251,7 @@ Perl_utf8_hop(pTHX_ U8 *s, I32 off) Converts a string C of length C from UTF8 into ASCII encoding. Unlike C, this over-writes the original string. +Returns zero on failure after converting as much as possible. =cut */ @@ -247,6 +272,10 @@ Perl_utf8_to_bytes(pTHX_ U8* s, STRLEN len) else { I32 ulen; UV uv = utf8_to_uv(s, &ulen); + if (uv > 255) { + *d = '\0'; + return 0; + } s += ulen; *d++ = (U8)uv; } @@ -256,24 +285,25 @@ Perl_utf8_to_bytes(pTHX_ U8* s, STRLEN len) } /* -=for apidoc Am|U8 *|bytes_to_utf8|U8 *s|STRLEN len +=for apidoc Am|U8 *|bytes_to_utf8|U8 *s|STRLEN *len Converts a string C of length C from ASCII into UTF8 encoding. -Returns a pointer to the newly-created string. +Returns a pointer to the newly-created string, and sets C to +reflect the new length. =cut */ U8* -Perl_bytes_to_utf8(pTHX_ U8* s, STRLEN len) +Perl_bytes_to_utf8(pTHX_ U8* s, STRLEN *len) { dTHR; U8 *send; U8 *d; U8 *dst; - send = s + len; + send = s + (*len); - Newz(801, d, len * 2 + 1, U8); + Newz(801, d, (*len) * 2 + 1, U8); dst = d; while (s < send) { @@ -286,6 +316,7 @@ Perl_bytes_to_utf8(pTHX_ U8* s, STRLEN len) } } *d = '\0'; + *len = d-dst; return dst; }