diff options
| -rwxr-xr-x | embed.pl | 2 | ||||
| -rw-r--r-- | embedvar.h | 4 | ||||
| -rw-r--r-- | global.sym | 1 | ||||
| -rw-r--r-- | gv.c | 1 | ||||
| -rw-r--r-- | intrpvar.h | 3 | ||||
| -rw-r--r-- | lib/charnames.pm | 16 | ||||
| -rw-r--r-- | lib/utf8.pm | 2 | ||||
| -rw-r--r-- | mg.c | 6 | ||||
| -rw-r--r-- | objXSUB.h | 4 | ||||
| -rw-r--r-- | op.c | 2 | ||||
| -rw-r--r-- | op.h | 3 | ||||
| -rwxr-xr-x | perlapi.c | 7 | ||||
| -rwxr-xr-x | perlapi.h | 2 | ||||
| -rw-r--r-- | pod/perlvar.pod | 35 | ||||
| -rw-r--r-- | pp.c | 2 | ||||
| -rw-r--r-- | sv.c | 8 | ||||
| -rw-r--r-- | sv.h | 11 | ||||
| -rw-r--r-- | t/lib/charnames.t | 2 | ||||
| -rw-r--r-- | toke.c | 16 | ||||
| -rw-r--r-- | win32/win32.c | 75 | ||||
| -rw-r--r-- | win32/win32.h | 8 |
21 files changed, 151 insertions, 59 deletions
@@ -1827,7 +1827,7 @@ Ap |void |push_scope p |OP* |ref |OP* o|I32 type p |OP* |refkids |OP* o|I32 type Ap |void |regdump |regexp* r -p |I32 |pregexec |regexp* prog|char* stringarg \ +Ap |I32 |pregexec |regexp* prog|char* stringarg \ |char* strend|char* strbeg|I32 minend \ |SV* screamer|U32 nosave Ap |void |pregfree |struct regexp* r diff --git a/embedvar.h b/embedvar.h index 342f5433b2..c9a0cec8e7 100644 --- a/embedvar.h +++ b/embedvar.h @@ -196,6 +196,7 @@ #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) @@ -460,6 +461,7 @@ #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) @@ -861,6 +863,7 @@ #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) @@ -1126,6 +1129,7 @@ #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 diff --git a/global.sym b/global.sym index 72a59db2ee..2f750fa170 100644 --- a/global.sym +++ b/global.sym @@ -300,6 +300,7 @@ Perl_pmflag Perl_pop_scope Perl_push_scope Perl_regdump +Perl_pregexec Perl_pregfree Perl_pregcomp Perl_re_intuit_start @@ -837,6 +837,7 @@ 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; diff --git a/intrpvar.h b/intrpvar.h index 2dde0dc4cd..869897dff6 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -44,7 +44,8 @@ The C variable which corresponds to Perl's $^W warning variable. =cut */ -PERLVAR(Idowarn, bool) +PERLVAR(Idowarn, U8) +PERLVAR(Ibigchar, bool) PERLVAR(Idoextract, bool) PERLVAR(Isawampersand, bool) /* must save all match strings */ PERLVAR(Iunsafe, bool) diff --git a/lib/charnames.pm b/lib/charnames.pm index bd97983abc..59350b2df9 100644 --- a/lib/charnames.pm +++ b/lib/charnames.pm @@ -29,17 +29,15 @@ sub charnames { } die "Unknown charname '$name'" unless @off; - # use caller 'encoding'; # Does not work at compile time? - my $ord = hex substr $txt, $off[0] - 4, 4; - if ($^H & 0x8) { - use utf8; - return chr $ord; + if ($^H & 0x10) { # "use byte" in effect? + use byte; + return chr $ord if $ord <= 255; + my $hex = sprintf '%X=0%o', $ord, $ord; + my $fname = substr $txt, $off[0] + 2, $off[1] - $off[0] - 2; + die "Character 0x$hex with name '$fname' is above 0xFF"; } - return chr $ord if $ord <= 255; - my $hex = sprintf '%X=0%o', $ord, $ord; - my $fname = substr $txt, $off[0] + 2, $off[1] - $off[0] - 2; - die "Character 0x$hex with name '$fname' is above 0xFF"; + return chr $ord; } sub import { diff --git a/lib/utf8.pm b/lib/utf8.pm index 5ddd4ba21a..691de0d630 100644 --- a/lib/utf8.pm +++ b/lib/utf8.pm @@ -1,5 +1,7 @@ package utf8; +$^U = 1; + sub import { $^H |= 0x00000008; $enc{caller()} = $_[1] if $_[1]; @@ -567,6 +567,9 @@ 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 & $^Warnings*/ if (*(mg->mg_ptr+1) == '\0') sv_setiv(sv, (IV)((PL_dowarn & G_WARN_ON) ? TRUE : FALSE)); @@ -1707,6 +1710,9 @@ 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 & $^Warnings */ if (*(mg->mg_ptr+1) == '\0') { if ( ! (PL_dowarn & G_WARN_ALL_MASK)) { @@ -1208,6 +1208,10 @@ #define Perl_regdump pPerl->Perl_regdump #undef regdump #define regdump Perl_regdump +#undef Perl_pregexec +#define Perl_pregexec pPerl->Perl_pregexec +#undef pregexec +#define pregexec Perl_pregexec #undef Perl_pregfree #define Perl_pregfree pPerl->Perl_pregfree #undef pregfree @@ -3401,7 +3401,7 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o) cop->op_ppaddr = PL_ppaddr[ OP_NEXTSTATE ]; } cop->op_flags = flags; - cop->op_private = (PL_hints & HINT_UTF8); + cop->op_private = (PL_hints & (HINT_UTF8|HINT_BYTE)); #ifdef NATIVE_HINTS cop->op_private |= NATIVE_HINTS; #endif @@ -107,6 +107,9 @@ Deprecated. Use C<GIMME_V> instead. : G_SCALAR) \ : dowantarray()) +/* NOTE: OP_NEXTSTATE, OP_DBSTATE, and OP_SETSTATE (i.e. COPs) carry lower + * bits of PL_hints in op_private */ + /* Private for lvalues */ #define OPpLVAL_INTRO 128 /* Lvalue must be localized or lvalue sub */ @@ -2212,6 +2212,13 @@ Perl_regdump(pTHXo_ regexp* r) ((CPerlObj*)pPerl)->Perl_regdump(r); } +#undef Perl_pregexec +I32 +Perl_pregexec(pTHXo_ regexp* prog, char* stringarg, char* strend, char* strbeg, I32 minend, SV* screamer, U32 nosave) +{ + return ((CPerlObj*)pPerl)->Perl_pregexec(prog, stringarg, strend, strbeg, minend, screamer, nosave); +} + #undef Perl_pregfree void Perl_pregfree(pTHXo_ struct regexp* r) @@ -130,6 +130,8 @@ 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 diff --git a/pod/perlvar.pod b/pod/perlvar.pod index 309425179f..3393fd930f 100644 --- a/pod/perlvar.pod +++ b/pod/perlvar.pod @@ -856,6 +856,41 @@ 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 switches on Unicode character support in the Perl +interpreter. The initial value is usually 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}>). It is also implicitly set to C<1> +whenever the utf8 pragma is loaded. + +Setting it to C<1> has the following effects: + +=over + +=item * + +C<chr> produces UTF-8 encoded Unicode characters. These are the same +as the corresponding ASCII characters if the argument is less than 128. + +=item * + +The C<%c> format in C<sprintf> generates a UTF-8 encoded Unicode +character. This is the same as the corresponding ASCII character +if the argument is less than 128. + +=item * + +Any system calls made by Perl will use wide character APIs native to +the system, if available. This is currently only implemented on the +Windows platform. + +=back + +The C<byte> pragma overrides the value of this flag in the current +lexical scope. See L<byte>. + =item $^V The revision, version, and subversion of the Perl interpreter, represented @@ -2202,7 +2202,7 @@ PP(pp_chr) SvUTF8_off(TARG); /* decontaminate */ (void)SvUPGRADE(TARG,SVt_PV); - if (value >= 128 && !IN_BYTE) { + if (value >= 128 && PL_bigchar && !IN_BYTE) { SvGROW(TARG,8); tmps = SvPVX(TARG); tmps = (char*)uv_to_utf8((U8*)tmps, (UV)value); @@ -3046,7 +3046,7 @@ Perl_sv_catpvn(pTHX_ register SV *sv, register const char *ptr, register STRLEN Move(ptr,SvPVX(sv)+tlen,len,char); SvCUR(sv) += len; *SvEND(sv) = '\0'; - (void)SvPOK_only(sv); /* validate pointer */ + (void)SvPOK_only_UTF8(sv); /* validate pointer */ SvTAINT(sv); } @@ -3083,6 +3083,8 @@ Perl_sv_catsv(pTHX_ SV *dstr, register SV *sstr) return; if (s = SvPV(sstr, len)) sv_catpvn(dstr,s,len); + if (SvUTF8(sstr)) + SvUTF8_on(dstr); } /* @@ -3125,7 +3127,7 @@ Perl_sv_catpv(pTHX_ register SV *sv, register const char *ptr) ptr = SvPVX(sv); Move(ptr,SvPVX(sv)+tlen,len+1,char); SvCUR(sv) += len; - (void)SvPOK_only(sv); /* validate pointer */ + (void)SvPOK_only_UTF8(sv); /* validate pointer */ SvTAINT(sv); } @@ -5828,7 +5830,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV uv = va_arg(*args, int); else uv = (svix < svmax) ? SvIVx(svargs[svix++]) : 0; - if (uv >= 128 && !IN_BYTE) { + if (uv >= 128 && PL_bigchar && !IN_BYTE) { eptr = (char*)utf8buf; elen = uv_to_utf8((U8*)eptr, uv) - utf8buf; is_utf = TRUE; @@ -503,9 +503,10 @@ Set the length of the string which is in the SV. See C<SvCUR>. #define SvOK(sv) (SvFLAGS(sv) & SVf_OK) #define SvOK_off(sv) (SvFLAGS(sv) &= ~(SVf_OK|SVf_AMAGIC| \ - SVf_IVisUV), \ + SVf_IVisUV|SVf_UTF8), \ SvOOK_off(sv)) -#define SvOK_off_exc_UV(sv) (SvFLAGS(sv) &= ~(SVf_OK|SVf_AMAGIC), \ +#define SvOK_off_exc_UV(sv) (SvFLAGS(sv) &= ~(SVf_OK|SVf_AMAGIC| \ + SVf_UTF8), \ SvOOK_off(sv)) #define SvOKp(sv) (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) @@ -547,7 +548,11 @@ Set the length of the string which is in the SV. See C<SvCUR>. #define SvPOK(sv) (SvFLAGS(sv) & SVf_POK) #define SvPOK_on(sv) (SvFLAGS(sv) |= (SVf_POK|SVp_POK)) #define SvPOK_off(sv) (SvFLAGS(sv) &= ~(SVf_POK|SVp_POK)) -#define SvPOK_only(sv) (SvFLAGS(sv) &= ~(SVf_OK|SVf_AMAGIC|SVf_IVisUV), \ +#define SvPOK_only(sv) (SvFLAGS(sv) &= ~(SVf_OK|SVf_AMAGIC| \ + SVf_IVisUV|SVf_UTF8), \ + SvFLAGS(sv) |= (SVf_POK|SVp_POK)) +#define SvPOK_only_UTF8(sv) (SvFLAGS(sv) &= ~(SVf_OK|SVf_AMAGIC| \ + SVf_IVisUV), \ SvFLAGS(sv) |= (SVf_POK|SVp_POK)) #define SvOOK(sv) (SvFLAGS(sv) & SVf_OOK) diff --git a/t/lib/charnames.t b/t/lib/charnames.t index 9775b141b2..84949896ac 100644 --- a/t/lib/charnames.t +++ b/t/lib/charnames.t @@ -16,7 +16,7 @@ print "not " unless "Here\N{EXCLAMATION MARK}?" eq "Here\041?"; print "ok 1\n"; { - no utf8; # UTEST can switch it on + use byte; # UTEST can switch utf8 on print "# \$res=$res \$\@='$@'\nnot " if $res = eval <<'EOE' @@ -1275,11 +1275,14 @@ S_scan_const(pTHX_ char *start) if (ckWARN(WARN_UTF8)) { (void)utf8_to_uv((U8*)s, &len); /* could cvt latin-1 to utf8 here... */ if (len) { + has_utf = TRUE; while (len--) *d++ = *s++; continue; } } + else + has_utf = TRUE; /* assume valid utf8 */ } /* backslashes */ @@ -6398,6 +6401,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) register char term; /* terminating character */ register char *to; /* current position in the sv's data */ I32 brackets = 1; /* bracket nesting level */ + bool has_utf = FALSE; /* is there any utf8 content? */ /* skip space before the delimiter */ if (isSPACE(*s)) @@ -6408,6 +6412,9 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) /* after skipping whitespace, the next character is the terminator */ term = *s; + if ((term & 0x80) && UTF) + has_utf = TRUE; + /* mark where we are */ PL_multi_start = CopLINE(PL_curcop); PL_multi_open = term; @@ -6452,6 +6459,8 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) have found the terminator */ else if (*s == term) break; + else if (!has_utf && (*s & 0x80) && UTF) + has_utf = TRUE; *to = *s; } } @@ -6479,6 +6488,8 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) break; else if (*s == PL_multi_open) brackets++; + else if (!has_utf && (*s & 0x80) && UTF) + has_utf = TRUE; *to = *s; } } @@ -6490,7 +6501,8 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) * this next chunk reads more into the buffer if we're not done yet */ - if (s < PL_bufend) break; /* handle case where we are done yet :-) */ + if (s < PL_bufend) + break; /* handle case where we are done yet :-) */ #ifndef PERL_STRICT_CR if (to - SvPVX(sv) >= 2) { @@ -6537,6 +6549,8 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) if (keep_delims) sv_catpvn(sv, s, 1); + if (has_utf) + SvUTF8_on(sv); PL_multi_end = CopLINE(PL_curcop); s++; diff --git a/win32/win32.c b/win32/win32.c index a50e8db0b0..86bfbb99be 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -1030,10 +1030,10 @@ win32_sleep(unsigned int t) } DllExport int -win32_stat(const char *path, struct stat *buffer) +win32_stat(const char *path, struct stat *sbuf) { dTHXo; - char t[MAX_PATH+1]; + char buffer[MAX_PATH+1]; int l = strlen(path); int res; WCHAR wbuffer[MAX_PATH+1]; @@ -1045,17 +1045,20 @@ win32_stat(const char *path, struct stat *buffer) /* FindFirstFile() and stat() are buggy with a trailing * backslash, so change it to a forward slash :-( */ case '\\': - strncpy(t, path, l-1); - t[l - 1] = '/'; - t[l] = '\0'; - path = t; + strncpy(buffer, path, l-1); + buffer[l - 1] = '/'; + buffer[l] = '\0'; + path = buffer; break; /* FindFirstFile() is buggy with "x:", so add a dot :-( */ case ':': if (l == 2 && isALPHA(path[0])) { - t[0] = path[0]; t[1] = ':'; t[2] = '.'; t[3] = '\0'; + buffer[0] = path[0]; + buffer[1] = ':'; + buffer[2] = '.'; + buffer[3] = '\0'; l = 3; - path = t; + path = buffer; } break; } @@ -1070,8 +1073,8 @@ win32_stat(const char *path, struct stat *buffer) handle = CreateFileW(wbuffer, 0, 0, NULL, OPEN_EXISTING, 0, NULL); } else { - path = PerlDir_mapA(path); - handle = CreateFileA(path, 0, 0, NULL, OPEN_EXISTING, 0, NULL); + strcpy(buffer, PerlDir_mapA(path)); + handle = CreateFileA(buffer, 0, 0, NULL, OPEN_EXISTING, 0, NULL); } if (handle != INVALID_HANDLE_VALUE) { BY_HANDLE_FILE_INFORMATION bhi; @@ -1082,32 +1085,32 @@ win32_stat(const char *path, struct stat *buffer) /* wbuffer or path will be mapped correctly above */ if (USING_WIDE()) { - res = _wstat(wbuffer, (struct _stat *)buffer); + res = _wstat(wbuffer, (struct _stat *)sbuf); } else { - res = stat(path, buffer); + res = stat(buffer, sbuf); } - buffer->st_nlink = nlink; + sbuf->st_nlink = nlink; if (res < 0) { /* CRT is buggy on sharenames, so make sure it really isn't. * XXX using GetFileAttributesEx() will enable us to set - * buffer->st_*time (but note that's not available on the + * sbuf->st_*time (but note that's not available on the * Windows of 1995) */ DWORD r; if (USING_WIDE()) { r = GetFileAttributesW(wbuffer); } else { - r = GetFileAttributesA(path); + r = GetFileAttributesA(buffer); } if (r != 0xffffffff && (r & FILE_ATTRIBUTE_DIRECTORY)) { - /* buffer may still contain old garbage since stat() failed */ - Zero(buffer, 1, struct stat); - buffer->st_mode = S_IFDIR | S_IREAD; + /* sbuf may still contain old garbage since stat() failed */ + Zero(sbuf, 1, struct stat); + sbuf->st_mode = S_IFDIR | S_IREAD; errno = 0; if (!(r & FILE_ATTRIBUTE_READONLY)) - buffer->st_mode |= S_IWRITE | S_IEXEC; + sbuf->st_mode |= S_IWRITE | S_IEXEC; return 0; } } @@ -1118,27 +1121,27 @@ win32_stat(const char *path, struct stat *buffer) /* The drive can be inaccessible, some _stat()s are buggy */ if (USING_WIDE() ? !GetVolumeInformationW(wbuffer,NULL,0,NULL,NULL,NULL,NULL,0) - : !GetVolumeInformationA(path,NULL,0,NULL,NULL,NULL,NULL,0)) { + : !GetVolumeInformationA(buffer,NULL,0,NULL,NULL,NULL,NULL,0)) { errno = ENOENT; return -1; } } #ifdef __BORLANDC__ - if (S_ISDIR(buffer->st_mode)) - buffer->st_mode |= S_IWRITE | S_IEXEC; - else if (S_ISREG(buffer->st_mode)) { + if (S_ISDIR(sbuf->st_mode)) + sbuf->st_mode |= S_IWRITE | S_IEXEC; + else if (S_ISREG(sbuf->st_mode)) { if (l >= 4 && path[l-4] == '.') { const char *e = path + l - 3; if (strnicmp(e,"exe",3) && strnicmp(e,"bat",3) && strnicmp(e,"com",3) && (IsWin95() || strnicmp(e,"cmd",3))) - buffer->st_mode &= ~S_IEXEC; + sbuf->st_mode &= ~S_IEXEC; else - buffer->st_mode |= S_IEXEC; + sbuf->st_mode |= S_IEXEC; } else - buffer->st_mode &= ~S_IEXEC; + sbuf->st_mode &= ~S_IEXEC; } #endif } @@ -1409,18 +1412,19 @@ win32_unlink(const char *filename) ret = _wunlink(wBuffer); } else { - filename = PerlDir_mapA(filename); - attrs = GetFileAttributesA(filename); + char buffer[MAX_PATH+1]; + strcpy(buffer, PerlDir_mapA(filename)); + attrs = GetFileAttributesA(buffer); if (attrs == 0xFFFFFFFF) goto fail; if (attrs & FILE_ATTRIBUTE_READONLY) { - (void)SetFileAttributesA(filename, attrs & ~FILE_ATTRIBUTE_READONLY); - ret = unlink(filename); + (void)SetFileAttributesA(buffer, attrs & ~FILE_ATTRIBUTE_READONLY); + ret = unlink(buffer); if (ret == -1) - (void)SetFileAttributesA(filename, attrs); + (void)SetFileAttributesA(buffer, attrs); } else - ret = unlink(filename); + ret = unlink(buffer); } return ret; fail: @@ -1438,6 +1442,7 @@ win32_utime(const char *filename, struct utimbuf *times) FILETIME ftWrite; struct utimbuf TimeBuffer; WCHAR wbuffer[MAX_PATH+1]; + char buffer[MAX_PATH+1]; int rc; if (USING_WIDE()) { @@ -1446,8 +1451,8 @@ win32_utime(const char *filename, struct utimbuf *times) rc = _wutime(wbuffer, (struct _utimbuf*)times); } else { - filename = PerlDir_mapA(filename); - rc = utime(filename, times); + strcpy(buffer, PerlDir_mapA(filename)); + rc = utime(buffer, times); } /* EACCES: path specifies directory or readonly file */ if (rc == 0 || errno != EACCES /* || !IsWinNT() */) @@ -1466,7 +1471,7 @@ win32_utime(const char *filename, struct utimbuf *times) OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL); } else { - handle = CreateFileA(filename, GENERIC_READ | GENERIC_WRITE, + handle = CreateFileA(buffer, GENERIC_READ | GENERIC_WRITE, FILE_SHARE_READ | FILE_SHARE_DELETE, NULL, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL); } diff --git a/win32/win32.h b/win32/win32.h index 69a4caf063..4fed26a911 100644 --- a/win32/win32.h +++ b/win32/win32.h @@ -422,12 +422,14 @@ struct interp_intern { /* Use CP_UTF8 when mode is UTF8 */ #define A2WHELPER(lpa, lpw, nBytes)\ - lpw[0] = 0, MultiByteToWideChar((IN_UTF8) ? CP_UTF8 : CP_ACP, 0, lpa, -1, lpw, (nBytes/sizeof(WCHAR))) + lpw[0] = 0, MultiByteToWideChar((IN_BYTE) ? CP_ACP : CP_UTF8, 0, \ + lpa, -1, lpw, (nBytes/sizeof(WCHAR))) #define W2AHELPER(lpw, lpa, nChars)\ - lpa[0] = '\0', WideCharToMultiByte((IN_UTF8) ? CP_UTF8 : CP_ACP, 0, lpw, -1, (LPSTR)lpa, nChars, NULL, NULL) + lpa[0] = '\0', WideCharToMultiByte((IN_BYTE) ? CP_ACP : CP_UTF8, 0, \ + lpw, -1, (LPSTR)lpa, nChars, NULL, NULL) -#define USING_WIDE() (PerlEnv_os_id() == VER_PLATFORM_WIN32_NT) +#define USING_WIDE() (PL_bigchar && PerlEnv_os_id() == VER_PLATFORM_WIN32_NT) #ifdef USE_ITHREADS # define PERL_WAIT_FOR_CHILDREN \ |