bytes->string copies the Vec's bytes into a new String, a String's character walk stops at its position and never reads past its length, and a builder's block is a String in the leak report.

lib/check.ml

@@ -12006,19 +12006,48 @@ and string_call ctx ~want loc name args =
   | "string-new", _ ->
     fail loc "string-new is (string-new), (string-new text), (string-new a) \
               or (string-new text a)"
-  (* (bytes->string v): the (Vec u8) becomes the String — the same block, no
+  (* (bytes->string v) and (bytes->string v a): the bytes of a (Vec u8) copied
-     copy — once its bytes are checked, here. *)
+     into a new String once they are checked, here. A copy, because v — and
-  | "bytes->string", [ x ] ->
+     any slice taken of it — could otherwise go on writing into the String's
+     block; v is untouched and still the caller's to free.
+
+     The prelude's builders are the one exception: each hands over a Vec
+     nothing else can reach, so there the Vec becomes the String with no copy,
+     still checked, and re-noted so a dev build's registry calls the block a
+     String. *)
+  | "bytes->string", (x :: rest) when List.length rest <= 1 ->
     let v = check ctx ~want:string_vec_ty x in
-    let sl = fresh_slot ctx string_vec_ty in
+    if String.equal loc.Loc.file Prelude.file && rest = [] then begin
-    let vv = mk loc string_vec_ty (Tast.Local sl) in
+      let sl = fresh_slot ctx string_vec_ty in
-    let view = vec_slice ctx ~want:None loc vv u8_ty [] in
+      let vv = mk loc string_vec_ty (Tast.Local sl) in
-    expect ctx loc ~want
+      let view = vec_slice ctx ~want:None loc vv u8_ty [] in
-      (mk loc string_ty
+      expect ctx loc ~want
-         (Tast.Let ([ (sl, v) ],
+        (mk loc string_ty
-                    [ rt loc Types.Unit "flan_utf8_check" [ view; here loc ];
+           (Tast.Let ([ (sl, v) ],
-                      mk loc string_ty (Tast.Make ("String", [ vv ])) ])))
+                      [ rt loc Types.Unit "flan_utf8_check" [ view; here loc ];
-  | "bytes->string", _ -> fail loc "bytes->string is (bytes->string v), over a (Vec u8)"
+                        reg_note loc "flan_dev_reg_note_vec" vv
+                          [ size_of loc u8_ty ] string_ty;
+                        mk loc string_ty (Tast.Make ("String", [ vv ])) ])))
+    end else begin
+      let a = allocator_arg ctx loc rest in
+      let src = fresh_slot ctx string_vec_ty in
+      let view =
+        vec_slice ctx ~want:None loc (mk loc string_vec_ty (Tast.Local src)) u8_ty []
+      in
+      let sl = fresh_slot ctx string_ty in
+      let s = mk loc string_ty (Tast.Local sl) in
+      let bytes = { view with Tast.ty = Types.Slice (Types.Const, u8_ty) } in
+      expect ctx loc ~want
+        (mk loc string_ty
+           (Tast.Let
+              ([ (src, v);
+                 (sl, mk loc string_ty
+                        (Tast.Make ("String", [ vec_init ~note:string_ty ctx loc u8_ty a ]))) ],
+               [ string_put ctx loc (string_vec loc s) (i64 (-1L)) (`Text (bytes, false));
+                 s ])))
+    end
+  | "bytes->string", _ ->
+    fail loc "bytes->string is (bytes->string v) or (bytes->string v a), over a (Vec u8)"
   | "append", [ target; x ] ->
     let t = check_target ctx target in
     (match t.Tast.ty with
@@ -16059,10 +16088,10 @@ let builtins : (string * string * string) list =
      "A String: owned, growable text that is always valid UTF-8. Empty, or \
       a copy of the text given; from the current allocator or one named, and \
       released by (free s). A str is checked as it is copied in.");
-    ("bytes->string", "bytes->string [(Vec u8)] String",
+    ("bytes->string", "bytes->string [(Vec u8) Allocator?] String",
-     "The Vec becomes a String over the same storage, once its bytes are \
+     "A new String holding a copy of the Vec's bytes, once they are checked \
-      checked to be UTF-8 — here, at run time. Bytes that are not stop the \
+      to be UTF-8 — here, at run time. Bytes that are not stop the program \
-      program at this call.");
+      at this call. The Vec is untouched and is still yours to free.");
     ("append", "append [String str|String|i32] ()  append [(Vec u8) [const u8]] ()",
      "Adds text or one code point to the end of a String. A str is checked \
       to be UTF-8 as it is stored and a code point to be a Unicode scalar \

runtime/flan_rt.c

@@ -3050,13 +3050,24 @@ int64_t flan_string_index(flan_vec *v, int32_t i, int32_t past_end,
   const uint8_t *p = (const uint8_t *)v->ptr;
   int64_t off = 0, count = 0, want = i, found = -1;
   flan_vec_check(v, loc, loclen);
+  /* Stops at the position, so an insert near the front costs what it walks
+   * and not the whole text. The count is finished only for the message. A
+   * width that would run past the end is taken as 1, so a String whose bytes
+   * were ever wrong is never read beyond its length. */
   while (off < v->len) {
-    if (count == want) found = off;
+    int64_t w;
-    off += utf8_width(p[off]);
+    if (count == want) { found = off; break; }
+    w = utf8_width(p[off]);
+    off += (w <= v->len - off) ? w : 1;
     count++;
   }
-  if (want == count && past_end) found = v->len;
+  if (found < 0 && want == count && past_end) found = v->len;
   if (want < 0 || found < 0) {
+    while (off < v->len) {
+      int64_t w = utf8_width(p[off]);
+      off += (w <= v->len - off) ? w : 1;
+      count++;
+    }
     if (flan_bounds_signal(loc, loclen, xfer, BOUNDS_AT, want, want, count))
       return 0;
     flan_vec_bounds_fail(loc, loclen, want, count);
@@ -3075,6 +3086,8 @@ int32_t flan_string_remove(flan_vec *v, int64_t off, const uint8_t *loc,
   if (off < 0 || off >= v->len) return 0;
   p = (const uint8_t *)v->ptr + off;
   w = utf8_width(p[0]);
+  /* Never past the length, however the bytes came to be what they are. */
+  if (w > v->len - off) w = 1;
   if (w == 1) c = p[0];
   else if (w == 2) c = ((p[0] & 0x1f) << 6) | (p[1] & 0x3f);
   else if (w == 3)

test/dev_limits.c

@@ -435,14 +435,44 @@ static int race(void) {
   return 0;
 }
 
+/* A String's character walk over bytes that are not valid UTF-8, which no
+ * Flan program can make: a lead byte promising three bytes where the length
+ * leaves one. The header is flan_rt.c's flan_vec, restated; a null allocator
+ * skips the epoch check. The bytes past the length are valid continuation
+ * bytes, so a walk that read past the end would count and decode them. */
+typedef struct {
+  void *ptr;
+  int64_t len, cap;
+  void *alloc;
+  int64_t epoch;
+} limits_vec;
+int64_t flan_string_index(void *v, int32_t i, int32_t past_end,
+                          const uint8_t *loc, int64_t loclen, void *xfer);
+int32_t flan_string_remove(void *v, int64_t off, const uint8_t *loc,
+                           int64_t loclen);
+
+static int string_walk(void) {
+  static uint8_t lead_last[4] = { 0x61, 0xe6, 0x80, 0x80 };
+  static uint8_t lead_first[4] = { 0xe6, 0x61, 0x80, 0x80 };
+  limits_vec a = { lead_last, 2, 4, NULL, 0 };
+  limits_vec b = { lead_first, 2, 4, NULL, 0 };
+  const uint8_t *loc = (const uint8_t *)"dev_limits.c";
+  printf("index %lld\n", (long long)flan_string_index(&b, 1, 0, loc, 12, NULL));
+  printf("end %lld\n", (long long)flan_string_index(&a, 2, 1, loc, 12, NULL));
+  printf("removed %d len %lld\n", flan_string_remove(&a, 1, loc, 12),
+         (long long)a.len);
+  return 0;
+}
+
 int main(int argc, char **argv) {
   flan_rt_init(argc, argv);
   if (argc < 2) {
     fprintf(stderr,
-            "usage: %s cap|race|names|regfull|regchurn|regrace|regoverflow\n",
+            "usage: %s cap|race|string|names|regfull|regchurn|regrace|regoverflow\n",
             argv[0]);
     return 2;
   }
+  if (strcmp(argv[1], "string") == 0) return string_walk();
   if (strcmp(argv[1], "cap") == 0) return cap();
   if (strcmp(argv[1], "race") == 0) return race();
   if (strcmp(argv[1], "names") == 0) return names();

test/programs/string-leak.flan

@@ -1,9 +1,16 @@
 ;;;; A dev build's registry names a String's block by its type: the one freed
-;;;; is gone from the report at exit, the one kept is listed under String.
+;;;; is gone from the report at exit, and the ones kept — made by string-new, by
+;;;; a prelude builder and by bytes->string — are listed under String.
 (defn main [] i32
   (let [kept (string-new "kept")
         gone (string-new "gone")]
     (append kept " for good")
     (free gone)
-    (println kept))
+    (println kept)
+    ;; A builder's answer and a checked copy are Strings in the report too.
+    (println (to-upper (bytes-view "loud")))
+    (let [v (vec-new u8)]
+      (push v 0x61)
+      (println (bytes->string v))
+      (free v)))
   0)

test/programs/string-owned.flan

@@ -65,6 +65,24 @@
       (println (= a b (to-upper (bytes-view "日本"))))
       (free a)
       (free b))
+    ;; bytes->string copies: a write through the Vec afterwards, or through a
+    ;; slice taken of it before, does not reach the String.
+    (let [v (vec-new u8)]
+      (push v 0xc3)
+      (push v 0xa9)
+      (let [early (slice v)
+            t (bytes->string v)]
+        (set (at v 0) 0xff)
+        (set (at early 1) 0xe6)
+        (println t (length t) (rune-count t))
+        (free t))
+      (free v))
+    ;; A remove near the front and an insert at the front, on a long text.
+    (let [long (string-new "é")]
+      (dotimes [i 1000] (append long "ab"))
+      (insert long 0 "x")
+      (println (remove long 1) (length long))
+      (free long))
     (let [e (string-new)]
       (println (length e) (rune-count e))
       (free e))

test/test_acceptance.ml

@@ -2037,7 +2037,7 @@ let () =
       "héllo wörld日!\n17 13\n😀h→éllo wörld日!\n8594\n128512\n\
        héllo wörld日!\nabababab 8\n233 246 26085 13\n17 18\ntrue\n17\n\
        (Named {.label \"x\" .n 3})\nhéllo wörld日!\n:text\na-b\n\
-       true false true true false true\ntrue\n0 0\n"
+       true false true true false true\ntrue\né 2 1\n233 2001\n0 0\n"
     in
     outputs "an owned String" "programs/string-owned.flan" owned_out;
     outputs ~opt:"-O0" "an owned String, -O0" "programs/string-owned.flan"
@@ -2084,7 +2084,8 @@ let () =
     string_trap ();
     string_trap ~x86:true ();
     (* A dev build's registry reports a String kept to the end under its own
-       name, and the one freed not at all. *)
+       name — string-new's, a builder's and bytes->string's alike — and the
+       one freed not at all. *)
     let string_leak ?x86 () =
       let exe = compile ~dev:true ?x86 "programs/string-leak.flan" in
       let out = exe ^ ".out" in
@@ -2096,8 +2097,8 @@ let () =
       let text = In_channel.with_open_bin out In_channel.input_all in
       (try Sys.remove out; Sys.remove exe with Sys_error _ -> ());
       let want =
-        "kept for good\nflan: 1 block still held at exit, 16 bytes\n\
+        "kept for good\nLOUD\na\nflan: 3 blocks still held at exit, 24 bytes\n\
-         flan:        1          16  String\n"
+         flan:        3          24  String\n"
       in
       if code <> 0 || text <> want then begin
         incr failures;

test/test_reload.ml

@@ -546,6 +546,14 @@ let () =
        counter and a value published twice would be read half-formed. The last
        line is the flag being cleared: a short value after a truncated one must
        not inherit its ellipsis. *)
+    (* A String's character walk, over a lead byte that promises more bytes
+       than the length holds: every step stays inside the length, so the
+       lead byte is one character and the one removed is the byte itself. *)
+    let code, out, err = mode "string" in
+    let want_string = "index 1\nend 2\nremoved 230 len 1\n" in
+    if code <> 0 || out <> want_string then
+      fail "a String's walk past its length\n        got: %S (exit %d, err %S)\n     wanted: %S"
+        out code err want_string;
     let code, out, _ = mode "cap" in
     let want_cap = "len 4096\ntail ...\nmid b\nhead a\ngen 1\nagain 12\n" in
     if code <> 0 || out <> want_cap then