diff options
| author | Estevan Castilho <tevo@riajuu.net> | 2026-05-30 01:43:10 +0000 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2026-05-30 01:43:10 +0000 |
| commit | 8106d31690dad61ee0ec649ae6de7f4e3fe1830e (patch) | |
| tree | fc50ca3bdf755cee7157540b79ba26d6ecef7e62 /lib/condition.ml | |
| parent | 1378202e6b0b51d7d338a1042824860f19fcbc9b (diff) | |
| download | Sakura-8106d31690dad61ee0ec649ae6de7f4e3fe1830e.tar.gz Sakura-8106d31690dad61ee0ec649ae6de7f4e3fe1830e.zip | |
Some scaffolding for sublanguage tests (#72)
* No need to take the multigroup name as an argument
* Record backtraces when instantiating conditions
* Equality for abstract values
* Move `make_ctx` out of the listener
* Include the return code on `handle-error` conditions
* Do not include brackets around stringified condition properties
* Equality for materialized attributes
* Equality for materialized tuples
* Scaffolding for a test suite
Diffstat (limited to '')
| -rw-r--r-- | lib/condition.ml | 14 |
1 files changed, 10 insertions, 4 deletions
diff --git a/lib/condition.ml b/lib/condition.ml index 44ef2ff..83ae9b8 100644 --- a/lib/condition.ml +++ b/lib/condition.ml @@ -11,16 +11,19 @@ end let of_sexp (expr : Sexplib.Sexp.t) = new literal expr let of_string (s : string) = new literal (Sexplib.Sexp.Atom s) +let of_int (n : int) = of_string (Int.to_string n) let of_list (f : 'a -> serializable) (l : 'a list) : serializable = new literal (Sexplib.Sexp.List (List.map (fun e -> (f e)#as_sexp) l)) type t = { name : string; message : string; + backtrace : Printexc.raw_backtrace; properties : (string, serializable) BatMap.t } let condition name message ?parent props = { name; message; + backtrace = Printexc.get_callstack 64; properties = parent |> Option.map (fun { properties; _ } -> properties) @@ -31,7 +34,7 @@ let ( |=| ) name value = (fun p -> BatMap.add name value p) let ( & ) l r = (fun p -> r (l p)) let empty = (fun p -> p) -let to_sexp { name; message; properties } = +let to_sexp { name; message; properties; _ } = let open Sexplib.Sexp in let properties' = properties @@ -40,10 +43,13 @@ let to_sexp { name; message; properties } = |> BatList.of_seq in List (Atom name :: Atom message :: properties') -let to_string { name; message; properties } = +let to_string { name; message; properties; backtrace } = let properties' = properties |> BatMap.to_seq - |> BatSeq.to_string ~sep:"\n" (fun (k, v) -> "\t" ^ k ^ ": " ^ v#as_string) + |> BatSeq.to_string + ~first:"" ~last:"" ~sep:"\n" + (fun (k, v) -> "\t" ^ k ^ ": " ^ v#as_string) in - name ^ ": " ^ message ^ properties' + let backtrace' = Printexc.raw_backtrace_to_string backtrace in + name ^ ": " ^ message ^ "\n" ^ properties' ^ "\n\nBacktrace:\n" ^ backtrace' |