better for the test framework

Author: TeamSPoon

mettalog

@@ -17,6 +17,8 @@ export METTALOG_DIR=$(dirname "$SCRIPT")
 # echo "METTALOG_DIR=$METTALOG_DIR"
 # cd "$METTALOG_DIR" || { echo "Failed to navigate to $METTALOG_DIR"; [[ "$IS_SOURCED" == "1" ]] && return 1 || exit 1; }
 
+METTALOG_TESTING_OPTS="--noninteractive --abort_trace --nodebug --repl=disable --no-regen"
+
 need_compile=0
 exe=true
 compatio=false

prolog/metta_lang/metta_compiler.pl

@@ -245,92 +245,6 @@
    partial_combine_lists(L1,L2,Lcomb,L1a,L2a).
 partial_combine_lists(L1,L2,[],L1,L2).
 
-is_proper_arg(O):- compound(O),iz_conz(O), \+ is_list(O),!,bt, trace.
-is_proper_arg(_).
-% This hook is called when an attributed var is unified
-proper_list_attr:attr_unify_hook(_, Value) :- \+ compound(Value),!.
-proper_list_attr:attr_unify_hook(_, Value) :- is_list(Value),!.
-proper_list_attr:attr_unify_hook(_, Value) :- iz_conz(Value),!,trace.
-proper_list_attr:attr_unify_hook(_, _Value).
-% Attach the attribute if not already present and not already a proper list
-ensure_proper_list_var(Var) :- var(Var),!, put_attr(Var, proper_list_attr, is_proper_arg).
-ensure_proper_list_var(Var) :- is_proper_arg(Var),!.
-
-
-eval_at(_Fn,Where):- nb_current('eval_in_only',NonNil),NonNil\==[],!,Where=NonNil.
-eval_at( Fn,Where):- use_evaluator(fa(Fn, _), Only, only),!,Only=Where.
-eval_at(_Fn,Where):- option_value(compile,false),!,Where=interp.
-eval_at( Fn,Where):- use_evaluator(fa(Fn, _), Where, enabled),!.
-eval_at( Fn,Where):- nb_current(disable_compiler,WasDC),member(Fn,WasDC), Where==compiler,!,fail.
-eval_at( Fn,Where):- nb_current(disable_interp,WasDC),member(Fn,WasDC), Where==interp,!,fail.
-eval_at(_Fn,Where):- option_value(compile,full),!,Where=compiler.
-eval_at(_Fn, _Any):- !.
-
-must_use_interp(Fn, only_interp(Fn), true):- use_evaluator(fa(Fn, _), interp, only).
-must_use_interp(_ , eval_in_only(compiler), never):- nb_current('eval_in_only',compiler).
-must_use_interp(_ , eval_in_only(interp), true):- nb_current('eval_in_only',interp).
-must_use_interp(Fn, disable_compiler(Fn), true):- nb_current(disable_compiler,WasDC), member(Fn,WasDC).
-must_use_interp(Fn,compiler_disabled(Fn), true):- use_evaluator(fa(Fn, _), compiler, disabled).
-must_use_interp(Fn,unknown(Fn), unknown).
-
-must_use_compiler(_ ,eval_in_only(compiler)):- nb_current('eval_in_only',compiler).
-must_use_compiler(_ ,eval_in_only(interp)):- nb_current('eval_in_only',interp), fail.
-must_use_compiler(Fn,only_compiler(Fn)):- use_evaluator(fa(Fn, _), compiler, only).
-must_use_compiler(Fn,disable_interp(Fn)):- nb_current(disable_interp,WasDC), member(Fn,WasDC).
-must_use_compiler(Fn,interp_disabled(Fn)):- use_evaluator(fa(Fn, _), interp, disabled).
-
-% Compiler is Disabled for Fn
-ci(PreInterp,Fn,Len,Eval,RetVal,_PreComp,_Compiled):- fail,
-    once(must_use_interp(Fn,Why,TF)),
-    TF \== unknown, TF \== never,
-    debug_info(must_use_interp,why(Why,Fn=TF)),
-    TF == true, !,
-
-    % \+ nb_current(disable_interp,WasDI),member(Fn,WasDI),
-    call(PreInterp),
-    maplist(lazy_eval_to_src,Eval,Src),
-    if_t(Eval\=@=Src,
-       debug_info(lazy_eval_to_src,ci(Fn,Len,Eval,RetVal))),
-    %eval_fn_disable(Fn,disable_compiler,interp,((call(PreComp),call(Compiled)))),
-    debug_info(Why,eval_args(Src,RetVal)),!,
-    eval_args(Src,RetVal).
-
-ci(_PreInterp,Fn,Len,_Eval,_RetVal,PreComp,Compiled):-
-    %(nb_current(disable_interp,WasDI),member(Fn,WasDI);
-    %\+ nb_current(disable_compiler,WasDC),member(Fn,WasDC)),!,
-    %\+ \+ (maplist(lazy_eval_to_src,Eval,Src),
-    %       if_t(Eval\=@=Src, debug_info(lazy_eval_to_src,ci(Fn,Len,Eval,RetVal)))),
-    if_t(false,debug_info(call_in_only_compiler,ci(Fn,Len,Compiled))),!,
-    % eval_fn_disable(Fn,disable_compiler,eval_args(EvalM,Ret))
-    %show_eval_into_src(PreInterp,Eval,_EvalM),
-    (call(PreComp),call(Compiled)),
-    %eval_fn_disable(Fn,disable_compiler,(call(PreComp),call(Compiled))),
-    true.
-
-eval_fn_disable(Fn,DisableCompiler,Call):-
-   (nb_current(DisableCompiler,Was)->true;Was=[]),
-   (New = [Fn|Was]),
-   Setup = nb_setval(DisableCompiler,New),
-   Restore = nb_setval(DisableCompiler,Was),
-   redo_call_cleanup(Setup,Call,Restore).
-
-
-lazy_eval_to_src(A,O):- nonvar(O),trace,A=O.
-%lazy_eval_to_src(A,O):- var(A),!,O=A,ensure_proper_list_var(A).
-lazy_eval_to_src(A,O):- \+ compound(A),!,O=A.
-%lazy_eval_to_src(A,P):- is_list(A), maplist(lazy_eval_to_src,A,P),!.
-lazy_eval_to_src(A,P):- [H|T] = A, lazy_eval_to_src(H,HH),lazy_eval_to_src(T,TT),!,P= [HH|TT].
-lazy_eval_to_src(A,P):- as_p1_expr(A,P),!.
-
-delistify(L,D):- is_list(L),L=[D],!.
-delistify(L,L).
-
-create_prefixed_name(Prefix,LenArgs,FnName,String) :-
-   %(sub_string(FnName, 0, _, _, "f") -> break ; true),
-   length(LenArgs,L),
-   append([Prefix,L|LenArgs],[FnName],Parts),
-   atomic_list_concat(Parts,'_',String).
-
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %%%%%%%%%%%%%%%%% Evaluation (!)
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -2401,7 +2315,9 @@
    stream_property(Err, file_no(2)),
    current_output(Cur), Cur\=@=Err,!,
    with_output_to(Err, trace_break(G)).
-trace_break(G):- nl, writeq(call(G)), trace,break.
+trace_break(G):- notrace, nl, writeq(call(G)),nl,nl, current_prolog_flag(noninteractive,true), format('~nTRACE_BREAK_CALLED~n',[]),
+  once(bt), writeq(call(G)),throw('aborted').
+trace_break(G):- notrace,nl, writeq(call(G)),nl,nl,format('~nTRACE_BREAK_CALLED~n',[]), nl, trace, \+  current_prolog_flag(noninteractive,true), break.
 %    :- set_prolog_flag(gc,false).
 
 :- if(debugging(metta(compiler_bugs))).

prolog/metta_lang/metta_debug.pl

@@ -793,23 +793,32 @@
 sub_var_safely(Sub,Source):- assertion(acyclic_term(Source)),!,sub_var(Sub,Source).
 sub_term_safely(Sub,Source):- assertion(acyclic_term(Source)),!,sub_term(Sub,Source).
 
-
-maybe_abolish_trace:- \+ is_flag(abolish_trace), !.
-maybe_abolish_trace:- abolish_trace.
-abolish_trace:-
+maybe_abort_trace:- \+ is_flag(abort_trace), !.
+maybe_abort_trace:- abort_trace.
+abort_trace:-
   redefine_system_predicate(system:trace/0),
   abolish(system:trace/0),
-  assert(( (system:trace) :- system:trace_called)),
+  assert(( (system:trace) :- system:trace_called)), !.
+system:trace_called:- notrace,format(user_error,'~nTRACE_CALLED~n',[]), once(bt),  current_prolog_flag(abort_trace,true), format(user_error,'~nTRACE_CALLED~n',[]), throw('aborted').
+system:trace_called:- break.
+
+
+maybe_noninteractive:- \+ is_flag(noninteractive), !.
+maybe_noninteractive:- noninteractive.
+noninteractive:-
+  set_prolog_flag(noninteractive,true),
+  %redefine_system_predicate(system:trace/0),
+  %abolish(system:trace/0),
+  %assert(( (system:trace) :- system:trace_called)),
+  leash(-all),
+  %no_interupts(nts1r),
   redefine_system_predicate(system:break/0),
   abolish(system:break/0),
   assert(( (system:break) :- system:break_called)).
+system:break_called:- notrace,format(user_error,'~nBREAK_CALLED~n',[]), once(bt),  current_prolog_flag(noninteractive,true), format(user_error,'~nBREAK_CALLED~n',[]), throw('aborted').
+system:break_called:- prolog.
 
-system:trace_called:- format(user_error,'~nTRACE_CALLED~n',[]), fail.
-system:trace_called:- once(bt), fail.
-%system:trace_called:- break.
 
-system:break_called:- format(user_error,'~nBREAK_CALLED~n',[]), fail.
-system:break_called:- once(bt), fail.
 %system:break_called:- break.
 
 % return true if we want to hide away developer chicanery

prolog/metta_lang/metta_eval.pl

@@ -329,7 +329,7 @@
 eval_001(Eq,RetType,Depth,Self,X,YO):-
    eval_01(Eq,RetType,Depth,Self,X,YO).
 
-overflow_depth(N,Depth):- Depth>(10_000-N).
+overflow_depth(N,Depth):- (10_000-N)=<Depth.
 overflow_depth(Depth):- Depth>10_000.
 deepen(Depth,Depth2):- succ(Depth,Depth2).
 
@@ -341,7 +341,7 @@
 
    if_t((overflow_depth(Depth), trace_on_overflow), debug(metta(e))),
 
-   trace_eval(eval_10(Eq,RetType),e,Depth2,Self,X,M),
+   trace_eval(eval_07(Eq,RetType),e,Depth2,Self,X,M),
 
    ((M=@=XX;M==X;M=@=X) -> Y=M ; eval_03(Eq,RetType,Depth2,Self,M,Y)).
 
@@ -465,13 +465,13 @@
 is_mettalog_tracing([X|_],Type):- !, is_mettalog_tracing(X,Type).
 is_mettalog_tracing(H,Type):- woc(metta_atom(_,[mettalog_trace,HH,Type])), \+ \+ H=HH, !.
 
-eval_08(Eq,RetType,Depth,Self,X,Y):- is_mettalog_tracing(X,Type),!,
-   with_debug(Type,eval_09(Eq,RetType,Depth,Self,X,Y)).
-eval_08(Eq,RetType,Depth,Self,X,Y):- eval_09(Eq,RetType,Depth,Self,X,Y).
+eval_07(Eq,RetType,Depth,Self,X,Y):- is_mettalog_tracing(X,Type),!,
+   with_debug(Type,eval_08(Eq,RetType,Depth,Self,X,Y)).
+eval_07(Eq,RetType,Depth,Self,X,Y):- eval_08(Eq,RetType,Depth,Self,X,Y).
 
-%eval_09(_Eq,_RetType, Depth,_Slf,X,Y):- Depth< 0, !, X=Y, fail.
-%eval_09(_Eq,_RetType, Depth,_Slf,X,Y):- Depth< 1, !, X=Y.
-%eval_09(_Eq,_RetType, Depth,_Slf,_X,_Y):- Depth<1, if_trace(e,bt),!, fail.
+%eval_08(_Eq,_RetType, Depth,_Slf,X,Y):- Depth< 0, !, X=Y, fail.
+%eval_08(_Eq,_RetType, Depth,_Slf,X,Y):- Depth< 1, !, X=Y.
+%eval_08(_Eq,_RetType, Depth,_Slf,_X,_Y):- Depth<1, if_trace(e,bt),!, fail.
 
 %hybrid_interp :- !.
 hybrid_interp :- option_value(compile,hybrid),!.
@@ -480,16 +480,34 @@
 hybrid_interp :- option_value(compile,full),!,fail.
 hybrid_interp :- option_value(compile,true),!.
 
+get_symbol_impl_only(interp,Fn,Len):- symbol_impl_only(interp,Fn,Len),!.
+get_symbol_impl_only(interp,Fn,Len):- eval_at(fa(Fn,Len), interp), \+ eval_at(fa(Fn,Len), compiler),!.
 
-eval_09(Eq,RetType,Depth,Self,X,Y):-
+eval_08(Eq,RetType,Depth,Self,X,Y):- option_value(compile, false), !, eval_09(Eq,RetType,Depth,Self,X,Y).
+eval_08(Eq,RetType,Depth,Self,X,Y):- \+ compound(X), !, eval_09(Eq,RetType,Depth,Self,X,Y).
+eval_08(Eq,RetType,Depth,Self,X,Y):- \+ is_list(X), !, eval_09(Eq,RetType,Depth,Self,X,Y).
+eval_08(Eq,RetType,Depth,Self,X,Y):-
   nb_current('eval_in_only', interp), !,
-  woc(eval_10(Eq,RetType,Depth,Self,X,Y)).
-eval_09(Eq,RetType,Depth,Self,X,Y):- hybrid_interp, !,
+  eval_09(Eq,RetType,Depth,Self,X,Y).
+eval_08(Eq,RetType,Depth,Self,X,Y):-
+  nb_current('eval_in_only', compiler), !,
+  with_scope(Eq, RetType, Depth, Self, transpile_eval(X,Y)).
+eval_08(Eq,RetType,Depth,Self,X,Y):-
+  nb_current('eval_in_only', rust), !,
+  with_scope(Eq, RetType, Depth, Self, rust_metta_run(exec(X),Y)).
+eval_08(Eq,RetType,Depth,Self,X,Y):- X = [Fn|Args], length(Args,Len), eval_08(Fn,Len,Eq,RetType,Depth,Self,X,Y).
+
+eval_08(Fn,Len,Eq,RetType,Depth,Self,X,Y):-
+  get_symbol_impl_only(interp,Fn,Len),!, eval_09(Eq,RetType,Depth,Self,X,Y).
+eval_08(Fn,Len,Eq,RetType,Depth,Self,X,Y):-
+  symbol_impl_exists(interp, Fn, Len),!, eval_09(Eq,RetType,Depth,Self,X,Y).
+eval_08(Eq,RetType,Depth,Self,X,Y):- hybrid_interp, !,
     eval_use_right_thing(Eq,RetType,Depth,Self,X,Y).
 eval_09(Eq,RetType,Depth,Self,X,Y):- woc(eval_10(Eq,RetType,Depth,Self,X,Y)).
 
-%eval_09(Eq,RetType,Depth,Self,X,Y):- !, no_repeats(X+Y,eval_10(Eq,RetType,Depth,Self,X,Y)).
-eval_09_hide(Eq,RetType,Depth,Self,X,Y):- !,
+
+%eval_08(Eq,RetType,Depth,Self,X,Y):- !, no_repeats(X+Y,eval_10(Eq,RetType,Depth,Self,X,Y)).
+eval_08_hide(Eq,RetType,Depth,Self,X,Y):- !,
      no_repeats_var(YY),
      eval_to_name(X,XX),!,
      eval_10(Eq,RetType,Depth,Self,X,Y), %break,
@@ -772,9 +790,11 @@
 eval_20(_,_,_,_,['echo',Value],Value):- !.
 %eval_20(=,Type,_,_,['coerce',Type,Value],Result):- !, coerce(Type,Value,Result).
 
-eval_20(_Eq,RetType,Depth,Self,['py-atom-call!',[Sym|Specialize]|Args],Res):- is_list(Args), !,
+eval_20(_Eq,RetType,Depth,Self,['py-atom-call!',SymSpecialize|Args],Res):- is_list(Args), !,
+    listify(SymSpecialize,[Sym|Specialize]),
     maplist(as_prolog_x(Depth,Self), Args , Adjusted),!,
-    py_call_method_and_args_sig(RetType,[],Sym,Adjusted,Res).
+    py_call_method_and_args_sig(RetType,Specialize,Sym,Adjusted,Res).
+
 eval_40(Eq,RetType,Depth,Self,['py-atom-call',Sym|Args],Res):-
     eval_20(Eq,RetType,Depth,Self,['py-atom-call!',Sym|Args],Res).
 
@@ -1172,7 +1192,7 @@
 
 
 
-eval_20(Eq,RetType,_Dpth,_Slf,['repl!'],Y):- !,  repl,check_returnval(Eq,RetType,Y).
+eval_20(Eq,RetType,_Dpth,_Slf,['repl!'],Y):- !, repl, check_returnval(Eq,RetType,Y).
 %eval_20(Eq,RetType,Depth,Self,['enforce',Cond],Res):- !, enforce_true(Eq,RetType,Depth,Self,Cond,Res).
 
 eval_20(Eq,RetType,Depth,Self,['trace!',A,B],C):- !, % writeln(trace(A)),
@@ -3084,7 +3104,7 @@
 no_repeat_variant_var(Var):- no_repeats_var(Var).
 %no_repeat_variant_var(Var):- no_repeats_var(variant_by_type,Var).
 
-eval_30(=,_RetType,_,_,[Var|Types],_):- var(Var), !, 
+eval_30(=,_RetType,_,_,[Var|Types],_):- var(Var), !,
    throw(var_eval_30([Var|Types])).
 
 eval_30(_Eq,_RetType,_Depth,_Self,[Space|More],[Space|More]):-
@@ -3435,7 +3455,7 @@
 transpiler_peek(Sym,Len,TypeL,Fn, Min, SpreadArgs):-
   is_list(TypeL), !, member(Type,TypeL),
   transpiler_peek(Sym,Len,Type,Fn, Min, SpreadArgs).
-  
+
 transpiler_peek(Sym,Len,Type,Fn, Min, exactArgs):-  Len=Min,
   if_t((var(Sym)),ignore(transpiler_predicate_store(_, Sym,_  , _, _, _, _))),
   nonvar(Sym),
@@ -3512,7 +3532,7 @@
     jiggle_args(Args,Res,Len,Min,AsList,PArgs), ! ,
     with_metta_ctx(Eq,RetType,Depth,Self,[Sym|Args],apply(Fn,PArgs)).
 
-eval_30(Eq, RetType, Depth, Self, [Sym | Args], Res) :- 
+eval_30(Eq, RetType, Depth, Self, [Sym | Args], Res) :-
   fail,
   \+ eval_at(Sym,interp), symbol(Sym), is_list(Args),
    len_or_unbound(Args, Len),

prolog/metta_lang/metta_interp.pl

@@ -868,6 +868,7 @@
 %   @example
 %     ?- nullify_output.
 %     true.
+
 nullify_output :- keep_output, !.
 nullify_output :- dont_change_streams, !.
 nullify_output :- nullify_output_really.
@@ -1554,7 +1555,9 @@
     on_set_value(Note,N,true).    % true
 on_set_value(Note,N,'False'):- nocut,
     on_set_value(Note,N,false).   % false
-on_set_value(_Note,abolish_trace,true):- nocut, ignore(abolish_trace),!.
+
+on_set_value(_Note,noninteractive,true):- nocut, ignore(noninteractive),!.
+on_set_value(_Note,abort_trace,true):- nocut, ignore(abort_trace),!.
 
 on_set_value(_Note,show, Value):-
     if_t( \+ prolog_debug:debugging(filter_default,_,_), set_debug(default,false)),
@@ -1675,7 +1678,8 @@
     !.
 % Enable unit testing with specific runtime configurations.
 set_is_unit_test(TF):-
-    maybe_abolish_trace,
+    maybe_noninteractive,
+    maybe_abort_trace,
     % Reset all options to their default values.
     %reset_default_flags,
     % Disable specific trace settings during unit testing.
@@ -6948,7 +6952,7 @@
     once(pre_halt1), fail.
 maybe_halt(Seven) :-
     % If the REPL is disabled (`repl = false`), halt with the specified exit code.
-    option_value('repl', false), !, halt(Seven).
+    option_value('repl', false), \+ current_prolog_flag(mettalog_rt, true), !, halt(Seven).
 maybe_halt(Seven) :-
     % If halting is explicitly enabled (`halt = true`), halt with the specified exit code.
     option_value('halt', true), !, halt(Seven).
@@ -7181,9 +7185,10 @@
 %   is allowed, it handles modifications to `system:notrace/1` to customize its behavior.
 %
 
-%nts1 :- !. % Disable redefinition by cutting execution.
+nts1 :- !. % Disable redefinition by cutting execution.
 %nts1 :- is_flag(notrace),!.
-nts1 :-
+nts1 :- no_interupts(nts1r).
+nts1r :-
     % Redefine the system predicate `system:notrace/1` to customize its behavior.
     redefine_system_predicate(system:notrace/1),
   %listing(system:notrace/1),
@@ -7193,13 +7198,32 @@
   dynamic(system:notrace/1),
     % Define the meta-predicate behavior for `system:notrace/1`.
   meta_predicate(system:notrace(0)),
+
     % Define the new behavior for `system:notrace/1`.
     % The redefined version executes the goal (`G`) with `once/1` and succeeds deterministically.
-    asserta(( system:notrace(G) :- (!, once(G) ))).
-nts1 :-
+    asserta(( system:notrace(G) :- (!, unotrace(G),! ))).
+nts1r :-
     % Ensure that further redefinitions of `nts1` are not allowed after the first.
     !.
 
+:- meta_predicate(no_interupts(0)).
+no_interupts(G):- setup_call_cleanup(G,true,true).
+:- use_module(library(logicmoo/redo_locally)).
+:- meta_predicate(unotrace(0)).
+unotrace(G):- unotrace2(G).
+:- meta_predicate(unotrace1(0)).
+unotrace1(G):-  (\+ tracing -> once(G) ; scce_orig(notrace,once(G),trace)).
+:- meta_predicate(unotrace2(0)).
+unotrace2(G):- with_leash_visible(-all,-all,G),!.
+:- meta_predicate(with_leash_visible(+,+,0)).
+with_leash_visible(Leash,Visible,Goal):-
+  '$leash'(OldL, OldL),'$visible'(OldV, OldV),
+   leash(Leash), visible(Visible),
+  '$leash'(NewL, NewL),'$visible'(NewV, NewV),
+   scce_orig(('$leash'(_, NewL),'$visible'(_, NewV)),
+                     (Goal*->('$leash'(_, OldL),'$visible'(_, OldV));(('$leash'(_, OldL),'$visible'(_, OldV)),fail)),
+            ('$leash'(_, OldL),'$visible'(_, OldV))).
+
 %:-nts1.
 :- initialization(nts1).
 %!  nts0 is det.

prolog/metta_lang/metta_repl.pl

@@ -232,9 +232,10 @@
 %     metta>
 %
 repl2 :-
+    if_t(option_value(repl,disable),throw('$aborted')),
+
     % Load the REPL history and clean it up if necessary.
     ignore(catch(load_and_trim_history,_,true)),
-
     % Begin an infinite loop using repeat to keep REPL active.
     repeat,
     % Reset internal caches for better performance.

scripts/run_commit_tests.sh

@@ -112,7 +112,7 @@ run_mettalog_tests() {
     echo "Running tests in: $test_dir"
 
     # Construct the command
-    local cmd=(mettalog --output="$output" --test --abolish_trace --no-regen --timeout="$max_time_per_test" "$test_dir")
+    local cmd=(mettalog --output="$output" --test --noninteractive --abort_trace --repl=disable --no-regen --timeout="$max_time_per_test" "$test_dir")
 
     if [ "${#args[@]}" -gt 0 ]; then
         cmd+=("${args[@]}")