39995 (from 39977): Optimise string parameter assignment.

If setter is the standard one and string length is unchnaged we can
copy into place.

3 files changed, 174 insertions, 8 deletions

diff --git a/ChangeLog b/ChangeLog
index 3a917f59c..7b05d39d3 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,8 @@
 2016-11-20  Peter Stephenson  <p.w.stephenson@ntlworld.com>
 
+	* 39995 (from 39977): Src/params.c, Test/A06assign.ztst:
+	optimisation of string assignment if length is unchanged.
+
 	* Mikel Ward: 39978: Doc/Zsh/jobs.yo: more accurate
 	documentation of searching for job by string.
 
diff --git a/Src/params.c b/Src/params.c
index 9d741cb7b..a79debc93 100644
--- a/Src/params.c
+++ b/Src/params.c
@@ -2436,9 +2436,10 @@ assignstrvalue(Value v, char *val, int flags)
 		v->pm->width = strlen(val);
 	} else {
 	    char *z, *x;
-	    int zlen;
+            int zlen, vlen, newsize;
 
-	    z = dupstring_glen(v->pm->gsu.s->getfn(v->pm), (unsigned*) &zlen);
+            z = v->pm->gsu.s->getfn(v->pm);
+            zlen = strlen(z);
 
 	    if ((v->flags & VALFLAG_INV) && unset(KSHARRAYS))
 		v->start--, v->end--;
@@ -2469,12 +2470,34 @@ assignstrvalue(Value v, char *val, int flags)
 	    }
 	    else if (v->end > zlen)
 		v->end = zlen;
-	    x = (char *) zalloc(v->start + strlen(val) + zlen - v->end + 1);
-	    strncpy(x, z, v->start);
-	    strcpy(x + v->start, val);
-	    strcat(x + v->start, z + v->end);
-	    v->pm->gsu.s->setfn(v->pm, x);
-	    zsfree(val);
+
+            vlen = strlen(val);
+            /* Characters preceding start index +
+               characters of what is assigned +
+               characters following end index */
+            newsize = v->start + vlen + (zlen - v->end);
+
+            /* Does new size differ? */
+            if (newsize != zlen || v->pm->gsu.s->setfn != strsetfn) {
+                x = (char *) zalloc(newsize + 1);
+                strncpy(x, z, v->start);
+                strcpy(x + v->start, val);
+                strcat(x + v->start, z + v->end);
+                v->pm->gsu.s->setfn(v->pm, x);
+            } else {
+		Param pm = v->pm;
+                /* Size doesn't change, can limit actions to only
+                 * overwriting bytes in already allocated string */
+                strncpy(z + v->start, val, vlen);
+		/* Implement remainder of strsetfn */
+		if (!(pm->node.flags & PM_HASHELEM) &&
+		    ((pm->node.flags & PM_NAMEDDIR) ||
+		     isset(AUTONAMEDIRS))) {
+		    pm->node.flags |= PM_NAMEDDIR;
+		    adduserdir(pm->node.nam, z, 0, 0);
+		}
+            }
+            zsfree(val);
 	}
 	break;
     case PM_INTEGER:
diff --git a/Test/A06assign.ztst b/Test/A06assign.ztst
index da4e3b0fe..bf39aee7f 100644
--- a/Test/A06assign.ztst
+++ b/Test/A06assign.ztst
@@ -489,3 +489,143 @@
  print $array
 0:slice beyond length of array
 >FIRST
+
+# tests of string assignments
+
+ a="abc"
+ a[1]=x
+ print $a
+0:overwrite first character in string
+>xbc
+
+ a="abc"
+ a[2]="x"
+ print $a
+0:overwrite middle character in string
+>axc
+
+ a="abc"
+ a[3]="x"
+ print $a
+0:overwrite last character in string
+>abx
+
+ a="abc"
+ a[-1]="x"
+ print $a
+0:overwrite -1 character in string
+>abx
+
+ a="abc"
+ a[-2]="x"
+ print $a
+0:overwrite -2 character (middle) in string
+>axc
+
+ a="ab"
+ a[-2]="x"
+ print $a
+0:overwrite -2 character (first) in string
+>xb
+
+ a="abc"
+ a[-3]="x"
+ print $a
+0:overwrite -3 character (first) in string
+>xbc
+
+ a="abc"
+ a[-4]="x"
+ print $a
+0:overwrite -4 character (before first) in string
+>xabc
+
+ a="abc"
+ a[-5]="x"
+ print $a
+0:overwrite -5 character (before-before first) in string
+>xabc
+
+ a="abc"
+ a[-4,0]="x"
+ print $a
+0:overwrite [-4,0] characters (before first) in string
+>xabc
+
+ a="abc"
+ a[-4,-4]="x"
+ print $a
+0:overwrite [-4,-4] character (before first) in string
+>xabc
+
+ a="abc"
+ a[-40,-30]="x"
+ print $a
+0:overwrite [-40,-30] characters (far before first) in string
+>xabc
+
+ a="abc"
+ a[-40,1]="x"
+ print $a
+0:overwrite [-40,1] characters in short string
+>xbc
+
+ a="abc"
+ a[-40,40]="x"
+ print $a
+0:overwrite [-40,40] characters in short string
+>x
+
+ a="abc"
+ a[2,40]="x"
+ print $a
+0:overwrite [2,40] characters in short string
+>ax
+
+ a="abc"
+ a[2,-1]="x"
+ print $a
+0:overwrite [2,-1] characters in short string
+>ax
+
+ a="abc"
+ a[-2,-1]="x"
+ print $a
+0:overwrite [-2,-1] characters in short string
+>ax
+
+ a="a"
+ a[-1]="xx"
+ print $a
+0:overwrite [-1] character with "xx"
+>xx
+
+ a="a"
+ a[-2]="xx"
+ print $a
+0:overwrite [-2] character (before first) with "xx"
+>xxa
+
+ a="a"
+ a[2]="xx"
+ print $a
+0:overwrite [2] character (after last) with "xx"
+>axx
+
+ a=""
+ a[1]="xx"
+ print $a
+0:overwrite [1] character (string: "") with "xx"
+>xx
+
+ a=""
+ a[-1]="xx"
+ print $a
+0:overwrite [-1] character (string: "") with "xx"
+>xx
+
+ a=""
+ a[2]="xx"
+ print $a
+0:overwrite [2] character (string: "") with "xx"
+>xx