1%:-module(mud_testing,[]).
    2/* *
    3 <module>
    4% A MUD testing API is defined here
    5%
    6%
    7% Logicmoo Project PrologMUD: A MUD server written in Prolog
    8% Maintainer: Douglas Miles
    9% Dec 13, 2035
   10%
   11*/
   12
   13/*
   14:- maplist(export,
   15	[run_mud_tests/0,
   16        run_mud_test/2,
   17        test_name/1,
   18        test_true/1,
   19        run_mud_test/1,
   20        test_false/1,
   21
   22        test_call/1]).
   23*/
   24
   25:- include(prologmud(mud_header)).   26
   27:- dynamic(lmcache:last_test_name/1).   28
   29:- thread_local t_l:was_test_name/1.   30:- multifile(baseKB:mud_regression_test/0).   31:- multifile(baseKB:mud_test_local/0).   32:- multifile(baseKB:mud_test_full/0).   33
   34:- discontiguous(baseKB:mud_regression_test/0).   35:- discontiguous(baseKB:mud_test_local/0).   36:- discontiguous(baseKB:mud_test_full/0).   37
   38:- meta_predicate test_call(+).   39:- meta_predicate run_mud_test(+,+).   40:- meta_predicate test_true(+).   41:- meta_predicate test_true_req(+).   42:- meta_predicate test_false(+).   43:- meta_predicate run_mud_test(+).   44
   45% :- trace,leash(+all),meta_predicate run_mud_tests().
   46
   47% :- register_module_type (utility).
   48
   49% do some sanity testing (expects the startrek world is loaded)
   50run_mud_tests:-
   51  forall(baseKB:mud_test(Name,Test),run_mud_test(Name,Test)).
   52
   53baseKB:action_info(actTests,"run run_mud_tests").
   54
   55baseKB:agent_command(_Agent,actTests) :- scan_updates, run_mud_tests.
   56
   57
   58baseKB:action_info(actTest(ftTerm),"run tests containing term").
   59
   60baseKB:agent_command(Agent,actTest(Obj)):-foc_current_agent(Agent),run_mud_test(Obj).
   61
   62
   63test_name(String):-fmt(start_moo_test(mudNamed(String))),asserta(t_l:was_test_name(String)).
   64lmcache:last_test_name(String):- t_l:was_test_name(String),!.
   65lmcache:last_test_name(unknown).
   66
   67test_result(Result):-test_result(Result,true).
   68
   69test_result(Result,SomeGoal):- lmcache:last_test_name(String),fmt(Result:test_mini_result(Result:String,SomeGoal)).
   70
   71from_here(_:SomeGoal):-!,functor(SomeGoal,F,_),atom_concat(actTest,_,F).
   72from_here(SomeGoal):-!,functor(SomeGoal,F,_),atom_concat(actTest,_,F).
   73
   74test_call(X):- var(X),!, throw(var(test_call(X))).
   75test_call(meta_callable(String,test_name(String))):-!,string(String).
   76test_call(meta_call(X)):- show_call(test_call0(X)).
   77test_call(Goal):-  meta_interp(test_call,Goal).
   78
   79test_call0(SomeGoal):- from_here(SomeGoal),!,req1(SomeGoal).
   80test_call0(SomeGoal):- dmsg(req1(SomeGoal)), catch(SomeGoal,E,(test_result(error(E),SomeGoal),!,fail)).
   81
   82test_true_req(Req):- test_true(req1(Req)).
   83test_true(SomeGoal):- test_call(SomeGoal) *-> test_result(passed,SomeGoal) ;  test_result(failed,SomeGoal).
   84test_false(SomeGoal):- test_true(not(SomeGoal)).
   85
   86run_mud_test(Filter):-
   87   catch(ignore(gui_tracer:noguitracer),_,true),
   88   doall((
   89   member(F/A,[baseKB:mud_test/0,baseKB:mud_test/1,baseKB:mud_test/2]),
   90   current_predicate(M:F/A),
   91   functor(H,F,A),
   92   not(predicate_property(M:H,imported_from(_))),
   93   clause(M:H,B),
   94   term_matches_hb(Filter,M:H,B),
   95   once(run_mud_test_clause(M:H,B)),
   96   fail)).
   97
   98run_mud_test_clause(M:mud_test,B):- must((contains_term(test_name(Name),nonvar(Name)))),!, M:run_mud_test(Name,B).
   99run_mud_test_clause(M:mud_test(Name),B):- !, M:run_mud_test(Name,B).
  100run_mud_test_clause(M:mud_test(Name,Test),B):- forall(B,M:run_mud_test(Name,Test)).
  101run_mud_test(Name,Test):-
  102   fmt(begin_mud_test(Name)),
  103   once(catch((test_call(Test),fmt(completed_mud_test(Name))),E,fmt(error_mud_test(E, Name)));fmt(actTests(incomplet_mud_test(Name)))).
  104
  105
  106
  107
  108
  109% define tests locally
  110
  111
  112%:- mpred_trace_exec.
  113%:- flag_call(runtime_debug=true).
  114
  115baseKB:mud_test(test_fwc_1,
  116  (on_x_debug(ain(tAgent(iExplorer1))),
  117   nop(mpred_fwc(tAgent(iExplorer1))),
  118   % test_false(mudFacing(iExplorer1,vSouth)),
  119   test_true(mudFacing(iExplorer1,vNorth)),
  120   ain(mudFacing(iExplorer1,vSouth)),
  121   test_false(mudFacing(iExplorer1,vNorth)),
  122   test_true(mudFacing(iExplorer1,vSouth)))).
  123
  124baseKB:mud_test(test_fwc_2,
  125  (ain(tAgent(iExplorer1)),
  126    mpred_fwc1(tAgent(iExplorer1)),
  127   mpred_remove(mudFacing(iExplorer1,vSouth)),
  128   test_true(mudFacing(iExplorer1,vNorth)),
  129   test_false(mudFacing(iExplorer1,vSouth)))).
  130
  131
  132baseKB:mud_test(test_movedist,
  133 (
  134  foc_current_agent(P),
  135   test_name("teleport to main enginering"),
  136   do_agent_action('tp self to Area1000'),
  137  test_name("now we are really somewhere"),
  138   test_true(req1(mudAtLoc(P,_Somewhere))),
  139  test_name("in main engineering?"),
  140   test_true(req1(localityOfObject(P,'Area1000'))),
  141   test_name("set the move dist to 5 meters"),
  142   do_agent_action('@set mudMoveDist 5'),
  143   test_name("going 5 meters"),
  144   % gets use out of othre NPC path
  145   do_agent_action('move e'),
  146   do_agent_action('move n'),
  147   test_name("must be now be in corridor"),
  148   test_true(req1(localityOfObject(P,'Area1002'))),
  149   do_agent_action('@set mudMoveDist 1'),
  150   call_n_times(5, do_agent_action('s')),
  151   do_agent_action('move s'),
  152   test_name("must be now be back in engineering"),
  153   test_true(req1(localityOfObject(P,'Area1000'))))).
  154
  155mud_test_level2(create_gensym_named,
  156  with_all_dmsg(((do_agent_action('create food999'),
  157  foc_current_agent(P),
  158  must(( req1(( mudPossess(P,Item),isa(Item,tFood))))))))) .
  159
  160mud_test_level2(drop_take,
  161  with_all_dmsg(((do_agent_action('create food'),
  162  do_agent_action('drop food'),
  163  do_agent_action('take food'),
  164  do_agent_action('eat food'))))).
  165
  166
  167% [Optionally] load and start sparql server
  168%:- after_boot(start_servers)
  169
  170% [Optionaly] Add some game content
  171:- if_flag_true(was_runs_tests_pl, declare_load_dbase(logicmoo('rooms/startrek.all.pfc.pl'))).  172
  173baseKB:mud_test_local:-
  174   test_name("tests to see if we have: player1"),
  175   test_true(show_call(foc_current_agent(_Agent))).
  176
  177baseKB:mud_test_local:-
  178   test_name("tests to see if we have: mudAtLoc"),
  179   test_true((foc_current_agent(Agent),show_call(mudAtLoc(Agent,_Where)))).
  180
  181baseKB:mud_test_local:-
  182   test_name("tests to see if we have: localityOfObject"),
  183   test_true((foc_current_agent(Agent),show_call(localityOfObject(Agent,_Where)))).
  184
  185baseKB:mud_test_local:-
  186   test_name("tests to see if our clothing doesnt: mudAtLoc"),
  187   test_false(mudAtLoc('iGoldUniform775',_X)).
  188
  189baseKB:mud_test_local:-
  190   foc_current_agent(Agent),
  191   test_name("tests to see if we have: argIsas on mudEnergy"),
  192   test_true(correctArgsIsa(mudEnergy(Agent,_),_)).
  193
  194baseKB:mud_test_local:-
  195   test_name("tests to see if we have: singleValued on mudMoveDist"),
  196   foc_current_agent(Agent),
  197   must(ain(mudMoveDist(Agent,3))),
  198   test_true(must((findall(X,mudMoveDist(Agent,X),L),length(L,1)))).
  199
  200baseKB:mud_test_local:-
  201      test_name("nudity test"),
  202      foc_current_agent(Agent),
  203       test_true_req(wearsClothing(Agent, 'ArtifactCol1003-Gold-Uniform775')).
  204
  205baseKB:mud_test_local:-
  206      test_name("genlInverse test"),
  207      foc_current_agent(Agent),
  208       test_true_req(mudPossess(Agent, 'ArtifactCol1003-Gold-Uniform775')).
  209
  210baseKB:mud_test_local:-
  211   test_name("Tests our action templates"), doall((get_all_templates(Templates),dmsg(get_all_templates(Templates)))).
  212
  213baseKB:mud_test_local:-
  214   test_name("tests to see if 'food' can be an item"),
  215      test_true(parseIsa(tItem, _, [food], [])).
  216
  217baseKB:mud_test_local:-req1(cmdShowRoomGrid('Area1000')).
  218
  219
  220% more tests even
  221baseKB:mud_test_local :- call_u(do_agent_action("look")).
  222baseKB:mud_test_local :- forall(localityOfObject(O,L),dmsg(localityOfObject(O,L))).
  223
  224% ---------------------------------------------------------------------------------------------
  225
  226:-thread_local t_l:is_checking_instance/1.  227
  228:- multifile(check_consistent/2).  229:- dynamic(check_consistent/2).  230prologHybrid(check_consistent(ftTerm,ftInt)).
  231:- dynamic(lmcache:is_instance_consistent/2).  232==>prologHybrid(bad_instance(ftTerm,ftTerm)).
  233% prologHybrid(t_l:is_checking_instance(ftTerm)).
  234
  235check_consistent(Obj,Scope):-var(Scope),!,check_consistent(Obj,0).
  236check_consistent(Obj,Scope):-call(call,lmcache:is_instance_consistent(Obj,Was)),!,Was>=Scope.
  237check_consistent(Obj,_):- call(call,t_l:is_checking_instance(Obj)),!.
  238check_consistent(Obj,Scope):- locally(t_l:is_checking_instance(Obj),doall(check_consistent_0(Obj,Scope))).
  239check_consistent_0(Obj,Scope):- once((catch((doall(((clause(hooked_check_consistent(Obj,AvScope),Body),once(var(AvScope); (AvScope =< Scope) ),Body))),assert_if_new(lmcache:is_instance_consistent(Obj,Scope))),E,assert_if_new(bad_instance(Obj,E))))),fail.
  240check_consistent_0(Type,Scope):- once(tCol(Type)),
  241 catch((forall(isa(Obj,Type),check_consistent(Obj,Scope)),
  242                                                   assert_if_new(lmcache:is_instance_consistent(Type,Scope))),E,assert_if_new(bad_instance(Type,E))),fail.
  243
  244% hooked_check_consistent(Obj,20):-must(object_string(_,Obj,0-5,String)),dmsg(checked_consistent(object_string(_,Obj,0-5,String))).
  245% ---------------------------------------------------------------------------------------------
  246baseKB:mud_test_local:-
  247  test_name("Tests our types to populate bad_instance/2 at level 5"),
  248  retractall(lmcache:is_instance_consistent(_,_)),
  249  retractall(bad_instance(_,_)),
  250  forall(genls(T,tSpatialThing),check_consistent(T,1000)),
  251  listing(bad_instance/2).
  252
  253
  254% baseKB:mud_test("local sanity tests",  do_mud_test_locals).
  255
  256% locally/2
  257
  258% :- 'mpred_hide_childs'(dbase:record_on_thread/2).
  259
  260% [Manditory] This loads the game and initializes so test can be ran
  261:- if_flag_true(was_runs_tests_pl, after_boot(run_setup)).  262
  263% the real tests now (once)
  264do_mud_test_locals:- forall(clause(baseKB:mud_test_local,B),must(B)).
  265:- if_flag_true(was_runs_tests_pl,after_boot(must_det(run_mud_tests))).  266
  267% the local tests each reload (once)
  268:- if_flag_true(was_runs_tests_pl, do_mud_test_locals).  269
  270% halt if this was the script file
  271:- if_flag_true(was_runs_tests_pl, halt).  272
  273
  274
  275% the local tests each reload (once)
  276now_run_local_tests_dbg :- doall(baseKB:mud_test_local).
  277
  278% nasty way i debug the parser
  279% :-repeat, trace, do_agent_action('who'),fail.
  280baseKB:mud_test_local :- call_u(do_agent_action('who')).
  281
  282% baseKB:mud_test_local :-do_agent_action("scansrc").
  283
  284% more tests even
  285baseKB:mud_test_local :- call_u(do_agent_action("look")).
  286baseKB:mud_test_local :-forall(localityOfObject(O,L),dmsg(localityOfObject(O,L))).
  287
  288must_test("tests to see if poorly canonicalized code (unrestricted quantification) will not be -too- inneffienct",
  289   forall(mudAtLoc(O,L),fmt(mudAtLoc(O,L)))).
  290
  291% the real tests now (once)
  292baseKB:mud_test_local :- after_boot(must_det(run_mud_tests)).
  293
  294
  295% :- forall(clause(mud_regression_test,Call),must(Call)).
  296
  297
  298
  299
  300
  301:- if(current_module(mud_testing)).  302:- module_meta_predicates_are_transparent(mud_testing).  303:- module_predicates_are_exported.  304:- endif.