From jbodwin@sebringring.com

Thanks.

  - Jim

===============================================

sub foo {
  my ($str) = @​_;
  return uc $str;
}

my ($str) = "abcdefghijklmnopqrstuvwxyz";

my ($ucafew) = foo(substr($str, 0, 4, "xxxx"));

print "$ucafew $str\n";

my ($notuc) = substr($str, 0, 4, "yyyy");

print "$notuc $str\n";

============================================
$ perl /tmp/perlbug.pl
ABCD abcdefghijklmnopqrstuvwxyz <===== should be xxxxefghijkl...
abcd yyyyefghijklmnopqrstuvwxyz

Here is my perl -V output​:

perl -V
Summary of my perl5 (5.0 patchlevel 5 subversion 03) configuration​:
  Platform​:
  osname=MSWin32, osvers=4.0, archname=MSWin32-x86-object
  uname=''
  hint=recommended, useposix=true, d_sigaction=undef
  usethreads=undef useperlio=undef d_sfio=undef
  Compiler​:
  cc='cl.exe', optimize='-O2 -MD -DNDEBUG -TP -GX', gccversion=
  cppflags='-DWIN32'
  ccflags ='-O2 -MD -DNDEBUG -TP -GX -DWIN32 -D_CONSOLE -DNO_STRICT
-DHAVE_DES_FCRYPT -DPERL_OBJECT'
  stdchar='char', d_stdstdio=define, usevfork=false
  intsize=4, longsize=4, ptrsize=4, doublesize=8
  d_longlong=undef, longlongsize=8, d_longdbl=define, longdblsize=10
  alignbytes=8, usemymalloc=n, prototype=define
  Linker and Libraries​:
  ld='link', ldflags ='-nologo -nodefaultlib -release -machine​:x86'
  libpth="d​:\program files\devstudio\vc\lib"
  libs= oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib
comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib netapi32.lib
uuid.lib wsock32.lib mpr.lib winmm.lib version.lib odbc32.lib odbccp32.lib
PerlCRT.lib
  libc=C​:\Perl\5.005\bin\MSWin32-x86-object\PerlCRT.lib, so=dll,
useshrplib=yes, libperl=perlcore.lib
  Dynamic Linking​:
  dlsrc=dl_win32.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' '
  cccdlflags=' ', lddlflags='-dll -nologo -nodefaultlib -release
-machine​:x86'

Characteristics of this binary (from libperl)​:
  Locally applied patches​:
  ActivePerl Build 519
  Built under MSWin32
  Compiled at Aug 12 1999 09​:50​:30
  %ENV​:
  PERL5DB="BEGIN { require "pivotdb.pl" }"

PERLLIB="c​:/bin;//Sebring-dev2/_MIS_data/Software/Perl/lib;c​:/perl/5.005/lib
"
  @​INC​:
  c​:/bin
  //Sebring-dev2/_MIS_data/Software/Perl/lib
  c​:/perl/5.005/lib
  c​:/perl/5.005/lib/MSWin32-x86-object
  c​:/perl/5.005/lib
  c​:/Perl/5.005/lib/MSWin32-x86-object
  c​:/Perl/5.005/lib
  c​:/Perl/site/5.005/lib/MSWin32-x86-object
  c​:/Perl/site/5.005/lib
  .

From @gsar

On Wed, 29 Dec 1999 17​:21​:45 PST, Jim Bodwin wrote​:

sub foo {
my ($str) = @​_;
return uc $str;
}

my ($str) = "abcdefghijklmnopqrstuvwxyz";

my ($ucafew) = foo(substr($str, 0, 4, "xxxx"));

print "$ucafew $str\n";

my ($notuc) = substr($str, 0, 4, "yyyy");

print "$notuc $str\n";

============================================
$ perl /tmp/perlbug.pl
ABCD abcdefghijklmnopqrstuvwxyz <===== should be xxxxefghijkl...
abcd yyyyefghijklmnopqrstuvwxyz

Here's a fix.

Sarathy
gsar@​ActiveState.com

-----------------------------------8<-----------------------------------
Change 4747 by gsar@auger on 2000/01/02 20:17:36

	fix 4-arg substr() when used as argument to subroutine

Affected files ...

... //depot/perl/pp.c#166 edit
... //depot/perl/t/op/substr.t#12 edit

Differences ...

==== //depot/perl/pp.c#166 (text) ====
Index: perl/pp.c
--- perl/pp.c.~1~	Wed Jan  5 10:44:22 2000
+++ perl/pp.c	Wed Jan  5 10:44:22 2000
@@ -2021,7 +2021,9 @@
 	    sv_pos_u2b(sv, &pos, &rem);
 	tmps += pos;
 	sv_setpvn(TARG, tmps, rem);
-	if (lvalue) {			/* it's an lvalue! */
+	if (repl)
+	    sv_insert(sv, pos, rem, repl, repl_len);
+	else if (lvalue) {		/* it's an lvalue! */
 	    if (!SvGMAGICAL(sv)) {
 		if (SvROK(sv)) {
 		    STRLEN n_a;
@@ -2050,8 +2052,6 @@
 	    LvTARGOFF(TARG) = pos;
 	    LvTARGLEN(TARG) = rem;
 	}
-	else if (repl)
-	    sv_insert(sv, pos, rem, repl, repl_len);
     }
     SPAGAIN;
     PUSHs(TARG);		/* avoid SvSETMAGIC here */

==== //depot/perl/t/op/substr.t#12 (xtext) ====
Index: perl/t/op/substr.t
--- perl/t/op/substr.t.~1~	Wed Jan  5 10:44:22 2000
+++ perl/t/op/substr.t	Wed Jan  5 10:44:22 2000
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..106\n";
+print "1..108\n";
 
 #P = start of string  Q = start of substr  R = end of substr  S = end of string
 
@@ -209,3 +209,9 @@
 eval 'substr($a,0,0,"") = "abc"';
 print "not " unless $@ && $@ =~ /Can't modify substr/ && $a eq "foo";
 print "ok 106\n";
+
+$a = "abcdefgh";
+print "not " unless sub { shift }->(substr($a, 0, 4, "xxxx")) eq 'abcd';
+print "ok 107\n";
+print "not " unless $a eq 'xxxxefgh';
+print "ok 108\n";
End of Patch.