open CONFIG, ">$config_pm" or die "Can't open $config_pm: $!\n";
-$myver = $];
+$myver = 0+$];
print CONFIG <<'ENDOFBEG_NOQ', <<"ENDOFBEG";
package Config;
ENDOFBEG_NOQ
\$] == $myver
- or die "Perl lib version ($myver) doesn't match executable version (\$])";
+ or die "Perl lib version ($myver) doesn't match executable version (" . 0+\$] . ")";
# This file was created by configpm when Perl was built. Any changes
# made to this file will be lost the next time perl is built.
#define sv_2mortal Perl_sv_2mortal
#define sv_2nv Perl_sv_2nv
#define sv_2pv Perl_sv_2pv
+#define sv_2pvutf8 Perl_sv_2pvutf8
+#define sv_2pvbyte Perl_sv_2pvbyte
#define sv_2uv Perl_sv_2uv
#define sv_iv Perl_sv_iv
#define sv_uv Perl_sv_uv
#define sv_nv Perl_sv_nv
#define sv_pvn Perl_sv_pvn
+#define sv_pvutf8n Perl_sv_pvutf8n
+#define sv_pvbyten Perl_sv_pvbyten
#define sv_true Perl_sv_true
#define sv_add_arena Perl_sv_add_arena
#define sv_backoff Perl_sv_backoff
#define sv_pos_u2b Perl_sv_pos_u2b
#define sv_pos_b2u Perl_sv_pos_b2u
#define sv_pvn_force Perl_sv_pvn_force
+#define sv_pvutf8n_force Perl_sv_pvutf8n_force
+#define sv_pvbyten_force Perl_sv_pvbyten_force
#define sv_reftype Perl_sv_reftype
#define sv_replace Perl_sv_replace
#define sv_report_used Perl_sv_report_used
#define vdefault_protect Perl_vdefault_protect
#define reginitcolors Perl_reginitcolors
#define sv_2pv_nolen Perl_sv_2pv_nolen
+#define sv_2pvutf8_nolen Perl_sv_2pvutf8_nolen
+#define sv_2pvbyte_nolen Perl_sv_2pvbyte_nolen
#define sv_pv Perl_sv_pv
+#define sv_pvutf8 Perl_sv_pvutf8
+#define sv_pvbyte Perl_sv_pvbyte
#define sv_force_normal Perl_sv_force_normal
#define tmps_grow Perl_tmps_grow
#define sv_rvweaken Perl_sv_rvweaken
#define sv_2mortal(a) Perl_sv_2mortal(aTHX_ a)
#define sv_2nv(a) Perl_sv_2nv(aTHX_ a)
#define sv_2pv(a,b) Perl_sv_2pv(aTHX_ a,b)
+#define sv_2pvutf8(a,b) Perl_sv_2pvutf8(aTHX_ a,b)
+#define sv_2pvbyte(a,b) Perl_sv_2pvbyte(aTHX_ a,b)
#define sv_2uv(a) Perl_sv_2uv(aTHX_ a)
#define sv_iv(a) Perl_sv_iv(aTHX_ a)
#define sv_uv(a) Perl_sv_uv(aTHX_ a)
#define sv_nv(a) Perl_sv_nv(aTHX_ a)
#define sv_pvn(a,b) Perl_sv_pvn(aTHX_ a,b)
+#define sv_pvutf8n(a,b) Perl_sv_pvutf8n(aTHX_ a,b)
+#define sv_pvbyten(a,b) Perl_sv_pvbyten(aTHX_ a,b)
#define sv_true(a) Perl_sv_true(aTHX_ a)
#define sv_add_arena(a,b,c) Perl_sv_add_arena(aTHX_ a,b,c)
#define sv_backoff(a) Perl_sv_backoff(aTHX_ a)
#define sv_pos_u2b(a,b,c) Perl_sv_pos_u2b(aTHX_ a,b,c)
#define sv_pos_b2u(a,b) Perl_sv_pos_b2u(aTHX_ a,b)
#define sv_pvn_force(a,b) Perl_sv_pvn_force(aTHX_ a,b)
+#define sv_pvutf8n_force(a,b) Perl_sv_pvutf8n_force(aTHX_ a,b)
+#define sv_pvbyten_force(a,b) Perl_sv_pvbyten_force(aTHX_ a,b)
#define sv_reftype(a,b) Perl_sv_reftype(aTHX_ a,b)
#define sv_replace(a,b) Perl_sv_replace(aTHX_ a,b)
#define sv_report_used() Perl_sv_report_used(aTHX)
#define vdefault_protect(a,b,c,d) Perl_vdefault_protect(aTHX_ a,b,c,d)
#define reginitcolors() Perl_reginitcolors(aTHX)
#define sv_2pv_nolen(a) Perl_sv_2pv_nolen(aTHX_ a)
+#define sv_2pvutf8_nolen(a) Perl_sv_2pvutf8_nolen(aTHX_ a)
+#define sv_2pvbyte_nolen(a) Perl_sv_2pvbyte_nolen(aTHX_ a)
#define sv_pv(a) Perl_sv_pv(aTHX_ a)
+#define sv_pvutf8(a) Perl_sv_pvutf8(aTHX_ a)
+#define sv_pvbyte(a) Perl_sv_pvbyte(aTHX_ a)
#define sv_force_normal(a) Perl_sv_force_normal(aTHX_ a)
#define tmps_grow(a) Perl_tmps_grow(aTHX_ a)
#define sv_rvweaken(a) Perl_sv_rvweaken(aTHX_ a)
#define sv_2nv Perl_sv_2nv
#define Perl_sv_2pv CPerlObj::Perl_sv_2pv
#define sv_2pv Perl_sv_2pv
+#define Perl_sv_2pvutf8 CPerlObj::Perl_sv_2pvutf8
+#define sv_2pvutf8 Perl_sv_2pvutf8
+#define Perl_sv_2pvbyte CPerlObj::Perl_sv_2pvbyte
+#define sv_2pvbyte Perl_sv_2pvbyte
#define Perl_sv_2uv CPerlObj::Perl_sv_2uv
#define sv_2uv Perl_sv_2uv
#define Perl_sv_iv CPerlObj::Perl_sv_iv
#define sv_nv Perl_sv_nv
#define Perl_sv_pvn CPerlObj::Perl_sv_pvn
#define sv_pvn Perl_sv_pvn
+#define Perl_sv_pvutf8n CPerlObj::Perl_sv_pvutf8n
+#define sv_pvutf8n Perl_sv_pvutf8n
+#define Perl_sv_pvbyten CPerlObj::Perl_sv_pvbyten
+#define sv_pvbyten Perl_sv_pvbyten
#define Perl_sv_true CPerlObj::Perl_sv_true
#define sv_true Perl_sv_true
#define Perl_sv_add_arena CPerlObj::Perl_sv_add_arena
#define sv_pos_b2u Perl_sv_pos_b2u
#define Perl_sv_pvn_force CPerlObj::Perl_sv_pvn_force
#define sv_pvn_force Perl_sv_pvn_force
+#define Perl_sv_pvutf8n_force CPerlObj::Perl_sv_pvutf8n_force
+#define sv_pvutf8n_force Perl_sv_pvutf8n_force
+#define Perl_sv_pvbyten_force CPerlObj::Perl_sv_pvbyten_force
+#define sv_pvbyten_force Perl_sv_pvbyten_force
#define Perl_sv_reftype CPerlObj::Perl_sv_reftype
#define sv_reftype Perl_sv_reftype
#define Perl_sv_replace CPerlObj::Perl_sv_replace
#define reginitcolors Perl_reginitcolors
#define Perl_sv_2pv_nolen CPerlObj::Perl_sv_2pv_nolen
#define sv_2pv_nolen Perl_sv_2pv_nolen
+#define Perl_sv_2pvutf8_nolen CPerlObj::Perl_sv_2pvutf8_nolen
+#define sv_2pvutf8_nolen Perl_sv_2pvutf8_nolen
+#define Perl_sv_2pvbyte_nolen CPerlObj::Perl_sv_2pvbyte_nolen
+#define sv_2pvbyte_nolen Perl_sv_2pvbyte_nolen
#define Perl_sv_pv CPerlObj::Perl_sv_pv
#define sv_pv Perl_sv_pv
+#define Perl_sv_pvutf8 CPerlObj::Perl_sv_pvutf8
+#define sv_pvutf8 Perl_sv_pvutf8
+#define Perl_sv_pvbyte CPerlObj::Perl_sv_pvbyte
+#define sv_pvbyte Perl_sv_pvbyte
#define Perl_sv_force_normal CPerlObj::Perl_sv_force_normal
#define sv_force_normal Perl_sv_force_normal
#define Perl_tmps_grow CPerlObj::Perl_tmps_grow
p |SV* |sv_2mortal |SV* sv
p |NV |sv_2nv |SV* sv
p |char* |sv_2pv |SV* sv|STRLEN* lp
+p |char* |sv_2pvutf8 |SV* sv|STRLEN* lp
+p |char* |sv_2pvbyte |SV* sv|STRLEN* lp
p |UV |sv_2uv |SV* sv
p |IV |sv_iv |SV* sv
p |UV |sv_uv |SV* sv
p |NV |sv_nv |SV* sv
p |char* |sv_pvn |SV *sv|STRLEN *len
+p |char* |sv_pvutf8n |SV *sv|STRLEN *len
+p |char* |sv_pvbyten |SV *sv|STRLEN *len
p |I32 |sv_true |SV *sv
p |void |sv_add_arena |char* ptr|U32 size|U32 flags
p |int |sv_backoff |SV* sv
p |void |sv_pos_u2b |SV* sv|I32* offsetp|I32* lenp
p |void |sv_pos_b2u |SV* sv|I32* offsetp
p |char* |sv_pvn_force |SV* sv|STRLEN* lp
+p |char* |sv_pvutf8n_force|SV* sv|STRLEN* lp
+p |char* |sv_pvbyten_force|SV* sv|STRLEN* lp
p |char* |sv_reftype |SV* sv|int ob
p |void |sv_replace |SV* sv|SV* nsv
p |void |sv_report_used
|protect_body_t body|va_list *args
p |void |reginitcolors
p |char* |sv_2pv_nolen |SV* sv
+p |char* |sv_2pvutf8_nolen|SV* sv
+p |char* |sv_2pvbyte_nolen|SV* sv
p |char* |sv_pv |SV *sv
+p |char* |sv_pvutf8 |SV *sv
+p |char* |sv_pvbyte |SV *sv
p |void |sv_force_normal|SV *sv
p |void |tmps_grow |I32 n
p |SV* |sv_rvweaken |SV *sv
#define PL_StdIO (PERL_GET_INTERP->IStdIO)
#define PL_amagic_generation (PERL_GET_INTERP->Iamagic_generation)
#define PL_an (PERL_GET_INTERP->Ian)
-#define PL_archpat_auto (PERL_GET_INTERP->Iarchpat_auto)
#define PL_argvgv (PERL_GET_INTERP->Iargvgv)
#define PL_argvout_stack (PERL_GET_INTERP->Iargvout_stack)
#define PL_argvoutgv (PERL_GET_INTERP->Iargvoutgv)
#define PL_StdIO (vTHX->IStdIO)
#define PL_amagic_generation (vTHX->Iamagic_generation)
#define PL_an (vTHX->Ian)
-#define PL_archpat_auto (vTHX->Iarchpat_auto)
#define PL_argvgv (vTHX->Iargvgv)
#define PL_argvout_stack (vTHX->Iargvout_stack)
#define PL_argvoutgv (vTHX->Iargvoutgv)
#define PL_StdIO (aTHXo->interp.IStdIO)
#define PL_amagic_generation (aTHXo->interp.Iamagic_generation)
#define PL_an (aTHXo->interp.Ian)
-#define PL_archpat_auto (aTHXo->interp.Iarchpat_auto)
#define PL_argvgv (aTHXo->interp.Iargvgv)
#define PL_argvout_stack (aTHXo->interp.Iargvout_stack)
#define PL_argvoutgv (aTHXo->interp.Iargvoutgv)
#define PL_IStdIO PL_StdIO
#define PL_Iamagic_generation PL_amagic_generation
#define PL_Ian PL_an
-#define PL_Iarchpat_auto PL_archpat_auto
#define PL_Iargvgv PL_argvgv
#define PL_Iargvout_stack PL_argvout_stack
#define PL_Iargvoutgv PL_argvoutgv
case ']':
if (len == 1) {
SV *sv = GvSV(gv);
- (void)SvUPGRADE(sv, SVt_PVNV);
- sv_setpv(sv, PL_patchlevel);
- (void)sv_2nv(sv);
- SvREADONLY_on(sv);
+ GvSV(gv) = SvREFCNT_inc(PL_patchlevel);
+ SvREFCNT_dec(sv);
}
break;
}
/* switches */
PERLVAR(Iminus_c, bool)
-PERLVARA(Ipatchlevel,10,char)
+PERLVAR(Ipatchlevel, SV *)
PERLVAR(Ilocalpatches, char **)
PERLVARI(Isplitstr, char *, " ")
PERLVAR(Ipreprocess, bool)
/* more statics moved here */
PERLVARI(Igeneration, int, 100) /* from op.c */
PERLVAR(IDBcv, CV *) /* from perl.c */
-PERLVAR(Iarchpat_auto, char*) /* from perl.c */
PERLVARI(Iin_clean_objs,bool, FALSE) /* from sv.c */
PERLVARI(Iin_clean_all, bool, FALSE) /* from sv.c */
--- /dev/null
+package byte;
+
+sub import {
+ $^H |= 0x00000010;
+}
+
+sub unimport {
+ $^H &= ~0x00000010;
+}
+
+sub AUTOLOAD {
+ require "byte_heavy.pl";
+ goto &$AUTOLOAD;
+}
+
+sub length ($);
+
+1;
+__END__
+
+=head1 NAME
+
+byte - Perl pragma to turn force treating strings as bytes not UNICODE
+
+=head1 SYNOPSIS
+
+ use byte;
+ no byte;
+
+=head1 DESCRIPTION
+
+
+=cut
--- /dev/null
+package byte;
+
+sub length ($)
+{
+ return CORE::length($_[0]);
+}
+
+1;
#define PL_amagic_generation (*Perl_Iamagic_generation_ptr(aTHXo))
#undef PL_an
#define PL_an (*Perl_Ian_ptr(aTHXo))
-#undef PL_archpat_auto
-#define PL_archpat_auto (*Perl_Iarchpat_auto_ptr(aTHXo))
#undef PL_argvgv
#define PL_argvgv (*Perl_Iargvgv_ptr(aTHXo))
#undef PL_argvout_stack
#define Perl_sv_2pv pPerl->Perl_sv_2pv
#undef sv_2pv
#define sv_2pv Perl_sv_2pv
+#undef Perl_sv_2pvutf8
+#define Perl_sv_2pvutf8 pPerl->Perl_sv_2pvutf8
+#undef sv_2pvutf8
+#define sv_2pvutf8 Perl_sv_2pvutf8
+#undef Perl_sv_2pvbyte
+#define Perl_sv_2pvbyte pPerl->Perl_sv_2pvbyte
+#undef sv_2pvbyte
+#define sv_2pvbyte Perl_sv_2pvbyte
#undef Perl_sv_2uv
#define Perl_sv_2uv pPerl->Perl_sv_2uv
#undef sv_2uv
#define Perl_sv_pvn pPerl->Perl_sv_pvn
#undef sv_pvn
#define sv_pvn Perl_sv_pvn
+#undef Perl_sv_pvutf8n
+#define Perl_sv_pvutf8n pPerl->Perl_sv_pvutf8n
+#undef sv_pvutf8n
+#define sv_pvutf8n Perl_sv_pvutf8n
+#undef Perl_sv_pvbyten
+#define Perl_sv_pvbyten pPerl->Perl_sv_pvbyten
+#undef sv_pvbyten
+#define sv_pvbyten Perl_sv_pvbyten
#undef Perl_sv_true
#define Perl_sv_true pPerl->Perl_sv_true
#undef sv_true
#define Perl_sv_pvn_force pPerl->Perl_sv_pvn_force
#undef sv_pvn_force
#define sv_pvn_force Perl_sv_pvn_force
+#undef Perl_sv_pvutf8n_force
+#define Perl_sv_pvutf8n_force pPerl->Perl_sv_pvutf8n_force
+#undef sv_pvutf8n_force
+#define sv_pvutf8n_force Perl_sv_pvutf8n_force
+#undef Perl_sv_pvbyten_force
+#define Perl_sv_pvbyten_force pPerl->Perl_sv_pvbyten_force
+#undef sv_pvbyten_force
+#define sv_pvbyten_force Perl_sv_pvbyten_force
#undef Perl_sv_reftype
#define Perl_sv_reftype pPerl->Perl_sv_reftype
#undef sv_reftype
#define Perl_sv_2pv_nolen pPerl->Perl_sv_2pv_nolen
#undef sv_2pv_nolen
#define sv_2pv_nolen Perl_sv_2pv_nolen
+#undef Perl_sv_2pvutf8_nolen
+#define Perl_sv_2pvutf8_nolen pPerl->Perl_sv_2pvutf8_nolen
+#undef sv_2pvutf8_nolen
+#define sv_2pvutf8_nolen Perl_sv_2pvutf8_nolen
+#undef Perl_sv_2pvbyte_nolen
+#define Perl_sv_2pvbyte_nolen pPerl->Perl_sv_2pvbyte_nolen
+#undef sv_2pvbyte_nolen
+#define sv_2pvbyte_nolen Perl_sv_2pvbyte_nolen
#undef Perl_sv_pv
#define Perl_sv_pv pPerl->Perl_sv_pv
#undef sv_pv
#define sv_pv Perl_sv_pv
+#undef Perl_sv_pvutf8
+#define Perl_sv_pvutf8 pPerl->Perl_sv_pvutf8
+#undef sv_pvutf8
+#define sv_pvutf8 Perl_sv_pvutf8
+#undef Perl_sv_pvbyte
+#define Perl_sv_pvbyte pPerl->Perl_sv_pvbyte
+#undef sv_pvbyte
+#define sv_pvbyte Perl_sv_pvbyte
#undef Perl_sv_force_normal
#define Perl_sv_force_normal pPerl->Perl_sv_force_normal
#undef sv_force_normal
#define PERL_REVISION 5 /* age */
#define PERL_VERSION 5 /* epoch */
-#define PERL_SUBVERSION 63 /* generation */
+#define PERL_SUBVERSION 640 /* generation */
/* Compatibility across versions: MakeMaker will install add-on
modules in a directory with the PERL_APIVERSION version number.
See INSTALL for how this works.
*/
-#define PERL_APIVERSION 5.00563 /* Adjust manually as needed. */
+#define PERL_APIVERSION 5.00564 /* Adjust manually as needed. */
#define __PATCHLEVEL_H_INCLUDED__
#endif
init_i18nl10n(1);
SET_NUMERIC_STANDARD();
+ {
+ U8 *s;
+ PL_patchlevel = NEWSV(0,4);
+ SvUPGRADE(PL_patchlevel, SVt_PVNV);
+ if (PERL_REVISION > 127 || PERL_VERSION > 127 || PERL_SUBVERSION > 127)
+ SvGROW(PL_patchlevel,24);
+ s = (U8*)SvPVX(PL_patchlevel);
+ s = uv_to_utf8(s, (UV)PERL_REVISION);
+ s = uv_to_utf8(s, (UV)PERL_VERSION);
+ s = uv_to_utf8(s, (UV)PERL_SUBVERSION);
+ *s = '\0';
+ SvCUR_set(PL_patchlevel, s - (U8*)SvPVX(PL_patchlevel));
+ SvPOK_on(PL_patchlevel);
+ SvNVX(PL_patchlevel) = (NV)PERL_REVISION
+ + ((NV)PERL_VERSION / (NV)1000)
#if defined(PERL_SUBVERSION) && PERL_SUBVERSION > 0
- sprintf(PL_patchlevel, "%7.5f", (double) PERL_REVISION
- + ((double) PERL_VERSION / (double) 1000)
- + ((double) PERL_SUBVERSION / (double) 100000));
-#else
- sprintf(PL_patchlevel, "%5.3f", (double) PERL_REVISION +
- ((double) PERL_VERSION / (double) 1000));
+ + ((NV)PERL_SUBVERSION / (NV)1000000)
#endif
+ ;
+ SvNOK_on(PL_patchlevel); /* dual valued */
+ SvUTF8_on(PL_patchlevel);
+ SvREADONLY_on(PL_patchlevel);
+ }
#if defined(LOCAL_PATCH_COUNT)
PL_localpatches = local_patches; /* For possible -v */
Safefree(PL_inplace);
PL_inplace = Nullch;
+ SvREFCNT_dec(PL_patchlevel);
if (PL_e_script) {
SvREFCNT_dec(PL_e_script);
/* No SVs have survived, need to clean out */
Safefree(PL_origfilename);
- Safefree(PL_archpat_auto);
Safefree(PL_reg_start_tmp);
if (PL_reg_curpm)
Safefree(PL_reg_curpm);
s++;
return s;
case 'v':
-#if defined(PERL_SUBVERSION) && PERL_SUBVERSION > 0
- printf("\nThis is perl, version %d.%03d_%02d built for %s",
- PERL_REVISION, PERL_VERSION, PERL_SUBVERSION, ARCHNAME);
-#else
- printf("\nThis is perl, version %s built for %s",
- PL_patchlevel, ARCHNAME);
-#endif
+ printf("\nThis is perl, v%"UVuf".%"UVuf".%"UVuf" built for %s",
+ (UV)PERL_REVISION, (UV)PERL_VERSION, (UV)PERL_SUBVERSION, ARCHNAME);
#if defined(LOCAL_PATCH_COUNT)
if (LOCAL_PATCH_COUNT > 0)
printf("\n(with %d registered patch%s, see perl -V for more detail)",
PL_statbuf.st_mode & (S_ISUID|S_ISGID))
{
/* try again */
- PerlProc_execv(Perl_form(aTHX_ "%s/sperl%s", BIN_EXP, PL_patchlevel), PL_origargv);
+ PerlProc_execv(Perl_form(aTHX_ "%s/sperl"PERL_FS_VER_FMT, BIN_EXP,
+ (UV)PERL_REVISION, (UV)PERL_VERSION,
+ (UV)PERL_SUBVERSION), PL_origargv);
Perl_croak(aTHX_ "Can't do setuid\n");
}
#endif
(void)PerlIO_close(PL_rsfp);
#ifndef IAMSUID
/* try again */
- PerlProc_execv(Perl_form(aTHX_ "%s/sperl%s", BIN_EXP, PL_patchlevel), PL_origargv);
+ PerlProc_execv(Perl_form(aTHX_ "%s/sperl"PERL_FS_VER_FMT, BIN_EXP,
+ (UV)PERL_REVISION, (UV)PERL_VERSION,
+ (UV)PERL_SUBVERSION), PL_origargv);
#endif
Perl_croak(aTHX_ "Can't do setuid\n");
}
#if defined(HAS_FCNTL) && defined(F_SETFD)
fcntl(PerlIO_fileno(PL_rsfp),F_SETFD,0); /* ensure no close-on-exec */
#endif
- PerlProc_execv(Perl_form(aTHX_ "%s/perl%s", BIN_EXP, PL_patchlevel), PL_origargv);/* try again */
+ PerlProc_execv(Perl_form(aTHX_ "%s/perl"PERL_FS_VER_FMT, BIN_EXP,
+ (UV)PERL_REVISION, (UV)PERL_VERSION,
+ (UV)PERL_SUBVERSION), PL_origargv);/* try again */
Perl_croak(aTHX_ "Can't do setuid\n");
#endif /* IAMSUID */
#else /* !DOSUID */
if (addsubdirs) {
subdir = sv_newmortal();
- if (!PL_archpat_auto) {
- STRLEN len = (sizeof(ARCHNAME) + strlen(PL_patchlevel)
- + sizeof("//auto"));
- New(55, PL_archpat_auto, len, char);
- sprintf(PL_archpat_auto, "/%s/%s/auto", ARCHNAME, PL_patchlevel);
-#ifdef VMS
- for (len = sizeof(ARCHNAME) + 2;
- PL_archpat_auto[len] != '\0' && PL_archpat_auto[len] != '/'; len++)
- if (PL_archpat_auto[len] == '.') PL_archpat_auto[len] = '_';
-#endif
- }
}
/* Break at all separators */
SvPV(libdir,len));
#endif
/* .../archname/version if -d .../archname/version/auto */
- sv_setsv(subdir, libdir);
- sv_catpv(subdir, PL_archpat_auto);
+ Perl_sv_setpvf(aTHX_ subdir, "%_/%s/"PERL_FS_VER_FMT"/auto", libdir,
+ ARCHNAME, (UV)PERL_REVISION,
+ (UV)PERL_VERSION, (UV)PERL_SUBVERSION);
if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
S_ISDIR(tmpstatbuf.st_mode))
av_push(GvAVn(PL_incgv),
newSVpvn(SvPVX(subdir), SvCUR(subdir) - sizeof "auto"));
/* .../archname if -d .../archname/auto */
- sv_insert(subdir, SvCUR(libdir) + sizeof(ARCHNAME),
- strlen(PL_patchlevel) + 1, "", 0);
+ Perl_sv_setpvf(aTHX_ subdir, "%_/%s/auto", libdir, ARCHNAME);
if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
S_ISDIR(tmpstatbuf.st_mode))
av_push(GvAVn(PL_incgv),
# define PERL_SYS_INIT3(argvp,argcp,envp) PERL_SYS_INIT(argvp,argcp)
#endif
-#ifndef PERL_SYS_INIT3
-# define PERL_SYS_INIT3(argvp,argcp,envp) PERL_SYS_INIT(argvp,argcp)
-#endif
-
#ifndef MAXPATHLEN
# ifdef PATH_MAX
# ifdef _POSIX_PATH_MAX
#define PERL_EXIT_EXPECTED 0x01
#ifndef MEMBER_TO_FPTR
-#define MEMBER_TO_FPTR(name) name
+# define MEMBER_TO_FPTR(name) name
+#endif
+
+/* format to use for version numbers in file/directory names */
+#ifndef PERL_FS_VER_FMT
+# define PERL_FS_VER_FMT "%"UVuf".%"UVuf".%"UVuf
#endif
/* This defines a way to flush all output buffers. This may be a
#define HINT_STRICT_REFS 0x00000002
/* #define HINT_notused4 0x00000004 */
#define HINT_UTF8 0x00000008
-/* #define HINT_notused10 0x00000010 */
+#define HINT_BYTE 0x00000010
/* Note: 20,40,80 used for NATIVE_HINTS */
#define HINT_BLOCK_SCOPE 0x00000100
return ((CPerlObj*)pPerl)->Perl_sv_2pv(sv, lp);
}
+#undef Perl_sv_2pvutf8
+char*
+Perl_sv_2pvutf8(pTHXo_ SV* sv, STRLEN* lp)
+{
+ return ((CPerlObj*)pPerl)->Perl_sv_2pvutf8(sv, lp);
+}
+
+#undef Perl_sv_2pvbyte
+char*
+Perl_sv_2pvbyte(pTHXo_ SV* sv, STRLEN* lp)
+{
+ return ((CPerlObj*)pPerl)->Perl_sv_2pvbyte(sv, lp);
+}
+
#undef Perl_sv_2uv
UV
Perl_sv_2uv(pTHXo_ SV* sv)
return ((CPerlObj*)pPerl)->Perl_sv_pvn(sv, len);
}
+#undef Perl_sv_pvutf8n
+char*
+Perl_sv_pvutf8n(pTHXo_ SV *sv, STRLEN *len)
+{
+ return ((CPerlObj*)pPerl)->Perl_sv_pvutf8n(sv, len);
+}
+
+#undef Perl_sv_pvbyten
+char*
+Perl_sv_pvbyten(pTHXo_ SV *sv, STRLEN *len)
+{
+ return ((CPerlObj*)pPerl)->Perl_sv_pvbyten(sv, len);
+}
+
#undef Perl_sv_true
I32
Perl_sv_true(pTHXo_ SV *sv)
return ((CPerlObj*)pPerl)->Perl_sv_pvn_force(sv, lp);
}
+#undef Perl_sv_pvutf8n_force
+char*
+Perl_sv_pvutf8n_force(pTHXo_ SV* sv, STRLEN* lp)
+{
+ return ((CPerlObj*)pPerl)->Perl_sv_pvutf8n_force(sv, lp);
+}
+
+#undef Perl_sv_pvbyten_force
+char*
+Perl_sv_pvbyten_force(pTHXo_ SV* sv, STRLEN* lp)
+{
+ return ((CPerlObj*)pPerl)->Perl_sv_pvbyten_force(sv, lp);
+}
+
#undef Perl_sv_reftype
char*
Perl_sv_reftype(pTHXo_ SV* sv, int ob)
return ((CPerlObj*)pPerl)->Perl_sv_2pv_nolen(sv);
}
+#undef Perl_sv_2pvutf8_nolen
+char*
+Perl_sv_2pvutf8_nolen(pTHXo_ SV* sv)
+{
+ return ((CPerlObj*)pPerl)->Perl_sv_2pvutf8_nolen(sv);
+}
+
+#undef Perl_sv_2pvbyte_nolen
+char*
+Perl_sv_2pvbyte_nolen(pTHXo_ SV* sv)
+{
+ return ((CPerlObj*)pPerl)->Perl_sv_2pvbyte_nolen(sv);
+}
+
#undef Perl_sv_pv
char*
Perl_sv_pv(pTHXo_ SV *sv)
return ((CPerlObj*)pPerl)->Perl_sv_pv(sv);
}
+#undef Perl_sv_pvutf8
+char*
+Perl_sv_pvutf8(pTHXo_ SV *sv)
+{
+ return ((CPerlObj*)pPerl)->Perl_sv_pvutf8(sv);
+}
+
+#undef Perl_sv_pvbyte
+char*
+Perl_sv_pvbyte(pTHXo_ SV *sv)
+{
+ return ((CPerlObj*)pPerl)->Perl_sv_pvbyte(sv);
+}
+
#undef Perl_sv_force_normal
void
Perl_sv_force_normal(pTHXo_ SV *sv)
SV *filter_sub = 0;
sv = POPs;
- if (SvNIOKp(sv) && !SvPOKp(sv)) {
- if (Atof(PL_patchlevel) + 0.00000999 < SvNV(sv))
- DIE(aTHX_ "Perl %s required--this is only version %s, stopped",
- SvPV(sv,n_a),PL_patchlevel);
+ if (SvNIOKp(sv)) {
+ UV rev, ver, sver;
+ if (SvPOKp(sv) && SvUTF8(sv)) { /* require v5.6.1 */
+ I32 len;
+ U8 *s = (U8*)SvPVX(sv);
+ U8 *end = (U8*)SvPVX(sv) + SvCUR(sv);
+ if (s < end) {
+ rev = utf8_to_uv(s, &len);
+ s += len;
+ if (s < end) {
+ ver = utf8_to_uv(s, &len);
+ s += len;
+ if (s < end)
+ sver = utf8_to_uv(s, &len);
+ else
+ sver = 0;
+ }
+ else
+ ver = 0;
+ }
+ else
+ rev = 0;
+ if (PERL_REVISION < rev
+ || (PERL_REVISION == rev
+ && (PERL_VERSION < ver
+ || (PERL_VERSION == ver
+ && PERL_SUBVERSION < sver))))
+ {
+ DIE(aTHX_ "Perl v%"UVuf".%"UVuf".%"UVuf" required--this is only version "
+ "v%"UVuf".%"UVuf".%"UVuf", stopped", rev, ver, sver, PERL_REVISION,
+ PERL_VERSION, PERL_SUBVERSION);
+ }
+ }
+ else if (!SvPOKp(sv)) { /* require 5.005_03 */
+ NV n = SvNV(sv);
+ rev = (UV)n;
+ ver = (UV)((n-rev)*1000);
+ sver = (UV)((((n-rev)*1000 - ver) + 0.0009) * 1000);
+
+ if ((NV)PERL_REVISION + ((NV)PERL_VERSION/(NV)1000)
+ + ((NV)PERL_SUBVERSION/(NV)1000000)
+ + 0.00000099 < SvNV(sv))
+ {
+ DIE(aTHX_ "Perl v%"UVuf".%"UVuf".%"UVuf" required--this is only version "
+ "v%"UVuf".%"UVuf".%"UVuf", stopped", rev, ver, sver, PERL_REVISION,
+ PERL_VERSION, PERL_SUBVERSION);
+ }
+ }
RETPUSHYES;
}
name = SvPV(sv, len);
#include <sys/file.h>
#endif
-#define HOP(pos,off) (IN_UTF8 ? utf8_hop(pos, off) : (pos + off))
/* Hot code. */
PERL_CALLCONV SV* Perl_sv_2mortal(pTHX_ SV* sv);
PERL_CALLCONV NV Perl_sv_2nv(pTHX_ SV* sv);
PERL_CALLCONV char* Perl_sv_2pv(pTHX_ SV* sv, STRLEN* lp);
+PERL_CALLCONV char* Perl_sv_2pvutf8(pTHX_ SV* sv, STRLEN* lp);
+PERL_CALLCONV char* Perl_sv_2pvbyte(pTHX_ SV* sv, STRLEN* lp);
PERL_CALLCONV UV Perl_sv_2uv(pTHX_ SV* sv);
PERL_CALLCONV IV Perl_sv_iv(pTHX_ SV* sv);
PERL_CALLCONV UV Perl_sv_uv(pTHX_ SV* sv);
PERL_CALLCONV NV Perl_sv_nv(pTHX_ SV* sv);
PERL_CALLCONV char* Perl_sv_pvn(pTHX_ SV *sv, STRLEN *len);
+PERL_CALLCONV char* Perl_sv_pvutf8n(pTHX_ SV *sv, STRLEN *len);
+PERL_CALLCONV char* Perl_sv_pvbyten(pTHX_ SV *sv, STRLEN *len);
PERL_CALLCONV I32 Perl_sv_true(pTHX_ SV *sv);
PERL_CALLCONV void Perl_sv_add_arena(pTHX_ char* ptr, U32 size, U32 flags);
PERL_CALLCONV int Perl_sv_backoff(pTHX_ SV* sv);
PERL_CALLCONV UV Perl_to_utf8_lower(pTHX_ U8 *p);
PERL_CALLCONV UV Perl_to_utf8_upper(pTHX_ U8 *p);
PERL_CALLCONV UV Perl_to_utf8_title(pTHX_ U8 *p);
+PERL_CALLCONV STRLEN Perl_sv_len_utf8(pTHX_ SV* sv);
+PERL_CALLCONV void Perl_sv_pos_u2b(pTHX_ SV* sv, I32* offsetp, I32* lenp);
+PERL_CALLCONV void Perl_sv_pos_b2u(pTHX_ SV* sv, I32* offsetp);
+PERL_CALLCONV char* Perl_sv_pvutf8n_force(pTHX_ SV* sv, STRLEN* lp);
+PERL_CALLCONV char* Perl_sv_pvbyten_force(pTHX_ SV* sv, STRLEN* lp);
#if defined(UNLINK_ALL_VERSIONS)
PERL_CALLCONV I32 Perl_unlnk(pTHX_ char* f);
#endif
PERL_CALLCONV void Perl_ptr_table_split(pTHX_ PTR_TBL_t *tbl);
#endif
+PERL_CALLCONV char* Perl_sv_2pvutf8_nolen(pTHX_ SV* sv);
+PERL_CALLCONV char* Perl_sv_2pvbyte_nolen(pTHX_ SV* sv);
+PERL_CALLCONV char* Perl_sv_pvutf8(pTHX_ SV *sv);
+PERL_CALLCONV char* Perl_sv_pvbyte(pTHX_ SV *sv);
#if defined(PERL_OBJECT)
protected:
#else
*SvEND(dstr) = '\0';
(void)SvPOK_only(dstr);
}
+ if (SvUTF8(sstr))
+ SvUTF8_on(dstr);
/*SUPPRESS 560*/
if (sflags & SVp_NOK) {
SvNOK_on(dstr);
/* switches */
PL_minus_c = proto_perl->Iminus_c;
- Copy(proto_perl->Ipatchlevel, PL_patchlevel, 10, char);
+ PL_patchlevel = sv_dup_inc(proto_perl->Ipatchlevel);
PL_localpatches = proto_perl->Ilocalpatches;
PL_splitstr = proto_perl->Isplitstr;
PL_preprocess = proto_perl->Ipreprocess;
/* more statics moved here */
PL_generation = proto_perl->Igeneration;
PL_DBcv = cv_dup(proto_perl->IDBcv);
- PL_archpat_auto = SAVEPV(proto_perl->Iarchpat_auto);
PL_in_clean_objs = proto_perl->Iin_clean_objs;
PL_in_clean_all = proto_perl->Iin_clean_all;
#define SVf_BREAK 0x00400000 /* refcnt is artificially low */
#define SVf_READONLY 0x00800000 /* may not be modified */
-#define SVf_THINKFIRST (SVf_READONLY|SVf_ROK|SVf_FAKE)
#define SVp_IOK 0x01000000 /* has valid non-public integer value */
#define SVp_NOK 0x02000000 /* has valid non-public numeric value */
#define SVp_POK 0x04000000 /* has valid non-public pointer value */
#define SVp_SCREAM 0x08000000 /* has been studied? */
+#define SVf_UTF8 0x20000000 /* SvPVX is UTF-8 encoded */
+
+#define SVf_THINKFIRST (SVf_READONLY|SVf_ROK|SVf_FAKE|SVf_UTF8)
+
#define SVf_OK (SVf_IOK|SVf_NOK|SVf_POK|SVf_ROK| \
SVp_IOK|SVp_NOK|SVp_POK)
#define SVpad_OUR 0x80000000 /* pad name is "our" instead of "my" */
+#define SVpad_OUR 0x80000000 /* pad name is "our" instead of "my" */
+
#define SVf_IVisUV 0x80000000 /* use XPVUV instead of XPVIV */
#define SVpfm_COMPILED 0x80000000 /* FORMLINE is compiled */
SvFLAGS(sv) |= (SVf_IOK|SVp_IOK))
#define SvIOK_only_UV(sv) (SvOK_off_exc_UV(sv), \
SvFLAGS(sv) |= (SVf_IOK|SVp_IOK))
-
+
#define SvIOK_UV(sv) ((SvFLAGS(sv) & (SVf_IOK|SVf_IVisUV)) \
== (SVf_IOK|SVf_IVisUV))
#define SvIOK_notUV(sv) ((SvFLAGS(sv) & (SVf_IOK|SVf_IVisUV)) \
#define SvNOK_only(sv) (SvOK_off(sv), \
SvFLAGS(sv) |= (SVf_NOK|SVp_NOK))
+#define SvUTF8(sv) (SvFLAGS(sv) & SVf_UTF8)
+#define SvUTF8_on(sv) (SvFLAGS(sv) |= (SVf_UTF8))
+#define SvUTF8_off(sv) (SvFLAGS(sv) &= ~(SVf_UTF8))
+
#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 SvPV_force(sv, lp) sv_pvn_force(sv, &lp)
#define SvPV(sv, lp) sv_pvn(sv, &lp)
#define SvPV_nolen(sv) sv_pv(sv)
+
+#define SvPVutf8_force(sv, lp) sv_pvutf8n_force(sv, &lp)
+#define SvPVutf8(sv, lp) sv_pvutf8n(sv, &lp)
+#define SvPVutf8_nolen(sv) sv_pvutf8(sv)
+
+#define SvPVbyte_force(sv, lp) sv_pvbyte_force(sv, &lp)
+#define SvPVbyte(sv, lp) sv_pvbyten(sv, &lp)
+#define SvPVbyte_nolen(sv) sv_pvbyte(sv)
+
+#define SvPVx(sv, lp) sv_pvn(sv, &lp)
+#define SvPVx_force(sv, lp) sv_pvn_force(sv, &lp)
+#define SvPVutf8x(sv, lp) sv_pvutf8n(sv, &lp)
+#define SvPVutf8x_force(sv, lp) sv_pvutf8n_force(sv, &lp)
+#define SvPVbytex(sv, lp) sv_pvbyten(sv, &lp)
+#define SvPVbytex_force(sv, lp) sv_pvbyten_force(sv, &lp)
+
#define SvIVx(sv) sv_iv(sv)
#define SvUVx(sv) sv_uv(sv)
#define SvNVx(sv) sv_nv(sv)
-#define SvPVx(sv, lp) sv_pvn(sv, &lp)
-#define SvPVx_force(sv, lp) sv_pvn_force(sv, &lp)
+
#define SvTRUEx(sv) sv_true(sv)
#define SvIV(sv) SvIVx(sv)
#undef SvPV
#define SvPV(sv, lp) \
- (SvPOK(sv) ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv(sv, &lp))
+ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv(sv, &lp))
+
#undef SvPV_force
#define SvPV_force(sv, lp) \
#undef SvPV_nolen
#define SvPV_nolen(sv) \
- (SvPOK(sv) ? SvPVX(sv) : sv_2pv_nolen(sv))
+ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ ? SvPVX(sv) : sv_2pv_nolen(sv))
+
+#undef SvPVutf8
+#define SvPVutf8(sv, lp) \
+ ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK|SVf_UTF8) \
+ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvutf8(sv, &lp))
+
+#undef SvPVutf8_force
+#define SvPVutf8_force(sv, lp) \
+ ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == (SVf_POK|SVf_UTF8) \
+ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvutf8n_force(sv, &lp))
+
+#undef SvPVutf8_nolen
+#define SvPVutf8_nolen(sv) \
+ ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK|SVf_UTF8)\
+ ? SvPVX(sv) : sv_2pvutf8_nolen(sv))
+
+#undef SvPVutf8
+#define SvPVutf8(sv, lp) \
+ ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK|SVf_UTF8) \
+ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvutf8(sv, &lp))
+
+#undef SvPVutf8_force
+#define SvPVutf8_force(sv, lp) \
+ ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == (SVf_POK|SVf_UTF8) \
+ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvutf8n_force(sv, &lp))
+
+#undef SvPVutf8_nolen
+#define SvPVutf8_nolen(sv) \
+ ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK|SVf_UTF8)\
+ ? SvPVX(sv) : sv_2pvutf8_nolen(sv))
+
+#undef SvPVbyte
+#define SvPVbyte(sv, lp) \
+ ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
+ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
+
+#undef SvPVbyte_force
+#define SvPVbyte_force(sv, lp) \
+ ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVf_THINKFIRST)) == (SVf_POK) \
+ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvbyte_force(sv, &lp))
+
+#undef SvPVbyte_nolen
+#define SvPVbyte_nolen(sv) \
+ ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK)\
+ ? SvPVX(sv) : sv_2pvbyte_nolen(sv))
+
#ifdef __GNUC__
# undef SvIVx
# undef SvUVx
# undef SvNVx
# undef SvPVx
+# undef SvPVutf8x
+# undef SvPVbytex
# undef SvTRUE
# undef SvTRUEx
# define SvIVx(sv) ({SV *nsv = (SV*)(sv); SvIV(nsv); })
# define SvUVx(sv) ({SV *nsv = (SV*)(sv); SvUV(nsv); })
# define SvNVx(sv) ({SV *nsv = (SV*)(sv); SvNV(nsv); })
# define SvPVx(sv, lp) ({SV *nsv = (sv); SvPV(nsv, lp); })
+# define SvPVutf8x(sv, lp) ({SV *nsv = (sv); SvPVutf8(nsv, lp); })
+# define SvPVbytex(sv, lp) ({SV *nsv = (sv); SvPVbyte(nsv, lp); })
# define SvTRUE(sv) ( \
!sv \
? 0 \
# undef SvUVx
# undef SvNVx
# undef SvPVx
+# undef SvPVutf8x
+# undef SvPVbytex
# undef SvTRUE
# undef SvTRUEx
# define SvIVx(sv) ((PL_Sv = (sv)), SvIV(PL_Sv))
# define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
# define SvNVx(sv) ((PL_Sv = (sv)), SvNV(PL_Sv))
# define SvPVx(sv, lp) ((PL_Sv = (sv)), SvPV(PL_Sv, lp))
+# define SvPVutf8x(sv, lp) ((PL_Sv = (sv)), SvPVutf8(PL_Sv, lp))
+# define SvPVbytex(sv, lp) ((PL_Sv = (sv)), SvPVbyte(PL_Sv, lp))
# define SvTRUE(sv) ( \
!sv \
? 0 \
# don't make this lexical
$i = 1;
-print "1..4\n";
+print "1..16\n";
sub do_require {
%INC = ();
close REQ;
}
+# new style version numbers
+
+eval { require v5.5.630; };
+print "# $@\nnot " if $@;
+print "ok ",$i++,"\n";
+
+eval { require v10.0.2; };
+print "# $@\nnot " unless $@ =~ /^Perl v10\.0\.2 required/;
+print "ok ",$i++,"\n";
+
+eval q{ use v5.5.630; };
+print "# $@\nnot " if $@;
+print "ok ",$i++,"\n";
+
+eval q{ use v10.0.2; };
+print "# $@\nnot " unless $@ =~ /^Perl v10\.0\.2 required/;
+print "ok ",$i++,"\n";
+
+my $ver = v5.5.630;
+eval { require $ver; };
+print "# $@\nnot " if $@;
+print "ok ",$i++,"\n";
+
+$ver = v10.0.2;
+eval { require $ver; };
+print "# $@\nnot " unless $@ =~ /^Perl v10\.0\.2 required/;
+print "ok ",$i++,"\n";
+
+print "not " unless v5.5.1 gt v5.5;
+print "ok ",$i++,"\n";
+
+print "not " unless 5.005_01 > v5.5;
+print "ok ",$i++,"\n";
+
+print "not " unless 5.005_64 - v5.5.640 < 0.0000001;
+print "ok ",$i++,"\n";
+
+{
+ use utf8;
+ print "not " unless v5.5.640 eq "\x{5}\x{5}\x{280}";
+ print "ok ",$i++,"\n";
+
+ print "not " unless v7.15 eq "\x{7}\x{f}";
+ print "ok ",$i++,"\n";
+
+ print "not "
+ unless v1.20.300.4000.50000.600000 eq "\x{1}\x{14}\x{12c}\x{fa0}\x{c350}\x{927c0}";
+ print "ok ",$i++,"\n";
+}
+
# interaction with pod (see the eof)
write_file('bleah.pm', "print 'ok $i\n'; 1;\n");
require "bleah.pm";
s = skipspace(s);
- /* default VERSION number -- GBARR */
-
- if(isDIGIT(*s)) {
- char *d;
- int c;
- for( d=s, c = 1; isDIGIT(*d) || *d == '_' || (*d == '.' && c--); d++);
- if((*d == ';' || isSPACE(*d)) && *(skipspace(d)) != ',') {
+ if (isDIGIT(*s) || (*s == 'v' && isDIGIT(s[1]))) {
+ char *d = s;
+ if (*d == 'v')
+ d++;
+ for (; isDIGIT(*d) || *d == '_' || *d == '.'; d++);
+ if ((*d == ';' || isSPACE(*d)) && *(skipspace(d)) != ',') {
s = scan_num(s);
/* real VERSION number -- GBARR */
version = yylval.opval;
no_op("Backslash",s);
OPERATOR(REFGEN);
+ case 'v':
+ if (isDIGIT(s[1]) && PL_expect == XTERM) {
+ char *start = s;
+ start++;
+ start++;
+ while (isDIGIT(*start))
+ start++;
+ if (*start == '.' && isDIGIT(start[1])) {
+ s = scan_num(s);
+ TERM(THING);
+ }
+ }
+ goto keylookup;
case 'x':
if (isDIGIT(s[1]) && PL_expect == XOPERATOR) {
s++;
case 's': case 'S':
case 't': case 'T':
case 'u': case 'U':
- case 'v': case 'V':
+ case 'V':
case 'w': case 'W':
case 'X':
case 'y': case 'Y':
OLDLOP(OP_RETURN);
case KEY_require:
- *PL_tokenbuf = '\0';
- s = force_word(s,WORD,TRUE,TRUE,FALSE);
- if (isIDFIRST_lazy(PL_tokenbuf))
- gv_stashpvn(PL_tokenbuf, strlen(PL_tokenbuf), TRUE);
- else if (*s == '<')
- yyerror("<> should be quotes");
+ s = skipspace(s);
+ if (isDIGIT(*s) || (*s == 'v' && isDIGIT(s[1]))) {
+ s = force_version(s);
+ }
+ else {
+ *PL_tokenbuf = '\0';
+ s = force_word(s,WORD,TRUE,TRUE,FALSE);
+ if (isIDFIRST_lazy(PL_tokenbuf))
+ gv_stashpvn(PL_tokenbuf, strlen(PL_tokenbuf), TRUE);
+ else if (*s == '<')
+ yyerror("<> should be quotes");
+ }
UNI(OP_REQUIRE);
case KEY_reset:
if (PL_expect != XSTATE)
yyerror("\"use\" not allowed in expression");
s = skipspace(s);
- if(isDIGIT(*s)) {
+ if (isDIGIT(*s) || (*s == 'v' && isDIGIT(s[1]))) {
s = force_version(s);
- if(*s == ';' || (s = skipspace(s), *s == ';')) {
+ if (*s == ';' || (s = skipspace(s), *s == ';')) {
PL_nextval[PL_nexttoke].opval = Nullop;
force_next(WORD);
}
register char *e; /* end of temp buffer */
IV tryiv; /* used to see if it can be an IV */
NV value; /* number read, as a double */
- SV *sv; /* place to put the converted number */
+ SV *sv = Nullsv; /* place to put the converted number */
bool floatit; /* boolean: int or float? */
char *lastub = 0; /* position of last underbar */
static char number_too_long[] = "Number too long";
Perl_croak(aTHX_ "panic: scan_num");
/* if it starts with a 0, it could be an octal number, a decimal in
- 0.13 disguise, or a hexadecimal number, or a binary number.
- */
+ 0.13 disguise, or a hexadecimal number, or a binary number. */
case '0':
{
/* variables:
(floatit ? "float" : "integer"),
sv, Nullsv, NULL);
break;
+ /* if it starts with a v, it could be a version number */
+ case 'v':
+ {
+ char *pos = s;
+ pos++;
+ while (isDIGIT(*pos))
+ pos++;
+ if (*pos == '.' && isDIGIT(pos[1])) {
+ UV rev;
+ U8 tmpbuf[10];
+ U8 *tmpend;
+ NV nshift = 1.0;
+ s++; /* get past 'v' */
+
+ sv = NEWSV(92,5);
+ SvUPGRADE(sv, SVt_PVNV);
+ sv_setpvn(sv, "", 0);
+
+ do {
+ rev = atoi(s);
+ s = ++pos;
+ while (isDIGIT(*pos))
+ pos++;
+
+ tmpend = uv_to_utf8(tmpbuf, rev);
+ *tmpend = '\0';
+ sv_catpvn(sv, tmpbuf, tmpend - tmpbuf);
+ if (rev > 0)
+ SvNVX(sv) += (NV)rev/nshift;
+ nshift *= 1000;
+ } while (*pos == '.' && isDIGIT(pos[1]));
+
+ rev = atoi(s);
+ s = pos;
+ tmpend = uv_to_utf8(tmpbuf, rev);
+ *tmpend = '\0';
+ sv_catpvn(sv, tmpbuf, tmpend - tmpbuf);
+ if (rev > 0)
+ SvNVX(sv) += (NV)rev/nshift;
+
+ SvPOK_on(sv);
+ SvNOK_on(sv);
+ SvREADONLY_on(sv);
+ SvUTF8_on(sv);
+ }
+ }
+ break;
}
/* make the op for the constant and return */
- yylval.opval = newSVOP(OP_CONST, 0, sv);
+ if (sv)
+ yylval.opval = newSVOP(OP_CONST, 0, sv);
+ else
+ yylval.opval = Nullop;
return s;
}
END_EXTERN_C
#define IN_UTF8 (PL_curcop->op_private & HINT_UTF8)
+#define IN_BYTE (PL_curcop->op_private & HINT_BYTE)
#define UTF8SKIP(s) PL_utf8skip[*(U8*)s]
projects / p5sagit/p5-mst-13.2.git / commitdiff