From: Nick Ing-Simmons Date: Thu, 31 May 2001 12:35:50 +0000 (+0000) Subject: Integrate mainline. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a080fe3d0f499f7661182f9f8b2f5f534ae785f2;p=p5sagit%2Fp5-mst-13.2.git Integrate mainline. p4raw-id: //depot/perlio@10359 --- diff --git a/AUTHORS b/AUTHORS index 58d5bc3..05029b2 100644 --- a/AUTHORS +++ b/AUTHORS @@ -1,9 +1,11 @@ # To give due honor to those who have made Perl 5 what is is today, # here are easily-from-changelogs-extractable people and their -# (hopefully) current and preferred email addresses (as of late 2000 +# (hopefully) current and preferred email addresses (as of early 2001, # if known) from the Changes files. These people have either submitted # patches or suggestions, or their bug reports or comments have inspired -# the appropriate patches. Corrections, additions, deletions welcome. +# the appropriate patches. Corrections, additions, deletions welcome; +# send them to perl5-porters@perl.org, preferably as the output of diff(1), +# diff -u or diff -c between the original and a corrected version of this file. # -- A. C. Yardley @@ -20,6 +22,7 @@ Alan Modra Albert Chin-A-Young Albert Dvornik Alex Cough +Alexander Gough Alexander Smishlajev Alexey V. Barantzev Allen Smith @@ -112,7 +115,7 @@ Dan Sugalski Daniel Chetlin Daniel Grisinger Daniel Muiño -Daniel S. Lewart +Daniel S. Lewart Daniel Yacob Danny R. Faught Danny Sadinoff @@ -131,8 +134,8 @@ David Dyck David F. Haertig David Filo David Glasser -David Hammen David H. Adler +David Hammen David J. Fiander David Kerry David Mitchell @@ -182,8 +185,8 @@ Gary Clark Gary Ng <71564.1743@compuserve.com> Geraint A Edwards Gerben Wierda -Gerrit P. Haase Gerd Knops +Gerrit P. Haase Giles Lean Gisle Aas Golubev I. N. @@ -210,10 +213,10 @@ Hal Pomeranz Hallvard B Furuseth Hannu Napari Hans Ginzel -Hans de Graaff Hans Mulder -Harri Pasanen +Hans de Graaff Harold O Morris +Harri Pasanen Harry Edmon Helmut Jarausch Henrik Tougaard @@ -265,9 +268,9 @@ Jens Hamisch Jens T. Berger Thielemann Jens Thomsen Jens-Uwe Mager +Jeremy D. Zawodny Jeremy H. Brown Jeremy Madea -Jeremy D. Zawodny Jerome Abela Jesús Quiroga Jim Anderson @@ -297,9 +300,9 @@ John Hughes John L. Allen John Macdonald John Nolan +John P. Linderman John Peacock John Pfuntner -John P. Linderman John Rowe John Salinas John Stoffel @@ -344,15 +347,15 @@ Krishna Sethuraman Kurt D. Starsinic Kyriakos Georgiou Larry Parmelee -Larry Shatzer Larry Schuler Larry Schwimmer +Larry Shatzer Larry W. Virden Larry Wall Lars Hecking Laszlo Molnar -Leon Brocard Len Johnson +Leon Brocard Les Peters Lincoln D. Stein Lionel Cons @@ -387,8 +390,8 @@ Mark R. Levinson Mark-Jason Dominus Martien Verbruggen Martijn Koster -Martin J. Bligh Martin Husemann Martin Jost Martin Lichtin Martin Plechsmid @@ -424,7 +427,7 @@ Mike W Ellwood Milton Hankins Milton L. Hankins Molnar Laszlo -Murray Nesbitt +Murray Nesbitt Nathan Kurz Nathan Torkington Neale Ferguson diff --git a/MANIFEST b/MANIFEST index 8da41ab..2af84c0 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1524,6 +1524,7 @@ t/lib/fatal.t See if Fatal works t/lib/fcntl.t See if Fcntl works t/lib/fields.t See if base/fields works t/lib/filecache.t See if FileCache works +t/lib/filecomp.t See if File::Compare works t/lib/filecopy.t See if File::Copy works t/lib/filefind.t See if File::Find works t/lib/filefunc.t See if File::Spec::Functions works diff --git a/ext/Storable/Storable.xs b/ext/Storable/Storable.xs index dfb0f76..f306a49 100644 --- a/ext/Storable/Storable.xs +++ b/ext/Storable/Storable.xs @@ -1037,11 +1037,11 @@ static void clean_store_context(stcxt_t *cxt) */ hv_iterinit(cxt->hseen); - while (he = hv_iternext(cxt->hseen)) + while ((he = hv_iternext(cxt->hseen))) HeVAL(he) = &PL_sv_undef; hv_iterinit(cxt->hclass); - while (he = hv_iternext(cxt->hclass)) + while ((he = hv_iternext(cxt->hclass))) HeVAL(he) = &PL_sv_undef; /* @@ -1296,7 +1296,6 @@ static SV *pkg_fetchmeth( { GV *gv; SV *sv; - SV **svh; /* * The following code is the same as the one performed by UNIVERSAL::can @@ -1767,7 +1766,7 @@ static int store_array(stcxt_t *cxt, AV *av) continue; } TRACEME(("(#%d) item", i)); - if (ret = store(cxt, *sav)) + if ((ret = store(cxt, *sav))) return ret; } @@ -1875,7 +1874,7 @@ static int store_hash(stcxt_t *cxt, HV *hv) TRACEME(("(#%d) value 0x%"UVxf, i, PTR2UV(val))); - if (ret = store(cxt, val)) + if ((ret = store(cxt, val))) goto out; /* @@ -1921,7 +1920,7 @@ static int store_hash(stcxt_t *cxt, HV *hv) TRACEME(("(#%d) value 0x%"UVxf, i, PTR2UV(val))); - if (ret = store(cxt, val)) + if ((ret = store(cxt, val))) goto out; /* @@ -2004,7 +2003,7 @@ static int store_tied(stcxt_t *cxt, SV *sv) * accesses on the retrieved object will indeed call the magic methods... */ - if (ret = store(cxt, mg->mg_obj)) + if ((ret = store(cxt, mg->mg_obj))) return ret; TRACEME(("ok (tied)")); @@ -2043,12 +2042,12 @@ static int store_tied_item(stcxt_t *cxt, SV *sv) PUTMARK(SX_TIED_KEY); TRACEME(("store_tied_item: storing OBJ 0x%"UVxf, PTR2UV(mg->mg_obj))); - if (ret = store(cxt, mg->mg_obj)) + if ((ret = store(cxt, mg->mg_obj))) return ret; TRACEME(("store_tied_item: storing PTR 0x%"UVxf, PTR2UV(mg->mg_ptr))); - if (ret = store(cxt, (SV *) mg->mg_ptr)) + if ((ret = store(cxt, (SV *) mg->mg_ptr))) return ret; } else { I32 idx = mg->mg_len; @@ -2057,7 +2056,7 @@ static int store_tied_item(stcxt_t *cxt, SV *sv) PUTMARK(SX_TIED_IDX); TRACEME(("store_tied_item: storing OBJ 0x%"UVxf, PTR2UV(mg->mg_obj))); - if (ret = store(cxt, mg->mg_obj)) + if ((ret = store(cxt, mg->mg_obj))) return ret; TRACEME(("store_tied_item: storing IDX %d", idx)); @@ -2279,7 +2278,7 @@ static int store_hook( * Serialize entry if not done already, and get its tag. */ - if (svh = hv_fetch(cxt->hseen, (char *) &xsv, sizeof(xsv), FALSE)) + if ((svh = hv_fetch(cxt->hseen, (char *) &xsv, sizeof(xsv), FALSE))) goto sv_seen; /* Avoid moving code too far to the right */ TRACEME(("listed object %d at 0x%"UVxf" is unknown", i-1, PTR2UV(xsv))); @@ -2304,7 +2303,7 @@ static int store_hook( } else PUTMARK(flags); - if (ret = store(cxt, xsv)) /* Given by hook for us to store */ + if ((ret = store(cxt, xsv))) /* Given by hook for us to store */ return ret; svh = hv_fetch(cxt->hseen, (char *) &xsv, sizeof(xsv), FALSE); @@ -2481,7 +2480,7 @@ static int store_hook( * [] */ - if (ret = store(cxt, mg->mg_obj)) + if ((ret = store(cxt, mg->mg_obj))) return ret; } @@ -2618,8 +2617,8 @@ static int store_other(stcxt_t *cxt, SV *sv) * Store placeholder string as a scalar instead... */ - (void) sprintf(buf, "You lost %s(0x%"UVxf")\0", sv_reftype(sv, FALSE), - PTR2UV(sv)); + (void) sprintf(buf, "You lost %s(0x%"UVxf")%c", sv_reftype(sv, FALSE), + PTR2UV(sv), (char)0); len = strlen(buf); STORE_SCALAR(buf, len); @@ -2702,7 +2701,6 @@ static int store(stcxt_t *cxt, SV *sv) { SV **svh; int ret; - SV *tag; int type; HV *hseen = cxt->hseen; @@ -3188,7 +3186,6 @@ static SV *retrieve_hook(stcxt_t *cxt, char *cname) SV *sv; SV *rv; int obj_type; - I32 classname; int clone = cxt->optype & ST_CLONE; char mtype = '\0'; unsigned int extra_type = 0; @@ -4155,7 +4152,6 @@ static SV *retrieve_hash(stcxt_t *cxt, char *cname) I32 i; HV *hv; SV *sv; - static SV *sv_h_undef = (SV *) 0; /* hv_store() bug */ TRACEME(("retrieve_hash (#%d)", cxt->tagnum)); @@ -4287,7 +4283,7 @@ static SV *old_retrieve_hash(stcxt_t *cxt, char *cname) I32 size; I32 i; HV *hv; - SV *sv; + SV *sv=NULL; int c; static SV *sv_h_undef = (SV *) 0; /* hv_store() bug */ diff --git a/gv.c b/gv.c index b038031..c0f0d93 100644 --- a/gv.c +++ b/gv.c @@ -1360,7 +1360,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) AMT *amtp=NULL, *oamtp=NULL; int fl=0, off=0, off1, lr=0, assign=AMGf_assign & flags, notfound=0; int postpr = 0, force_cpy = 0, assignshift = assign ? 1 : 0; - HV* stash; + HV* stash=NULL; if (!(AMGf_noleft & flags) && SvAMAGIC(left) && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(left))), PERL_MAGIC_overload_table)) diff --git a/perl.c b/perl.c index d3c8a95..9920a0f 100644 --- a/perl.c +++ b/perl.c @@ -1681,7 +1681,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags) LOGOP myop; /* fake syntax tree node */ UNOP method_op; I32 oldmark; - I32 retval = 0; + volatile I32 retval = 0; I32 oldscope; bool oldcatch = CATCH_GET; int ret; @@ -1869,7 +1869,7 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags) dSP; UNOP myop; /* fake syntax tree node */ I32 oldmark = SP - PL_stack_base; - I32 retval = 0; + volatile I32 retval = 0; I32 oldscope; int ret; OP* oldop = PL_op; diff --git a/perl.h b/perl.h index 7286921..1aee654 100644 --- a/perl.h +++ b/perl.h @@ -2263,23 +2263,28 @@ Gid_t getegid (void); } STMT_END # endif -# define DEBUG_f(a) if (DEBUG_f_TEST) a -# define DEBUG_r(a) if (DEBUG_r_TEST) a -# define DEBUG_x(a) if (DEBUG_x_TEST) a -# define DEBUG_u(a) if (DEBUG_u_TEST) a -# define DEBUG_L(a) if (DEBUG_L_TEST) a -# define DEBUG_H(a) if (DEBUG_H_TEST) a -# define DEBUG_X(a) if (DEBUG_X_TEST) a -# define DEBUG_D(a) if (DEBUG_D_TEST) a +# define DEBUG__(t, a) \ + STMT_START { \ + if (t) STMT_START {a;} STMT_END; \ + } STMT_END + +# define DEBUG_f(a) DEBUG__(DEBUG_f_TEST, a) +# define DEBUG_r(a) DEBUG__(DEBUG_r_TEST, a) +# define DEBUG_x(a) DEBUG__(DEBUG_x_TEST, a) +# define DEBUG_u(a) DEBUG__(DEBUG_u_TEST, a) +# define DEBUG_L(a) DEBUG__(DEBUG_L_TEST, a) +# define DEBUG_H(a) DEBUG__(DEBUG_H_TEST, a) +# define DEBUG_X(a) DEBUG__(DEBUG_X_TEST, a) +# define DEBUG_D(a) DEBUG__(DEBUG_D_TEST, a) # ifdef USE_THREADS -# define DEBUG_S(a) if (DEBUG_S_TEST) a +# define DEBUG_S(a) DEBUG__(DEBUG_S_TEST, a) # else # define DEBUG_S(a) # endif -# define DEBUG_T(a) if (DEBUG_T_TEST) a -# define DEBUG_R(a) if (DEBUG_R_TEST) a +# define DEBUG_T(a) DEBUG__(DEBUG_T_TEST, a) +# define DEBUG_R(a) DEBUG__(DEBUG_R_TEST, a) #else /* DEBUGGING */ diff --git a/pp_ctl.c b/pp_ctl.c index 032be2e..91baaf0 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -373,7 +373,7 @@ PP(pp_formline) PerlIO_printf(Perl_debug_log, "%-16s%ld\n", name, (long) arg); else PerlIO_printf(Perl_debug_log, "%-16s\n", name); - } ) + } ); switch (*fpc++) { case FF_LINEMARK: linemark = t; diff --git a/sv.c b/sv.c index 6b933b1..eac192d 100644 --- a/sv.c +++ b/sv.c @@ -9505,7 +9505,7 @@ do_clean_objs(pTHXo_ SV *sv) SV* rv; if (SvROK(sv) && SvOBJECT(rv = SvRV(sv))) { - DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning object ref:\n "), sv_dump(sv));) + DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning object ref:\n "), sv_dump(sv))); if (SvWEAKREF(sv)) { sv_del_backref(sv); SvWEAKREF_off(sv); @@ -9531,7 +9531,7 @@ do_clean_named_objs(pTHXo_ SV *sv) (GvIO(sv) && SvOBJECT(GvIO(sv))) || (GvCV(sv) && SvOBJECT(GvCV(sv))) ) { - DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning named glob object:\n "), sv_dump(sv));) + DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning named glob object:\n "), sv_dump(sv))); SvREFCNT_dec(sv); } } @@ -9541,7 +9541,7 @@ do_clean_named_objs(pTHXo_ SV *sv) static void do_clean_all(pTHXo_ SV *sv) { - DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning loops: SV at 0x%"UVxf"\n", PTR2UV(sv)) );) + DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning loops: SV at 0x%"UVxf"\n", PTR2UV(sv)) )); SvFLAGS(sv) |= SVf_BREAK; SvREFCNT_dec(sv); } diff --git a/t/lib/1_compile.t b/t/lib/1_compile.t index eb2d70b..e46e14b 100644 --- a/t/lib/1_compile.t +++ b/t/lib/1_compile.t @@ -147,6 +147,7 @@ Fatal Fcntl File::Basename File::CheckTree +File::Compare File::Copy File::DosGlob File::Find diff --git a/t/lib/filecomp.t b/t/lib/filecomp.t new file mode 100644 index 0000000..b841d87 --- /dev/null +++ b/t/lib/filecomp.t @@ -0,0 +1,103 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; +} + +BEGIN { + our @TEST = stat "TEST"; + our @README = stat "README"; + unless (@TEST && @README) { + print "1..0 # Skip: no file TEST or README\n"; + exit 0; + } +} + +print "1..12\n"; + +use File::Compare qw(compare compare_text); + +print "ok 1\n"; + +# named files, same, existing but different, cause an error +print "not " unless compare("README","README") == 0; +print "ok 2\n"; + +print "not " unless compare("TEST","README") == 1; +print "ok 3\n"; + +print "not " unless compare("README","HLAGHLAG") == -1; + # a file which doesn't exist +print "ok 4\n"; + +# compare_text, the same file, different but existing files +# cause error, test sub form. +print "not " unless compare_text("README","README") == 0; +print "ok 5\n"; + +print "not " unless compare_text("TEST","README") == 1; +print "ok 6\n"; + +print "not " unless compare_text("TEST","HLAGHLAG") == -1; +print "ok 7\n"; + +print "not " unless + compare_text("README","README",sub {$_[0] ne $_[1]}) == 0; +print "ok 8\n"; + +# filehandle and same file +{ + my $fh; + open ($fh, "catfile(File::Spec->tmpdir, 'fcmpXXXX'); + my($tfh,$filename) = mkstemp($template); + { + local $/; #slurp + my $fh; + open($fh,'README'); + my $data = <$fh>; + print $tfh $data; + close($fh); + } + seek($tfh,0,0); + $donetests[0] = compare($tfh,'README'); + $donetests[1] = compare("$filename",'README'); + unlink0($tfh,$filename); +}; +print "# problems when testing with a tempory file\n" if $@; + +if (@donetests == 2) { + print "not " unless $donetests[0] == 0; + print "ok 11\n"; + print "not " unless $donetests[1] == 0; + print "ok 12\n"; +} +else { + print "ok 11# Skip\nok 12 # Skip Likely due to File::Temp\n"; +} + diff --git a/toke.c b/toke.c index 851b759..5a0d01a 100644 --- a/toke.c +++ b/toke.c @@ -196,7 +196,7 @@ S_tokereport(pTHX_ char *thing, char* s, I32 rv) sv_catpv(report, PL_tokenbuf); } PerlIO_printf(Perl_debug_log, "### %s\n", SvPV_nolen(report)); - }) + }); } /* @@ -2168,7 +2168,7 @@ Perl_yylex(pTHX) PL_pending_ident = 0; DEBUG_T({ PerlIO_printf(Perl_debug_log, - "### Tokener saw identifier '%s'\n", PL_tokenbuf); }) + "### Tokener saw identifier '%s'\n", PL_tokenbuf); }); /* if we're in a my(), we can't allow dynamics here. $foo'bar has already been turned into $foo::bar, so @@ -2309,7 +2309,7 @@ Perl_yylex(pTHX) } DEBUG_T({ PerlIO_printf(Perl_debug_log, "### Next token after '%s' was known, type %"IVdf"\n", PL_bufptr, - (IV)PL_nexttype[PL_nexttoke]); }) + (IV)PL_nexttype[PL_nexttoke]); }); return(PL_nexttype[PL_nexttoke]); @@ -2343,7 +2343,7 @@ Perl_yylex(pTHX) } else { DEBUG_T({ PerlIO_printf(Perl_debug_log, - "### Saw case modifier at '%s'\n", PL_bufptr); }) + "### Saw case modifier at '%s'\n", PL_bufptr); }); s = PL_bufptr + 1; if (strnEQ(s, "L\\u", 3) || strnEQ(s, "U\\l", 3)) tmp = *s, *s = s[2], s[2] = tmp; /* misordered... */ @@ -2395,7 +2395,7 @@ Perl_yylex(pTHX) if (PL_bufptr == PL_bufend) return sublex_done(); DEBUG_T({ PerlIO_printf(Perl_debug_log, - "### Interpolated variable at '%s'\n", PL_bufptr); }) + "### Interpolated variable at '%s'\n", PL_bufptr); }); PL_expect = XTERM; PL_lex_dojoin = (*PL_bufptr == '@'); PL_lex_state = LEX_INTERPNORMAL; @@ -2495,7 +2495,7 @@ Perl_yylex(pTHX) DEBUG_T( { PerlIO_printf(Perl_debug_log, "### Tokener expecting %s at %s\n", exp_name[PL_expect], s); - } ) + } ); retry: switch (*s) { @@ -2514,7 +2514,7 @@ Perl_yylex(pTHX) yyerror("Missing right curly or square bracket"); DEBUG_T( { PerlIO_printf(Perl_debug_log, "### Tokener got EOF\n"); - } ) + } ); TOKEN(0); } if (s++ < PL_bufend) @@ -2876,7 +2876,7 @@ Perl_yylex(pTHX) s = force_word(PL_bufptr,WORD,FALSE,FALSE,FALSE); DEBUG_T( { PerlIO_printf(Perl_debug_log, "### Saw unary minus before =>, forcing word '%s'\n", s); - } ) + } ); OPERATOR('-'); /* unary minus */ } PL_last_uni = PL_oldbufptr; @@ -2921,7 +2921,7 @@ Perl_yylex(pTHX) PL_last_lop_op = ftst; DEBUG_T( { PerlIO_printf(Perl_debug_log, "### Saw file test %c\n", (int)ftst); - } ) + } ); FTST(ftst); } else { @@ -2930,7 +2930,7 @@ Perl_yylex(pTHX) DEBUG_T( { PerlIO_printf(Perl_debug_log, "### %c looked like a file test but was not\n", (int)ftst); - } ) + } ); s -= 2; } } @@ -3698,7 +3698,7 @@ Perl_yylex(pTHX) s = scan_num(s, &yylval); DEBUG_T( { PerlIO_printf(Perl_debug_log, "### Saw number in '%s'\n", s); - } ) + } ); if (PL_expect == XOPERATOR) no_op("Number",s); TERM(THING); @@ -3707,7 +3707,7 @@ Perl_yylex(pTHX) s = scan_str(s,FALSE,FALSE); DEBUG_T( { PerlIO_printf(Perl_debug_log, "### Saw string before '%s'\n", s); - } ) + } ); if (PL_expect == XOPERATOR) { if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) { PL_expect = XTERM; @@ -3726,7 +3726,7 @@ Perl_yylex(pTHX) s = scan_str(s,FALSE,FALSE); DEBUG_T( { PerlIO_printf(Perl_debug_log, "### Saw string before '%s'\n", s); - } ) + } ); if (PL_expect == XOPERATOR) { if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) { PL_expect = XTERM; @@ -3751,7 +3751,7 @@ Perl_yylex(pTHX) s = scan_str(s,FALSE,FALSE); DEBUG_T( { PerlIO_printf(Perl_debug_log, "### Saw backtick string before '%s'\n", s); - } ) + } ); if (PL_expect == XOPERATOR) no_op("Backticks",s); if (!s) diff --git a/util.c b/util.c index de0c052..9a3ff31 100644 --- a/util.c +++ b/util.c @@ -2369,9 +2369,13 @@ Perl_my_popen_list(pTHX_ char *mode, int n, SV **args) # ifndef NOFILE # define NOFILE 20 # endif - for (int fd = PL_maxsysfd + 1; fd < NOFILE; fd++) { - if (fd != pp[1]) - PerlLIO_close(fd); + { + int fd; + + for (fd = PL_maxsysfd + 1; fd < NOFILE; fd++) { + if (fd != pp[1]) + PerlLIO_close(fd); + } } #endif do_aexec5(Nullsv, args-1, args-1+n, pp[1], did_pipes); @@ -2500,11 +2504,16 @@ Perl_my_popen(pTHX_ char *cmd, char *mode) #ifndef NOFILE #define NOFILE 20 #endif - for (fd = PL_maxsysfd + 1; fd < NOFILE; fd++) - if (fd != pp[1]) - PerlLIO_close(fd); + { + int fd; + + for (fd = PL_maxsysfd + 1; fd < NOFILE; fd++) + if (fd != pp[1]) + PerlLIO_close(fd); + } #endif - do_exec3(cmd,pp[1],did_pipes); /* may or may not use the shell */ + /* may or may not use the shell */ + do_exec3(cmd, pp[1], did_pipes); PerlProc__exit(1); } #endif /* defined OS2 */