From 6940069f6d5beebb5f66572e358b4e7d0c3d1c43 Mon Sep 17 00:00:00 2001 From: Gurusamy Sarathy Date: Tue, 11 Jul 2000 17:48:28 +0000 Subject: integrate cfgperl changes#6220..6222 into mainline p4raw-link: @6222 on //depot/cfgperl: cb6e01d9fd93f1025bb60ed9c000931b2c8542a3 p4raw-link: @6220 on //depot/cfgperl: 94414bfbc497e71da32f6edca513d34725e3cae6 p4raw-id: //depot/perl@6350 p4raw-integrated: from //depot/cfgperl@6349 'copy in' lib/Pod/Usage.pm (@5717..) win32/win32.h (@6026..) pod/perlop.pod (@6206..) p4raw-integrated: from //depot/cfgperl@6221 'copy in' utf8.c (@6174..) doop.c (@6193..) toke.c (@6196..) 'merge in' embed.pl (@6217..) p4raw-integrated: from //depot/cfgperl@6220 'merge in' makedef.pl (@6156..) --- toke.c | 29 ++--------------------------- 1 file changed, 2 insertions(+), 27 deletions(-) (limited to 'toke.c') diff --git a/toke.c b/toke.c index 05822e1e87..fe1435805c 100644 --- a/toke.c +++ b/toke.c @@ -6130,45 +6130,20 @@ S_scan_trans(pTHX_ char *start) Perl_croak(aTHX_ "Transliteration replacement not terminated"); } - if (UTF) { - o = newSVOP(OP_TRANS, 0, 0); - utf8 = OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF; - } - else { New(803,tbl,256,short); o = newPVOP(OP_TRANS, 0, (char*)tbl); - utf8 = 0; - } complement = del = squash = 0; - while (strchr("cdsCU", *s)) { + while (strchr("cds", *s)) { if (*s == 'c') complement = OPpTRANS_COMPLEMENT; else if (*s == 'd') del = OPpTRANS_DELETE; else if (*s == 's') squash = OPpTRANS_SQUASH; - else { - switch (count++) { - case 0: - if (*s == 'C') - utf8 &= ~OPpTRANS_FROM_UTF; - else - utf8 |= OPpTRANS_FROM_UTF; - break; - case 1: - if (*s == 'C') - utf8 &= ~OPpTRANS_TO_UTF; - else - utf8 |= OPpTRANS_TO_UTF; - break; - default: - Perl_croak(aTHX_ "Too many /C and /U options"); - } - } s++; } - o->op_private = del|squash|complement|utf8; + o->op_private = del|squash|complement; PL_lex_op = o; yylval.ival = OP_TRANS; -- cgit v1.2.1 From def3634bd95d269e50804282110ddcc3b0e6e39b Mon Sep 17 00:00:00 2001 From: Gurusamy Sarathy Date: Tue, 11 Jul 2000 18:34:56 +0000 Subject: integrate cfgperl change#6250 into mainline p4raw-link: @6250 on //depot/cfgperl: ec6a9911b75518dd4c77eb4985d8bee0371df340 p4raw-id: //depot/perl@6360 p4raw-branched: from //depot/cfgperl@6250 'branch in' t/op/my_stash.t p4raw-integrated: from //depot/cfgperl@6250 'copy in' MANIFEST (@6232..) 'merge in' toke.c (@6241..) embed.pl proto.h (@6243..) --- toke.c | 25 ++++++++++++++++++++++++- 1 file changed, 24 insertions(+), 1 deletion(-) (limited to 'toke.c') diff --git a/toke.c b/toke.c index fe1435805c..6b5fc4901e 100644 --- a/toke.c +++ b/toke.c @@ -2006,6 +2006,29 @@ S_filter_gets(pTHX_ register SV *sv, register PerlIO *fp, STRLEN append) return (sv_gets(sv, fp, append)); } +STATIC HV *S_find_in_my_stash(pTHX_ char *pkgname, I32 len) +{ + GV *gv; + + if (*pkgname == '_' && strEQ(pkgname, "__PACKAGE__")) + return PL_curstash; + + if (len > 2 && + (pkgname[len - 2] == ':' && pkgname[len - 1] == ':') && + (gv = gv_fetchpv(pkgname, FALSE, SVt_PVHV))) { + return GvHV(gv); /* Foo:: */ + } + + /* use constant CLASS => 'MyClass' */ + if ((gv = gv_fetchpv(pkgname, FALSE, SVt_PVCV))) { + SV *sv; + if (GvCV(gv) && (sv = cv_const_sv(GvCV(gv)))) { + pkgname = SvPV_nolen(sv); + } + } + + return gv_stashpv(pkgname, FALSE); +} #ifdef DEBUGGING static char* exp_name[] = @@ -4410,7 +4433,7 @@ Perl_yylex(pTHX) s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, TRUE, &len); if (len == 3 && strnEQ(PL_tokenbuf, "sub", 3)) goto really_sub; - PL_in_my_stash = gv_stashpv(PL_tokenbuf, FALSE); + PL_in_my_stash = find_in_my_stash(PL_tokenbuf, len); if (!PL_in_my_stash) { char tmpbuf[1024]; PL_bufptr = s; -- cgit v1.2.1 From b250498faaf6fbd04315d2b632649596e2498c42 Mon Sep 17 00:00:00 2001 From: Gurusamy Sarathy Date: Tue, 11 Jul 2000 18:49:43 +0000 Subject: integrate cfgperl changes#6261..6266 into mainline p4raw-link: @6266 on //depot/cfgperl: a009ce76c9b4ddbde44a58eab3fe27d331cf27fe p4raw-link: @6261 on //depot/cfgperl: 27d76ecff97d0a9449f569d789504cc8b69a6d01 p4raw-id: //depot/perl@6363 p4raw-integrated: from //depot/cfgperl@6362 'copy in' README.epoc epoc/createpkg.pl epoc/epocish.c (@5586..) epoc/epocish.h t/comp/require.t (@5639..) cygwin/Makefile.SHs (@6096..) ext/POSIX/POSIX.pm (@6140..) hints/bsdos.sh (@6156..) epoc/config.sh (@6168..) ext/POSIX/POSIX.xs (@6198..) p4raw-integrated: from //depot/cfgperl@6265 'copy in' ext/POSIX/POSIX.pod (@5586..) p4raw-integrated: from //depot/cfgperl@6263 'copy in' doop.c (@6256..) p4raw-integrated: from //depot/cfgperl@6261 'merge in' pod/perldiag.pod (@6206..) toke.c (@6250..) --- toke.c | 60 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 58 insertions(+), 2 deletions(-) (limited to 'toke.c') diff --git a/toke.c b/toke.c index 6b5fc4901e..f601cf1e4a 100644 --- a/toke.c +++ b/toke.c @@ -326,7 +326,7 @@ S_cr_textfilter(pTHX_ int idx, SV *sv, int maxlen) } #endif -#if 0 +#ifdef PERL_UTF16_FILTER STATIC I32 S_utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen) { @@ -2490,6 +2490,8 @@ Perl_yylex(pTHX) goto retry; } do { + bool bof; + bof = PL_rsfp && (PerlIO_tell(PL_rsfp)==0); /* *Before* read! */ if ((s = filter_gets(PL_linestr, PL_rsfp, 0)) == Nullch) { fake_eof: if (PL_rsfp) { @@ -2525,7 +2527,9 @@ Perl_yylex(pTHX) PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); PL_doextract = FALSE; } - } + } + if (bof) + s = swallow_bom(s); incline(s); } while (PL_doextract); PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = s; @@ -7407,3 +7411,55 @@ restore_rsfp(pTHXo_ void *f) PerlIO_close(PL_rsfp); PL_rsfp = fp; } + +STATIC char* +S_swallow_bom(pTHX_ char *s) { + STRLEN slen; + slen = SvCUR(PL_linestr); + switch (*s) { + case -1: + if ((s[1] & 255) == 254) { + /* UTF-16 little-endian */ +#ifdef PERL_UTF16_FILTER + U8 *news; +#endif + s+=2; + if (*s == 0 && s[1] == 0) /* UTF-32 little-endian */ + Perl_croak(aTHX_ "Unsupported script encoding"); +#ifdef PERL_UTF16_FILTER + filter_add(S_utf16rev_textfilter, NULL); + New(898, news, (PL_bufend - s) * 3 / 2 + 1, U8); + PL_bufend = utf16_to_utf8((U16*)s, news, PL_bufend - s); + s = news; +#else + Perl_croak(aTHX_ "Unsupported script encoding"); +#endif + } + break; + + case -2: + if ((s[1] & 255) == 255) { /* UTF-16 big-endian */ +#ifdef PERL_UTF16_FILTER + U8 *news; + filter_add(S_utf16_textfilter, NULL); + New(898, news, (PL_bufend - s) * 3 / 2 + 1, U8); + PL_bufend = utf16_to_utf8((U16*)s, news, PL_bufend - s); + s = news; +#else + Perl_croak(aTHX_ "Unsupported script encoding"); +#endif + } + break; + + case -17: + if ( slen>2 && (s[1] & 255) == 187 && (s[2] & 255) == 191) { + s+=3; /* UTF-8 */ + } + break; + case 0: + if (slen > 3 && s[1] == 0 && /* UTF-32 big-endian */ + s[2] & 255 == 254 && s[3] & 255 == 255) + Perl_croak(aTHX_ "Unsupported script encoding"); +} +return s; +} -- cgit v1.2.1 From 4755096ec61711c5104ba0b6b9314f32ca0351fe Mon Sep 17 00:00:00 2001 From: Gurusamy Sarathy Date: Tue, 11 Jul 2000 19:27:48 +0000 Subject: integrate cfgperl changes#6293..6324 into mainline p4raw-link: @6324 on //depot/cfgperl: 81bf48a6dbba4b295dfa172a17ca70b654dbf225 p4raw-link: @6293 on //depot/cfgperl: 6e37ea6052902cde1aeb08a2129ffc7c8ea53736 p4raw-id: //depot/perl@6369 p4raw-branched: from //depot/cfgperl@6368 'branch in' lib/Win32.pod lib/lib_pm.PL p4raw-deleted: from //depot/cfgperl@6368 'delete in' pod/Win32.pod (@5937..) pod/buildtoc (@6091..) lib/lib.pm.PL (@6227..) pod/Makefile (@6232..) p4raw-integrated: from //depot/cfgperl@6368 'copy in' thread.h (@5656..) lib/warnings/register.pm (@5704..) ext/B/B/Stash.pm (@5972..) lib/CGI/Util.pm (@6034..) util.c (@6217..) gv.c (@6244..) pp.c (@6260..) doop.c (@6269..) pod/perlfunc.pod (@6277..) pp_ctl.c (@6293..) makedef.pl (@6301..) embed.h global.sym objXSUB.h perlapi.c proto.h (@6305..) win32/Makefile (@6307..) Makefile.SH (@6309..) t/op/method.t (@6312..) sv.h (@6315..) 'ignore' op.c (@6273..) 'merge in' embed.pl win32/win32.c (@6305..) p4raw-integrated: from //depot/cfgperl@6324 'merge in' toke.c (@6307..) p4raw-branched: from //depot/cfgperl@6323 'branch in' pod/buildtoc.PL (@6319..) p4raw-integrated: from //depot/cfgperl@6323 'copy in' pod/perl.pod (@6319..) pod/perltoc.pod (@6322..) 'merge in' MANIFEST (@6319..) p4raw-branched: from //depot/cfgperl@6319 'branch in' pod/Makefile.SH p4raw-integrated: from //depot/cfgperl@6315 'ignore' pp_hot.c (@6313..) p4raw-integrated: from //depot/cfgperl@6311 'copy in' ext/POSIX/POSIX.pod (@6296..) p4raw-integrated: from //depot/cfgperl@6307 'merge in' doio.c (@6223..) --- toke.c | 52 ++++++++++++++++++++++++++-------------------------- 1 file changed, 26 insertions(+), 26 deletions(-) (limited to 'toke.c') diff --git a/toke.c b/toke.c index f601cf1e4a..fc9d6818f5 100644 --- a/toke.c +++ b/toke.c @@ -1875,7 +1875,7 @@ S_incl_perldb(pTHX) * store private buffers and state information. * * The supplied datasv parameter is upgraded to a PVIO type - * and the IoDIRP field is used to store the function pointer, + * and the IoDIRP/IoANY field is used to store the function pointer, * and IOf_FAKE_DIRP is enabled on datasv to mark this as such. * Note that IoTOP_NAME, IoFMT_NAME, IoBOTTOM_NAME, if set for * private use must be set using malloc'd pointers. @@ -1893,7 +1893,7 @@ Perl_filter_add(pTHX_ filter_t funcp, SV *datasv) datasv = NEWSV(255,0); if (!SvUPGRADE(datasv, SVt_PVIO)) Perl_die(aTHX_ "Can't upgrade filter_add data to SVt_PVIO"); - IoDIRP(datasv) = (DIR*)funcp; /* stash funcp into spare field */ + IoANY(datasv) = (void *)funcp; /* stash funcp into spare field */ IoFLAGS(datasv) |= IOf_FAKE_DIRP; DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_add func %p (%s)\n", funcp, SvPV_nolen(datasv))); @@ -1913,9 +1913,9 @@ Perl_filter_del(pTHX_ filter_t funcp) return; /* if filter is on top of stack (usual case) just pop it off */ datasv = FILTER_DATA(AvFILLp(PL_rsfp_filters)); - if (IoDIRP(datasv) == (DIR*)funcp) { + if (IoANY(datasv) == (void *)funcp) { IoFLAGS(datasv) &= ~IOf_FAKE_DIRP; - IoDIRP(datasv) = (DIR*)NULL; + IoANY(datasv) = (void *)NULL; sv_free(av_pop(PL_rsfp_filters)); return; @@ -1975,7 +1975,7 @@ Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen) return FILTER_READ(idx+1, buf_sv, maxlen); /* recurse */ } /* Get function pointer hidden within datasv */ - funcp = (filter_t)IoDIRP(datasv); + funcp = (filter_t)IoANY(datasv); DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_read %d: via function %p (%s)\n", idx, funcp, SvPV_nolen(datasv))); @@ -7391,27 +7391,6 @@ Perl_yyerror(pTHX_ char *s) } -#ifdef PERL_OBJECT -#include "XSUB.h" -#endif - -/* - * restore_rsfp - * Restore a source filter. - */ - -static void -restore_rsfp(pTHXo_ void *f) -{ - PerlIO *fp = (PerlIO*)f; - - if (PL_rsfp == PerlIO_stdin()) - PerlIO_clearerr(PL_rsfp); - else if (PL_rsfp && (PL_rsfp != fp)) - PerlIO_close(PL_rsfp); - PL_rsfp = fp; -} - STATIC char* S_swallow_bom(pTHX_ char *s) { STRLEN slen; @@ -7463,3 +7442,24 @@ S_swallow_bom(pTHX_ char *s) { } return s; } + +#ifdef PERL_OBJECT +#include "XSUB.h" +#endif + +/* + * restore_rsfp + * Restore a source filter. + */ + +static void +restore_rsfp(pTHXo_ void *f) +{ + PerlIO *fp = (PerlIO*)f; + + if (PL_rsfp == PerlIO_stdin()) + PerlIO_clearerr(PL_rsfp); + else if (PL_rsfp && (PL_rsfp != fp)) + PerlIO_close(PL_rsfp); + PL_rsfp = fp; +} -- cgit v1.2.1 From c2e66d9e68806a7000ee1a4760c35703a0e0ae89 Mon Sep 17 00:00:00 2001 From: Gurusamy Sarathy Date: Tue, 11 Jul 2000 20:37:23 +0000 Subject: integrate cfgperl changes#6325..6373 into mainline (NOTE: today's batch of integrations still untested) p4raw-link: @6373 (not found) p4raw-link: @6325 on //depot/cfgperl: d6ac44cc5a00fa38a56717785146bc16b716472c p4raw-id: //depot/perl@6373 --- toke.c | 22 ++++++++++++++++++---- 1 file changed, 18 insertions(+), 4 deletions(-) (limited to 'toke.c') diff --git a/toke.c b/toke.c index fc9d6818f5..8f42dcfb5e 100644 --- a/toke.c +++ b/toke.c @@ -1208,6 +1208,7 @@ S_scan_const(pTHX_ char *start) register char *s = start; /* start of the constant */ register char *d = SvPVX(sv); /* destination for copies */ bool dorange = FALSE; /* are we in a translit range? */ + bool didrange = FALSE; /* did we just finish a range? */ bool has_utf = FALSE; /* embedded \x{} */ I32 len; /* ? */ UV uv; @@ -1241,6 +1242,13 @@ S_scan_const(pTHX_ char *start) min = (U8)*d; /* first char in range */ max = (U8)d[1]; /* last char in range */ + + if (min > max) { + Perl_croak(aTHX_ + "Invalid [] range \"%c-%c\" in transliteration operator", + min, max); + } + #ifndef ASCIIish if ((isLOWER(min) && isLOWER(max)) || (isUPPER(min) && isUPPER(max))) { @@ -1261,11 +1269,15 @@ S_scan_const(pTHX_ char *start) /* mark the range as done, and continue */ dorange = FALSE; + didrange = TRUE; continue; - } + } /* range begins (ignore - as first or last char) */ else if (*s == '-' && s+1 < send && s != start) { + if (didrange) { + croak("Ambiguous range in transliteration operator"); + } if (utf) { *d++ = (char)0xff; /* use illegal utf8 byte--see pmtrans */ s++; @@ -1273,7 +1285,9 @@ S_scan_const(pTHX_ char *start) } dorange = TRUE; s++; - } + } else { + didrange = FALSE; + } } /* if we get here, we're not doing a transliteration */ @@ -3158,7 +3172,7 @@ Perl_yylex(pTHX) yyerror("Unmatched right curly bracket"); else PL_expect = (expectation)PL_lex_brackstack[--PL_lex_brackets]; - if (PL_lex_brackets < PL_lex_formbrack) + if (PL_lex_brackets < PL_lex_formbrack && PL_lex_state != LEX_INTERPNORMAL) PL_lex_formbrack = 0; if (PL_lex_state == LEX_INTERPNORMAL) { if (PL_lex_brackets == 0) { @@ -7162,7 +7176,7 @@ S_scan_formline(pTHX_ register char *s) bool needargs = FALSE; while (!needargs) { - if (*s == '.' || *s == '}') { + if (*s == '.' || *s == /*{*/'}') { /*SUPPRESS 530*/ #ifdef PERL_STRICT_CR for (t = s+1;SPACE_OR_TAB(*t); t++) ; -- cgit v1.2.1 From 1fafa243e0e99b59995e42a09247678007f02409 Mon Sep 17 00:00:00 2001 From: Gurusamy Sarathy Date: Tue, 11 Jul 2000 20:48:50 +0000 Subject: tweak for build failure under multiplicity p4raw-id: //depot/perl@6374 --- toke.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'toke.c') diff --git a/toke.c b/toke.c index 8f42dcfb5e..f39b3bdc0e 100644 --- a/toke.c +++ b/toke.c @@ -1276,7 +1276,7 @@ S_scan_const(pTHX_ char *start) /* range begins (ignore - as first or last char) */ else if (*s == '-' && s+1 < send && s != start) { if (didrange) { - croak("Ambiguous range in transliteration operator"); + Perl_croak(aTHX_ "Ambiguous range in transliteration operator"); } if (utf) { *d++ = (char)0xff; /* use illegal utf8 byte--see pmtrans */ -- cgit v1.2.1