13:- if((prolog_load_context(source,File),prolog_load_context(file,File));current_prolog_flag(xref,true)). 14:- module(logicmoo_test,[]). 15:-endif. 16
17:- define_into_module(
18 [mpred_test/1,
19 run_junit_tests/0,
20 must_ex/1,
21 quietly_must_ex/1,
22 run_junit_tests/1,
23 add_test_info/3,
24 25 run_tests_and_halt/0,
26 run_tests_and_halt/1]). 27
28
29:- use_module('../prolog/logicmoo_common'). 30:- use_module('../prolog/echo_source_files'). 31
32:- system:use_module(library(must_trace)). 33:- use_module(library(prolog_stack)). 34:- use_module(library(listing)). 36:- use_module(library(must_trace)). 37:- reexport(library(statistics), [profile/1]). 38
39:- plunit:use_module(library(plunit)). 40:- use_module(library(test_cover)). 41
42
43:- set_prolog_flag(ran_junit_tests,false). 44run_junit_tests_at_halt:-
45 current_prolog_flag(ran_junit_tests,true)-> true;
46 call_with_time_limit(20,run_junit_tests).
47
49
51run_junit_tests:-
52 run_junit_tests(all).
53
54run_junit_tests(Spec) :-
55 \+ is_list(Spec),
56 Spec \= all,
57 !,
58 run_junit_tests([Spec]).
59
60run_junit_tests(Spec) :-
61 set_prolog_flag(ran_junit_tests,true),
62 term_to_atom(Spec,SpecAtom),
63 statistics(cputime,Y),
64 (getenv_safe('TESTING_TEMP',TESTING_TEMP)->true;TESTING_TEMP='/tmp'), 65 atomic_list_concat([TESTING_TEMP,'/',SpecAtom,Y,'-junit.xml'],FileName),
66 capturing_user_error(string(UserErr), (run_junit_tests_user_error(Spec,UnitXml),plunit:check_for_test_errors)),
67 sformat(JUnitStr,"~w~n~w]]>></system-out></testsuites>\n",[UnitXml,UserErr]),
68 format(user_error,"~N% Writing: ~w~n",[FileName]),
69 setup_call_cleanup(open(FileName, write, Out),write(Out,JUnitStr),close(Out)),
70 write(JUnitStr),!.
71 72
73:- create_prolog_flag(junit_show_converage, false, [keep(true)]). 74
75do_show_coverage(Spec,TotalConverage):- current_prolog_flag(junit_show_converage, false),!,
76 TotalConverage = "% use :- set_prolog_flag(junit_show_converage, true). ",
77 (Spec==all -> run_tests ; run_tests(Spec)).
78
79do_show_coverage(Spec,TotalConverage):-
80 patch_show_coverage,
81 nb_setval(seen, 0),
82 nb_setval(covered, 0),
83 (
84 Spec \= all
85 ->
86 maplist(get_pl_module, Spec, Modules)
87 ;
88 Modules=[]
89 ),
90 with_output_to(
91 string(Coverage),
92 (
93 (
94 Spec == all
95 ->
96 (
97 flag(slow_test, true, true)
98 ->
99 show_coverage((run_tests, generate_doc))
100 ;
101 show_coverage(run_tests)
102 )
103 ;
104 show_coverage(run_tests(Spec), Modules)
105 )
106 ->
107 true
108 ;
109 110 true
111 )
112 ),
113 split_string(Coverage, "\n", "\r", CovLines),
114 forall(
115 (
116 member(Line, CovLines),
117 split_string(Line, "\t ", "\t ", [_File, Clauses, Percent, _Fail]),
118 119 split_string(Clauses, ",", "", LClauses),
120 atomics_to_string(LClauses, ClausesNoComma),
121 number_string(NClauses, ClausesNoComma),
122 number_string(NPercent, Percent)
123 ),
124 (
125 Covered is round(NPercent*NClauses/100),
126 nb_getval(seen, Seen),
127 nb_getval(covered, Cover),
128 NSeen is Seen + NClauses,
129 NCover is Cover + Covered,
130 nb_setval(seen, NSeen),
131 nb_setval(covered, NCover)
132 )
133 ),
134 nb_getval(seen, Seen),
135 nb_getval(covered, Cover),
136 Covered is Cover*100/Seen,
137 sformat(TotalConverage,'~w~nTOTAL coverage~t ~D~64| ~t~1f~72|~n', [Coverage, Seen, Covered]).
138
139
140run_junit_tests_user_error(Spec,UnitXml):-
141 set_prolog_flag(verbose, normal),
142 do_show_coverage(Spec,TotalConverage),
143 with_output_to(string(UnitXml),
144 (format(
145
146 "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n<testsuites>\n", []
147 ),
148 forall(
149 plunit:current_test_set(Unit),
150 (
151 unit_to_sn(Unit,SuiteName,Package),
152 format( " <testsuite name=\"~w\" package=\"~w\">\n", [SuiteName,Package]),
153 output_unit_results(Unit),
154 format( " </testsuite>\n", [])
155 )
156 ),
157 format('<system-out><![C~w[',['DATA']),
158 current_prolog_flag(version, V2),
159 format("Running on SWI-Prolog ~w~n", [ V2]),
160 writeln(TotalConverage))).
161
162
163
164:- meta_predicate(capturing_user_error(+,:)). 165capturing_user_error(To, Goal):-
166 with_output_to(To,
167 (current_output(Stream),
168 stream_property(Was,alias(user_error)),
169 setup_call_cleanup(once(stream_property(Stream,alias(A));A=[]),
170 setup_call_cleanup(
171 (tracing->true;set_stream(Stream,alias(user_error))),
172 call(Goal),
173 set_stream(Was,alias(user_error))),
174 once(A=[];set_stream(Stream,alias(A)))))).
175
176
177get_pl_module(Spec, Module) :-
178 atom_concat('plunit_', Spec, TestModule),
179 module_property(TestModule, file(TestFile)),
180 atom_concat(PlFile, 't', TestFile),
181 module_property(Module, file(PlFile)).
182
183
184patch_show_coverage :-
185 186 187 file_search_path(swi, SWI),
188 set_prolog_flag(access_level, system),
189 (
190 current_predicate(prolog_cover:show_coverage/2)
191 ->
192 dynamic(prolog_cover:file_coverage/4),
193 prolog_cover:asserta(
194 (prolog_cover:file_coverage(File, _, _, _) :- atom_concat(SWI, _, File),!)
195 ),
196 prolog_cover:asserta(
197 (prolog_cover:file_coverage(File, _, _, _) :- atom_concat(_, '.plt', File),!)
198 )
199 ;
200 dynamic(show_coverage/2),
201 assertz(show_coverage(A, _) :- show_coverage(A)),
202 (
203 catch(
204 (
205 dynamic(prolog_cover:file_coverage/3),
206 prolog_cover:asserta(
207 (prolog_cover:file_coverage(File, _, _) :- atom_concat(SWI, _, File),!)
208 ),
209 prolog_cover:asserta(
210 (prolog_cover:file_coverage(File, _, _) :- atom_concat(_, '.plt', File),!)
211 )
212 ),
213 error(permission_error(_, _, _), _),
214 true
215 )
216 )
217 ).
218
219
220run_tests_and_halt :-
221 run_tests_and_halt(all).
222
223
224run_tests_and_halt(Spec) :-
225 call_cleanup(
226 (
227 run_junit_tests(Spec),
228 test_completed(64)
229 ),
230 test_completed(8)
231 ).
232
233
234getenv_safe(N,V):- getenv(N,V),!.
235getenv_safe(N,N).
236
237unit_to_sn(Unit,SuiteName,Package):- getenv_safe('JUNIT_PACKAGE',Package),getenv_safe('JUNIT_SUITE',Suite),
238 sformat(SuiteName,"~w_~w",[Suite,Unit]).
239name_to_tc(Name,Line,SCName,Classname):-
240 getenv_safe('JUNIT_CLASSNAME',Classname),
241 sformat(TCName,"~w@Test_0001_Line_~4d ~w",[Classname,Line,Name]),
242 replace_in_string(['_0.'='_'],TCName,SCName),!.
243
245output_unit_results(Unit) :-
246 output_passed_results(Unit),
247 output_failed_results(Unit).
248
249
251output_passed_results(Unit) :-
252 forall(
253 plunit:passed(Unit, Name, Line, _Det, Time),
254 (name_to_tc(Name,Line,TCName,Classname),
255 add_test_info(TCName,result,passed),
256 format( " <testcase name=\"~w\" classname=\"~w\" time=\"~w\" />\n", [TCName, Classname, Time]))
257 ).
258
259
261output_failed_results(Unit) :-
262 forall(
263 plunit:failed(Unit, Name, Line, Error),
264 (
265 name_to_tc(Name,Line,TCName,Classname),
266 add_test_info(TCName,result,failure),
267 format( " <testcase name=\"~w\" classname=\"~w\">\n", [TCName,Classname]),
268 format( " <failure message=\"~w\" />\n", [Error]),
269 format( " </testcase>\n", [])
270 )
271 ).
272
273
274
276:- meta_predicate(quietly_must_ex(:)). 277quietly_must_ex(G):- !, call(G).
278quietly_must_ex(G):- tracing -> (notrace,call_cleanup(must_or_rtrace(G),trace)); quietly_must(G).
279:- module_transparent(quietly_must_ex/1). 280
281:- meta_predicate(must_ex(:)). 282must_ex(G):- !, call(G).
283must_ex(G):- !, must_or_rtrace(G).
284:- module_transparent(must_ex/1). 285must_ex(G):- !, must(G).
288
290
291test_red_lined(Failed):- notrace((
292 format('~N'),
293 quietly((doall((between(1,3,_),
294 ansifmt(red,"%%%%%%%%%%%%%%%%%%%%%%%%%%% find ~q in srcs %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n",[Failed]),
295 ansifmt(yellow,"%%%%%%%%%%%%%%%%%%%%%%%%%%% find test_red_lined in srcs %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n"))))))).
296
304:- meta_predicate(mpred_test(:)). 305:- module_transparent(mpred_test/1). 306:- if(false). 309mpred_test(MPRED):- must_ex(mpred_to_pfc(MPRED,PFC)),!,(show_call(umt(PFC))*->true;(call_u(PFC)*->mpred_why2(MPRED);test_red_lined(mpred_test(MPRED)),!,fail)).
312:- endif. 313mpred_test(G):- mpred_test(_Testcase, G).
314
315:- meta_predicate(mpred_test_fok(:)). 316:- module_transparent(mpred_test_fok/1). 317mpred_test_fok(G):- !, call(G).
318mpred_test_fok(G):- mpred_test_fok(_Testcase, G).
319:- meta_predicate(mpred_test_mok(:)). 320:- module_transparent(mpred_test_mok/1). 321mpred_test_mok(G):- !, call(G).
322mpred_test_mok(G):- mpred_test_fok(_Testcase, G).
323
324negate_call(\+ G, G).
325negate_call(M:G,M:NG):- !, negate_call(G, NG).
326negate_call(G, \+ G).
327
328:- thread_local(t_l:mpred_current_testcase/1). 329:- dynamic(j_u:junit_prop/3). 330
331mpred_test(_,_):- notrace((compiling; current_prolog_flag(xref,true))),!.
332mpred_test(Testcase, G):- ignore(mpred_test_fok(Testcase, G)).
333
334must_det_l_ex(G):- must_det_l(ignore(G)),!.
336
337mpred_test_fok(Testcase, G):-
338 junit_incr(tests),
339 junit_incr(test_number),
340 ignore((var(Testcase),generate_test_name(G, Testcase))),
341 add_test_info(testsuite,testcase,Testcase),
342 locally(t_l:mpred_current_testcase(Testcase),
343 (must_det_l_ex((
344 wdmsg('?-'(mpred_test(Testcase, G))),
345 add_test_info(Testcase,goal,G),
346 ignore((source_location(S,L),atom(S),add_test_info(Testcase,src,S:L),
347 sformat(URI,'~w#L~w',[S,L]),
348 replace_in_string( [ "/opt/logicmoo_workspace"
349 ="https://logicmoo.org/gitlab/logicmoo/logicmoo_workspace/-/edit/master"],
350 URI,URL),
351 add_test_info(Testcase,url,URL))),
352 get_time(Start))),
353 Answers = nb(0),
354 catch( ( call_u_hook(G) *-> TestResult = passed; TestResult = failure), E, TestResult=error(E)),
355 notrace((ignore(( 356 must_det_l_ex((get_time(End),
357 Elapsed is End - Start,
358 add_test_info(Testcase,time,Elapsed),
359 process_test_result(TestResult, G),
360 TestResult=..[Type|Info],add_test_info(Testcase,Type,Info),
361 add_test_info(Testcase,result,Type),
362 ignore((getenv('TEE_FILE',Tee),
363 must_det_l_ex((
364 read_file_to_string(Tee,Str,[]),
365 add_test_info(Testcase,out,Str),
366 save_single_testcase(Testcase),
367 nop(kill_junit_tee))))))))))),
368 (TestResult=error(E)-> throw(E) ; true),
369 nb_setarg(1,Answers,1))),
370 Type == passed.
371
372kill_junit_tee:-
373 ignore((getenv('TEE_FILE',Tee),
374 sformat(Exec,'cat /dev/null > ~w',[Tee]),
375 shell(Exec))).
376
377process_test_result(TestResult, G):- TestResult == passed, !, save_info_to(TestResult, why_was_true(G)).
378process_test_result(TestResult, G):- TestResult \== failure,junit_incr(errors), !, save_info_to(TestResult, catch(rtrace(call_u_hook(G)), E, writeln(E))).
379process_test_result(TestResult, G):- !,
380 junit_incr(failures),
381 negate_call(G, Retry),
382 save_info_to(TestResult,
383 (why_was_true(Retry),
384 nop(ftrace(G)))).
385
386
387
388junit_incr(Count):- flag(Count,T,T+1).
389call_u_hook(\+ G):- !, \+ call_u_hook(G).
390call_u_hook(M:( \+ G)):- !, \+ call_u_hook(M:G).
391call_u_hook(G):- current_predicate(call_u/1),!,catch_timeout(call(call,call_u,G)).
392call_u_hook(G):- catch_timeout(G).
393
394mpred_why_hook(P):- current_predicate(call_u/1),!,catch_timeout(call(call,mpred_why,P)).
395
396:- export(why_was_true/1). 397why_was_true((A,B)):- !,why_was_true(A),why_was_true(B).
398why_was_true(P):- 399 catch_timeout(mpred_why_hook(P)),!.
400why_was_true(P):- dmsg_pretty(justfied_true(P)),!.
401
402catch_timeout(P):- tracing,!,call(P).
404catch_timeout(P):- getenv('CMD',X), atom_contains(X,"timeout"),!, call(P). 405catch_timeout(P):- catch(call_with_time_limit(30,w_o_c(P)),E,wdmsg(P->E)).
406
408generate_test_name(G,Name):- source_context_name(SCName), gtn_no_pack(G,GUName), trim_to_size(GUName,-30,GName),
409 (atom_length(GName,0)-> SCName = Name ; sformat(Name,'~w__~w',[SCName,GName])).
410
411find_string(G,String):- sub_term(String,G), string(String), !.
412find_string(G,String):- sub_term(NameL,G),is_list(NameL), maplist(atomic,NameL),atomic_list_concat(NameL,' ',String).
413find_string(G,String):- sub_term(String,G),atom(String),member(Space,[' ','_']),atom_contains(String,Space).
414
415gtn_no_pack(G,''):- \+ callable(G), !.
416gtn_no_pack(baseKB:G,Testcase):- nonvar(G), !, gtn_no_pack(G,Testcase).
417gtn_no_pack(M: G, Name):- nonvar(G), !, gtn_no_pack(G,Name1), sformat(Name,'~w_in_~w',[Name1, M]).
418gtn_no_pack(\+ G, Name):- nonvar(G), !, gtn_no_pack(G,Name1), sformat(Name,'naf_~w',[Name1]).
420gtn_no_pack(G,Name):- \+ compound(G), sformat(Name1,'~w',[G]), !, shorten_and_clean_name(Name1,Name).
421gtn_no_pack(G,Name):- find_string(G,String), !, shorten_and_clean_name(String,Name).
422gtn_no_pack(G,Name):- arg(_,G,A), compound(A), \+ is_list(A), !, gtn_no_pack(A,Name).
423gtn_no_pack(G,Name):- is_list(G), member(E,G),!,gtn_no_pack(E,Name).
424gtn_no_pack(G,Name):- arg(_,G,A), integer(A), !, functor(G,F,_),sformat(Name,'~w_~w',[F,A]).
425gtn_no_pack(G,Name):- arg(_,G,A), atom(A), !, gtn_no_pack(A,Name).
426gtn_no_pack(G,Name):- compound_name_arity(G,F,A),sformat(Name,'~w_~w',[F,A]).
435
436
437
438source_context_name(SCName):-
439 (source_location(_,L); (_='',L=0)), flag(test_number,X,X),
440 sformat(Name,'Test_~4d_Line_~4d',[X,L]),
441 replace_in_string(['_0.'='_'],Name,SCName).
442
443:- module_transparent(pfc_feature/1). 444:- dynamic(pfc_feature/1). 445:- export(pfc_feature/1). 446pfc_feature(test_a_feature).
447
448:- module_transparent(pfc_test_feature/2). 449:- export(pfc_test_feature/2). 450
451pfc_test_feature(Feature,Test):- pfc_feature(Feature)*-> mpred_test(Test) ; junit_incr(skipped).
452
453:- system:import(pfc_feature/1). 454:- system:export(pfc_feature/1). 455:- system:import(pfc_test_feature/2). 456:- system:export(pfc_test_feature/2). 457
458:- baseKB:import(pfc_feature/1). 459:- baseKB:export(pfc_feature/1). 460:- baseKB:import(pfc_test_feature/2). 461:- baseKB:export(pfc_test_feature/2). 462
463
464warn_fail_TODO(G):- dmsg_pretty(:-warn_fail_TODO(G)).
465
466
467
471
476:- create_prolog_flag(logicmoo_message_hook,none,[keep(true),type(term)]). 477
478system:test_src(Src):- (current_prolog_flag(test_src,Src), Src\==[]);j_u:junit_prop(testsuite,file,Src).
479system:is_junit_test:- getenv('JUNIT_PACKAGE',_),!.
481system:is_junit_test_file:- test_src(Src), prolog_load_context(file,Src),!.
482
483skip_warning(T):- \+ callable(T),!,fail.
484skip_warning(informational).
485skip_warning(information).
486skip_warning(debug).
487
488skip_warning(discontiguous).
489skip_warning(query).
490skip_warning(banner).
491skip_warning(silent).
492skip_warning(debug_no_topic).
493skip_warning(break).
494skip_warning(io_warning).
495skip_warning(interrupt).
496skip_warning(statistics).
497skip_warning(editline).
499skip_warning(compiler_warnings).
500skip_warning(T):- \+ compound(T),!,fail.
502skip_warning(C):- compound_name_arguments(C,N,A),member(E,[N|A]),skip_warning(E).
503
504
505with_output_to_tracing(Where,Goal):- \+ tracing,!,with_output_to(Where,Goal).
506with_output_to_tracing(_Where,Goal):- call(Goal).
507
508save_info_to(TestResult,Goal):-
509 with_output_to_tracing(string(S),
510 (fmt(TestResult=info(Goal)),
511 ignore(Goal))), write(S),
512 add_test_info(TestResult,S).
513
514here_dumpST:- !.
515here_dumpST:- dumpST.
516
517add_test_info(Type,Info):- ignore(((get_current_testcase(Testcase), add_test_info(Testcase,Type,Info)))).
518
519get_current_testcase(Testcase):- t_l:mpred_current_testcase(Testcase),!.
520
521get_current_testcase(Testcase):- getenv('FileTestCase',Testcase), add_test_info(testsuite,testcase,Testcase),!.
522get_current_testcase(Testcase):- "suiteTestcase"=Testcase, add_test_info(testsuite,testcase,Testcase),!.
524
525add_test_info(Testcase,Type,Info):- j_u:junit_prop(Testcase,Type,InfoM),Info=@=InfoM,!.
526add_test_info(Testcase,Type,_):- retract(j_u:junit_prop(Testcase,Type,[])),fail.
527add_test_info(Testcase,Type,Info):- assertz(j_u:junit_prop(Testcase,Type,Info)).
528
529
530inform_message_hook(T1,T2,_):- (skip_warning(T1);skip_warning(T2);(\+ thread_self_main)),!.
531inform_message_hook(_,_,_):- \+ current_predicate(dumpST/0),!.
532
533inform_message_hook(compiler_warnings(_,[always(true,var,_),always(false,integer,_),
534 always(false,integer,_),always(true,var,_),always(false,integer,_),always(false,integer,_)]),warning,[]):- !.
535
537
538inform_message_hook(error(existence_error(procedure,'$toplevel':_),_),error,_).
540
541inform_message_hook(T,Type,Term):- atom(Type),
542 memberchk(Type,[error,warning]),!,
543 once((nop(dmsg_pretty(message_hook_type(Type))),dmsg_pretty(message_hook(T,Type,Term)),
544 ignore((source_location(File,Line),dmsg_pretty(source_location(File,Line)))),
545 with_output_to(string(Text),
546 ignore((set_stream(current_output,tty(true)),
547 548 inform_message_to_string(Term,Str),write(Str)))),
549 add_test_info(Type,Text),
550 write(Text),
551 nop(dumpST),
552 nop(dmsg_pretty(message_hook(File:Line:T,Type,Term))))),
553 fail.
554inform_message_hook(T,Type,Term):-
555 ignore(source_location(File,Line)),
556 once((nl,dmsg_pretty(message_hook(T,Type,Term)),nl,
557 add_test_info(Type,{type:Type,info:T,data:Term,src:(File:Line)}),
558 here_dumpST, nl,dmsg_pretty(message_hook(File:Line:T,Type,Term)),nl)),
559 fail.
560
561inform_message_hook(T,Type,Term):- dmsg_pretty(message_hook(T,Type,Term)),here_dumpST,dmsg_pretty(message_hook(T,Type,Term)),!,fail.
562inform_message_hook(_,error,_):- current_prolog_flag(runtime_debug, N),N>2,break.
563inform_message_hook(_,warning,_):- current_prolog_flag(runtime_debug, N),N>2,break.
564
565inform_message_to_string(Term,Str):- catch(message_to_string(Term,Str),_,fail),string(Str),\+ atom_contains(Str,"Unknown message"),!.
566inform_message_to_string(Term,Str):-
567 catch('$messages':actions_to_format(Term, Fmt, Args),_,fail),
568 catch(format(string(Str), Fmt, Args),_,fail),!.
569inform_message_to_string(Term,Str):- format(string(Str), '~q', [Term]),!.
570
572list_test_results:-
573 write('\n<'),writeln('!-- '),
574 575 show_all_junit_suites,
576 write(' -'),writeln('->'),!.
577
578
579show_all_junit_suites:-
580 581 outer_junit((xml_header,writeln('<testsuites>'))),
582 findall(File,j_u:junit_prop(testsuite,file,File),L),list_to_set(L,S),
583 maplist(show_junit_suite,S),
584 outer_junit(writeln('</testsuites>')).
585
586outer_junit(G):- nop(G).
587
588
589system:halt_junit:- j_u:junit_prop(system,halted_junit,true),!.
590system:halt_junit:- asserta(j_u:junit_prop(system,halted_junit,true)),!,
591 592 593 ignore(save_junit_results),
594 ignore(catch(run_junit_tests_at_halt,_,true)).
595
596
597
598:- initialization(retractall(j_u:junit_prop(_,_,_)),prepare_state). 599:- initialization(set_prolog_flag(test_src,[]),prepare_state). 600
601junit_term_expansion(Var , _ ):- notrace(var(Var)),!,fail.
602junit_term_expansion(M:I,M:O):- !, junit_term_expansion(I,O).
603
604junit_term_expansion(_ , _ ):- prolog_load_context(file,Src), \+ j_u:junit_prop(testsuite,file,Src),
605 \+ current_prolog_flag(test_src,Src), !, fail.
606junit_term_expansion( (end_of_file), [] ):- !, test_completed.
607
608junit_term_expansion((:- I),O):- !, junit_dirrective_expansion(I,M), (is_list(M) -> O=M ; O=(:-M)).
609
610junit_dirrective_expansion(I,O):- junit_expansion(junit_dirrective_exp,I,O).
611
612junit_dirrective_exp( I , O ) :- junit_goal_exp(I,O) -> I\=@=O.
613junit_dirrective_exp( listing(X), dmsg(skipped(listing(X))) ):- keep_going.
614junit_dirrective_exp( \+ X, mpred_test( \+ X ) ):- is_junit_test_file.
618junit_dirrective_exp( X, X ):- !.
619
620junit_expansion(_,Var , Var ):- var(Var),!.
621junit_expansion(P,(A,B),(AO,BO)):- !,junit_expansion(P,A,AO),junit_expansion(P,B,BO).
622junit_expansion(P,(A;B),(AO;BO)):- !,junit_expansion(P,A,AO),junit_expansion(P,B,BO).
623junit_expansion(P,M:I,M:O):- !, junit_expansion(P,I,O).
624junit_expansion(P,I,O):-call(P,I,O).
625
626junit_goal_expansion(I,O):- junit_expansion(junit_goal_exp,I,O).
627
628junit_goal_exp( must_ex(A),mpred_test(A)) :- is_junit_test_file.
629junit_goal_exp( sanity(A),mpred_test(A)) :- is_junit_test_file.
630junit_goal_exp( mpred_why(A),mpred_test(A)) :- is_junit_test_file.
631junit_goal_exp( test_boxlog(A),mpred_test(test_boxlog(A))) :- is_junit_test_file.
632
633junit_goal_exp( Break, dmsg(skipped(blocks_on_input,Break))):- blocks_on_input(Break), keep_going.
634junit_goal_exp( Messy, dmsg(skipped(messy_on_output,Messy))):- messy_on_output(Messy), keep_going.
635
636
637
638messy_on_output( cls ).
639messy_on_output( listing ).
640messy_on_output( xlisting(_) ).
641
642blocks_on_input( trace ).
643blocks_on_input( break ).
644blocks_on_input( prolog ).
645
646test_completed_props(warn).
647test_completed_props(warning).
648test_completed_props(error).
649test_completed_props(result).
650
652explain_junit_results:-
653 j_u:junit_prop(S,V,O),
654 once(test_completed_props(V);(fail,term_to_atom(O,Atom), atom_length(Atom,L), L<200)),
655 write_testcase_prop(S,V,O),
656 fail.
657explain_junit_results:- nl, ttyflush.
658
664
666test_completed_exit(_):- ttyflush,fail.
667test_completed_exit(_):- once(system:halt_junit),fail.
668test_completed_exit(_):- ttyflush,fail.
669test_completed_exit(_):- explain_junit_results,fail.
670test_completed_exit(_):- ttyflush,fail.
671test_completed_exit(N):- dmsg_pretty(test_completed_exit(N)),fail.
672test_completed_exit(_):- dumpST,fail.
673test_completed_exit(_):- ttyflush,fail.
674test_completed_exit(_):- current_prolog_flag(test_completed,MGoal), strip_module(MGoal,M,Goal), Goal\=[],
675 Goal\==test_completed, callable(Goal), call(M:Goal).
676
677test_completed_exit(_):- ttyflush,fail.
680test_completed_exit(N):- halt(N).
687test_completed_exit_maybe(N):- test_completed_exit(N).
688
689calc_exit_code(XC):- findall(X,calc_exit_code0(X),List),lists:sum_list(List,XC).
690
691calc_exit_code0(8):- \+ \+ j_u:junit_prop(_,result,failure).
692calc_exit_code0(16):- \+ \+ j_u:junit_prop(_,warning,_).
693calc_exit_code0(32):- once(j_u:junit_prop(_,error,_) ; j_u:junit_prop(_,result,error)).
694calc_exit_code0(64):- \+ j_u:junit_prop(_,result,failure), \+ \+ j_u:junit_prop(_,result,passed).
695
696
697
698:- dynamic(j_u:started_test_completed/0). 699:- volatile(j_u:started_test_completed/0). 700system:test_completed:- j_u:started_test_completed,!.
701system:test_completed:-
702 ignore((asserta(j_u:started_test_completed),logicmoo_test:calc_exit_code(XC),logicmoo_test:test_completed_exit_maybe(XC))).
703
704system:test_repl:- assertz(j_u:junit_prop(need_retake,warn,need_retake)).
705system:test_retake:- system:halt_junit,logicmoo_test:test_completed_exit_maybe(3).
706
707save_junit_results:-
708 \+ \+ j_u:junit_prop(testsuite,file,_),
709 forall(j_u:junit_prop(testsuite,file,File),
710 (with_output_to(string(Text),show_junit_suite_xml(File)),
711 save_to_junit_file(File,Text))),!.
712save_junit_results:- test_src(Named),
713 (with_output_to(string(Text),show_junit_suite_xml(Named)),
714 save_to_junit_file(Named,Text)),!.
715save_junit_results:- wdmsg(unused(no_junit_results)).
716
717show_junit_suite_xml(File):-
718 xml_header,
719 writeln('<testsuites>'),
720 maplist(show_junit_suite,File),
721 writeln('</testsuites>'),!.
722
723
724junit_count(tests).
725junit_count(errors).
726junit_count(skipped).
728junit_count(failures).
729
730
731clear_suite_attribs:- forall(junit_count(F),flag(F,_,0)),
732 retractall(j_u:junit_prop(testsuite,start,_)),
733 get_time(Start),asserta(j_u:junit_prop(testsuite,start,Start)).
734
735get_suite_attribs(SuiteAttribs):-
736 with_output_to(string(SuiteAttribs),
737(( ignore((getenv('JUNIT_PACKAGE',Package), format(' package="~w"', [Package]))),
738 ignore((j_u:junit_prop(testsuite,start,Start),get_time(End),Elapsed is End - Start,format(' time="~3f"',[Elapsed]))),
739 forall((junit_count(F),flag(F,C,C)),format(' ~w="~w"',[F,C]))))).
740
741show_junit_suite(File):-
742 (getenv_safe('JUNIT_SUITE',SuiteName);SuiteName=File),!,
743 get_suite_attribs(SuiteAttribs),
744 format(" <testsuite name=\"~w\" ~w>\n", [SuiteName, SuiteAttribs]),
745 findall(Name,j_u:junit_prop(testsuite,testcase,Name),L),list_to_set(L,S),
746 maplist(show_junit_testcase(File),S),
747 writeln(" </testsuite>"),
748 clear_suite_attribs.
749
750find_issue_with_name(Name,IssueNumber):-
751 issue_labels(Name,Labels),
752 fail, 753 find_issues_by_labels(Labels,[Issue|_]),
754 issue_number(Issue,IssueNumber).
755
756update_issue(IssueNumber,FileName):- throw(todo(update_issue(IssueNumber,FileName))).
757
758create_issue_with_name(Name,FileName,IssueNumber):- nop(really_create_issue_with_name(Name,FileName,IssueNumber)),!.
759
760create_issue_with_name(Name,FileName,IssueNumber):-
761 issue_labels(Name,Labels),
762 dmsg(todo(create_issue_with_name(Name,FileName,Labels))),
763 IssueNumber=find(labels=Labels),!.
764
765
766issue_labels(Name,[Package,ShortClass,TestNum]):-
767 getenv_safe('JUNIT_CLASSNAME',Classname),
768 classname_to_package(Classname,Package,ShortClass),
769 sub_string(Name,1,9,_,TestNum).
770
771
772save_single_testcase(Name):-
773 must_det_l_ex((
774 locally(t_l:dont_shrink,
775 save_single_testcase_shrink(Name,FileName)),
776 nop(((find_issue_with_name(Name,IssueNumber)-> update_issue(IssueNumber,FileName);
777 create_issue_with_name(Name,FileName,_IssueNumber)))),
778 nop(save_single_testcase_shrink(Name,_)),
779 clear_suite_attribs)).
780
:- write('<?'),write('xml version="1.0" '), writeln('encoding="utf-8"?>').
782
783save_single_testcase_shrink(_Name,_FileName):- \+ j_u:junit_prop(testsuite,file,_File),!.
784save_single_testcase_shrink(Name,FileName):-
785 must_det_l_ex((
786 with_output_to(string(Text),
787 (xml_header,
788 must_det_l_ex((
789 j_u:junit_prop(testsuite,file,File),
790 writeln(" <testsuites>"),
791 (getenv_safe('JUNIT_SUITE',SuiteName);SuiteName=File),!,
792 get_suite_attribs(SuiteAttribs),
793 format(" <testsuite name=\"~w\" ~w>\n", [SuiteName, SuiteAttribs]),
794 show_junit_testcase(File,Name),
795 writeln(" </testsuite>"),
796 writeln(" </testsuites>"))))),
797 798 799 800 atomic_list_concat([SuiteName,'-',Name],RSName),
801 save_to_junit_file(RSName,Text,FileName))).
802
803classname_to_package(CN,P,C):- atomic_list_concat(List,'.',CN), append(Left,[C],List),atomic_list_concat(Left,'.',P).
804
808
809shorten_and_clean_name(Name,RSName):- shorten_and_clean_name(Name,-30,RSName),!.
810shorten_and_clean_name(Name,Size,RSName):-
811 ensure_compute_file_link(Name,Name0),
812 replace_in_string(
813 ['https://logicmoo.org:2082/gitlab/logicmoo/'="",
814 'https://gitlab.logicmoo.org/gitlab/logicmoo/'="",
815 '-/blob/'='',
816 '/'='_',
817 '_master_packs_'='_'],Name0,Name1),
818 p_n_atom_filter_var_chars(Name1,Name2),
819 replace_in_string(['_c32_'='_','_c46_'='_','_c64_'='_','___'='__'],Name2,Name3),
820 trim_to_size(Name3,Size,RSName),!.
821
822trim_to_size(SName,-N,RSName):- !, sub_atom(SName,_,N,0,RSName)->true;SName=RSName.
823trim_to_size(SName,N,RSName):- N <0 ,!, NN is -N, trim_to_size(SName,-NN,RSName).
824trim_to_size(SName,N,RSName):- sub_atom(SName,0,N,_,RSName)->true;SName=RSName.
825
826
827clean_away_ansi(DirtyText,CleanText):- atom_codes(DirtyText,Codes),clean_ansi_codes(Codes,CodesC),sformat(CleanText,'~s',[CodesC]),!.
828clean_away_ansi(DirtyText,DirtyText).
829
830 is_control_code(10):-!, fail. is_control_code(13):-!, fail.
831 is_control_code(C):- C < 32. is_control_code(C):- \+ char_type(C,print),!.
832 is_control_code(C):- C>128.
833
834 clean_ansi_codes([],[]).
835 clean_ansi_codes([27,_|Codes],CodesC):- !, clean_ansi_codes(Codes,CodesC).
836 clean_ansi_codes([C|Codes],CodesC):- is_control_code(C),!, clean_ansi_codes(Codes,CodesC).
837 clean_ansi_codes([C|Codes],[C|CodesC]):- clean_ansi_codes(Codes,CodesC).
838
839:- dynamic(j_u:last_saved_junit/1). 840
841save_to_junit_file_text(Full,Text,FullF):- j_u:last_saved_junit(Full),!,
842 flag(Full,X,X+1),
843 atomic_list_concat([Full,'_',X,'-junit.xml'],FullF),
844 format('~N% saving_junit: ~w~n',[FullF]),
845 setup_call_cleanup(open(FullF, write, Out),writeln(Out,Text), close(Out)),!.
846save_to_junit_file_text(Full,Text,FullF):-
847 asserta(j_u:last_saved_junit(Full)),
848 atomic_list_concat([Full,'-junit.xml'],FullF),
849 format('~N% saving_junit: ~w~n',[FullF]),
850 setup_call_cleanup(open(FullF, write, Out),writeln(Out,Text), close(Out)),!.
851
852save_to_junit_file(Name,DirtyText,FileName):-
853 must_det_l_ex((clean_away_ansi(DirtyText,Text),
854 getenv_safe('TEST_STEM_PATH',Dir),!,
855 shorten_and_clean_name(Name,-150,SName),
856 atomic_list_concat([Dir,'-',SName],Full),
857 write_testcase_env(Name),
858 save_to_junit_file_text(Full,Text,FileName))).
859
860
861save_junit_results_single:-
862 863 getenv('TESTING_TEMP',Dir),
864 directory_file_path(Dir,'junit_single.ansi',Full),!,
865 tell(Full),
866 show_all_junit_suites,
867 told, clear_suite_attribs.
868save_junit_results_single.
869
870
871good_type(passed).
872nongood_type(warn).
873nongood_type(error).
874nongood_type(warning).
875nongood_type(failure).
876info_type(T):- \+ good_type(T), \+ nongood_type(T).
877
878suite_to_package(Suite,Package):- shorten_and_clean_name(Suite,Suite0),
879 atomic_list_concat(Split,'/logicmoo_workspace/',Suite0),last(Split,Right),
880 replace_in_string([".pfc"="",".pl"="",'/'='.'],Right,Package),!.
881
882show_junit_testcase(Suite,Testcase):-
883 j_u:junit_prop(Testcase,goal,Goal),
884 (getenv_safe('JUNIT_CLASSNAME',Classname)-> true ; suite_to_package(Suite,Classname)),
885 886 887 888 889 sformat(DisplayName,'~w@~w: ~p',[Classname,Testcase,Goal]),
890 escape_attribute(DisplayName,EDisplayName),
891 ignore((
892 format('\n <testcase name=~q ', [EDisplayName]),
893 894 format('classname="~w" ', [Classname]),
895 ignore((j_u:junit_prop(Testcase,time,Time),format('time="~3f"', [Time]))),
896 writeln('>'),
897 ignore((write_testcase_info(Testcase))),
898 writeln("\n </testcase>"))),!.
899
900write_testcase_env(Name):-
901 write_testcase_prop(name,Name),
902 forall(junit_env_var(N),ignore((getenv_safe(N,V),write_testcase_prop(N,V)))),!.
903
904junit_env_var('JUNIT_CLASSNAME').
908junit_env_var('JUNIT_CMD').
909
910write_testcase_std_info(Testcase):-
911 with_output_to(string(StdErr),
912 (write_testcase_env(Testcase),
913 ignore((j_u:junit_prop(Testcase,out,Str),format('~w',[Str]))),
914 forall(j_u:junit_prop(Testcase,Type,Term), write_testcase_prop(Type,Term)))),
915 shrink_to(StdErr,200,Summary),
916 replace_in_string(['CDATA'='CDAT4'],Summary,SummaryClean),
917 format(" <system-err>~wCD~w[~w]]></system-err>",['<![','ATA',SummaryClean]),!.
918
919write_testcase_prop(S,V,O):- format('~N'), write(S),write_testcase_n_v(V,O), format('~N').
920write_testcase_prop(Type,Term):- format('~N'), write_testcase_n_v(Type,Term), format('~N').
921
922write_testcase_n_v(_Type,[]):-!.
923write_testcase_n_v(info,S):- !, format('~w ',[S]).
924write_testcase_n_v(out,_).
925write_testcase_n_v(url,Term):- !, format('\t~w\t=\t~w ',[url,Term]).
926write_testcase_n_v(Type,Term):- string(Term),!,format('\t~w\t=\t~w ',[Type,Term]).
927write_testcase_n_v(Type,Term):- format('\t~w\t=\t~q. ',[Type,Term]).
928
929:- use_module(library(sgml)). 930escape_attribute(I,O):-xml_quote_attribute(I,O).
931
932
933get_nongood_strings(Testcase,NonGood):-
934 with_output_to(string(NonGood),
935 forall((j_u:junit_prop(Testcase,Type,Term), nongood_type(Type)),
936 format('~N~w = ~q.~n',[Type,Term]))).
937
938write_testcase_info(Testcase):- j_u:junit_prop(Testcase,result,failure),!,
939 get_nongood_strings(Testcase,NonGood),
940 write_message_ele('failure',NonGood),
941 write_testcase_std_info(Testcase),!.
942
943write_testcase_info(Testcase):- \+ j_u:junit_prop(Testcase,result,passed),!,
944 get_nongood_strings(Testcase,NonGood),
945 write_message_ele('error',NonGood),
946 write_testcase_std_info(Testcase),!.
947
948write_testcase_info(Testcase):- write_testcase_std_info(Testcase),!.
949
950write_message_ele(Ele,NonGood):-
951 text_to_string(NonGood,SNonGood),
952 escape_attribute(SNonGood,ENonGood),
953 shrink_to(ENonGood,250,NonGoodTrimmed),
954 format(" <~w message=\"~w\" />\n", [Ele,NonGoodTrimmed]).
955
956:- thread_local(t_l:dont_shrink/0). 957shrink_to(I,_,O):- replace_in_string([' \n'='\n','\t\n'='\n','\n\n\n'='\n\n'],I,O), !. 958shrink_to(I,_,I):- t_l:dont_shrink,!.
959shrink_to(I,Max,O):- \+ sub_string(I,0,Max,_,_),!,I=O.
960shrink_to(I,Mx,O):- replace_in_string([
961 '%%%'='%%','%~'='%','~*/'='*/','/*~'='/*',
962 ' \n'='\n','\t\n'='\n',
963 '\n\n\n'='\n\n',
964 ' '='\t',
965 '==='='=',
966 '\\x1B'=' ','\\[32m'=' ','\\[0m'=' ',
967 ' '=' '],
968 I,M),I\==M,!,shrink_to(M,Mx,O).
969shrink_to(SNonGood,Max,NonGoodTrimmed):- sub_string(SNonGood,_,Max,0,NonGoodTrimmed),!.
970
971
972:- multifile prolog:message//1, user:message_hook/3. 974
975message_hook_dontcare(import_private(_,_),_,_).
976message_hook_dontcare(check(undefined(_, _)),_,_).
977message_hook_dontcare(ignored_weak_import(header_sane,_),_,_).
978message_hook_dontcare(io_warning(_,'Illegal UTF-8 start'),warning,_):- source_location(_,_),!.
979message_hook_dontcare(undefined_export(jpl, _), error, _):- source_location(_,_),!.
980message_hook_dontcare(_, error, _):- source_location(File,4235),atom_concat(_,'/jpl.pl',File),!.
981
982
983message_hook_handle(Term, Kind, Lines):- message_hook_dontcare(Term, Kind, Lines),!.
984message_hook_handle(message_lines(_),error,['~w'-[_]]).
985message_hook_handle(error(resource_error(portray_nesting),_),
986 error, ['Not enough resources: ~w'-[portray_nesting], nl,
987 'In:', nl, '~|~t[~D]~6+ '-[9], '~q'-[_], nl, '~|~t[~D]~6+ '-[64],
988 _-[], nl, nl, 'Note: some frames are missing due to last-call optimization.'-[], nl,
989 'Re-run your program in debug mode (:- debug.) to get more detail.'-[]]).
990message_hook_handle(T,Type,Term):-
991 ((current_prolog_flag(runtime_debug, N),N>2) -> true ; source_location(_,_)),
992 memberchk(Type,[error,warning]),once(inform_message_hook(T,Type,Term)),fail.
993
994:- if( \+ current_prolog_flag(test_completed,_)). 995:- if(set_prolog_flag(test_completed,test_completed)). :- endif. 996:- endif. 998
999:- if(current_predicate(fixup_exports/0)). 1000:- fixup_exports. 1001:- endif. 1002
1003:- system:import(junit_term_expansion/2). 1004:- system:import(junit_goal_expansion/2). 1005
1006:- multifile prolog:message//1, user:message_hook/3. 1007:- dynamic prolog:message//1, user:message_hook/3. 1008:- module_transparent prolog:message//1, user:message_hook/3. 1009
1010user:message_hook(T,Type,Term):-
1011 1012 ((
1013 Type \== silent, Type \== debug, Type \== informational,
1014 current_prolog_flag(logicmoo_message_hook,Was),Was\==none,Was\==false)),
1015 setup_call_cleanup(create_prolog_flag(logicmoo_message_hook,none,[type(term),keep(false)]),
1016 once(catch(message_hook_handle(T,Type,Term),_,fail)),
1017 create_prolog_flag(logicmoo_message_hook,Was,[type(term),keep(false)])),!.
1018
1020
1021system:term_expansion(I,P,O,PO):- ((nonvar(P),is_junit_test, junit_term_expansion(I,O))),P=PO.
1022system:goal_expansion(I,P,O,PO):- notrace((nonvar(P),is_junit_test, junit_goal_expansion(I,O))),P=PO.
1081