fed-sx-m1: Step 7d-pure — sandbox:eval_pure/2,/3 + 13 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 25s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 25s
This commit is contained in:
41
next/kernel/sandbox.erl
Normal file
41
next/kernel/sandbox.erl
Normal file
@@ -0,0 +1,41 @@
|
||||
-module(sandbox).
|
||||
-export([eval_pure/2, eval_pure/3]).
|
||||
|
||||
%% Sandboxed evaluation of an Erlang fun.
|
||||
%%
|
||||
%% eval_pure/2(Fun, Arg) -> {ok, Result} | {error, Reason}
|
||||
%% eval_pure/3(Fun, Arg1, Arg2) -> {ok, Result} | {error, Reason}
|
||||
%%
|
||||
%% The 3-arity variant matches the (Activity, State) -> NewState
|
||||
%% shape of projection folds. The projection scheduler can wrap
|
||||
%% every fold call in `sandbox:eval_pure(Fun, Act, State)` to
|
||||
%% ensure a misbehaving fold body can't crash the projection
|
||||
%% gen_server.
|
||||
%%
|
||||
%% v1 sandboxing is just the try/catch envelope: no gas budget,
|
||||
%% no IO denial, no environment stripping. Real sandboxing lands
|
||||
%% with SX-source eval (the fold body would then be an SX form
|
||||
%% evaluated under the spec/harness platform). The API shape is
|
||||
%% stable — callers don't need to change when that arrives.
|
||||
|
||||
%% Port note: this Erlang implementation catches by explicit
|
||||
%% class names (throw, error, exit) rather than the open
|
||||
%% `Class:Reason` pattern. The wrappers below enumerate the three.
|
||||
|
||||
eval_pure(Fun, Arg) ->
|
||||
try Fun(Arg) of
|
||||
Result -> {ok, Result}
|
||||
catch
|
||||
throw:Reason -> {error, {throw, Reason}};
|
||||
error:Reason -> {error, {error, Reason}};
|
||||
exit:Reason -> {error, {exit, Reason}}
|
||||
end.
|
||||
|
||||
eval_pure(Fun, Arg1, Arg2) ->
|
||||
try Fun(Arg1, Arg2) of
|
||||
Result -> {ok, Result}
|
||||
catch
|
||||
throw:Reason -> {error, {throw, Reason}};
|
||||
error:Reason -> {error, {error, Reason}};
|
||||
exit:Reason -> {error, {exit, Reason}}
|
||||
end.
|
||||
130
next/tests/sandbox_eval.sh
Executable file
130
next/tests/sandbox_eval.sh
Executable file
@@ -0,0 +1,130 @@
|
||||
#!/usr/bin/env bash
|
||||
# next/tests/sandbox_eval.sh — Step 7d-pure test.
|
||||
#
|
||||
# Exercises sandbox:eval_pure/2 and eval_pure/3. Catches all
|
||||
# three exception classes (throw / error / exit) and returns
|
||||
# them tagged. Successful fold-shaped (Activity, State) calls
|
||||
# pass through unchanged. 13 cases.
|
||||
|
||||
set -uo pipefail
|
||||
cd "$(git rev-parse --show-toplevel)"
|
||||
|
||||
SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
|
||||
if [ ! -x "$SX_SERVER" ]; then
|
||||
SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
|
||||
fi
|
||||
if [ ! -x "$SX_SERVER" ]; then
|
||||
echo "ERROR: sx_server.exe not found." >&2
|
||||
exit 1
|
||||
fi
|
||||
|
||||
VERBOSE="${1:-}"
|
||||
PASS=0; FAIL=0; ERRORS=""
|
||||
TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT
|
||||
|
||||
cat > "$TMPFILE" <<'EPOCHS'
|
||||
(epoch 1)
|
||||
(load "lib/erlang/tokenizer.sx")
|
||||
(load "lib/erlang/parser.sx")
|
||||
(load "lib/erlang/parser-core.sx")
|
||||
(load "lib/erlang/parser-expr.sx")
|
||||
(load "lib/erlang/parser-module.sx")
|
||||
(load "lib/erlang/transpile.sx")
|
||||
(load "lib/erlang/runtime.sx")
|
||||
(load "lib/erlang/vm/dispatcher.sx")
|
||||
|
||||
(epoch 2)
|
||||
(eval "(get (erlang-load-module (file-read \"next/kernel/sandbox.erl\")) :name)")
|
||||
|
||||
;; eval_pure/2 normal return
|
||||
(epoch 10)
|
||||
(eval "(get (erlang-eval-ast \"sandbox:eval_pure(fun (X) -> X + 1 end, 41) =:= {ok, 42}\") :name)")
|
||||
|
||||
;; eval_pure/2 throw caught
|
||||
(epoch 11)
|
||||
(eval "(get (erlang-eval-ast \"case sandbox:eval_pure(fun (_) -> throw(boom) end, 1) of {error, {throw, boom}} -> ok; _ -> bad end\") :name)")
|
||||
|
||||
;; eval_pure/2 error caught
|
||||
(epoch 12)
|
||||
(eval "(get (erlang-eval-ast \"case sandbox:eval_pure(fun (_) -> erlang:error(crash) end, 1) of {error, {error, crash}} -> ok; _ -> bad end\") :name)")
|
||||
|
||||
;; eval_pure/2 exit caught
|
||||
(epoch 13)
|
||||
(eval "(get (erlang-eval-ast \"case sandbox:eval_pure(fun (_) -> erlang:exit(bye) end, 1) of {error, {exit, bye}} -> ok; _ -> bad end\") :name)")
|
||||
|
||||
;; eval_pure/2 carries the original argument through
|
||||
(epoch 14)
|
||||
(eval "(get (erlang-eval-ast \"sandbox:eval_pure(fun (X) -> X end, marker) =:= {ok, marker}\") :name)")
|
||||
|
||||
;; eval_pure/2 returning a tuple is wrapped in {ok, _}
|
||||
(epoch 15)
|
||||
(eval "(get (erlang-eval-ast \"sandbox:eval_pure(fun (_) -> {a, b} end, 0) =:= {ok, {a, b}}\") :name)")
|
||||
|
||||
;; eval_pure/3 normal return (Activity, State) shape
|
||||
(epoch 16)
|
||||
(eval "(get (erlang-eval-ast \"sandbox:eval_pure(fun (A, S) -> S + A end, 10, 5) =:= {ok, 15}\") :name)")
|
||||
|
||||
;; eval_pure/3 throw caught
|
||||
(epoch 17)
|
||||
(eval "(get (erlang-eval-ast \"case sandbox:eval_pure(fun (_, _) -> throw(stop) end, x, y) of {error, {throw, stop}} -> ok; _ -> bad end\") :name)")
|
||||
|
||||
;; eval_pure/3 error caught
|
||||
(epoch 18)
|
||||
(eval "(get (erlang-eval-ast \"case sandbox:eval_pure(fun (_, _) -> erlang:error(badarith) end, 1, 2) of {error, {error, badarith}} -> ok; _ -> bad end\") :name)")
|
||||
|
||||
;; eval_pure/3 fold-style fun: tag activities into state
|
||||
(epoch 19)
|
||||
(eval "(get (erlang-eval-ast \"Fold = fun ({tag, T}, S) -> [T | S]; (_, S) -> S end, sandbox:eval_pure(Fold, {tag, foo}, []) =:= {ok, [foo]}\") :name)")
|
||||
|
||||
;; Successful eval_pure does not catch silently — distinguishes ok+nil from error
|
||||
(epoch 20)
|
||||
(eval "(get (erlang-eval-ast \"sandbox:eval_pure(fun (_) -> nil end, 0) =:= {ok, nil}\") :name)")
|
||||
|
||||
;; Tuple reason inside the caught exception is preserved
|
||||
(epoch 21)
|
||||
(eval "(get (erlang-eval-ast \"case sandbox:eval_pure(fun (_) -> throw({bad_input, {field, x}}) end, 0) of {error, {throw, {bad_input, {field, x}}}} -> ok; _ -> bad end\") :name)")
|
||||
EPOCHS
|
||||
|
||||
OUTPUT=$(timeout 60 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
|
||||
|
||||
check() {
|
||||
local epoch="$1" desc="$2" expected="$3"
|
||||
local actual
|
||||
actual=$(echo "$OUTPUT" | awk -v e="$epoch" '
|
||||
$0 ~ "^\\(ok-len " e " " { getline; print; exit }
|
||||
$0 ~ "^\\(ok " e " " { print; exit }
|
||||
$0 ~ "^\\(error " e " " { print; exit }
|
||||
')
|
||||
[ -z "$actual" ] && actual="<no output for epoch $epoch>"
|
||||
if echo "$actual" | grep -qF -- "$expected"; then
|
||||
PASS=$((PASS+1))
|
||||
[ "$VERBOSE" = "-v" ] && echo " ok $desc"
|
||||
else
|
||||
FAIL=$((FAIL+1))
|
||||
ERRORS+=" FAIL [$desc] (epoch $epoch) expected: $expected | actual: $actual
|
||||
"
|
||||
fi
|
||||
}
|
||||
|
||||
check 2 "module load name" "sandbox"
|
||||
check 10 "eval_pure/2 normal return" "true"
|
||||
check 11 "eval_pure/2 throw caught" "ok"
|
||||
check 12 "eval_pure/2 error caught" "ok"
|
||||
check 13 "eval_pure/2 exit caught" "ok"
|
||||
check 14 "eval_pure/2 arg passthrough" "true"
|
||||
check 15 "eval_pure/2 tuple wrapped in ok" "true"
|
||||
check 16 "eval_pure/3 fold-shape success" "true"
|
||||
check 17 "eval_pure/3 throw caught" "ok"
|
||||
check 18 "eval_pure/3 error caught" "ok"
|
||||
check 19 "eval_pure/3 tag-fold body" "true"
|
||||
check 20 "ok+nil distinct from error" "true"
|
||||
check 21 "tuple reason preserved" "ok"
|
||||
|
||||
TOTAL=$((PASS+FAIL))
|
||||
if [ $FAIL -eq 0 ]; then
|
||||
echo "ok $PASS/$TOTAL next/tests/sandbox_eval.sh passed"
|
||||
else
|
||||
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
|
||||
echo "$ERRORS"
|
||||
fi
|
||||
[ $FAIL -eq 0 ]
|
||||
Reference in New Issue
Block a user