coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

otel P8: W3C traceparent propagation + error spans

Browse Source 
otel/format-traceparent + otel/current-traceparent emit '00-<32hex>-<16hex>-01';
otel/parse-traceparent round-trips it (nil on malformed/bad-width). otel/-timed
now guards the thunk: success spans get :status ok, a raised error records a
span with :status error + an exception event then propagates. Error propagation
uses a false-returning guard clause test (an explicit (raise e) in a guard
handler re-enters the guard and hangs).
This commit is contained in:
giles
2026-07-01 16:11:40 +00:00
parent b478d0a8da
commit 3d9dc832fc
2 changed files with 102 additions and 10 deletions
Download Patch File Download Diff File Expand all files Collapse all files

47
lib/host/tests/otel.sx
View File

@@ -322,6 +322,53 @@
(host-ot-test "empty export has zero spans"
(len (get (first (get (first (get (otel/export-otlp (list)) :resourceSpans)) :scopeSpans)) :spans)) 0)
;; ── P8: context propagation (W3C traceparent) + error spans ────────
;; traceparent = "00-<32hex trace>-<16hex span>-<flags>"; round-trips.
(define host-ot-tp (otel/format-traceparent "trace-1" "span-1"))
(host-ot-test "traceparent format"
host-ot-tp (str "00-" (otel/-trace-hex "trace-1") "-" (otel/-span-hex "span-1") "-01"))
(define host-ot-tpp (otel/parse-traceparent host-ot-tp))
(host-ot-test "parsed version" (get host-ot-tpp :version) "00")
(host-ot-test "trace-id round-trips" (get host-ot-tpp :trace-id) (otel/-trace-hex "trace-1"))
(host-ot-test "parent-id round-trips" (get host-ot-tpp :parent-id) (otel/-span-hex "span-1"))
(host-ot-test "sampled flag" (get host-ot-tpp :sampled) true)
(host-ot-test "malformed traceparent → nil" (otel/parse-traceparent "garbage") nil)
(host-ot-test "wrong-width traceparent → nil" (otel/parse-traceparent "00-abc-def-01") nil)
(host-ot-test "empty traceparent → nil" (otel/parse-traceparent "") nil)
;; current-traceparent reflects the active span
(otel/reset!)
(otel/with-span "x" {}
(fn ()
(begin
(host-ot-test "current-traceparent set inside a span"
(not (= (otel/current-traceparent) nil)) true)
(host-ot-test "current-traceparent has 4 dash-parts"
(len (split (otel/current-traceparent) "-")) 4)
nil)))
(host-ot-test "current-traceparent nil outside a span" (otel/current-traceparent) nil)
;; error spans: a raising thunk records a span marked :status error + an event,
;; then re-raises (caught by the test's guard); the stack is left clean.
(otel/reset!)
(guard (e (else nil))
(otel/with-span "boom" {} (fn () (raise "kaboom"))))
(host-ot-test "error span recorded" (len (otel/recent)) 1)
(define host-ot-err (first (otel/recent)))
(host-ot-test "error span status" (get host-ot-err :status) "error")
(host-ot-test "error span name" (get host-ot-err :name) "boom")
(host-ot-test "error span has one event" (len (get host-ot-err :events)) 1)
(host-ot-test "error event name" (get (first (get host-ot-err :events)) :name) "exception")
(host-ot-test "error event carries the message"
(contains? (str (get (first (get host-ot-err :events)) :message)) "kaboom") true)
(host-ot-test "stack cleared after an error span" (otel/current-span) nil)
;; success spans are marked ok (and keep empty attrs when none given)
(otel/reset!)
(otel/with-span "ok-span" {} (fn () 1))
(host-ot-test "success span status ok" (get (first (otel/recent)) :status) "ok")
(host-ot-test "success span keeps empty attrs" (get (first (otel/recent)) :attrs) {})
(define
host-ot-tests-run!
(fn