From 4a7df449aaa81b60147f2dc75b1c4ea714aeb3dc Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 13:00:13 +0700 Subject: [PATCH] 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 | 61 ++++++++++++++++++++++++--------- runtime/flan_rt.c | 19 ++++++++-- test/dev_limits.c | 32 ++++++++++++++++- test/programs/string-leak.flan | 11 ++++-- test/programs/string-owned.flan | 18 ++++++++++ test/test_acceptance.ml | 9 ++--- test/test_reload.ml | 8 +++++ 7 files changed, 132 insertions(+), 26 deletions(-) diff --git a/lib/check.ml b/lib/check.ml index ed8ae070..66e63803 100644 --- a/lib/check.ml +++ b/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 - copy — once its bytes are checked, here. *) - | "bytes->string", [ x ] -> + (* (bytes->string v) and (bytes->string v a): the bytes of a (Vec u8) copied + into a new String once they are checked, here. A copy, because v — and + 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 - let vv = mk loc string_vec_ty (Tast.Local sl) in - let view = vec_slice ctx ~want:None loc vv u8_ty [] in - expect ctx loc ~want - (mk loc string_ty - (Tast.Let ([ (sl, v) ], - [ rt loc Types.Unit "flan_utf8_check" [ view; here loc ]; - mk loc string_ty (Tast.Make ("String", [ vv ])) ]))) - | "bytes->string", _ -> fail loc "bytes->string is (bytes->string v), over a (Vec u8)" + if String.equal loc.Loc.file Prelude.file && rest = [] then begin + let sl = fresh_slot ctx string_vec_ty in + let vv = mk loc string_vec_ty (Tast.Local sl) in + let view = vec_slice ctx ~want:None loc vv u8_ty [] in + expect ctx loc ~want + (mk loc string_ty + (Tast.Let ([ (sl, v) ], + [ rt loc Types.Unit "flan_utf8_check" [ view; here loc ]; + 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", - "The Vec becomes a String over the same storage, once its bytes are \ - checked to be UTF-8 — here, at run time. Bytes that are not stop the \ - program at this call."); + ("bytes->string", "bytes->string [(Vec u8) Allocator?] String", + "A new String holding a copy of the Vec's bytes, once they are checked \ + to be UTF-8 — here, at run time. Bytes that are not stop the program \ + 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 \ diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c index bd318963..475cfc9e 100644 --- a/runtime/flan_rt.c +++ b/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; - off += utf8_width(p[off]); + int64_t w; + 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) diff --git a/test/dev_limits.c b/test/dev_limits.c index 33480c7f..1f159307 100644 --- a/test/dev_limits.c +++ b/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(); diff --git a/test/programs/string-leak.flan b/test/programs/string-leak.flan index bbb4c628..7842406e 100644 --- a/test/programs/string-leak.flan +++ b/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) diff --git a/test/programs/string-owned.flan b/test/programs/string-owned.flan index 65f30d6a..7b1bc099 100644 --- a/test/programs/string-owned.flan +++ b/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)) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index b25acd71..f6ef6d78 100644 --- a/test/test_acceptance.ml +++ b/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\ - flan: 1 16 String\n" + "kept for good\nLOUD\na\nflan: 3 blocks still held at exit, 24 bytes\n\ + flan: 3 24 String\n" in if code <> 0 || text <> want then begin incr failures; diff --git a/test/test_reload.ml b/test/test_reload.ml index 919508df..a1f11c9a 100644 --- a/test/test_reload.ml +++ b/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