Every store of a frame address into a global outside main is refused, fn and handler bodies and restart clauses are checked as frames of their own, and the suggested clone keeps the slice's bounds
This commit is contained in:
parent
c6a3259a62
commit
a6ccce0e67
427
lib/check.ml
427
lib/check.ml
@ -3084,6 +3084,240 @@ let view_not_permanent loc (container : Types.t) =
|
||||
the other"
|
||||
(Types.to_string container) (Types.to_string container)
|
||||
|
||||
(* A value handed out of [f] that points into [f]'s own frame: returned (the
|
||||
last form's tails, or a [return]), or stored into a global or a field or
|
||||
array element of one. Both read a dead frame the moment [f] returns, so
|
||||
both are refused.
|
||||
|
||||
Deliberately narrow — the exact spellings that can only be wrong, so
|
||||
nothing that could be valid is ever refused:
|
||||
- [(addr p)] where [p] is a local, a field of one, or an element of a
|
||||
local *array* (an array's elements are the frame's bytes; a Vec's or a
|
||||
slice's are not);
|
||||
- [(slice a …)] where [a] is such a place of array type;
|
||||
- a local bound by [let] to one of those and never assigned or addressed
|
||||
afterwards, which is also how a [return] under a [defer] arrives here.
|
||||
A parameter is a local: its value is copied into the frame (an array
|
||||
parameter too), so its address dies with the frame as well. Anything
|
||||
reached through a [Ptr] is not the frame's, and a struct literal holding
|
||||
such an address is not looked into.
|
||||
|
||||
The store is let through in [main], whose frame outlives everything the
|
||||
program runs.
|
||||
|
||||
A lifted [fn] literal or handler clause is checked as a function of its
|
||||
own: its parameters, its locals and its copies of what it captured are its
|
||||
frame. What this does not see is the enclosing function's frame escaping
|
||||
*through* one — a closure over a pointer to a local, handed out — because
|
||||
that is a value holding an address, not one of the spellings above. *)
|
||||
let refuse_frame_escapes (f : Tast.fn) =
|
||||
(* Keyed by slot alone: [fresh_slot] never reuses one, so a slot has at
|
||||
most one binding [Let] in the function. *)
|
||||
let binds = Hashtbl.create 16 in
|
||||
let unstable = Hashtbl.create 16 in
|
||||
let rec place_global = function
|
||||
| Tast.Pglobal g -> Some g
|
||||
| Tast.Pfield (t, _) -> expr_global t
|
||||
| Tast.Pindex (t, idx) when all_array t.Tast.ty idx -> expr_global t
|
||||
| _ -> None
|
||||
and expr_global (e : Tast.expr) =
|
||||
match e.Tast.e with
|
||||
| Tast.Global g -> Some g
|
||||
| Tast.Field (t, _) -> expr_global t
|
||||
| Tast.Prim (Tast.At, t :: idx) when all_array t.Tast.ty idx -> expr_global t
|
||||
| _ -> None
|
||||
(* [(at a i j)] is one node carrying every index; each level stepped must
|
||||
be an array for the element to be inside [a]'s own bytes. *)
|
||||
and all_array ty = function
|
||||
| [] -> true
|
||||
| _ :: rest ->
|
||||
(match ty with Types.Array (_, el) -> all_array el rest | _ -> false)
|
||||
in
|
||||
List.iter
|
||||
(Tast.walk (fun (e : Tast.expr) ->
|
||||
match e.Tast.e with
|
||||
| Tast.Let (bs, _) -> List.iter (fun (s, v) -> Hashtbl.replace binds s v) bs
|
||||
| Tast.Set (Tast.Plocal s, _) | Tast.Addr (Tast.Plocal s) ->
|
||||
Hashtbl.replace unstable s ()
|
||||
| _ -> ()))
|
||||
f.Tast.body;
|
||||
(* The local at the root of a place inside this frame, if it is one. *)
|
||||
let rec root_expr (e : Tast.expr) =
|
||||
match e.Tast.e with
|
||||
| Tast.Local s -> Some s
|
||||
| Tast.Field (t, _) -> root_expr t
|
||||
| Tast.Prim (Tast.At, t :: idx) when all_array t.Tast.ty idx -> root_expr t
|
||||
| _ -> None
|
||||
in
|
||||
let root_place = function
|
||||
| Tast.Plocal s -> Some s
|
||||
| Tast.Pfield (t, _) -> root_expr t
|
||||
| Tast.Pindex (t, idx) when all_array t.Tast.ty idx -> root_expr t
|
||||
| _ -> None
|
||||
in
|
||||
(* What escapes: the root local, whether it is a slice (else an address),
|
||||
and whether the place is the bare local rather than a path into it —
|
||||
only then can the fix be spelled with its name alone. *)
|
||||
let rec escapes depth (e : Tast.expr) =
|
||||
match e.Tast.e with
|
||||
| Tast.Addr p ->
|
||||
Option.map
|
||||
(fun s ->
|
||||
(e, (s, `Addr, (match p with Tast.Plocal _ -> true | _ -> false))))
|
||||
(root_place p)
|
||||
| Tast.Prim (Tast.Slice, [ t; _; _ ]) ->
|
||||
(match t.Tast.ty with
|
||||
| Types.Array _ ->
|
||||
Option.map
|
||||
(fun s ->
|
||||
( e,
|
||||
(s, `Slice,
|
||||
(match t.Tast.e with Tast.Local _ -> true | _ -> false)) ))
|
||||
(root_expr t)
|
||||
| _ -> None)
|
||||
| Tast.Local s when depth < 32 && not (Hashtbl.mem unstable s) ->
|
||||
Option.bind (Hashtbl.find_opt binds s) (escapes (depth + 1))
|
||||
| _ -> None
|
||||
in
|
||||
(* A slot with no name is a value the function made for itself, such as
|
||||
the array a literal like [(slice [7 8 9])] is stored in. *)
|
||||
(* What a lifted body is called in a message: its symbol is the compiler's. *)
|
||||
let who =
|
||||
let starts p =
|
||||
String.length f.Tast.name >= String.length p
|
||||
&& String.sub f.Tast.name 0 (String.length p) = p
|
||||
in
|
||||
if starts "fn/" then "this fn"
|
||||
else if starts "handler/" then "this handler"
|
||||
else f.Tast.name
|
||||
in
|
||||
let what (s, kind, exact) =
|
||||
match f.Tast.snames.(s), kind, exact with
|
||||
| Some n, `Slice, true -> "a slice of " ^ n
|
||||
| Some n, `Slice, false -> "a slice of an array inside " ^ n
|
||||
| Some n, `Addr, true -> "the address of " ^ n
|
||||
| Some n, `Addr, false -> "an address inside " ^ n
|
||||
| None, `Slice, _ -> "a slice of a temporary array"
|
||||
| None, `Addr, _ -> "the address of a temporary"
|
||||
in
|
||||
(* Reported at the addr or slice itself: a [return] under a [defer], or a
|
||||
local bound to one, reaches here as a read of a slot, and the caret
|
||||
belongs on the form that took the address. *)
|
||||
let fail ~verb ~target ~fix_slice ~fix_addr
|
||||
((e : Tast.expr), ((s, kind, exact) as hit)) =
|
||||
let fix =
|
||||
(* The slice as written, bounds and all, when the source can be read
|
||||
back; its root's name otherwise. *)
|
||||
let rec bound (b : Tast.expr) =
|
||||
match b.Tast.e with
|
||||
| Tast.Int (v, _) -> Some (Int64.to_string v)
|
||||
| Tast.Local i -> f.Tast.snames.(i)
|
||||
| Tast.Prim (Tast.Cast _, [ x ]) -> bound x
|
||||
| _ -> None
|
||||
in
|
||||
let rebuilt =
|
||||
match e.Tast.e, f.Tast.snames.(s), exact with
|
||||
| Tast.Prim (Tast.Slice, [ t; lo; hi ]), Some n, true ->
|
||||
(match t.Tast.ty, bound lo, bound hi with
|
||||
| Types.Array (len, _), Some "0", Some h
|
||||
when h = Int64.to_string len ->
|
||||
Some ("(slice " ^ n ^ ")")
|
||||
| _, Some l, Some h -> Some ("(slice " ^ n ^ " " ^ l ^ " " ^ h ^ ")")
|
||||
| _ -> None)
|
||||
| _ -> None
|
||||
in
|
||||
let written =
|
||||
match rebuilt, Loc.snippet ~lim:120 e.Tast.loc with
|
||||
| Some t, _ -> Some t
|
||||
| None, Some t
|
||||
when String.length t > 7 && String.sub t 0 7 = "(slice "
|
||||
&& not (String.contains t '\n')
|
||||
&& not (String.ends_with ~suffix:"\xe2\x80\xa6" t) -> Some t
|
||||
| _ -> None
|
||||
in
|
||||
match written, f.Tast.snames.(s), kind, exact with
|
||||
| Some t, _, `Slice, _ ->
|
||||
fix_slice ("wrap the slice in clone, as in (clone " ^ t ^ ")")
|
||||
| None, Some n, `Slice, true ->
|
||||
fix_slice ("wrap the slice in clone, as in (clone (slice " ^ n ^ "))")
|
||||
| _, _, `Slice, _ -> fix_slice "wrap the slice in (clone ...)"
|
||||
| _, _, `Addr, _ ->
|
||||
let pointee =
|
||||
match e.Tast.ty with
|
||||
| Types.Ptr (_, t) -> Types.to_string t
|
||||
| t -> Types.to_string t
|
||||
in
|
||||
fix_addr pointee
|
||||
in
|
||||
let whose =
|
||||
match f.Tast.snames.(s) with
|
||||
| Some n -> Printf.sprintf "%s is a local of %s" n who
|
||||
| None -> "That value lives in the frame of " ^ who
|
||||
in
|
||||
Loc.failk "check/frame-escape" e.Tast.loc
|
||||
"%s %s %s%s. %s, and its storage is gone once %s returns, so every \
|
||||
later read through it reads whatever the next call leaves there. %s"
|
||||
(if String.equal who f.Tast.name then who
|
||||
else String.capitalize_ascii who)
|
||||
verb (what hit) target whose who fix
|
||||
in
|
||||
let rec tails (e : Tast.expr) =
|
||||
match e.Tast.e with
|
||||
| Tast.Do es | Tast.Let (_, es) | Tast.WithAlloc (_, es)
|
||||
| Tast.Handled (_, es) ->
|
||||
(match List.rev es with x :: _ -> tails x | [] -> ())
|
||||
(* A restart clause is a branch of this function whose value is the
|
||||
form's value when that restart is taken. *)
|
||||
| Tast.RestartCase (cs, body) ->
|
||||
List.iter
|
||||
(fun (c : Tast.rclause) ->
|
||||
match List.rev c.Tast.rbody with x :: _ -> tails x | [] -> ())
|
||||
cs;
|
||||
tails body
|
||||
| Tast.If (_, a, b) -> tails a; tails b
|
||||
| Tast.Match (_, arms) ->
|
||||
List.iter
|
||||
(fun (a : Tast.arm) ->
|
||||
match List.rev a.Tast.abody with x :: _ -> tails x | [] -> ())
|
||||
arms
|
||||
| _ ->
|
||||
Option.iter
|
||||
(fail ~verb:"returns" ~target:""
|
||||
~fix_slice:(fun c ->
|
||||
"Return a copy the caller owns: " ^ c
|
||||
^ ", which puts the elements in the context allocator")
|
||||
~fix_addr:(fun t ->
|
||||
if String.equal who f.Tast.name then
|
||||
"Return the value instead: declare " ^ who
|
||||
^ " to return " ^ t ^ " and drop the addr"
|
||||
else
|
||||
"Return the value, of type " ^ t
|
||||
^ ", instead of its address: drop the addr"))
|
||||
(escapes 0 e)
|
||||
in
|
||||
let returns = not (Types.equal f.Tast.ret Types.Unit) in
|
||||
List.iter
|
||||
(Tast.walk (fun (e : Tast.expr) ->
|
||||
match e.Tast.e with
|
||||
| Tast.Return (Some v) when returns -> tails v
|
||||
| Tast.Set (p, v) when not (String.equal f.Tast.name "main") ->
|
||||
(match place_global p with
|
||||
| Some g ->
|
||||
Option.iter
|
||||
(fail ~verb:"stores" ~target:(" into the global " ^ g)
|
||||
~fix_slice:(fun c ->
|
||||
"Store a copy that outlives the frame: " ^ c
|
||||
^ ", which puts the elements in the context allocator")
|
||||
~fix_addr:(fun t ->
|
||||
"Store the value instead: declare " ^ g ^ " as " ^ t
|
||||
^ " and drop the addr"))
|
||||
(escapes 0 v)
|
||||
| _ -> ())
|
||||
| _ -> ()))
|
||||
f.Tast.body;
|
||||
if returns then
|
||||
match List.rev f.Tast.body with x :: _ -> tails x | [] -> ()
|
||||
|
||||
let box loc (e : Tast.expr) : Tast.expr =
|
||||
let dyn sym args = rt loc Types.Dyn sym args in
|
||||
match e.Tast.ty with
|
||||
@ -5450,13 +5684,15 @@ and check_fn ctx ~want ?gen loc (params : string list) body =
|
||||
one must not — it is reached by calls that pass none, and a parameter
|
||||
nobody supplies is read off whatever the register held. *)
|
||||
let fenv = if bare then fenv else declare_env fctx fenv in
|
||||
ctx.env.lifted <-
|
||||
let lifted =
|
||||
{ Tast.name = fname; params = pts;
|
||||
slots = Array.of_list (List.rev fctx.slot_tys);
|
||||
snames = Array.of_list (List.rev fctx.slot_names);
|
||||
ret; body = prefix fbody; fdefers = [];
|
||||
fenv; fparent = Some ctx.owner; floc = loc }
|
||||
:: ctx.env.lifted;
|
||||
in
|
||||
refuse_frame_escapes lifted;
|
||||
ctx.env.lifted <- lifted :: ctx.env.lifted;
|
||||
let fty = if bare then Types.CFn (pts, ret) else Types.Fn (pts, ret) in
|
||||
(* [Flanfn] and not [Fnval], which is the handler clause's choice and is the
|
||||
same choice for the same reason. [Fnval] exists so that a *name* taken as
|
||||
@ -5571,13 +5807,15 @@ and check_handler_bind ctx ?want ?(what = "handler-bind") loc clauses body =
|
||||
[flan_signal] reads it off the frame and passes it to whichever
|
||||
clause matched, and it cannot know which of them captured. *)
|
||||
let fenv = declare_env hctx fenv in
|
||||
ctx.env.lifted <-
|
||||
let lifted =
|
||||
{ Tast.name = fname; params = [ Types.Ptr (Types.Mut, ty) ];
|
||||
slots = Array.of_list (List.rev hctx.slot_tys);
|
||||
snames = Array.of_list (List.rev hctx.slot_names);
|
||||
ret = Types.Unit; body = prefix hbody; fdefers = [];
|
||||
fenv; fparent = Some ctx.owner; floc = c.Ast.hloc }
|
||||
:: ctx.env.lifted;
|
||||
in
|
||||
refuse_frame_escapes lifted;
|
||||
ctx.env.lifted <- lifted :: ctx.env.lifted;
|
||||
{ Tast.htype = type_id name; hfn = fname; henv = addr }, bind)
|
||||
clauses
|
||||
in
|
||||
@ -13415,187 +13653,6 @@ let escaping_names ~returns (body : Ast.expr list) : string list =
|
||||
if returns then (match List.rev body with x :: _ -> tails x | [] -> ());
|
||||
!names
|
||||
|
||||
(* A value handed out of [f] that points into [f]'s own frame: returned (the
|
||||
last form's tails, or a [return]), or stored into a global or a field or
|
||||
array element of one. Both read a dead frame the moment [f] returns, so
|
||||
both are refused.
|
||||
|
||||
Deliberately narrow — the exact spellings that can only be wrong, so
|
||||
nothing that could be valid is ever refused:
|
||||
- [(addr p)] where [p] is a local, a field of one, or an element of a
|
||||
local *array* (an array's elements are the frame's bytes; a Vec's or a
|
||||
slice's are not);
|
||||
- [(slice a …)] where [a] is such a place of array type;
|
||||
- a local bound by [let] to one of those and never assigned or addressed
|
||||
afterwards, which is also how a [return] under a [defer] arrives here.
|
||||
A parameter is a local: its value is copied into the frame (an array
|
||||
parameter too), so its address dies with the frame as well. Anything
|
||||
reached through a [Ptr] is not the frame's, and a struct literal holding
|
||||
such an address is not looked into.
|
||||
|
||||
The store is let through in two cases where it can be right. In [main],
|
||||
whose frame outlives everything the program runs. And where the function
|
||||
sets that same global again elsewhere — the stash-then-restore shape, the
|
||||
global pointed at the frame only while the frame was live. *)
|
||||
let refuse_frame_escapes (f : Tast.fn) =
|
||||
(* Keyed by slot alone: [fresh_slot] never reuses one, so a slot has at
|
||||
most one binding [Let] in the function. *)
|
||||
let binds = Hashtbl.create 16 in
|
||||
let unstable = Hashtbl.create 16 in
|
||||
let global_sets = Hashtbl.create 8 in
|
||||
let rec place_global = function
|
||||
| Tast.Pglobal g -> Some g
|
||||
| Tast.Pfield (t, _) -> expr_global t
|
||||
| Tast.Pindex (t, idx) when all_array t.Tast.ty idx -> expr_global t
|
||||
| _ -> None
|
||||
and expr_global (e : Tast.expr) =
|
||||
match e.Tast.e with
|
||||
| Tast.Global g -> Some g
|
||||
| Tast.Field (t, _) -> expr_global t
|
||||
| Tast.Prim (Tast.At, t :: idx) when all_array t.Tast.ty idx -> expr_global t
|
||||
| _ -> None
|
||||
(* [(at a i j)] is one node carrying every index; each level stepped must
|
||||
be an array for the element to be inside [a]'s own bytes. *)
|
||||
and all_array ty = function
|
||||
| [] -> true
|
||||
| _ :: rest ->
|
||||
(match ty with Types.Array (_, el) -> all_array el rest | _ -> false)
|
||||
in
|
||||
List.iter
|
||||
(Tast.walk (fun (e : Tast.expr) ->
|
||||
match e.Tast.e with
|
||||
| Tast.Let (bs, _) -> List.iter (fun (s, v) -> Hashtbl.replace binds s v) bs
|
||||
| Tast.Set (Tast.Plocal s, _) | Tast.Addr (Tast.Plocal s) ->
|
||||
Hashtbl.replace unstable s ()
|
||||
| Tast.Set (p, _) ->
|
||||
Option.iter
|
||||
(fun g ->
|
||||
Hashtbl.replace global_sets g
|
||||
(1 + Option.value ~default:0 (Hashtbl.find_opt global_sets g)))
|
||||
(place_global p)
|
||||
| _ -> ()))
|
||||
f.Tast.body;
|
||||
(* The local at the root of a place inside this frame, if it is one. *)
|
||||
let rec root_expr (e : Tast.expr) =
|
||||
match e.Tast.e with
|
||||
| Tast.Local s -> Some s
|
||||
| Tast.Field (t, _) -> root_expr t
|
||||
| Tast.Prim (Tast.At, t :: idx) when all_array t.Tast.ty idx -> root_expr t
|
||||
| _ -> None
|
||||
in
|
||||
let root_place = function
|
||||
| Tast.Plocal s -> Some s
|
||||
| Tast.Pfield (t, _) -> root_expr t
|
||||
| Tast.Pindex (t, idx) when all_array t.Tast.ty idx -> root_expr t
|
||||
| _ -> None
|
||||
in
|
||||
(* What escapes: the root local, whether it is a slice (else an address),
|
||||
and whether the place is the bare local rather than a path into it —
|
||||
only then can the fix be spelled with its name alone. *)
|
||||
let rec escapes depth (e : Tast.expr) =
|
||||
match e.Tast.e with
|
||||
| Tast.Addr p ->
|
||||
Option.map
|
||||
(fun s ->
|
||||
(e, (s, `Addr, (match p with Tast.Plocal _ -> true | _ -> false))))
|
||||
(root_place p)
|
||||
| Tast.Prim (Tast.Slice, [ t; _; _ ]) ->
|
||||
(match t.Tast.ty with
|
||||
| Types.Array _ ->
|
||||
Option.map
|
||||
(fun s ->
|
||||
( e,
|
||||
(s, `Slice,
|
||||
(match t.Tast.e with Tast.Local _ -> true | _ -> false)) ))
|
||||
(root_expr t)
|
||||
| _ -> None)
|
||||
| Tast.Local s when depth < 32 && not (Hashtbl.mem unstable s) ->
|
||||
Option.bind (Hashtbl.find_opt binds s) (escapes (depth + 1))
|
||||
| _ -> None
|
||||
in
|
||||
(* A slot with no name is a value the function made for itself, such as
|
||||
the array a literal like [(slice [7 8 9])] is stored in. *)
|
||||
let what (s, kind, exact) =
|
||||
match f.Tast.snames.(s), kind, exact with
|
||||
| Some n, `Slice, true -> "a slice of " ^ n
|
||||
| Some n, `Slice, false -> "a slice of an array inside " ^ n
|
||||
| Some n, `Addr, true -> "the address of " ^ n
|
||||
| Some n, `Addr, false -> "an address inside " ^ n
|
||||
| None, `Slice, _ -> "a slice of a temporary array"
|
||||
| None, `Addr, _ -> "the address of a temporary"
|
||||
in
|
||||
(* Reported at the addr or slice itself: a [return] under a [defer], or a
|
||||
local bound to one, reaches here as a read of a slot, and the caret
|
||||
belongs on the form that took the address. *)
|
||||
let fail ~verb ~target ~fix_slice ~fix_addr
|
||||
((e : Tast.expr), ((s, kind, exact) as hit)) =
|
||||
let fix =
|
||||
match f.Tast.snames.(s), kind, exact with
|
||||
| Some n, `Slice, true ->
|
||||
fix_slice ("wrap the slice in clone, as in (clone (slice " ^ n ^ "))")
|
||||
| _, `Slice, _ -> fix_slice "wrap the slice in (clone ...)"
|
||||
| _, `Addr, _ ->
|
||||
let pointee =
|
||||
match e.Tast.ty with
|
||||
| Types.Ptr (_, t) -> Types.to_string t
|
||||
| t -> Types.to_string t
|
||||
in
|
||||
fix_addr pointee
|
||||
in
|
||||
let whose =
|
||||
match f.Tast.snames.(s) with
|
||||
| Some n -> Printf.sprintf "%s is a local of %s" n f.Tast.name
|
||||
| None -> "That value lives in " ^ f.Tast.name ^ "'s frame"
|
||||
in
|
||||
Loc.failk "check/frame-escape" e.Tast.loc
|
||||
"%s %s %s%s. %s, and its storage is gone once %s returns, so every \
|
||||
later read through it reads whatever the next call leaves there. %s"
|
||||
f.Tast.name verb (what hit) target whose f.Tast.name fix
|
||||
in
|
||||
let rec tails (e : Tast.expr) =
|
||||
match e.Tast.e with
|
||||
| Tast.Do es | Tast.Let (_, es) | Tast.WithAlloc (_, es) ->
|
||||
(match List.rev es with x :: _ -> tails x | [] -> ())
|
||||
| Tast.If (_, a, b) -> tails a; tails b
|
||||
| Tast.Match (_, arms) ->
|
||||
List.iter
|
||||
(fun (a : Tast.arm) ->
|
||||
match List.rev a.Tast.abody with x :: _ -> tails x | [] -> ())
|
||||
arms
|
||||
| _ ->
|
||||
Option.iter
|
||||
(fail ~verb:"returns" ~target:""
|
||||
~fix_slice:(fun c ->
|
||||
"Return a copy the caller owns: " ^ c
|
||||
^ ", which puts the elements in the context allocator")
|
||||
~fix_addr:(fun t ->
|
||||
"Return the value instead: declare " ^ f.Tast.name
|
||||
^ " to return " ^ t ^ " and drop the addr"))
|
||||
(escapes 0 e)
|
||||
in
|
||||
let returns = not (Types.equal f.Tast.ret Types.Unit) in
|
||||
List.iter
|
||||
(Tast.walk (fun (e : Tast.expr) ->
|
||||
match e.Tast.e with
|
||||
| Tast.Return (Some v) when returns -> tails v
|
||||
| Tast.Set (p, v) when not (String.equal f.Tast.name "main") ->
|
||||
(match place_global p with
|
||||
| Some g when Hashtbl.find_opt global_sets g = Some 1 ->
|
||||
Option.iter
|
||||
(fail ~verb:"stores" ~target:(" into the global " ^ g)
|
||||
~fix_slice:(fun c ->
|
||||
"Store a copy that outlives the frame: " ^ c
|
||||
^ ", which puts the elements in the context allocator")
|
||||
~fix_addr:(fun t ->
|
||||
"Store the value instead: declare " ^ g ^ " as " ^ t
|
||||
^ " and drop the addr"))
|
||||
(escapes 0 v)
|
||||
| _ -> ())
|
||||
| _ -> ()))
|
||||
f.Tast.body;
|
||||
if returns then
|
||||
match List.rev f.Tast.body with x :: _ -> tails x | [] -> ()
|
||||
|
||||
let rec check_fn env (fn : Ast.fn) : Tast.fn =
|
||||
let params, ret = Hashtbl.find env.fns fn.Ast.name in
|
||||
let ctx = { (invented_ctx env ret) with owner = fn.Ast.name } in
|
||||
|
||||
@ -3375,7 +3375,7 @@ let () =
|
||||
~needle:"mk returns a slice of a";
|
||||
rejects_check "returning a local bound to a slice of a local array"
|
||||
"(defn mk [] [i32] (let [a [1 2 3 4] s (slice a 1 3)] s))"
|
||||
~needle:"(clone (slice a))";
|
||||
~needle:"(clone (slice a 1 3))";
|
||||
rejects_check "returning a slice of an array parameter"
|
||||
"(defn mk [a [4 i32]] [i32] (slice a))"
|
||||
~needle:"mk returns a slice of a";
|
||||
@ -3403,9 +3403,33 @@ let () =
|
||||
accepts "a local reassigned before it is returned"
|
||||
"(defonce k [3 i32]) \
|
||||
(defn mk [] [i32] (let [a [1 2 3] s (slice a)] (set s (slice k)) s))";
|
||||
accepts "a global stashed and restored"
|
||||
"(defonce g [i32]) (defonce k [3 i32]) \
|
||||
(defn f [] () (let [a [1 2 3]] (set g (slice a)) (set g (slice k))))";
|
||||
rejects_check "two slices of locals stored into one global"
|
||||
"(defonce g [i32]) \
|
||||
(defn f [] () (let [a [1 2 3] b [4 5]] (set g (slice a)) (set g (slice b))))"
|
||||
~needle:"f stores a slice of a into the global g";
|
||||
rejects_check "the fix keeps the slice's bounds"
|
||||
"(defn mk [a [4 i32]] [i32] (slice a 1 3))"
|
||||
~needle:"(clone (slice a 1 3))";
|
||||
rejects_check "an fn returning the address of its own local"
|
||||
"(defn call [f (Fn [] (Ptr i32))] (Ptr i32) (f)) \
|
||||
(defn g [] (Ptr i32) (call (fn [] (let [x (i32 4)] (addr x)))))"
|
||||
~needle:"This fn returns the address of x";
|
||||
rejects_check "an fn returning a slice of its copy of a captured array"
|
||||
"(defn call [f (Fn [] [i32])] [i32] (f)) \
|
||||
(defn g [] i32 (let [a [1 2 3]] (at (call (fn [] (slice a))) 0)))"
|
||||
~needle:"This fn returns a slice of a";
|
||||
rejects_check "a handler storing a slice of its local into a global"
|
||||
"(defstruct Oops [code i32]) (defonce g [i32]) \
|
||||
(defn main [] i32 \
|
||||
(handler-bind [(Oops [c] (let [a [1 2 3]] (set g (slice a))))] \
|
||||
(signal (Oops {.code 1}))) 0)"
|
||||
~needle:"This handler stores a slice of a into the global g";
|
||||
rejects_check "a restart clause answering the address of a local"
|
||||
"(defstruct Oops [code i32]) \
|
||||
(defn mk [p (Ptr i32)] (Ptr i32) (let [x (i32 4)] \
|
||||
(restart-case (do (signal (Oops {.code 1})) p) \
|
||||
(use-it [] (addr x)))))"
|
||||
~needle:"mk returns the address of x";
|
||||
accepts "main stores its own local into a global"
|
||||
"(defonce g (Ptr i32)) (defn main [] i32 (let [x (i32 5)] (set g (addr x))) 0)";
|
||||
accepts "a unit function's last form is not returned"
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user