summaryrefslogtreecommitdiff
path: root/t/op/substr.t
diff options
context:
space:
mode:
authorTim Bunce <Tim.Bunce@ig.co.uk>1997-08-07 00:00:00 +0000
committerTim Bunce <Tim.Bunce@ig.co.uk>1997-08-07 00:00:00 +0000
commit8490252049bf42d3d2f75d89178a8682bf22ba74 (patch)
tree71550615591dde7ae3fdf7f2e1be055faf33675e /t/op/substr.t
parent59586d7795db81c5ffcd935ba8614353199c2a71 (diff)
downloadperl-8490252049bf42d3d2f75d89178a8682bf22ba74.tar.gz
[inseperable differences up to perl 5.004_02]perl-5.004_02
[editor's note - this list of differences was built manually, so is either a little inaccurate or the most well preened out of the "unapplied changes" lists so far. It certainly didn't get the usual injection of message bodies. The aim of these changes is to give you a vector for finding a list message if you have an annotate operation hit this commit] ------ BUILD PROCESS ------ Title: "[PATCH]: HP-UX 10 w/o transition links" From: Jeff Okamoto <okamoto@hpcc123.corp.hp.com> Msg-ID: <199706231650.AA070364627@hpcc123.corp.hp.com> Files: Configure Title: "INSTALL updates for GNU ld and __inet_* errors" From: Andy Dougherty <doughera@newton.phys.lafayette.edu> Files: INSTALL ------ CORE LANGUAGE ------ Title: "[PATCH] Additional patch for "Can't execute ..."" From: Ilya Zakharevich <ilya@math.ohio-state.edu> Msg-ID: <199707191651.MAA04897@monk.mps.ohio-state.edu> Files: pod/perldiag.pod perl.c See 21fc060b433a5fd003b9aca5789342207c46ada4 and 2a92aaa05aa1acbf01092228d30e9b1d7b2a3f61 Title: "[PATCH] Re: Can't pack literals as pointers" From: Gurusamy Sarathy <gsar@engin.umich.edu> Msg-ID: <199708012250.SAA20278@aatma.engin.umich.edu> Files: pod/perldiag.pod pod/perlfunc.pod pp.c t/op/pack.t On Wed, 25 Jun 1997 00:23:18 GMT, John Tobey wrote: > >IMHO, pack("p","foo") should evaluate to a pointer that's valid >in the current context. pack("p",undef) should return the NULL >value. Currently, they both produce the error "Modification of a >read-only value attempted". > >This looks pretty easy to fix, so I've prepared a diff against >the 5.004_01 distribution. This tests fine on my Linux. I hope >I'm not introducing a memory leak or other ailment... That doesn't look quite right to me. When provided a literal, you should point at the actual literal (which normally has a global lifetime), rather than making a mortal copy of it and pointing at that. The mortal copy will be destroyed at the next statement boundary, and you'll be left with a dangling pointer when you unpack(). You're doing the very thing the XXX comment above was intended to highlight. I do agree that literals should be pack('p')-able. So, I'd suggest the change be modified [...] Title: "One-liner regex causes SEGV on 5.003 under HP-UX and Linux" From: Hugo van der Sanden <hv@crypt.compulink.co.uk> Msg-ID: <199707061144.MAA04443@crypt.compulink.co.uk> Files: regexec.c t/op/re_tests [was originally credited as the same change as 44ed422101809141bc33c2b85c1cff357de4d7bf] Title: "Free temps before calling END blocks", "Too late destruction" From: Chip Salzenberg <chip@rio.atlantic.net> Msg-ID: <m33erfv5hx.fsf@chany-p100.emwp.com> Files: perl.c Title: "Forbid "goto" into middle of foreach loop" From: Chip Salzenberg <chip@rio.atlantic.net> Files: pod/perldiag.pod pp_ctl.c Title: "[PATCH] m2t2: problem in NetBSD 1.2D with sfio" From: Jarkko Hietaniemi <jhi@iki.fi> Files: perl.h Title: "Forbid negative splice offset beyond array start" From: "John L. Allen" <allen@gateway.grumman.com>, Chip Salzenberg <chip@rio.atlantic.net> Msg-ID: <Pine.SOL.3.91.970625111744.19300A-100000@gateway> Files: pp.c Title: "Fix memory leak on eval 'sub {}'" From: Chip Salzenberg <chip@rio.atlantic.net> Files: pp_ctl.c Title: "Fix C<qq #hi#>" From: Chip Salzenberg <chip@rio.atlantic.net> Files: toke.c Title: "Don't warn about "${foo}" in string, even if &foo exists" From: Chip Salzenberg <chip@rio.atlantic.net> Files: toke.c Title: "Perldb internal flag rehaul" From: Ilya Zakharevich <ilya@math.ohio-state.edu> Files: pod/perldebug.pod pod/perlvar.pod perl.h gv.c mg.c op.c perl.c pp_ctl.c pp_hot.c pp_sys.c sv.c toke.c Title: "Fix C<print $foo x 2> parsing" From: "Chuck D. Phillips (NON-HP Employee)" <cdp@hpescdp.fc.hp.com>, Chip Salzenberg <chip@rio.atlantic.net> Msg-ID: <199706121737.KAA00503@palrel3.hp.com> Files: toke.c Title: "Fix lockf_emulate_flock() positioning" From: Chip Salzenberg <chip@rio.atlantic.net>, gen@atd.rdc.ricoh.co.jp Msg-ID: <199706091132.UAA00895@wampa.atd.rdc.ricoh.co.jp> Files: pp_sys.c Title: "[PATCH] Make DEBUGGING_MSTATS info consistent" From: Andy Dougherty <doughera@newton.phys.lafayette.edu> Msg-ID: <Pine.SUN.3.96.970731131529.3740A-100000@newton.phys> Files: INSTALL pod/perldelta.pod perl.h Title: "semctl broken under Linux" From: Andreas Schwab <schwab@LS5.informatik.uni-dortmund.de>, Andreas Schwab <schwab@issan.informatik.uni-dortmund.de>, Graham Barr <gbarr@ti.com>, Tim Bunce <Tim.Bunce@ig.co.uk> Msg-ID: <33C38291.2D9302DA@ti.com>, <9707040912.AA03470@issan.informatik.uni-dortmund.de>, <9707041538.AA08946@toad.ig.co.uk>, <9707070924.AA11774@issan.informatik.uni-dortmund.de>, <9707090933.AA19012@issan.informatik.uni-dortmund.de> Files: doio.c [one change made it, as 8e591e46b4c6543ed80895327199c4a628ce11b6] Title: "One-liner regex causes SEGV on 5.003 under HP-UX and Linux" From: Hugo van der Sanden <hv@crypt.compulink.co.uk> Msg-ID: <199707061144.MAA04443@crypt.compulink.co.uk> Files: regexec.c t/op/re_tests [was originally credited as the same change as 44ed422101809141bc33c2b85c1cff357de4d7bf] Title: "Fix up problems with *DBM tests" From: Paul Marquess <pmarquess@bfsec.bt.co.uk> Files: t/lib/gdbm.t t/lib/ndbm.t t/lib/odbm.t t/lib/sdbm.t Title: "Faster int to string conversion", "[PATCH} Re: memory leak in buffer safety code" From: Chip Salzenberg <chip@rio.atlantic.net>, Hugo van der Sanden <hv@crypt.compulink.co.uk>, Tim Bunce <Tim.Bunce@ig.co.uk> Msg-ID: <199707140912.KAA09935@crypt.compulink.co.uk>, <199707142050.QAA20976@rio.atlantic.net>, <199707182035.VAA20990@crypt.compulink.co.uk>, <9707151040.AA02883@toad.ig.co.uk> Files: global.sym sv.c Title: "Fix '-' flag on sprintf() of floats" From: Chip Salzenberg <chip@rio.atlantic.net>, Jarkko Hietaniemi <jhi@iki.fi> Msg-ID: <199705270646.JAA02510@alpha.hut.fi> Files: sv.c Title: "Don't use atol() for unsigned values", "signedness problem in pack("N", "value");" From: Chip Salzenberg <chip@rio.atlantic.net>, Roger Espel Llima <espel@llaic.univ-bpclermont.fr> Msg-ID: <19970531200007.40218@llaic.univ-bpclermont.fr> Files: sv.c Title: "Perldb internal flag rehaul" From: Ilya Zakharevich <ilya@math.ohio-state.edu> Files: pod/perldebug.pod pod/perlvar.pod perl.h gv.c mg.c op.c perl.c pp_ctl.c pp_hot.c pp_sys.c sv.c toke.c Title: "[PATCH] Exporter new export_to_level method" From: epeschko@elmer.tci.com (Ed Peschko) Files: lib/Exporter.pm Title: "[MM] Small patch to MakeMaker, new release" From: "Andreas J. Koenig" <k@anna.in-berlin.de> Msg-ID: <199706281603.SAA10869@anna.in-berlin.de> Files: lib/ExtUtils/Command.pm lib/ExtUtils/Install.pm lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Mksymlists.pm Title: "CPAN.pm, $VERSION and nested (bundled) modules." From: a.koenig@kulturbox.de (Andreas J. Koenig) Files: lib/ExtUtils/Install.pm lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Mksymlists.pm Title: "Time::Local patch (plus perl.c and filehand.t)" From: ilya@math.ohio-state.edu (Ilya Zakharevich) Files: lib/Time/Local.pm perl.c t/lib/filehand.t Title: "Slightly safer signals" From: Ilya Zakharevich <ilya@math.ohio-state.edu> Files: mg.c perl.c Title: "Perldb internal flag rehaul" From: Ilya Zakharevich <ilya@math.ohio-state.edu> Files: pod/perldebug.pod pod/perlvar.pod perl.h gv.c mg.c op.c perl.c pp_ctl.c pp_hot.c pp_sys.c sv.c toke.c Title: "'use UNIVERSAL;' deprecated, do C<UNIVERSAL::isa()> instead", "UNIVERSAL.pm and import methods" From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>, Gisle Aas <aas@bergen.sn.no>, Graham Barr <gbarr@ti.com>, Gurusamy Sarathy <gsar@engin.umich.edu>, Hugo van der Sanden <hv@crypt.compulink.co.uk> Msg-ID: <199706271701.NAA25664@aatma.engin.umich.edu>, <199706271904.UAA00120@crypt.compulink.co.uk>, <199706272054.QAA28913@aatma.engin.umich.edu>, <199706301554.LAA03763@aatma.engin.umich.edu>, <33B22248.7D7C1985@ti.com>, <E0wf5TN-0006ps-00@taurus.cus.cam.ac.uk>, <E0wguTR-0005bs-00@ursa.cus.cam.ac.uk>, <E0whaZJ-0007BA-00@ursa.cus.cam.ac.uk>, <E0whfHh-0007bW-00@ursa.cus.cam.ac.uk>, <E0wiyUG-00073j-00@taurus.cus.cam.ac.uk>, <hiuyv6q9k.fsf@bergen.sn.no> Files: lib/Class/Struct.pm lib/File/Compare.pm lib/File/Copy.pm t/op/universal.t universal.c [two changes made it, as d704f39a0db2dc23790dfd9d7bd59ce9928a6e2c, e09f3e01ccd721309f0eb0aae224d84db2e8436a] ------ PORTABILITY - WIN32 ------ Title: "[PATCH] Embedding threaded apps in perl.dll" From: Gurusamy Sarathy <gsar@engin.umich.edu> Msg-ID: <199707261518.LAA24346@aatma.engin.umich.edu>, <199707301833.OAA19570@aatma.engin.umich.edu> Files: win32/win32.c [one change made it, as 4dd614da4d1132b957c4951dd00f64d81b89dc20] Title: "minor win32 scribbles" From: Hugo van der Sanden <hv@crypt.compulink.co.uk> Msg-ID: <199707270832.JAA19399@crypt.compulink.co.uk> Files: README.win32 [nitpicking f7c603cbfba7c97f77e257c42aa119ffdb47fe1e] Title: "[PATCH] binary coexistence on win32", "[RESEND] [PATCH] binary coexistence on win32" From: Gurusamy Sarathy <gsar@engin.umich.edu> Msg-ID: <199707250109.VAA02666@aatma.engin.umich.edu>, <199707301829.OAA19516@aatma.engin.umich.edu> Files: lib/ExtUtils/Mksymlists.pm win32/win32.h win32/win32io.h win32/win32iop.h win32/makedef.pl win32/win32.c win32/win32io.c Title: "WIN32 Build - pod2xxx.bat Missing?", "[PATCH] Re: WIN32 Build - pod2xxx.bat Missing?" From: Chris Williams <chrisw@netinfo.com.au>, Gurusamy Sarathy <gsar@engin.umich.edu> Msg-ID: <199707011423.KAA15855@aatma.engin.umich.edu>, <33B8B962.D96FA1F5@netinfo.com.au> Files: win32/Makefile win32/makefile.mk Title: "[PATCH] docs for win32 utilities" From: Gurusamy Sarathy <gsar@engin.umich.edu> Msg-ID: <199707250045.UAA02510@aatma.engin.umich.edu> Files: win32/bin/pl2bat.bat win32/bin/runperl.bat Title: "[PATCH] trial2: some batch files won't run" From: Gurusamy Sarathy <gsar@engin.umich.edu> Msg-ID: <199708040226.WAA17301@aatma.engin.umich.edu> Files: win32/bin/pl2bat.bat win32/bin/runperl.bat Title: "[PATCH] win32 extras and embedding" From: Gurusamy Sarathy <gsar@engin.umich.edu> Msg-ID: <199707250232.WAA03421@aatma.engin.umich.edu>, <199707301831.OAA19528@aatma.engin.umich.edu> Files: dosish.h win32/win32.h perl.c win32/config.bc win32/config_H.bc win32/makedef.pl win32/perllib.c win32/win32.c [one change was applied (hastily), as ad2e33dc060dc2ccf73a5ff1557a69a9b09c30c8] ------ PORTABILITY - OTHER ------ Title: "Additional OS/2 patches" From: Gurusamy Sarathy <gsar@engin.umich.edu>, Ilya Zakharevich <ilya@math.ohio-state.edu> Msg-ID: <199708020823.EAA19521@monk.mps.ohio-state.edu>, <199708021424.KAA28561@aatma.engin.umich.edu>, <199708042108.RAA27671@aatma.engin.umich.edu> Files: README.os2 os2/Changes perl.c [one change was applied, as d8c2d278168b862ff4120ad8e5887d37d31f858b] Title: "make depend loop fix and minor OS/2 improvements to build process" From: ilya@math.ohio-state.edu (Ilya Zakharevich) Files: Makefile.SH hints/os2.sh os2/Makefile.SHs Title: "Minor VMS patches" From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> Msg-ID: <01ILCUO6XXTE000WFK@hmivax.humgen.upenn.edu> Files: lib/ExtUtils/MM_VMS.pm vms/vmsish.h vms/descrip.mms vms/test.com vms/vms.c vms/ext/filespec.t Title: "[PATCH] Two un-disabled tests for VMS" From: Dan Sugalski <sugalsd@lbcc.cc.or.us> Msg-ID: <3.0.2.32.19970718095842.00879220@stargate.lbcc.cc.or.us> Files: vms/test.com Title: "fix substr fix (tests 27 etc)", "perl5.004_02 trial 1 available (with substr bug and still some" From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>, Hugo van der Sanden <hv@crypt.compulink.co.uk>, Jarkko Hietaniemi <jhi@iki.fi> Msg-ID: <199707301759.SAA02899@crypt.compulink.co.uk>, <199707302228.BAA18032@alpha.hut.fi>, <199707310929.KAA06515@crypt.compulink.co.uk>, <E0wtruH-0002JM-00@ursa.cus.cam.ac.uk> Files: pp.c Title: "Fwd: substr("foo", -1000)", "substr: warn if substring doesn't intersect original at all" From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>, Jarkko Hietaniemi <jhi@iki.fi> Msg-ID: <199707100655.JAA14924@alpha.hut.fi>, <E0wm1JG-0000UY-00@taurus.cus.cam.ac.uk> Files: pod/perlfunc.pod pp.c t/op/substr.t [one change was applied, as d9fdd1afe4b88705294e21dc4e070c42d3d9a4d8] Title: "[PATCH] Changes for VMS 7.1 support" From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU>, Dan Sugalski <sugalsd@lbcc.cc.or.us> Msg-ID: <01ILDXUH0J1W00026U@hmivax.humgen.upenn.edu>, <3.0.2.32.19970718095935.0087a2d0@stargate.lbcc.cc.or.us> Files: vms/sockadapt.h vms/config.vms vms/sockadapt.c ------ DOCUMENTATION ------ Title: "Document bug fix in localization of $1 etc." From: Chip Salzenberg <salzench@nielsenmedia.com> Files: pod/perldelta.pod Title: "[BUG:PATCH] Missing semicolon message wrong in perldiag" From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk> Msg-ID: <E0welEn-0002vT-00@taurus.cus.cam.ac.uk>, <E0wfRJU-0006Aw-00@taurus.cus.cam.ac.uk> Files: pod/perldiag.pod [one change was applied, as 702d120df290e0de1b21f167f7d0110b35ee2fef] Title: "OK: perl <some_version> on <some_system> (corrected)", "enhancements to perlbug -ok" From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>, Stephen McCamant <alias@mcs.com> Msg-ID: <E0wukVt-0006Da-00@ursa.cus.cam.ac.uk>, <E0wvMQl-00055y-00@ursa.cus.cam.ac.uk>, <m0wv81x-000EYPC@alias-2.pr.mcs.net> Files: utils/Makefile utils/perlbug.PL Title: "perldoc doesn't grok Win32 UNC paths" From: Warren Jones <wjones@tc.fluke.com> Msg-ID: <97Jun17.184420pdt.35728-1@gateway.fluke.com>, <97Jun18.165618pdt.35713-1@gateway.fluke.com> Files: utils/perldoc.PL [one change was applied, as f72119fc50f0d88b02501ba41112f82ab99f0c3b]
Diffstat (limited to 't/op/substr.t')
-rwxr-xr-xt/op/substr.t154
1 files changed, 133 insertions, 21 deletions
diff --git a/t/op/substr.t b/t/op/substr.t
index e34216fb17..bb655f5209 100755
--- a/t/op/substr.t
+++ b/t/op/substr.t
@@ -2,25 +2,40 @@
# $RCSfile: substr.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:31 $
-print "1..25\n";
+print "1..97\n";
+
+#P = start of string Q = start of substr R = end of substr S = end of string
$a = 'abcdefxyz';
+BEGIN { $^W = 1 };
+
+$SIG{__WARN__} = sub {
+ if ($_[0] =~ /^substr outside of string/) {
+ $w++;
+ } elsif ($_[0] =~ /^Attempt to use reference as lvalue in substr/) {
+ $w += 2;
+ } else {
+ warn @_;
+ }
+};
-print (substr($a,0,3) eq 'abc' ? "ok 1\n" : "not ok 1\n");
-print (substr($a,3,3) eq 'def' ? "ok 2\n" : "not ok 2\n");
-print (substr($a,6,999) eq 'xyz' ? "ok 3\n" : "not ok 3\n");
-print (substr($a,999,999) eq '' ? "ok 4\n" : "not ok 4\n");
-print (substr($a,0,-6) eq 'abc' ? "ok 5\n" : "not ok 5\n");
-print (substr($a,-3,1) eq 'x' ? "ok 6\n" : "not ok 6\n");
+sub fail { !defined(shift) && $w-- };
+
+print (substr($a,0,3) eq 'abc' ? "ok 1\n" : "not ok 1\n"); # P=Q R S
+print (substr($a,3,3) eq 'def' ? "ok 2\n" : "not ok 2\n"); # P Q R S
+print (substr($a,6,999) eq 'xyz' ? "ok 3\n" : "not ok 3\n"); # P Q S R
+print (fail(substr($a,999,999)) ? "ok 4\n" : "not ok 4\n"); # P R Q S
+print (substr($a,0,-6) eq 'abc' ? "ok 5\n" : "not ok 5\n"); # P=Q R S
+print (substr($a,-3,1) eq 'x' ? "ok 6\n" : "not ok 6\n"); # P Q R S
$[ = 1;
-print (substr($a,1,3) eq 'abc' ? "ok 7\n" : "not ok 7\n");
-print (substr($a,4,3) eq 'def' ? "ok 8\n" : "not ok 8\n");
-print (substr($a,7,999) eq 'xyz' ? "ok 9\n" : "not ok 9\n");
-print (substr($a,999,999) eq '' ? "ok 10\n" : "not ok 10\n");
-print (substr($a,1,-6) eq 'abc' ? "ok 11\n" : "not ok 11\n");
-print (substr($a,-3,1) eq 'x' ? "ok 12\n" : "not ok 12\n");
+print (substr($a,1,3) eq 'abc' ? "ok 7\n" : "not ok 7\n"); # P=Q R S
+print (substr($a,4,3) eq 'def' ? "ok 8\n" : "not ok 8\n"); # P Q R S
+print (substr($a,7,999) eq 'xyz' ? "ok 9\n" : "not ok 9\n"); # P Q S R
+print (fail(substr($a,999,999)) ? "ok 10\n" : "not ok 10\n");# P R Q S
+print (substr($a,1,-6) eq 'abc' ? "ok 11\n" : "not ok 11\n");# P=Q R S
+print (substr($a,-3,1) eq 'x' ? "ok 12\n" : "not ok 12\n"); # P Q R S
$[ = 0;
@@ -28,7 +43,6 @@ substr($a,3,3) = 'XYZ';
print $a eq 'abcXYZxyz' ? "ok 13\n" : "not ok 13\n";
substr($a,0,2) = '';
print $a eq 'cXYZxyz' ? "ok 14\n" : "not ok 14\n";
-y/a/a/;
substr($a,0,0) = 'ab';
print $a eq 'abcXYZxyz' ? "ok 15\n" : "not ok 15 $a\n";
substr($a,0,0) = '12345678';
@@ -42,9 +56,103 @@ print $a eq '12345678abcXYZ12345678' ? "ok 19\n" : "not ok 19\n";
$a = 'abcdefxyz';
-print (substr($a,6) eq 'xyz' ? "ok 20\n" : "not ok 20\n");
-print (substr($a,-3) eq 'xyz' ? "ok 21\n" : "not ok 21\n");
-print (substr($a,999) eq '' ? "ok 22\n" : "not ok 22\n");
+print (substr($a,6) eq 'xyz' ? "ok 20\n" : "not ok 20\n"); # P Q R=S
+print (substr($a,-3) eq 'xyz' ? "ok 21\n" : "not ok 21\n"); # P Q R=S
+print (fail(substr($a,999)) ? "ok 22\n" : "not ok 22\n"); # P R=S Q
+print (substr($a,0) eq 'abcdefxyz' ? "ok 23\n" : "not ok 23\n");# P=Q R=S
+print (substr($a,9) eq '' ? "ok 24\n" : "not ok 24\n"); # P Q=R=S
+print (substr($a,-11) eq 'abcdefxyz' ? "ok 25\n" : "not ok 25\n");# Q P R=S
+print (substr($a,-9) eq 'abcdefxyz' ? "ok 26\n" : "not ok 26\n"); # P=Q R=S
+
+$a = '54321';
+
+print (fail(substr($a,-7, 1)) ? "ok 27\n" : "not ok 27\n"); # Q R P S
+print (fail(substr($a,-7,-6)) ? "ok 28\n" : "not ok 28\n"); # Q R P S
+print (substr($a,-5,-7) eq '' ? "ok 29\n" : "not ok 29\n"); # R P=Q S
+print (substr($a, 2,-7) eq '' ? "ok 30\n" : "not ok 30\n"); # R P Q S
+print (substr($a,-3,-7) eq '' ? "ok 31\n" : "not ok 31\n"); # R P Q S
+print (substr($a, 2,-5) eq '' ? "ok 32\n" : "not ok 32\n"); # P=R Q S
+print (substr($a,-3,-5) eq '' ? "ok 33\n" : "not ok 33\n"); # P=R Q S
+print (substr($a, 2,-4) eq '' ? "ok 34\n" : "not ok 34\n"); # P R Q S
+print (substr($a,-3,-4) eq '' ? "ok 35\n" : "not ok 35\n"); # P R Q S
+print (substr($a, 5,-6) eq '' ? "ok 36\n" : "not ok 36\n"); # R P Q=S
+print (substr($a, 5,-5) eq '' ? "ok 37\n" : "not ok 37\n"); # P=R Q S
+print (substr($a, 5,-3) eq '' ? "ok 38\n" : "not ok 38\n"); # P R Q=S
+print (fail(substr($a, 7,-7)) ? "ok 39\n" : "not ok 39\n"); # R P S Q
+print (fail(substr($a, 7,-5)) ? "ok 40\n" : "not ok 40\n"); # P=R S Q
+print (fail(substr($a, 7,-3)) ? "ok 41\n" : "not ok 41\n"); # P R S Q
+print (fail(substr($a, 7, 0)) ? "ok 42\n" : "not ok 42\n"); # P S Q=R
+
+print (substr($a,-7,2) eq '' ? "ok 43\n" : "not ok 43\n"); # Q P=R S
+print (substr($a,-7,4) eq '54' ? "ok 44\n" : "not ok 44\n"); # Q P R S
+print (substr($a,-7,7) eq '54321' ? "ok 45\n" : "not ok 45\n");# Q P R=S
+print (substr($a,-7,9) eq '54321' ? "ok 46\n" : "not ok 46\n");# Q P S R
+print (substr($a,-5,0) eq '' ? "ok 47\n" : "not ok 47\n"); # P=Q=R S
+print (substr($a,-5,3) eq '543' ? "ok 48\n" : "not ok 48\n");# P=Q R S
+print (substr($a,-5,5) eq '54321' ? "ok 49\n" : "not ok 49\n");# P=Q R=S
+print (substr($a,-5,7) eq '54321' ? "ok 50\n" : "not ok 50\n");# P=Q S R
+print (substr($a,-3,0) eq '' ? "ok 51\n" : "not ok 51\n"); # P Q=R S
+print (substr($a,-3,3) eq '321' ? "ok 52\n" : "not ok 52\n");# P Q R=S
+print (substr($a,-2,3) eq '21' ? "ok 53\n" : "not ok 53\n"); # P Q S R
+print (substr($a,0,-5) eq '' ? "ok 54\n" : "not ok 54\n"); # P=Q=R S
+print (substr($a,2,-3) eq '' ? "ok 55\n" : "not ok 55\n"); # P Q=R S
+print (substr($a,0,0) eq '' ? "ok 56\n" : "not ok 56\n"); # P=Q=R S
+print (substr($a,0,5) eq '54321' ? "ok 57\n" : "not ok 57\n");# P=Q R=S
+print (substr($a,0,7) eq '54321' ? "ok 58\n" : "not ok 58\n");# P=Q S R
+print (substr($a,2,0) eq '' ? "ok 59\n" : "not ok 59\n"); # P Q=R S
+print (substr($a,2,3) eq '321' ? "ok 60\n" : "not ok 60\n"); # P Q R=S
+print (substr($a,5,0) eq '' ? "ok 61\n" : "not ok 61\n"); # P Q=R=S
+print (substr($a,5,2) eq '' ? "ok 62\n" : "not ok 62\n"); # P Q=S R
+print (substr($a,-7,-5) eq '' ? "ok 63\n" : "not ok 63\n"); # Q P=R S
+print (substr($a,-7,-2) eq '543' ? "ok 64\n" : "not ok 64\n");# Q P R S
+print (substr($a,-5,-5) eq '' ? "ok 65\n" : "not ok 65\n"); # P=Q=R S
+print (substr($a,-5,-2) eq '543' ? "ok 66\n" : "not ok 66\n");# P=Q R S
+print (substr($a,-3,-3) eq '' ? "ok 67\n" : "not ok 67\n"); # P Q=R S
+print (substr($a,-3,-1) eq '32' ? "ok 68\n" : "not ok 68\n");# P Q R S
+
+$a = '';
+
+print (substr($a,-2,2) eq '' ? "ok 69\n" : "not ok 69\n"); # Q P=R=S
+print (substr($a,0,0) eq '' ? "ok 70\n" : "not ok 70\n"); # P=Q=R=S
+print (substr($a,0,1) eq '' ? "ok 71\n" : "not ok 71\n"); # P=Q=S R
+print (substr($a,-2,3) eq '' ? "ok 72\n" : "not ok 72\n"); # Q P=S R
+print (substr($a,-2) eq '' ? "ok 73\n" : "not ok 73\n"); # Q P=R=S
+print (substr($a,0) eq '' ? "ok 74\n" : "not ok 74\n"); # P=Q=R=S
+
+
+print (substr($a,0,-1) eq '' ? "ok 75\n" : "not ok 75\n"); # R P=Q=S
+print (fail(substr($a,-2,0)) ? "ok 76\n" : "not ok 76\n"); # Q=R P=S
+print (fail(substr($a,-2,1)) ? "ok 77\n" : "not ok 77\n"); # Q R P=S
+print (fail(substr($a,-2,-1)) ? "ok 78\n" : "not ok 78\n"); # Q R P=S
+print (fail(substr($a,-2,-2)) ? "ok 79\n" : "not ok 79\n"); # Q=R P=S
+print (fail(substr($a,1,-2)) ? "ok 80\n" : "not ok 81\n"); # R P=S Q
+print (fail(substr($a,1,1)) ? "ok 81\n" : "not ok 81\n"); # P=S Q R
+print (fail(substr($a,1,0)) ? "ok 82\n" : "not ok 82\n"); # P=S Q=R
+print (fail(substr($a,1)) ? "ok 83\n" : "not ok 83\n"); # P=R=S Q
+
+
+my $a = 'zxcvbnm';
+substr($a,2,0) = '';
+print $a eq 'zxcvbnm' ? "ok 84\n" : "not ok 84\n";
+substr($a,7,0) = '';
+print $a eq 'zxcvbnm' ? "ok 85\n" : "not ok 85\n";
+substr($a,5,0) = '';
+print $a eq 'zxcvbnm' ? "ok 86\n" : "not ok 86\n";
+substr($a,0,2) = 'pq';
+print $a eq 'pqcvbnm' ? "ok 87\n" : "not ok 87\n";
+substr($a,2,0) = 'r';
+print $a eq 'pqrcvbnm' ? "ok 88\n" : "not ok 88\n";
+substr($a,8,0) = 'asd';
+print $a eq 'pqrcvbnmasd' ? "ok 89\n" : "not ok 89\n";
+substr($a,0,2) = 'iop';
+print $a eq 'ioprcvbnmasd' ? "ok 90\n" : "not ok 90\n";
+substr($a,0,5) = 'fgh';
+print $a eq 'fghvbnmasd' ? "ok 91\n" : "not ok 91\n";
+substr($a,3,5) = 'jkl';
+print $a eq 'fghjklsd' ? "ok 92\n" : "not ok 92\n";
+substr($a,3,2) = '1234';
+print $a eq 'fgh1234lsd' ? "ok 93\n" : "not ok 93\n";
+
# with lexicals (and in re-entered scopes)
for (0,1) {
@@ -52,17 +160,21 @@ for (0,1) {
unless ($_) {
$txt = "Foo";
substr($txt, -1) = "X";
- print $txt eq "FoX" ? "ok 23\n" : "not ok 23\n";
+ print $txt eq "FoX" ? "ok 94\n" : "not ok 94\n";
}
else {
+ local $^W = 0; # because of (spurious?) "uninitialised value"
substr($txt, 0, 1) = "X";
- print $txt eq "X" ? "ok 24\n" : "not ok 24\n";
+ print $txt eq "X" ? "ok 95\n" : "not ok 95\n";
}
}
-# coersion of references
+# coercion of references
{
my $s = [];
substr($s, 0, 1) = 'Foo';
- print substr($s,0,7) eq "FooRRAY" ? "ok 25\n" : "not ok 25\n";
+ print substr($s,0,7) eq "FooRRAY" && !($w-=2) ? "ok 96\n" : "not ok 96\n";
}
+
+# check no spurious warnings
+print $w ? "not ok 97\n" : "ok 97\n";