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.
This commit is contained in:
parent
e5fd44920e
commit
4a7df449aa
45
lib/check.ml
45
lib/check.ml
@ -12006,10 +12006,18 @@ 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
|
||||
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
|
||||
@ -12017,8 +12025,29 @@ and string_call ctx ~want loc name args =
|
||||
(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 ])) ])))
|
||||
| "bytes->string", _ -> fail loc "bytes->string is (bytes->string v), over a (Vec u8)"
|
||||
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 \
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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();
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user