13
14:- module(pfc_test,[why_was_true/1,mpred_test/1]). 15
17
18test_red_lined(Failed):- quietly((
19 format('~N',[]),
20 quietly_ex((doall((between(1,3,_),
21 ansifmt(red,"%%%%%%%%%%%%%%%%%%%%%%%%%%% find ~q in srcs %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n",[Failed]),
22 ansifmt(yellow,"%%%%%%%%%%%%%%%%%%%%%%%%%%% find test_red_lined in srcs %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n"))))))).
23
30mpred_test(G):-var(G),!,dmsg_pretty(var_mpred_test(G)),trace_or_throw(var_mpred_test(G)).
32mpred_test(_):- quietly_ex((compiling; current_prolog_flag(xref,true))),!.
33mpred_test(G):- quietly_ex(mpred_is_silent),!, with_no_mpred_trace_exec(must(mpred_test_fok(G))),!.
34mpred_test(G):- dmsg_pretty(:-mpred_test(G)),fail.
35mpred_test(G):- current_prolog_flag(runtime_debug,D),D<1,!,with_no_mpred_trace_exec(must((G))),!.
36mpred_test(G):- with_no_breaks(with_mpred_trace_exec(must(mpred_test_fok(G)))),!.
37:- if(false). 38mpred_test(MPRED):- must(mpred_to_pfc(MPRED,PFC)),!,(show_call(umt(PFC))*->true;(pfc_call(PFC)*->mpred_why2(MPRED);test_red_lined(mpred_test(MPRED)),!,fail)).
39mpred_why2(MPRED):- must(mpred_to_pfc(MPRED,PFC)),!,(show_call(mpred_why(PFC))*->true;(test_red_lined(mpred_why(MPRED)),!,fail)).
40:- endif. 41
42
43why_was_true((A,B)):- !,mpred_why(A),mpred_why(B).
44why_was_true(P):- predicate_property(P,dynamic),mpred_why(P),!.
45why_was_true(P):- dmsg_pretty(justfied_true(P)),!.
46
47mpred_test_fok(G):- source_file(_,_),!,mpred_test_fok0(G),!.
48mpred_test_fok(G):- mpred_test_fok0(G),!.
49
50mpred_test_fok0(\+ G):-!, ( \+ call_u(G) -> wdmsg_pretty(passed_mpred_test(\+ G)) ; (log_failure(failed_mpred_test(\+ G)),!,
51 ignore(why_was_true(G)),!,fail)).
53mpred_test_fok0(G):- (call_u(G) *-> ignore(must(why_was_true(G))) ; (log_failure(failed_mpred_test(G))),!,fail).
54
55
56
57:- module_transparent(pfc_feature/1). 58:- dynamic(pfc_feature/1). 59:- export(pfc_feature/1). 60pfc_feature(test_a_feature).
61
62:- module_transparent(pfc_test_feature/2). 63:- export(pfc_test_feature/2). 64
65pfc_test_feature(Feature,Test):- pfc_feature(Feature)*-> mpred_test(Test) ; true.
66
67:- system:import(pfc_feature/1). 68:- system:export(pfc_feature/1). 69:- system:import(pfc_test_feature/2). 70:- system:export(pfc_test_feature/2). 71
72:- system:import(pfc_feature/1). 73:- system:export(pfc_feature/1). 74:- baseKB:import(pfc_test_feature/2). 75:- baseKB:export(pfc_test_feature/2). 76
77
78warn_fail_TODO(G):- dmsg_pretty(:-warn_fail_TODO(G)).
79
80
81
85
90:- create_prolog_flag(logicmoo_message_hook,none,[keep(true),type(term)]). 91
92
93skip_warning(informational).
94skip_warning(information).
95skip_warning(debug).
96
97skip_warning(discontiguous).
98skip_warning(query).
99skip_warning(banner).
100skip_warning(silent).
101skip_warning(debug_no_topic).
102skip_warning(break).
103skip_warning(io_warning).
104skip_warning(interrupt).
105skip_warning(statistics).
107skip_warning(compiler_warnings).
108skip_warning(T):- \+ compound(T),!,fail.
109skip_warning(_:T):- !, compound(T),functor(T,F,_),skip_warning(F).
110skip_warning(T):-compound(T),functor(T,F,_),skip_warning(F).
111
112
113
114inform_message_hook(T1,T2,_):- (skip_warning(T1);skip_warning(T2);(\+ thread_self_main)),!.
115inform_message_hook(_,_,_):- \+ current_predicate(dumpST/0),!.
116inform_message_hook(compiler_warnings(_,[always(true,var,_),always(false,integer,_),
117 always(false,integer,_),always(true,var,_),always(false,integer,_),always(false,integer,_)]),warning,[]):- !.
118inform_message_hook(import_private(_,_),_,_).
119inform_message_hook(check(undefined(_, _)),_,_).
120inform_message_hook(ignored_weak_import(header_sane,_),_,_).
121inform_message_hook(error(existence_error(procedure,'$toplevel':_),_),error,_).
123
124inform_message_hook(T,Type,Warn):- atom(Type),
125 memberchk(Type,[error,warning]),!,
126 once((dmsg_pretty(message_hook_type(Type)),dmsg_pretty(message_hook(T,Type,Warn)),
127 ignore((source_location(File,Line),dmsg_pretty(source_location(File,Line)))),
128 assertz(system:test_results(File:Line/T,Type,Warn)),nop(dumpST),
129 nop(dmsg_pretty(message_hook(File:Line:T,Type,Warn))))),
130 fail.
131inform_message_hook(T,Type,Warn):-
132 ignore(source_location(File,Line)),
133 once((nl,dmsg_pretty(message_hook(T,Type,Warn)),nl,
134 assertz(system:test_results(File:Line/T,Type,Warn)),
135 dumpST,nl,dmsg_pretty(message_hook(File:Line:T,Type,Warn)),nl)),
136 fail.
137
138inform_message_hook(T,Type,Warn):- dmsg_pretty(message_hook(T,Type,Warn)),dumpST,dmsg_pretty(message_hook(T,Type,Warn)),!,fail.
139inform_message_hook(_,error,_):- current_prolog_flag(runtime_debug, N),N>2,break.
140inform_message_hook(_,warning,_):- current_prolog_flag(runtime_debug, N),N>2,break.
141
142
143:- multifile prolog:message//1, user:message_hook/3. 144
145:- dynamic(system:test_results/3). 146
147system:test_repl:- assertz(system:test_results(need_retake,warn,need_retake)).
148system:test_completed:- listing(system:test_results/3),test_completed_exit_maybe(7).
149system:test_retake:- listing(system:test_results/3),test_completed_exit_maybe(3).
150
151test_completed_exit(N):- dmsg_pretty(test_completed_exit(N)),fail.
152test_completed_exit(7):- halt(7).
153test_completed_exit(4):- halt(4).
154test_completed_exit(5):- halt(5).
155test_completed_exit(N):- (debugging-> break ; true), halt(N).
156test_completed_exit(N):- (debugging-> true ; halt(N)).
157
158test_completed_exit_maybe(_):- system:test_results(_,error,_),test_completed_exit(9).
159test_completed_exit_maybe(_):- system:test_results(_,warning,_),test_completed_exit(3).
160test_completed_exit_maybe(_):- system:test_results(_,warn,_),test_completed_exit(3).
161test_completed_exit_maybe(N):- test_completed_exit(N).
162
163set_file_abox_module(User):- '$set_typein_module'(User), '$set_source_module'(User),
164 set_fileAssertMt(User).
165
166set_file_abox_module_wa(User):- set_file_abox_module(User),set_defaultAssertMt(User).
167
168:- multifile prolog:message//1, user:message_hook/3. 170message_hook_handle(io_warning(_,'Illegal UTF-8 start'),warning,_):- source_location(_,_),!.
171message_hook_handle(undefined_export(jpl, _), error, _):- source_location(_,_),!.
172message_hook_handle(_, error, _):- source_location(File,4235),atom_concat(_,'/jpl.pl',File),!.
173message_hook_handle(message_lines(_),error,['~w'-[_]]).
174message_hook_handle(error(resource_error(portray_nesting),_),
175 error, ['Not enough resources: ~w'-[portray_nesting], nl,
176 'In:', nl, '~|~t[~D]~6+ '-[9], '~q'-[_], nl, '~|~t[~D]~6+ '-[7],
177 _-[], nl, nl, 'Note: some frames are missing due to last-call optimization.'-[], nl,
178 'Re-run your program in debug mode (:- debug.) to get more detail.'-[]]).
179message_hook_handle(T,Type,Warn):-
180 ((current_prolog_flag(runtime_debug, N),N>2) -> true ; source_location(_,_)),
181 memberchk(Type,[error,warning]),once(inform_message_hook(T,Type,Warn)),fail.
182
183:- fixup_exports. 184
185user:message_hook(T,Type,Warn):-
186 Type \== silent,Type \== debug, Type \== informational,
187 current_prolog_flag(logicmoo_message_hook,Was),Was\==none,
188 once(message_hook_handle(T,Type,Warn)),!