diff options
| -rw-r--r-- | embedvar.h | 8 | ||||
| -rw-r--r-- | gv.c | 4 | ||||
| -rw-r--r-- | intrpvar.h | 2 | ||||
| -rw-r--r-- | mg.c | 14 | ||||
| -rw-r--r-- | perl.c | 6 | ||||
| -rw-r--r-- | perlapi.h | 4 | ||||
| -rw-r--r-- | pod/perlrun.pod | 10 | ||||
| -rw-r--r-- | pod/perlunicode.pod | 7 | ||||
| -rw-r--r-- | pod/perlvar.pod | 28 | ||||
| -rw-r--r-- | win32/win32.h | 2 |
10 files changed, 50 insertions, 35 deletions
diff --git a/embedvar.h b/embedvar.h index c9a0cec8e7..e44a2cee2c 100644 --- a/embedvar.h +++ b/embedvar.h @@ -196,7 +196,6 @@ #define PL_argvoutgv (PERL_GET_INTERP->Iargvoutgv) #define PL_basetime (PERL_GET_INTERP->Ibasetime) #define PL_beginav (PERL_GET_INTERP->Ibeginav) -#define PL_bigchar (PERL_GET_INTERP->Ibigchar) #define PL_bitcount (PERL_GET_INTERP->Ibitcount) #define PL_bufend (PERL_GET_INTERP->Ibufend) #define PL_bufptr (PERL_GET_INTERP->Ibufptr) @@ -413,6 +412,7 @@ #define PL_utf8_xdigit (PERL_GET_INTERP->Iutf8_xdigit) #define PL_uudmap (PERL_GET_INTERP->Iuudmap) #define PL_warnhook (PERL_GET_INTERP->Iwarnhook) +#define PL_widesyscalls (PERL_GET_INTERP->Iwidesyscalls) #define PL_xiv_arenaroot (PERL_GET_INTERP->Ixiv_arenaroot) #define PL_xiv_root (PERL_GET_INTERP->Ixiv_root) #define PL_xnv_root (PERL_GET_INTERP->Ixnv_root) @@ -461,7 +461,6 @@ #define PL_argvoutgv (vTHX->Iargvoutgv) #define PL_basetime (vTHX->Ibasetime) #define PL_beginav (vTHX->Ibeginav) -#define PL_bigchar (vTHX->Ibigchar) #define PL_bitcount (vTHX->Ibitcount) #define PL_bufend (vTHX->Ibufend) #define PL_bufptr (vTHX->Ibufptr) @@ -678,6 +677,7 @@ #define PL_utf8_xdigit (vTHX->Iutf8_xdigit) #define PL_uudmap (vTHX->Iuudmap) #define PL_warnhook (vTHX->Iwarnhook) +#define PL_widesyscalls (vTHX->Iwidesyscalls) #define PL_xiv_arenaroot (vTHX->Ixiv_arenaroot) #define PL_xiv_root (vTHX->Ixiv_root) #define PL_xnv_root (vTHX->Ixnv_root) @@ -863,7 +863,6 @@ #define PL_argvoutgv (aTHXo->interp.Iargvoutgv) #define PL_basetime (aTHXo->interp.Ibasetime) #define PL_beginav (aTHXo->interp.Ibeginav) -#define PL_bigchar (aTHXo->interp.Ibigchar) #define PL_bitcount (aTHXo->interp.Ibitcount) #define PL_bufend (aTHXo->interp.Ibufend) #define PL_bufptr (aTHXo->interp.Ibufptr) @@ -1080,6 +1079,7 @@ #define PL_utf8_xdigit (aTHXo->interp.Iutf8_xdigit) #define PL_uudmap (aTHXo->interp.Iuudmap) #define PL_warnhook (aTHXo->interp.Iwarnhook) +#define PL_widesyscalls (aTHXo->interp.Iwidesyscalls) #define PL_xiv_arenaroot (aTHXo->interp.Ixiv_arenaroot) #define PL_xiv_root (aTHXo->interp.Ixiv_root) #define PL_xnv_root (aTHXo->interp.Ixnv_root) @@ -1129,7 +1129,6 @@ #define PL_Iargvoutgv PL_argvoutgv #define PL_Ibasetime PL_basetime #define PL_Ibeginav PL_beginav -#define PL_Ibigchar PL_bigchar #define PL_Ibitcount PL_bitcount #define PL_Ibufend PL_bufend #define PL_Ibufptr PL_bufptr @@ -1346,6 +1345,7 @@ #define PL_Iutf8_xdigit PL_utf8_xdigit #define PL_Iuudmap PL_uudmap #define PL_Iwarnhook PL_warnhook +#define PL_Iwidesyscalls PL_widesyscalls #define PL_Ixiv_arenaroot PL_xiv_arenaroot #define PL_Ixiv_root PL_xiv_root #define PL_Ixnv_root PL_xnv_root @@ -837,7 +837,6 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) case '\017': /* $^O */ case '\020': /* $^P */ case '\024': /* $^T */ - case '\025': /* $^U */ if (len > 1) break; goto magicalize; @@ -846,7 +845,8 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) break; goto ro_magicalize; case '\027': /* $^W & $^WARNING_BITS */ - if (len > 1 && strNE(name, "\027ARNING_BITS")) + if (len > 1 && (strNE(name, "\027ARNING_BITS") + || strNE(name, "\027IDE_SYSTEM_CALLS"))) break; goto magicalize; diff --git a/intrpvar.h b/intrpvar.h index 869897dff6..e578b1ab19 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -45,7 +45,7 @@ The C variable which corresponds to Perl's $^W warning variable. */ PERLVAR(Idowarn, U8) -PERLVAR(Ibigchar, bool) +PERLVAR(Iwidesyscalls, bool) /* wide system calls */ PERLVAR(Idoextract, bool) PERLVAR(Isawampersand, bool) /* must save all match strings */ PERLVAR(Iunsafe, bool) @@ -567,10 +567,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) sv_setiv(sv, (IV)PL_basetime); #endif break; - case '\025': /* ^U */ - sv_setiv(sv, (IV)PL_bigchar); - break; - case '\027': /* ^W & $^WARNING_BITS */ + case '\027': /* ^W & $^WARNING_BITS & ^WIDE_SYSTEM_CALLS */ if (*(mg->mg_ptr+1) == '\0') sv_setiv(sv, (IV)((PL_dowarn & G_WARN_ON) ? TRUE : FALSE)); else if (strEQ(mg->mg_ptr, "\027ARNING_BITS")) { @@ -586,6 +583,8 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) sv_setsv(sv, PL_compiling.cop_warnings); } } + else if (strEQ(mg->mg_ptr, "\027IDE_SYSTEM_CALLS")) + sv_setiv(sv, (IV)PL_widesyscalls); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': case '&': @@ -1710,10 +1709,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) PL_basetime = (Time_t)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); #endif break; - case '\025': /* ^U */ - PL_bigchar = SvTRUE(sv); - break; - case '\027': /* ^W & $^WARNING_BITS */ + case '\027': /* ^W & $^WARNING_BITS & ^WIDE_SYSTEM_CALLS */ if (*(mg->mg_ptr+1) == '\0') { if ( ! (PL_dowarn & G_WARN_ALL_MASK)) { i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); @@ -1739,6 +1735,8 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) } } } + else if (strEQ(mg->mg_ptr, "\027IDE_SYSTEM_CALLS")) + PL_widesyscalls = SvTRUE(sv); break; case '.': if (PL_localizing) { @@ -845,6 +845,7 @@ S_parse_body(pTHX_ va_list args) #endif case ' ': case '0': + case 'C': case 'F': case 'a': case 'c': @@ -1797,6 +1798,7 @@ S_usage(pTHX_ char *name) /* XXX move this out into a module ? */ static char *usage_msg[] = { "-0[octal] specify record separator (\\0, if no argument)", "-a autosplit mode with -n or -p (splits $_ into @F)", +"-C enable native wide character system interfaces", "-c check syntax only (runs BEGIN and END blocks)", "-d[:debugger] run program under debugger", "-D[number/list] set debugging flags (argument is a bit mask or alphabets)", @@ -1852,6 +1854,10 @@ Perl_moreswitches(pTHX_ char *s) } return s + numlen; } + case 'C': + PL_widesyscalls = TRUE; + s++; + return s; case 'F': PL_minus_F = TRUE; PL_splitstr = savepv(s + 1); @@ -130,8 +130,6 @@ START_EXTERN_C #define PL_basetime (*Perl_Ibasetime_ptr(aTHXo)) #undef PL_beginav #define PL_beginav (*Perl_Ibeginav_ptr(aTHXo)) -#undef PL_bigchar -#define PL_bigchar (*Perl_Ibigchar_ptr(aTHXo)) #undef PL_bitcount #define PL_bitcount (*Perl_Ibitcount_ptr(aTHXo)) #undef PL_bufend @@ -564,6 +562,8 @@ START_EXTERN_C #define PL_uudmap (*Perl_Iuudmap_ptr(aTHXo)) #undef PL_warnhook #define PL_warnhook (*Perl_Iwarnhook_ptr(aTHXo)) +#undef PL_widesyscalls +#define PL_widesyscalls (*Perl_Iwidesyscalls_ptr(aTHXo)) #undef PL_xiv_arenaroot #define PL_xiv_arenaroot (*Perl_Ixiv_arenaroot_ptr(aTHXo)) #undef PL_xiv_root diff --git a/pod/perlrun.pod b/pod/perlrun.pod index f668d53178..8aa06fb2bf 100644 --- a/pod/perlrun.pod +++ b/pod/perlrun.pod @@ -4,7 +4,7 @@ perlrun - how to execute the Perl interpreter =head1 SYNOPSIS -B<perl> S<[ B<-sTuUWX> ]> +B<perl> S<[ B<-CsTuUWX> ]> S<[ B<-hv> ] [ B<-V>[:I<configvar>] ]> S<[ B<-cw> ] [ B<-d>[:I<debugger>] ] [ B<-D>[I<number/list>] ]> S<[ B<-pna> ] [ B<-F>I<pattern> ] [ B<-l>[I<octal>] ] [ B<-0>[I<octal>] ]> @@ -265,6 +265,14 @@ is equivalent to An alternate delimiter may be specified using B<-F>. +=item B<-C> + +enables Perl to use the native wide character APIs on the target system. +The magic variable C<${^WIDE_SYSTEM_CALLS}> reflects the state of +this switch. See L<perlvar/"${^WIDE_SYSTEM_CALLS}">. + +This feature is currently only implemented on the Win32 platform. + =item B<-c> causes Perl to check the syntax of the program and then exit without diff --git a/pod/perlunicode.pod b/pod/perlunicode.pod index bebf7aadec..bc880364d3 100644 --- a/pod/perlunicode.pod +++ b/pod/perlunicode.pod @@ -31,9 +31,10 @@ or from literals and constants in the source text. Later, in L</Character encodings for input and output>, we'll see how such inputs may be marked as being Unicode character data sources. -If the C<$^U> global flag is set to C<1>, all system calls will use the +If the C<-C> command line switch is used, (or the ${^WIDE_SYSTEM_CALLS} +global flag is set to C<1>), all system calls will use the corresponding wide character APIs. This is currently only implemented -on Windows. [XXX: Should there be a -C switch to enable $^U?] +on Windows. Regardless of the above, the C<byte> pragma can always be used to force byte semantics in a particular lexical scope. See L<byte>. @@ -226,6 +227,6 @@ tend to run slower. Avoidance of locales is strongly encouraged. =head1 SEE ALSO -L<byte>, L<utf8>, L<perlvar/"$^U"> +L<byte>, L<utf8>, L<perlvar/"${^WIDE_SYSTEM_CALLS}"> =cut diff --git a/pod/perlvar.pod b/pod/perlvar.pod index 5b93be11f0..28842efa5b 100644 --- a/pod/perlvar.pod +++ b/pod/perlvar.pod @@ -873,19 +873,6 @@ The time at which the program began running, in seconds since the epoch (beginning of 1970). The values returned by the B<-M>, B<-A>, and B<-C> filetests are based on this value. -=item $^U - -Global flag that enables system calls made by Perl to use wide character -APIs native to the system, if available. This is currently only implemented -on the Windows platform. - -The initial value is typically C<0> for compatibility with Perl versions -earlier than 5.6, but may be automatically set to C<1> by Perl if the system -provides a user-settable default (e.g., C<$ENV{LC_CTYPE}>). - -The C<byte> pragma always overrides the effect of this flag in the current -lexical scope. See L<byte>. - =item $^V The revision, version, and subversion of the Perl interpreter, represented @@ -919,6 +906,21 @@ related to the B<-w> switch.) See also L<warnings>. The current set of warning checks enabled by the C<use warnings> pragma. See the documentation of C<warnings> for more details. +=item ${^WIDE_SYSTEM_CALLS} + +Global flag that enables system calls made by Perl to use wide character +APIs native to the system, if available. This is currently only implemented +on the Windows platform. + +This can also be enabled from the command line using the C<-C> switch. + +The initial value is typically C<0> for compatibility with Perl versions +earlier than 5.6, but may be automatically set to C<1> by Perl if the system +provides a user-settable default (e.g., C<$ENV{LC_CTYPE}>). + +The C<byte> pragma always overrides the effect of this flag in the current +lexical scope. See L<byte>. + =item $EXECUTABLE_NAME =item $^X diff --git a/win32/win32.h b/win32/win32.h index 924ce8ae03..65d24e4c65 100644 --- a/win32/win32.h +++ b/win32/win32.h @@ -432,7 +432,7 @@ struct interp_intern { lpw, wlen, (LPSTR)lpa, nChars,NULL,NULL)) #define W2AHELPER(lpw, lpa, nChars) W2AHELPER_LEN(lpw, -1, lpa, nChars) -#define USING_WIDE() (PL_bigchar && PerlEnv_os_id() == VER_PLATFORM_WIN32_NT) +#define USING_WIDE() (PL_widesyscalls && PerlEnv_os_id() == VER_PLATFORM_WIN32_NT) #ifdef USE_ITHREADS # define PERL_WAIT_FOR_CHILDREN \ |