From 977336f534851e24a2161d3011e030ea4043a2ae Mon Sep 17 00:00:00 2001 From: Gurusamy Sarathy Date: Sun, 23 Nov 1997 07:32:24 +0000 Subject: Add to docs about the BEGIN { shift } feature. Make the change yet simpler using CvUNIQUE(compcv) instead of subline (Chip's idea). p4raw-id: //depot/win32/perl@284 --- op.c | 10 +++++----- perly.c | 2 +- perly.y | 2 +- pod/perlfunc.pod | 10 ++++++---- vms/perly_c.vms | 2 +- 5 files changed, 14 insertions(+), 12 deletions(-) diff --git a/op.c b/op.c index 73c85844db..d7a6fe4e16 100644 --- a/op.c +++ b/op.c @@ -3438,9 +3438,9 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block) CV *cv; HV *hv; - sv_setpvf(sv, "%_:%ld-%ld", GvSV(curcop->cop_filegv), - (long)(subline < 0 ? -subline : subline), - (long)curcop->cop_line); + sv_setpvf(sv, "%_:%ld-%ld", + GvSV(curcop->cop_filegv), + (long)subline, (long)curcop->cop_line); gv_efullname3(tmpstr, gv, Nullch); hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0); if (!db_postponed) { @@ -4412,7 +4412,7 @@ ck_shift(OP *o) op_free(o); #ifdef USE_THREADS - if (subline > 0) { + if (!CvUNIQUE(compcv)) { argop = newOP(OP_PADAV, OPf_REF); argop->op_targ = 0; /* curpad[0] is @_ */ } @@ -4423,7 +4423,7 @@ ck_shift(OP *o) } #else argop = newUNOP(OP_RV2AV, 0, - scalar(newGVOP(OP_GV, 0, subline > 0 ? + scalar(newGVOP(OP_GV, 0, !CvUNIQUE(compcv) ? defgv : gv_fetchpv("ARGV", TRUE, SVt_PVAV)))); #endif /* USE_THREADS */ return newUNOP(type, 0, scalar(argop)); diff --git a/perly.c b/perly.c index 9ae4211943..7117566c20 100644 --- a/perly.c +++ b/perly.c @@ -1767,7 +1767,7 @@ case 56: { char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv, na); if (strEQ(name, "BEGIN") || strEQ(name, "END") || strEQ(name, "INIT")) - { CvUNIQUE_on(compcv); subline = -subline; } + CvUNIQUE_on(compcv); yyval.opval = yyvsp[0].opval; } break; case 57: diff --git a/perly.y b/perly.y index fa0e0f5f59..481a2ccad6 100644 --- a/perly.y +++ b/perly.y @@ -291,7 +291,7 @@ startformsub: /* NULL */ /* start a format subroutine scope */ subname : WORD { char *name = SvPV(((SVOP*)$1)->op_sv, na); if (strEQ(name, "BEGIN") || strEQ(name, "END") || strEQ(name, "INIT")) - { CvUNIQUE_on(compcv); subline = -subline; } + CvUNIQUE_on(compcv); $$ = $1; } ; diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index aa1e82eac8..887f827381 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -2856,10 +2856,12 @@ argument. Shifts the first value of the array off and returns it, shortening the array by 1 and moving everything down. If there are no elements in the array, returns the undefined value. If ARRAY is omitted, shifts the -@ARGV array in the main program, and the @_ array in subroutines. -(This is determined lexically.) See also unshift(), push(), and pop(). -Shift() and unshift() do the same thing to the left end of an array -that pop() and push() do to the right end. +@_ array within the lexical scope of subroutines and formats, and the +@ARGV array at file scopes or within the lexical scopes established by +the C, C, C, and C constructs. +See also unshift(), push(), and pop(). Shift() and unshift() do the +same thing to the left end of an array that pop() and push() do to the +right end. =item shmctl ID,CMD,ARG diff --git a/vms/perly_c.vms b/vms/perly_c.vms index e3c100b45d..7514f16803 100644 --- a/vms/perly_c.vms +++ b/vms/perly_c.vms @@ -1770,7 +1770,7 @@ case 56: { char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv, na); if (strEQ(name, "BEGIN") || strEQ(name, "END") || strEQ(name, "INIT")) - { CvUNIQUE_on(compcv); subline = -subline; } + CvUNIQUE_on(compcv); yyval.opval = yyvsp[0].opval; } break; case 57: -- cgit v1.2.1 From 769c30bc4bb5d7abeb7306e297a4071100a0e741 Mon Sep 17 00:00:00 2001 From: Gurusamy Sarathy Date: Tue, 25 Nov 1997 20:57:31 +0000 Subject: [win32] Fixup the places where the automatic merge got it wrong. Previous change (#302) was just a normal integration--ignore the "reverse" in there. p4raw-id: //depot/win32/perl@303 --- op.c | 6 +++--- perl.h | 4 ---- 2 files changed, 3 insertions(+), 7 deletions(-) diff --git a/op.c b/op.c index c86880c901..070fce4a85 100644 --- a/op.c +++ b/op.c @@ -3437,9 +3437,9 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block) CV *cv; HV *hv; - sv_setpvf(sv, "%_:%ld-%ld", GvSV(curcop->cop_filegv), - (long)(subline < 0 ? -subline : subline), - (long)curcop->cop_line); + sv_setpvf(sv, "%_:%ld-%ld", + GvSV(curcop->cop_filegv), + (long)subline, (long)curcop->cop_line); gv_efullname3(tmpstr, gv, Nullch); hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0); if (!db_postponed) { diff --git a/perl.h b/perl.h index c05d4a91c3..0ffb04c74b 100644 --- a/perl.h +++ b/perl.h @@ -2309,10 +2309,6 @@ EXT bool numeric_local INIT(TRUE); /* Assume local numerics */ #define PERL_SCRIPT_MODE "r" #endif -#ifndef PERL_SCRIPT_MODE -#define PERL_SCRIPT_MODE "r" -#endif - /* * nice_chunk and nice_chunk size need to be set * and queried under the protection of sv_mutex -- cgit v1.2.1 From c31fac668b253062b943c71d3452e678b6f02609 Mon Sep 17 00:00:00 2001 From: Gurusamy Sarathy Date: Wed, 26 Nov 1997 00:27:57 +0000 Subject: [win32] Various changes to make it build cleanly and pass all tests: - needed to run `perl embed.pl` - use PERL_CORE instead of PERLDLL in places that do mean PERL_CORE - fix prototypes for a few declarations (Borland is finally quiet) - move declaration of Mymalloc etc to perl.h (since win32 and other ports may #define malloc themselves, to let extensions bind to the version that perl used) - move struct reg_data into a public header file, since it is referenced in a public datatype - win32 makefile fixes - fix remaining s/thread/perl_thread/ p4raw-id: //depot/win32/perl@304 --- EXTERN.h | 2 +- embed.h | 3 ++- ext/DynaLoader/dlutils.c | 10 +--------- ext/SDBM_File/sdbm/sdbm.h | 2 +- hv.c | 9 +++------ perl.h | 12 ++++++++++-- proto.h | 7 ------- regcomp.h | 6 ------ regexp.h | 6 ++++++ win32/Makefile | 2 +- win32/dl_win32.xs | 2 +- win32/makefile.mk | 6 +++--- win32/win32.h | 2 +- win32/win32iop.h | 2 +- win32/win32thread.c | 6 +++--- 15 files changed, 34 insertions(+), 43 deletions(-) diff --git a/EXTERN.h b/EXTERN.h index 228ed52406..1c10f643b9 100644 --- a/EXTERN.h +++ b/EXTERN.h @@ -24,7 +24,7 @@ # define dEXTCONST globaldef {"$GLOBAL_RO_VARS"} readonly #else # if (defined(_MSC_VER) && defined(_WIN32)) || (defined(__BORLANDC__) && defined(__WIN32__)) -# ifdef PERLDLL +# ifdef PERL_CORE # define EXT extern __declspec(dllexport) # define dEXT # define EXTCONST extern __declspec(dllexport) const diff --git a/embed.h b/embed.h index b577200f98..541fcf757e 100644 --- a/embed.h +++ b/embed.h @@ -254,7 +254,6 @@ #define he_root Perl_he_root #define hexdigit Perl_hexdigit #define hints Perl_hints -#define hoistmust Perl_hoistmust #define hv_clear Perl_hv_clear #define hv_delayfree_ent Perl_hv_delayfree_ent #define hv_delete Perl_hv_delete @@ -911,6 +910,8 @@ #define rsignal_save Perl_rsignal_save #define rsignal_state Perl_rsignal_state #define runops Perl_runops +#define runops_debug Perl_runops_debug +#define runops_standard Perl_runops_standard #define rxres_free Perl_rxres_free #define rxres_restore Perl_rxres_restore #define rxres_save Perl_rxres_save diff --git a/ext/DynaLoader/dlutils.c b/ext/DynaLoader/dlutils.c index 58006789ef..422b3d1bf9 100644 --- a/ext/DynaLoader/dlutils.c +++ b/ext/DynaLoader/dlutils.c @@ -26,7 +26,7 @@ static int dl_debug = 0; /* value copied from $DynaLoader::dl_error */ static void -dl_generic_private_init() /* called by dl_*.xs dl_private_init() */ +dl_generic_private_init(void) /* called by dl_*.xs dl_private_init() */ { char *perl_dl_nonlazy; #ifdef DEBUGGING @@ -44,16 +44,8 @@ dl_generic_private_init() /* called by dl_*.xs dl_private_init() */ /* SaveError() takes printf style args and saves the result in LastError */ -#ifdef STANDARD_C static void SaveError(char* pat, ...) -#else -/*VARARGS0*/ -static void -SaveError(pat, va_alist) - char *pat; - va_dcl -#endif { va_list args; char *message; diff --git a/ext/SDBM_File/sdbm/sdbm.h b/ext/SDBM_File/sdbm/sdbm.h index 5bc629f402..ac2dc36b01 100644 --- a/ext/SDBM_File/sdbm/sdbm.h +++ b/ext/SDBM_File/sdbm/sdbm.h @@ -49,7 +49,7 @@ typedef struct { extern datum nullitem; -#if defined(__STDC__) || defined(__cplusplus) +#if defined(__STDC__) || defined(__cplusplus) || defined(CAN_PROTOTYPE) #define proto(p) p #else #define proto(p) () diff --git a/hv.c b/hv.c index e495e91769..12c17483fd 100644 --- a/hv.c +++ b/hv.c @@ -16,8 +16,8 @@ static void hsplit _((HV *hv)); static void hfreeentries _((HV *hv)); - -static HE* more_he(void); +static void hv_magic_check _((HV *hv, bool *needs_copy, bool *needs_store)); +static HE* more_he _((void)); static HE* new_he(void) @@ -217,10 +217,7 @@ hv_fetch_ent(HV *hv, SV *keysv, I32 lval, register U32 hash) } static void -hv_magic_check (hv, needs_copy, needs_store) -HV *hv; -bool *needs_copy; -bool *needs_store; +hv_magic_check (HV *hv, bool *needs_copy, bool *needs_store) { MAGIC *mg = SvMAGIC(hv); *needs_copy = FALSE; diff --git a/perl.h b/perl.h index 0ffb04c74b..e68ecf6a88 100644 --- a/perl.h +++ b/perl.h @@ -254,6 +254,8 @@ register struct op *op asm(stringify(OP_IN_REGISTER)); # include #endif +#define MEM_SIZE Size_t + /* This comes after so we don't try to change the standard * library prototypes; we'll use our own in proto.h instead. */ @@ -264,12 +266,20 @@ register struct op *op asm(stringify(OP_IN_REGISTER)); # define calloc Mycalloc # define realloc Myremalloc # define free Myfree +Malloc_t Mymalloc _((MEM_SIZE nbytes)); +Malloc_t Mycalloc _((MEM_SIZE elements, MEM_SIZE size)); +Malloc_t Myrealloc _((Malloc_t where, MEM_SIZE nbytes)); +Free_t Myfree _((Malloc_t where)); # endif # ifdef EMBEDMYMALLOC # define malloc Perl_malloc # define calloc Perl_calloc # define realloc Perl_realloc # define free Perl_free +Malloc_t Perl_malloc _((MEM_SIZE nbytes)); +Malloc_t Perl_calloc _((MEM_SIZE elements, MEM_SIZE size)); +Malloc_t Perl_realloc _((Malloc_t where, MEM_SIZE nbytes)); +Free_t Perl_free _((Malloc_t where)); # endif # undef safemalloc @@ -283,8 +293,6 @@ register struct op *op asm(stringify(OP_IN_REGISTER)); #endif /* MYMALLOC */ -#define MEM_SIZE Size_t - #if defined(STANDARD_C) && defined(I_STDDEF) # include # define STRUCT_OFFSET(s,m) offsetof(s,m) diff --git a/proto.h b/proto.h index 202331be98..7b47a93099 100644 --- a/proto.h +++ b/proto.h @@ -568,13 +568,6 @@ int yylex _((void)); int yyparse _((void)); int yywarn _((char* s)); -#if defined(MYMALLOC) || !defined(STANDARD_C) -Malloc_t malloc _((MEM_SIZE nbytes)); -Malloc_t calloc _((MEM_SIZE elements, MEM_SIZE size)); -Malloc_t realloc _((Malloc_t where, MEM_SIZE nbytes)); -Free_t free _((Malloc_t where)); -#endif - #ifndef MYMALLOC Malloc_t safemalloc _((MEM_SIZE nbytes)); Malloc_t safecalloc _((MEM_SIZE elements, MEM_SIZE size)); diff --git a/regcomp.h b/regcomp.h index 2a00d40b6f..fe29b2dd06 100644 --- a/regcomp.h +++ b/regcomp.h @@ -440,12 +440,6 @@ const static char reg_off_by_arg[] = { }; #endif -struct reg_data { - U32 count; - U8 *what; - void* data[1]; -}; - #define REG_SEEN_ZERO_LEN 1 #define REG_SEEN_LOOKBEHIND 2 #define REG_SEEN_GPOS 4 diff --git a/regexp.h b/regexp.h index 2f7aa02b3d..7137ffc329 100644 --- a/regexp.h +++ b/regexp.h @@ -17,6 +17,12 @@ struct regnode { typedef struct regnode regnode; +struct reg_data { + U32 count; + U8 *what; + void* data[1]; +}; + typedef struct regexp { I32 refcnt; char **startp; diff --git a/win32/Makefile b/win32/Makefile index 91a417da2f..e2d3d446c2 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -52,7 +52,7 @@ RUNTIME = -MD INCLUDES = -I.\include -I. -I.. #PCHFLAGS = -Fp"$(INTDIR)/modules.pch" -YX DEFINES = -DWIN32 -D_CONSOLE $(BUILDOPT) -LOCDEFS = -DPERLDLL $(CORECCOPT) +LOCDEFS = -DPERLDLL -DPERL_CORE $(CORECCOPT) SUBSYS = console !IF "$(RUNTIME)" == "-MD" diff --git a/win32/dl_win32.xs b/win32/dl_win32.xs index 7b227e299c..cf6797e5fe 100644 --- a/win32/dl_win32.xs +++ b/win32/dl_win32.xs @@ -28,7 +28,7 @@ calls. #include "dlutils.c" /* SaveError() etc */ static void -dl_private_init() +dl_private_init(void) { (void)dl_generic_private_init(); } diff --git a/win32/makefile.mk b/win32/makefile.mk index 03788c731e..7bbf0bb426 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -55,7 +55,7 @@ CCLIBDIR = $(CCHOME)\lib CC = bcc32 LINK32 = tlink32 LIB32 = tlib -IMPLIB = implib +IMPLIB = implib -c # # Options @@ -64,7 +64,7 @@ RUNTIME = -D_RTLDLL INCLUDES = -I.\include -I. -I.. -I$(CCINCDIR) #PCHFLAGS = -H -H$(INTDIR)\bcmoduls.pch DEFINES = -DWIN32 $(BUILDOPT) -LOCDEFS = -DPERLDLL +LOCDEFS = -DPERLDLL -DPERL_CORE SUBSYS = console LIBC = cw32mti.lib LIBFILES = import32.lib $(LIBC) odbc32.lib odbccp32.lib @@ -97,7 +97,7 @@ RUNTIME = -MD INCLUDES = -I.\include -I. -I.. #PCHFLAGS = -Fp$(INTDIR)\vcmoduls.pch -YX DEFINES = -DWIN32 -D_CONSOLE $(BUILDOPT) -LOCDEFS = -DPERLDLL +LOCDEFS = -DPERLDLL -DPERL_CORE SUBSYS = console .IF "$(RUNTIME)" == "-MD" diff --git a/win32/win32.h b/win32/win32.h index 2e31d0e3ba..d0dde7e53f 100644 --- a/win32/win32.h +++ b/win32/win32.h @@ -151,7 +151,7 @@ typedef char * caddr_t; /* In malloc.c (core address). */ /* #define PERL_SBRK_VIA_MALLOC /**/ #endif -#ifdef PERLDLL +#if defined(PERLDLL) && !defined(PERL_CORE) #define PERL_CORE #endif diff --git a/win32/win32iop.h b/win32/win32iop.h index bd70def18e..533370e99e 100644 --- a/win32/win32iop.h +++ b/win32/win32iop.h @@ -220,7 +220,7 @@ END_EXTERN_C #define getchar win32_getchar #define putchar win32_putchar -#if !defined(MYMALLOC) || !defined(PERLDLL) +#if !defined(MYMALLOC) || !defined(PERL_CORE) #undef malloc #undef calloc #undef realloc diff --git a/win32/win32thread.c b/win32/win32thread.c index 3e63327638..039f8b4b6f 100644 --- a/win32/win32thread.c +++ b/win32/win32thread.c @@ -1,15 +1,15 @@ #include "EXTERN.h" #include "perl.h" -__declspec(thread) struct thread *Perl_current_thread = NULL; +__declspec(thread) struct perl_thread *Perl_current_thread = NULL; void -Perl_setTHR(struct thread *t) +Perl_setTHR(struct perl_thread *t) { Perl_current_thread = t; } -struct thread * +struct perl_thread * Perl_getTHR(void) { return Perl_current_thread; -- cgit v1.2.1 From 00d579c5f79d1baaed14ef28a9c9de3c6d64f4d0 Mon Sep 17 00:00:00 2001 From: Gurusamy Sarathy Date: Tue, 28 Oct 1997 15:06:06 -0500 Subject: [win32] Sync a change from local repository. Message-Id: <199710290106.UAA11485@aatma.engin.umich.edu> Subject: [PATCH] Re: Core dump from using sockets w/ system or open(pipe) or "`" p4raw-id: //depot/win32/perl@306 --- mg.c | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/mg.c b/mg.c index b7b09d34a1..8a7cfdda14 100644 --- a/mg.c +++ b/mg.c @@ -1733,10 +1733,10 @@ Signal_t sighandler(int sig) { dSP; - GV *gv; + GV *gv = Nullgv; HV *st; SV *sv, *tSv = Sv; - CV *cv; + CV *cv = Nullcv; AV *oldstack; OP *myop = op; U32 flags = 0; @@ -1788,8 +1788,11 @@ sighandler(int sig) if (!cv || !CvROOT(cv)) { if (dowarn) warn("SIG%s handler \"%s\" not defined.\n", - sig_name[sig], GvENAME(gv) ); - return; + sig_name[sig], (gv ? GvENAME(gv) + : ((cv && CvGV(cv)) + ? GvENAME(CvGV(cv)) + : "__ANON__"))); + goto cleanup; } oldstack = curstack; @@ -1812,6 +1815,7 @@ sighandler(int sig) perl_call_sv((SV*)cv, G_DISCARD); SWITCHSTACK(signalstack, oldstack); +cleanup: if (flags & 1) savestack_ix -= 8; /* Unprotect save in progress. */ if (flags & 2) { -- cgit v1.2.1 From 549bb64a6fc9695371ddc1f831ff6052dc3ba7f1 Mon Sep 17 00:00:00 2001 From: Gurusamy Sarathy Date: Tue, 28 Oct 1997 17:16:13 -0500 Subject: [win32] Sync another change from local repository. Message-Id: <199710290316.WAA15888@aatma.engin.umich.edu> Subject: Re: do_postponed breaks with multiple interpreters p4raw-id: //depot/win32/perl@307 --- op.c | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/op.c b/op.c index 070fce4a85..35fd3a04c1 100644 --- a/op.c +++ b/op.c @@ -3433,7 +3433,7 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block) if (PERLDB_SUBLINE && curstash != debstash) { SV *sv = NEWSV(0,0); SV *tmpstr = sv_newmortal(); - static GV *db_postponed; + GV *db_postponed = gv_fetchpv("DB::postponed", GV_ADDMULTI, SVt_PVHV); CV *cv; HV *hv; @@ -3442,9 +3442,6 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block) (long)subline, (long)curcop->cop_line); gv_efullname3(tmpstr, gv, Nullch); hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0); - if (!db_postponed) { - db_postponed = gv_fetchpv("DB::postponed", GV_ADDMULTI, SVt_PVHV); - } hv = GvHVn(db_postponed); if (HvFILL(hv) > 0 && hv_exists(hv, SvPVX(tmpstr), SvCUR(tmpstr)) && (cv = GvCV(db_postponed))) { -- cgit v1.2.1 From e41fc98bd7f2023e39e515f98825ef0e1db2c6e4 Mon Sep 17 00:00:00 2001 From: Gurusamy Sarathy Date: Tue, 28 Oct 1997 16:51:25 -0500 Subject: [win32] Sync yet another patch (this one manually edited): Message-Id: <199710290251.VAA14362@aatma.engin.umich.edu> Subject: [PATCH] Re: local($@) gives core dump p4raw-id: //depot/win32/perl@308 --- pp_ctl.c | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/pp_ctl.c b/pp_ctl.c index d9f985e8e4..834f0c0dad 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -1050,11 +1050,14 @@ die_where(char *message) if (svp) { if (!SvIOK(*svp)) { static char prefix[] = "\t(in cleanup) "; + SV *err = ERRSV; sv_upgrade(*svp, SVt_IV); (void)SvIOK_only(*svp); - SvGROW(ERRSV, SvCUR(ERRSV)+sizeof(prefix)+klen); - sv_catpvn(ERRSV, prefix, sizeof(prefix)-1); - sv_catpvn(ERRSV, message, klen); + if (!SvPOK(err)) + sv_setpv(err,""); + SvGROW(err, SvCUR(err)+sizeof(prefix)+klen); + sv_catpvn(err, prefix, sizeof(prefix)-1); + sv_catpvn(err, message, klen); } sv_inc(*svp); } -- cgit v1.2.1 From 0e4ced382cb959db083cda30b8dbdae68933842a Mon Sep 17 00:00:00 2001 From: Gurusamy Sarathy Date: Wed, 29 Oct 1997 16:45:26 -0500 Subject: [win32] Another trivial patch: Message-Id: <199710300245.VAA04244@aatma.engin.umich.edu> Subject: [PATCH] Re: Why doesn't XSRETURN have STMT_START/STMT_END brackets? p4raw-id: //depot/win32/perl@310 --- XSUB.h | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/XSUB.h b/XSUB.h index c7c3f6d80e..054b4cc7f7 100644 --- a/XSUB.h +++ b/XSUB.h @@ -15,7 +15,11 @@ #define dXSI32 I32 ix = XSANY.any_i32 -#define XSRETURN(off) stack_sp = stack_base + ax + ((off) - 1); return +#define XSRETURN(off) \ + STMT_START { \ + stack_sp = stack_base + ax + ((off) - 1); \ + return; \ + } STMT_END /* Simple macros to put new mortal values onto the stack. */ /* Typically used to return values from XS functions. */ -- cgit v1.2.1 From 15f0808c5d67b362ecb8b59cf6a3ed61fbf51bbf Mon Sep 17 00:00:00 2001 From: Gurusamy Sarathy Date: Wed, 26 Nov 1997 01:50:37 +0000 Subject: [win32] Fix for C bug: From: Gurusamy Sarathy Message-Id: <199711011946.OAA18882@aatma.engin.umich.edu> Subject: [PATCH] Re: Sort grammar bug Date: Sat, 01 Nov 1997 14:46:35 -0500 ------ From: Hugo van der Sanden Message-Id: <199711021247.MAA01743@crypt.compulink.co.uk> Subject: Re: Sort grammar bug Date: Sun, 02 Nov 1997 12:47:51 +0000 p4raw-id: //depot/win32/perl@312 --- t/op/sort.t | 13 ++++++++++++- toke.c | 6 +++--- 2 files changed, 15 insertions(+), 4 deletions(-) diff --git a/t/op/sort.t b/t/op/sort.t index c792bbb48e..a6829e01e4 100755 --- a/t/op/sort.t +++ b/t/op/sort.t @@ -2,7 +2,7 @@ # $RCSfile: sort.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:24 $ -print "1..19\n"; +print "1..21\n"; sub backwards { $a lt $b ? 1 : $a gt $b ? -1 : 0 } @@ -91,3 +91,14 @@ print ($@ =~ /redefine active sort/ ? "ok 18\n" : "not ok 18\n"); }; eval { @b = sort twoface 4,1 }; print $@ ? "$@" : "not ok 19\n"; + +eval <<'CODE'; + my @result = sort main'backwards 'one', 'two'; +CODE +print $@ ? "not ok 20\n# $@" : "ok 20\n"; + +eval <<'CODE'; + # "sort 'one', 'two'" should not try to parse "'one" as a sort sub + my @result = sort 'one', 'two'; +CODE +print $@ ? "not ok 21\n# $@" : "ok 21\n"; diff --git a/toke.c b/toke.c index 95be7df498..dbb273a263 100644 --- a/toke.c +++ b/toke.c @@ -500,7 +500,7 @@ force_next(I32 type) } static char * -force_word(register char *start, int token, int check_keyword, int allow_pack, int allow_tick) +force_word(register char *start, int token, int check_keyword, int allow_pack, int allow_initial_tick) { register char *s; STRLEN len; @@ -509,7 +509,7 @@ force_word(register char *start, int token, int check_keyword, int allow_pack, i s = start; if (isIDFIRST(*s) || (allow_pack && *s == ':') || - (allow_tick && *s == '\'') ) + (allow_initial_tick && *s == '\'') ) { s = scan_word(s, tokenbuf, sizeof tokenbuf, allow_pack, &len); if (check_keyword && keyword(tokenbuf, len)) @@ -3542,7 +3542,7 @@ yylex(void) if (*s == ';' || *s == ')') /* probably a close */ croak("sort is now a reserved word"); expect = XTERM; - s = force_word(s,WORD,TRUE,TRUE,TRUE); + s = force_word(s,WORD,TRUE,TRUE,FALSE); LOP(OP_SORT,XREF); case KEY_split: -- cgit v1.2.1