1:- if((prolog_load_context(source,File),prolog_load_context(file,File));current_prolog_flag(xref,true)).    2
    3:- else.    4
    5%test_completed% This file is mostly all inside if/endifs so it doesnt interfere with `module/2`
    6:- if((set_stream(current_output,tty(true)))).  :- endif.    7
    8%:- dumpST.
    9
   10:- if((
   11 %set_prolog_flag(debug, true),
   12 %set_prolog_flag(gc, false),
   13 %set_prolog_flag(runtime_speed,0), % 0 = dont care
   14 set_prolog_flag(runtime_speed, 0), % 1 = default
   15 set_prolog_flag(runtime_debug, 3), % 2 = important but dont sacrifice other features for it
   16 set_prolog_flag(runtime_safety, 3),  % 3 = very important
   17 set_prolog_flag(unsafe_speedups, false),
   18 create_prolog_flag(logicmoo_message_hook,junit,[type(term),keep(false)]),
   19 %mpred_trace_exec,
   20 true)).   21:- endif.   22
   23
   24:- if( \+ current_module(logicmoo_clif)).   25
   26:- if( \+ getenv('keep_going','-k')).   27% Load Editline/Readline
   28:- if( \+ current_module(prolog_history)).   29:- if((set_stream(current_input,tty(true)))).  :- endif.   30:- if(( %ignore(exists_source(library(editline))->use_module(library(editline))
   31       %;(exists_source(library(readline)),use_module(library(readline)))),
   32   '$toplevel':(  setup_colors,
   33                  setup_history,
   34                  setup_readline))). :- endif.   35:- endif.   36:- endif.   37
   38% Load SWI Utils
   39:- if(( \+ exists_source(library(logicmoo_utils)),
   40   prolog_load_context(directory,X),absolute_file_name('../../',O,[relative_to(X),file_type(directory)]), attach_packs(O))).   41:- endif.   42:- if(use_module(library(logicmoo_utils))). :-endif.   43
   44% Load PFC
   45:- if(set_prolog_flag(pfc_version,v(2,0,0))). :- endif.   46:- if(ignore((exists_source(library(pfc_lib)),ensure_loaded(library(pfc_lib))))). :-endif.   47
   48% Load CLIF
   49:- if(ignore((exists_source(library(logicmoo_clif)),ensure_loaded(library(logicmoo_clif))))). :-endif.   50
   51:- endif. % \+ current_module(logicmoo_clif)
   52
   53:- if(assert_if_new((clifops:clif_op_decls((
   54 op(1199,fx,('==>')), op(1190,xfx,('::::')), op(1180,xfx,('==>')), op(1170,xfx,('<==>')), op(1160,xfx,('<-')),
   55 op(1150,xfx,('=>')), op(1140,xfx,('<=')), op(1130,xfx,'<=>'),
   56 op(1120,xfx,'<->'),
   57 op(600,yfx,('&')), op(600,yfx,('v')),op(350,xfx,('xor')), op(300,fx,('-')),
   58 op(300,fx,('~'))))))).   :- endif.   59
   60:- if((prolog_load_context(source,S),format(user_error,'~N~q,~n',[running(S)]))). :- endif.   61:- if(( \+ current_prolog_flag(test_module,_),set_prolog_flag(test_module,baseKB),assert(baseKB:this_is_baseKB))). :- endif.   62:- if(( \+ current_prolog_flag(test_typein_module,_), set_prolog_flag(test_typein_module,baseKB))). :- endif.   63
   64:- if(current_prolog_flag(loaded_test_header,_)).   65:- wdmsg(reload_of_test_header).   66:- mpred_reset.   67:- else.   68:- if(( \+ current_prolog_flag(loaded_test_header,_),set_prolog_flag(loaded_test_header,loaded))).  :- endif.   69
   70:- if(prolog_load_context(module,user)).   71:- if(( \+ current_prolog_flag(test_module,user), \+ current_prolog_flag(test_module,baseKB))).   72% writes a temp header file and include/1s it
   73:- if(( tmp_file(swi, Dir), make_directory(Dir),working_directory(OLD,Dir),asserta(t_l:old_pwd(OLD,Dir)),current_prolog_flag(test_module,Module),open('module_header.pl',write,OS),
   74  format(OS,'\n:- module(~q,[test_header_include/0]).\n test_header_include. ',[Module]),close(OS))). :- endif.   75:- include('module_header.pl').   76:- retract(t_l:old_pwd(OLD,Delete)),working_directory(_,OLD),delete_directory_and_contents(Delete).   77:- endif.   78:- endif. % prolog_load_context(module,user)
   79:- endif. % current_prolog_flag(loaded_test_header,_)
   80
   81%:- if((current_prolog_flag(test_module,Module), '$set_source_module'(Module))). :- endif.
   82
   83:- if((prolog_load_context(source,File),!,
   84   ignore((((sub_atom(File,_,_,_,'.pfc')
   85   -> (sanity(is_pfc_file),set_prolog_flag(is_pfc_file_dialect,true))
   86   ; nop((sanity( \+ is_pfc_file),set_prolog_flag(is_pfc_file_dialect,false))))))))).   87:- if((current_prolog_flag(test_module,Module), clifops:clif_op_decls(OPS), call(Module:OPS))). :- endif.   88:- endif.   89
   90
   91% :- if(('$current_source_module'(W), '$set_typein_module'(W))). :- endif.
   92%:- if((current_prolog_flag(test_typein_module,Module), '$set_typein_module'(Module), module(Module))). :- endif.
   93
   94:- if(current_prolog_flag(is_pfc_file_dialect,true)).   95:- if((current_prolog_flag(test_typein_module,Module), clifops:clif_op_decls(OPS), call(Module:OPS))). :- endif.   96:- expects_dialect(pfc).   97:- else.   98:- if((dmsg(this_test_might_need(:- expects_dialect(pfc))))).  :- endif.   99:- endif.  100
  101:- if((dmsg(this_test_might_need(:- use_module(library(logicmoo_plarkc)))))).  :- endif.  102
  103:- if((ensure_loaded(library(logicmoo_test)))).  104:- if(at_halt(system:test_completed)). :- endif.  105:- endif.  106
  107
  108%:- if(false).
  109:- if((prolog_load_context(source,Src),set_prolog_flag(test_src,Src))). :- endif.  110:- if((prolog_load_context(source,Src),add_test_info(testsuite,file,Src))). :- endif.  111%:- endif.
  112
  113:- if((prolog_load_context(source,File), sub_atom(File,_,_,_,'.plt'),!, user:use_module(library(plunit)))).  114:- if(at_halt(logicmoo_test:run_junit_tests_at_halt)). :- endif.  115:- else.  116:- if((prolog_load_context(source,F),echo_source_file_no_catchup(F))).  :- endif.  117:- endif.  118
  119:- endif.