# 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 <yardley@tanet.net>
Albert Chin-A-Young <china@thewrittenword.com>
Albert Dvornik <bert@genscan.com>
Alex Cough <alex@rcon.rog>
+Alexander Gough <alexander.gough@st-hughs.oxford.ac.uk>
Alexander Smishlajev <als@turnhere.com>
Alexey V. Barantzev <barancev@kazbek.ispras.ru>
Allen Smith <easmith@beatrice.rutgers.edu>
Daniel Chetlin <daniel@chetlin.com>
Daniel Grisinger <dgris@dimensional.com>
Daniel Muiño <dmuino@afip.gov.ar>
-Daniel S. Lewart <lewart@vadds.cvm.uiuc.edu>
+Daniel S. Lewart <d-lewart@uiuc.edu>
Daniel Yacob <dmulholl@cs.indiana.edu>
Danny R. Faught <faught@mailhost.rsn.hp.com>
Danny Sadinoff <sadinoff@olf.com>
David F. Haertig <dfh@dwroll.lucent.com>
David Filo
David Glasser <me@davidglasser.net>
-David Hammen <hammen@gothamcity.jsc.nasa.gov>
David H. Adler <dha@panix.com>
+David Hammen <hammen@gothamcity.jsc.nasa.gov>
David J. Fiander <davidf@mks.com>
David Kerry <davidk@tor.securecomputing.com>
David Mitchell <davem@fdgroup.co.uk>
Gary Ng <71564.1743@compuserve.com>
Geraint A Edwards <gedge@serf.org>
Gerben Wierda <G.C.Th.Wierda@AWT.nl>
-Gerrit P. Haase <gerrit.haase@t-online.de>
Gerd Knops <gerti@BITart.com>
+Gerrit P. Haase <gerrit.haase@t-online.de>
Giles Lean <giles@nemeton.com.au>
Gisle Aas <gisle@aas.no>
Golubev I. N. <gin@mo.msk.ru>
Hallvard B Furuseth <h.b.furuseth@usit.uio.no>
Hannu Napari <Hannu.Napari@hut.fi>
Hans Ginzel <hans@kolej.mff.cuni.cz>
-Hans de Graaff <J.J.deGraaff@twi.tudelft.nl>
Hans Mulder <hansmu@xs4all.nl>
-Harri Pasanen <harri.pasanen@trema.com>
+Hans de Graaff <J.J.deGraaff@twi.tudelft.nl>
Harold O Morris <hom00@utsglobal.com>
+Harri Pasanen <harri.pasanen@trema.com>
Harry Edmon <harry@atmos.washington.edu>
Helmut Jarausch <jarausch@numa1.igpm.rwth-aachen.de>
Henrik Tougaard <ht.000@foa.dk>
Jens T. Berger Thielemann <jensthi@ifi.uio.no>
Jens Thomsen <jens@fiend.cis.com>
Jens-Uwe Mager <jum@helios.de>
+Jeremy D. Zawodny <jzawodn@wcnet.org>
Jeremy H. Brown <jhbrown@ai.mit.edu>
Jeremy Madea <jmadea@inktomi.com>
-Jeremy D. Zawodny <jzawodn@wcnet.org>
Jerome Abela <abela@hsc.fr>
Jesús Quiroga <jquiroga@pobox.com>
Jim Anderson <jander@ml.com>
John L. Allen <allen@grumman.com>
John Macdonald <jmm@revenge.elegant.com>
John Nolan <jpnolan@Op.Net>
+John P. Linderman <jpl@research.att.com>
John Peacock <jpeacock@rowman.com>
John Pfuntner <pfuntner@vnet.ibm.com>
-John P. Linderman <jpl@research.att.com>
John Rowe
John Salinas <jsalinas@cray.com>
John Stoffel <jfs@fluent.com>
Kurt D. Starsinic <kstar@wolfetech.com>
Kyriakos Georgiou
Larry Parmelee <parmelee@CS.Cornell.EDU>
-Larry Shatzer <lshatzer@islanddata.com>
Larry Schuler
Larry Schwimmer <rosebud@cyclone.Stanford.EDU>
+Larry Shatzer <lshatzer@islanddata.com>
Larry W. Virden <lvirden@cas.org>
Larry Wall <larry@wall.org>
Lars Hecking <lhecking@nmrc.ucc.ie>
Laszlo Molnar <laszlo.molnar@eth.ericsson.se>
-Leon Brocard <acme@astray.com>
Len Johnson <lenjay@ibm.net>
+Leon Brocard <acme@astray.com>
Les Peters <lpeters@aol.net>
Lincoln D. Stein <lstein@cshl.org>
Lionel Cons <lionel.cons@cern.ch>
Mark-Jason Dominus <mjd@plover.com>
Martien Verbruggen <mgjv@comdyn.com.au>
Martijn Koster <mak@excitecorp.com>
-Martin J. Bligh <mbligh@sequent.com>
Martin Husemann <martin@duskware.de.
+Martin J. Bligh <mbligh@sequent.com>
Martin Jost <Martin.Jost@icn.siemens.de>
Martin Lichtin <lichtin@bivio.com>
Martin Plechsmid <plechsmi@karlin.mff.cuni.cz>
Milton Hankins <webtools@uewrhp03.msd.ray.com>
Milton L. Hankins <mlh@swl.msd.ray.com>
Molnar Laszlo <molnarl@cdata.tvnet.hu>
-Murray Nesbitt <mjn@pathcom.com>
+Murray Nesbitt <murray@nesbitt.ca>
Nathan Kurz <nate@valleytel.net>
Nathan Torkington <gnat@frii.com>
Neale Ferguson <neale@VMA.TABNSW.COM.AU>
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
*/
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;
/*
{
GV *gv;
SV *sv;
- SV **svh;
/*
* The following code is the same as the one performed by UNIVERSAL::can
continue;
}
TRACEME(("(#%d) item", i));
- if (ret = store(cxt, *sav))
+ if ((ret = store(cxt, *sav)))
return ret;
}
TRACEME(("(#%d) value 0x%"UVxf, i, PTR2UV(val)));
- if (ret = store(cxt, val))
+ if ((ret = store(cxt, val)))
goto out;
/*
TRACEME(("(#%d) value 0x%"UVxf, i, PTR2UV(val)));
- if (ret = store(cxt, val))
+ if ((ret = store(cxt, val)))
goto out;
/*
* 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)"));
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;
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));
* 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)));
} 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);
* [<magic object>]
*/
- if (ret = store(cxt, mg->mg_obj))
+ if ((ret = store(cxt, mg->mg_obj)))
return ret;
}
* 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);
{
SV **svh;
int ret;
- SV *tag;
int type;
HV *hseen = cxt->hseen;
SV *sv;
SV *rv;
int obj_type;
- I32 classname;
int clone = cxt->optype & ST_CLONE;
char mtype = '\0';
unsigned int extra_type = 0;
I32 i;
HV *hv;
SV *sv;
- static SV *sv_h_undef = (SV *) 0; /* hv_store() bug */
TRACEME(("retrieve_hash (#%d)", cxt->tagnum));
I32 size;
I32 i;
HV *hv;
- SV *sv;
+ SV *sv=NULL;
int c;
static SV *sv_h_undef = (SV *) 0; /* hv_store() bug */
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))
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;
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;
} 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 */
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;
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);
(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);
}
}
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);
}
Fcntl
File::Basename
File::CheckTree
+File::Compare
File::Copy
File::DosGlob
File::Find
--- /dev/null
+#!./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, "<README") or print "not ";
+ print "not " unless compare($fh,"README") == 0;
+ print "ok 9\n";
+ close $fh;
+}
+
+# filehandle and different (but existing) file.
+{
+ my $fh;
+ open ($fh, "<README") or print "not ";
+ print "not " unless compare_text($fh,"TEST") == 1;
+ print "ok 10\n";
+ close $fh;
+}
+
+# Different file with contents of known file,
+# will use File::Temp to do this, skip rest of
+# tests if this doesn't seem to work
+
+my @donetests;
+eval {
+ require File::Spec; import File::Spec;
+ require File::Path; import File::Path;
+ require File::Temp; import File::Temp qw/ :mktemp unlink0 /;
+
+ my $template = File::Spec->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";
+}
+
sv_catpv(report, PL_tokenbuf);
}
PerlIO_printf(Perl_debug_log, "### %s\n", SvPV_nolen(report));
- })
+ });
}
/*
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
}
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]);
}
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... */
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;
DEBUG_T( {
PerlIO_printf(Perl_debug_log, "### Tokener expecting %s at %s\n",
exp_name[PL_expect], s);
- } )
+ } );
retry:
switch (*s) {
yyerror("Missing right curly or square bracket");
DEBUG_T( { PerlIO_printf(Perl_debug_log,
"### Tokener got EOF\n");
- } )
+ } );
TOKEN(0);
}
if (s++ < PL_bufend)
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;
PL_last_lop_op = ftst;
DEBUG_T( { PerlIO_printf(Perl_debug_log,
"### Saw file test %c\n", (int)ftst);
- } )
+ } );
FTST(ftst);
}
else {
DEBUG_T( { PerlIO_printf(Perl_debug_log,
"### %c looked like a file test but was not\n",
(int)ftst);
- } )
+ } );
s -= 2;
}
}
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);
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;
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;
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)
# 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);
#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 */
projects / p5sagit/p5-mst-13.2.git / commitdiff