diff --git a/README.md b/README.md index fee0015..b11ae6a 100644 --- a/README.md +++ b/README.md @@ -42,6 +42,7 @@ The following customizations have been made to adapt the original `ichiban/prolo - Removed support for trigonometric functions (`sin`, `cos`, `tan`, `asin`, `acos`, `atan`). - Introduced VM hooks for enhanced Prolog execution control. - Added support for the `Dict` term. +- `halt/0` and `halt/1` are forbidden and will throw an error. ## License diff --git a/engine/builtin.go b/engine/builtin.go index 1986cdc..fbe1af1 100644 --- a/engine/builtin.go +++ b/engine/builtin.go @@ -1960,7 +1960,9 @@ func PeekChar(vm *VM, streamOrAlias, char Term, k Cont, env *Env) *Promise { } } -var osExit = os.Exit +var osExit = func(_ int) { + panic("halt/1 is not allowed") +} // Halt exits the process with exit code of n. func Halt(_ *VM, n Term, k Cont, env *Env) *Promise { diff --git a/engine/builtin_test.go b/engine/builtin_test.go index 3d818bc..a03ef40 100644 --- a/engine/builtin_test.go +++ b/engine/builtin_test.go @@ -37,6 +37,12 @@ func TestCall(t *testing.T) { vm.Register0(NewAtom("do_not_call_wrapped"), func(*VM, Cont, *Env) *Promise { panic(errors.New("told you")) }) + vm.Register0(NewAtom("do_not_call_exception"), func(*VM, Cont, *Env) *Promise { + panic(Exception{NewAtom("error").Apply(NewAtom("panic_error").Apply(NewAtom("told you")))}) + }) + vm.Register0(NewAtom("do_not_call_misc_error"), func(*VM, Cont, *Env) *Promise { + panic(42) + }) assert.NoError(t, vm.Compile(context.Background(), ` foo. foo(_, _). @@ -64,9 +70,11 @@ f(g([a, [b, c|X], Y{x:5}])). {title: `cover all`, goal: atomComma.Apply(atomCut, NewAtom("f").Apply(NewAtom("g").Apply(List(NewAtom("a"), PartialList(NewVariable(), NewAtom("b"), NewAtom("c")), makeDict(NewAtom("foo"), NewAtom("x"), Integer(5)))))), ok: true}, {title: `out of memory`, goal: NewAtom("foo").Apply(NewVariable(), NewVariable(), NewVariable(), NewVariable(), NewVariable(), NewVariable(), NewVariable(), NewVariable(), NewVariable()), err: resourceError(resourceMemory, nil), mem: 1}, - {title: `panic`, goal: NewAtom("do_not_call"), err: PanicError{errors.New("told you")}}, - {title: `panic (lazy)`, goal: NewAtom("lazy_do_not_call"), err: PanicError{errors.New("told you")}}, - {title: `panic (wrapped)`, goal: NewAtom("do_not_call_wrapped"), err: PanicError{errors.New("told you")}}, + {title: `panic`, goal: NewAtom("do_not_call"), err: Exception{NewAtom("error").Apply(NewAtom("panic_error").Apply(NewAtom("told you")))}}, + {title: `panic (lazy)`, goal: NewAtom("lazy_do_not_call"), err: Exception{NewAtom("error").Apply(NewAtom("panic_error").Apply(NewAtom("told you")))}}, + {title: `panic (wrapped)`, goal: NewAtom("do_not_call_wrapped"), err: Exception{NewAtom("error").Apply(NewAtom("panic_error").Apply(NewAtom("told you")))}}, + {title: `panic (exception)`, goal: NewAtom("do_not_call_exception"), err: Exception{NewAtom("error").Apply(NewAtom("panic_error").Apply(NewAtom("told you")))}}, + {title: `panic (misc)`, goal: NewAtom("do_not_call_misc_error"), err: Exception{NewAtom("error").Apply(NewAtom("panic_error").Apply(NewAtom("42")))}}, } for _, tt := range tests { @@ -5519,20 +5527,11 @@ func TestPeekChar(t *testing.T) { func Test_Halt(t *testing.T) { t.Run("ok", func(t *testing.T) { - var exitCalled bool - osExit = func(code int) { - assert.Equal(t, 2, code) - exitCalled = true - } - defer func() { - osExit = os.Exit - }() - - ok, err := Halt(nil, Integer(2), Success, nil).Force(context.Background()) - assert.NoError(t, err) - assert.True(t, ok) - - assert.True(t, exitCalled) + ok, err := Delay(func(ctx context.Context) *Promise { + return Halt(nil, Integer(2), Success, nil) + }).Force(context.Background()) + assert.EqualError(t, err, "error(panic_error(halt/1 is not allowed))") + assert.False(t, ok) }) t.Run("n is a variable", func(t *testing.T) { diff --git a/engine/promise.go b/engine/promise.go index b92774f..7a4fd0d 100644 --- a/engine/promise.go +++ b/engine/promise.go @@ -162,10 +162,12 @@ func ensurePromise(p **Promise) { func panicError(r interface{}) error { switch r := r.(type) { + case Exception: + return r case error: - return PanicError{r} + return Exception{term: atomError.Apply(NewAtom("panic_error").Apply(NewAtom(r.Error())))} default: - return PanicError{fmt.Errorf("%v", r)} + return Exception{term: atomError.Apply(NewAtom("panic_error").Apply(NewAtom(fmt.Sprintf("%v", r))))} } }