36
37:- module(prolog_coverage,
38 [ coverage/1, 39 coverage/2, 40 show_coverage/1, 41 show_coverage/2, 42 cov_save_data/2, 43 cov_load_data/2, 44 cov_reset/0, 45 cov_property/1 46 ]). 47:- autoload(library(apply),
48 [exclude/3, maplist/2, convlist/3, maplist/3, maplist/4]). 49:- autoload(library(ordsets), [ord_intersection/3, ord_subtract/3, ord_union/3]). 50:- autoload(library(pairs),
51 [ group_pairs_by_key/2,
52 pairs_keys_values/3,
53 pairs_values/2,
54 map_list_to_pairs/3
55 ]). 56:- autoload(library(ansi_term), [ansi_format/3]). 57:- autoload(library(filesex), [directory_file_path/3, make_directory_path/1]). 58:- autoload(library(lists),
59 [append/3, flatten/2, max_list/2, member/2, append/2, sum_list/2]). 60:- autoload(library(option), [option/2, option/3]). 61:- autoload(library(readutil), [read_line_to_string/2]). 62:- use_module(library(prolog_breakpoints), []). 63:- autoload(library(prolog_clause), [clause_info/4]). 64:- autoload(library(solution_sequences), [call_nth/2, distinct/2]). 65:- use_module(library(debug), [debug/3, assertion/1]). 66:- autoload(library(error), [must_be/2]). 67:- autoload(library(prolog_code), [pi_head/2]). 68:- autoload(library(terms), [mapsubterms/3]). 69
70:- set_prolog_flag(generate_debug_info, false). 71
131
132:- meta_predicate
133 coverage(0),
134 coverage(0,+), 135 show_coverage(:), 136 show_coverage(0,+). 137
138:- predicate_options(show_coverage/1, 1,
139 [ all(boolean),
140 modules(list(atom)),
141 roots(list),
142 annotate(boolean),
143 ext(atom),
144 dir(atom),
145 line_numbers(boolean),
146 color(boolean)
147 ]). 148:- predicate_options(coverage/2, 2,
149 [ show(boolean),
150 pass_to(prolog_coverage:show_coverage/1,1)
151 ]). 152:- predicate_options(cov_save_data/2, 2,
153 [ append(boolean)
154 ]). 155:- predicate_options(cov_load_data/2, 2,
156 [ load(boolean),
157 silent(boolean)
158 ]). 159
160
167
168coverage(Goal) :-
169 setup_call_cleanup(
170 '$cov_start'(Level),
171 cov_run(Goal, Level),
172 '$cov_stop'(Level)).
173
174cov_run(Goal, Level) :-
175 call(Goal),
176 deterministic(Det),
177 ( Det == true
178 -> true
179 ; ( '$cov_stop'(Level)
180 ; '$cov_start'(Level),
181 fail
182 )
183 ).
184
195
196coverage(Goal, Options) :-
197 clean_output(Options),
198 setup_call_cleanup(
199 '$cov_start'(Level),
200 once(Goal),
201 cov_finish(Level, Options)).
202
203show_coverage(Goal, Options) :-
204 print_message(warning, coverage(deprecated(show_coverage/2))),
205 coverage(Goal, Options).
206
207cov_finish(Level, Options) :-
208 option(show(true), Options, true),
209 !,
210 '$cov_stop'(Level),
211 ( Level == 1
212 -> show_coverage(Options),
213 cov_reset
214 ; true
215 ).
216cov_finish(Level, _) :-
217 '$cov_stop'(Level).
218
219
279
280show_coverage(_:Options), is_list(Options) =>
281 covered(Succeeded, Failed),
282 ( report_hook(Succeeded, Failed)
283 -> true
284 ; file_coverage(Succeeded, Failed, Options)
285 ).
286show_coverage(_:Goal), Goal=_:Call, callable(Call) =>
287 print_message(warning, cov_deprecated(show_coverage)),
288 coverage(Goal, []).
289show_coverage(_:Options) =>
290 must_be(list, Options).
291
295
296covered(Succeeded, Failed) :-
297 findall(Cl, ('$cov_data'(clause(Cl), Enter, 0), Enter > 0), Failed0),
298 findall(Cl, ('$cov_data'(clause(Cl), _, Exit), Exit > 0), Succeeded0),
299 sort(Failed0, Failed),
300 sort(Succeeded0, Succeeded).
301
302
303 306
312
313file_coverage(Succeeded, Failed, Options) :-
314 abolish_module_tables(prolog_coverage),
315 findall(File-PrintFile,
316 report_file(File, PrintFile, Succeeded, Failed, Options),
317 Pairs),
318 Pairs \== [],
319 !,
320
321 ( option(width(W0), Options)
322 -> W is max(40, W0)
323 ; pairs_values(Pairs, PrintFiles),
324 maplist(atom_length, PrintFiles, Lengths),
325 max_list(Lengths, Longest),
326 IdealWidth is Longest+21,
327
328 tty_width(Width, Options),
329 W is min(IdealWidth, Width - 2)
330 ),
331 CovCol is W - 6,
332 ClausesCol is CovCol - 6,
333
334 header('Coverage by File', W),
335 ansi_format(bold, '~w~t~w~*|~t~w~*|~t~w~*|~n',
336 ['File', 'Clauses', ClausesCol, '%Cov', CovCol, '%Fail', W]),
337 hr(W),
338 forall(member(File-_, Pairs),
339 file_summary(File, Succeeded, Failed,
340 W, CovCol, ClausesCol,
341 Options)),
342 hr(W),
343
344 ( annotate_files(Options)
345 -> forall(member(File-_, Pairs),
346 file_details(File, Succeeded, Failed, Options)),
347 progress_done('done', [])
348 ; true
349 ).
350file_coverage(_Succeeded, _Failed, _Options) :-
351 print_message(warning, coverage(no_files_to_report)).
352
354
355report_file(File, PrintFile, Succeeded, Failed, Options) :-
356 ( nonvar(File)
357 -> true
358 ; ( source_file(File)
359 ; distinct(File, source_includes(_, File))
360 )
361 ),
362 cov_report_file(File, PrintFile, Options),
363 cov_clause_sets(File, Succeeded, Failed, Sets),
364 \+ ( Sets.failed == [],
365 Sets.succeeded == []
366 ).
367
372
373:- table source_includes/2. 374
375source_includes(Main, Included) :-
376 nonvar(Main),
377 !,
378 source_file_property(Main, includes(File, _Time)),
379 ( Included = File
380 ; source_includes(File, Included)
381 ).
382source_includes(Main, Included) :-
383 nonvar(Included),
384 !,
385 source_file_property(Included, included_in(Parent, _Time)),
386 ( no_included_file(Parent)
387 -> Main = Parent
388 ; source_includes(Main, Parent)
389 ).
390source_includes(Main, Included) :-
391 source_file(Main), 392 source_includes(Main, Included).
393
394main_source(File, Main) :-
395 no_included_file(File),
396 !,
397 Main = File.
398main_source(File, Main) :-
399 source_includes(Main, File).
400
406
407file_summary(File, Succeeded, Failed, W, CovCol, ClausesCol, Options) :-
408 cov_report_file(File, PrintFile, Options),
409 cov_clause_sets(File, Succeeded, Failed, Sets0),
410 \+ ( Sets0.failed == [],
411 Sets0.succeeded == []
412 ),
413 !,
414 deduplicate_clauses(File, Sets0, Sets),
415
416 length(Sets.clauses, AC),
417 length(Sets.uncovered, UC),
418 length(Sets.failed, FC),
419
420 CP is 100-100*UC/AC,
421 FCP is 100*FC/AC,
422 summary(PrintFile, ClausesCol-8, SFile),
423 format('~w ~`.t ~D~*| ~t~1f~*| ~t~1f~*|~n',
424 [SFile, AC, ClausesCol, CP, CovCol, FCP, W]).
425file_summary(_,_,_,_,_,_,_).
426
427file_details(File, Succeeded, Failed, Options) :-
428 cov_report_file(File, _PrintFile, Options),
429 cov_clause_sets(File, Succeeded, Failed, Sets0),
430 \+ ( Sets0.failed == [],
431 Sets0.succeeded == []
432 ),
433 !,
434 deduplicate_clauses(File, Sets0, Sets),
435 ord_union(Sets.failed, Sets.succeeded, Covered),
436 detailed_report(Sets.uncovered, Covered, File, Options).
437file_details(_,_,_,_).
438
440
441cov_clause_sets(File, Succeeded, Failed,
442 #{ clauses: All_wo_system,
443 succeeded: Succeeded_wo_system,
444 failed: Failed_wo_system,
445 uncovered: Uncovered_wo_system
446 }) :-
447 file_clauses(File, FileClauses),
448 ord_intersection(FileClauses, Failed, FailedInFile),
449 ord_intersection(FileClauses, Succeeded, SucceededInFile),
450 ord_subtract(FileClauses, SucceededInFile, UnCov1),
451 ord_subtract(UnCov1, FailedInFile, Uncovered),
452
453 clean_set(FileClauses, All_wo_system),
454 clean_set(SucceededInFile, Succeeded_wo_system),
455 clean_set(FailedInFile, Failed_wo_system),
456 clean_set(Uncovered, Uncovered_wo_system).
457
458clean_set(Clauses, UserClauses) :-
459 exclude(is_pldoc, Clauses, Clauses_wo_pldoc),
460 exclude(is_system_clause, Clauses_wo_pldoc, UserClauses).
461
462is_system_clause(Clause) :-
463 clause_pi(Clause, Name),
464 Name = system:_.
465
466is_pldoc(Clause) :-
467 clause_pi(Clause, _Module:Name2/_Arity),
468 pldoc_predicate(Name2).
469
470pldoc_predicate('$pldoc').
471pldoc_predicate('$mode').
472pldoc_predicate('$pred_option').
473pldoc_predicate('$exported_op'). 474
475summary(String, MaxLen, Summary) :-
476 string_length(String, Len),
477 ( Len < MaxLen
478 -> Summary = String
479 ; SLen is MaxLen - 5,
480 sub_string(String, _, SLen, 0, End),
481 string_concat('...', End, Summary)
482 ).
483
487
488file_clauses(File, Set) :-
489 findall(Cl, clause_source(Cl, File, _), Clauses),
490 sort(Clauses, Set).
491
494
495clause_source(Clause, File, Line) :-
496 nonvar(Clause),
497 !,
498 clause_property(Clause, file(File)),
499 clause_property(Clause, line_count(Line)).
500clause_source(Clause, File, Line) :-
501 clause_in_file(File, File, Clause, Line).
502clause_source(Clause, File, Line) :-
503 source_includes(Main, File),
504 clause_in_file(Main, File, Clause, Line).
505
506clause_in_file(Main, Source, Clause, Line) :-
507 Pred = _:_,
508 source_file(Pred, Main),
509 \+ predicate_property(Pred, multifile),
510 nth_clause(Pred, _Index, Clause),
511 clause_property(Clause, file(Source)),
512 clause_property(Clause, line_count(Line)).
513clause_in_file(_Main, Source, Clause, Line) :-
514 Pred = _:_,
515 predicate_property(Pred, multifile),
516 nth_clause(Pred, _Index, Clause),
517 clause_property(Clause, file(Source)),
518 clause_property(Clause, line_count(Line)).
519
524
525deduplicate_clauses(File, Set, Set) :-
526 no_included_file(File),
527 !.
528deduplicate_clauses(_File, SetIn, SetOut) :-
529 _{clauses:AC, uncovered:UC, failed:FC, succeeded:FS} :< SetIn,
530 clause_duplicates(AC, AC1),
531 clause_duplicates(UC, UC1),
532 clause_duplicates(FC, FC1),
533 clause_duplicates(FS, FS1),
534 exclude(covered_in_some_file(AC1, FC, FS), UC1, UC2),
535 exclude(succeeded_in_some_file(AC1, FS), FC1, FC2),
536 SetOut = SetIn.put(_{clauses:AC1, uncovered:UC2, failed:FC2, succeeded:FS1}).
537
538no_included_file(File) :-
539 source_file(File).
540
549
550clause_duplicates(Clauses, Sets) :-
551 maplist(clause_dedup_data, Clauses, Dedups),
552 sort(2, @=<, Dedups, ByMain), 553 sort(1, @=<, ByMain, ByLine), 554 clause_sets(ByLine, Sets0),
555 sort(Sets0, Sets).
556
557clause_dedup_data(Clause, dd(Line, Main, Clause)) :-
558 clause_property(Clause, line_count(Line)),
559 clause_property(Clause, source(Main)).
560
561clause_sets([], []).
562clause_sets([H|T0], Sets) :-
563 same_line_clauses(H, SameL, T0, T1),
564 same_line_clause_sets([H|SameL], Sets, More),
565 clause_sets(T1, More).
566
567same_line_clauses(CRef, [H|TS], [H|T0], T) :-
568 arg(1, CRef, Line),
569 arg(1, H, Line),
570 !,
571 same_line_clauses(CRef, TS, T0, T).
572same_line_clauses(_, [], L, L).
573
582
583same_line_clause_sets([], Sets, Sets) :-
584 !.
585same_line_clause_sets(SameL, Sets, More) :-
586 map_list_to_pairs(arg(2), SameL, Pairs),
587 group_pairs_by_key(Pairs, ByFile),
588 pairs_values(ByFile, FileSets),
589 \+ member([_,_|_], FileSets),
590 !,
591 maplist(arg(3), SameL, Clauses0),
592 sort(Clauses0, Clauses),
593 Sets = [Clauses|More].
594same_line_clause_sets([H|T0], [Clauses|Sets], More) :-
595 same_clauses(H, Same, T0, T),
596 maplist(arg(3), [H|Same], Clauses0),
597 sort(Clauses0, Clauses),
598 same_line_clause_sets(T, Sets, More).
599
600same_clauses(CRef, [Same|TS], L0, L) :-
601 select(Same, L0, L1),
602 same_clause(CRef, Same),
603 !,
604 same_clauses(CRef, TS, L1, L).
605same_clauses(_, [], L, L).
606
607same_clause(dd(L1, F1, C1), dd(L2, F2, C2)) :-
608 assertion(L1 == L2),
609 F1 \== F2,
610 clause_property(C1, size(Size)),
611 clause_property(C2, size(Size)),
612 clause(Head0, Body1, C1),
613 clause(Head1, Body2, C2),
614 mapsubterms(unqualify, (Head0:-Body1), Clause1),
615 mapsubterms(unqualify, (Head1:-Body2), Clause2),
616 Clause1 =@= Clause2.
617
618unqualify(_:X, X).
619
620covered_in_some_file(AllEQ, Failed, Succeeded, UncoveredSet) :-
621 member(Clause, UncoveredSet),
622 member(EQSet, AllEQ),
623 memberchk(Clause, EQSet),
624 !,
625 member(Cl2, EQSet),
626 ( memberchk(Cl2, Succeeded)
627 ; memberchk(Cl2, Failed)
628 ),
629 !.
630covered_in_some_file(_AllEQ, _Failed, _Succeeded, _UncoveredSet) :-
631 assertion(fail).
632
633succeeded_in_some_file(AllEQ, Succeeded, FailedSet) :-
634 member(Clause, FailedSet),
635 member(EQSet, AllEQ),
636 memberchk(Clause, EQSet),
637 !,
638 member(Cl2, EQSet),
639 memberchk(Cl2, Succeeded),
640 !.
641succeeded_in_some_file(_AllEQ, _Succeeded, _FailedSet) :-
642 assertion(fail).
643
656
657cov_report_file(File, _, _) :-
658 source_file(cov_report_file(_,_,_), File),
659 !,
660 fail. 661cov_report_file(File, File, Options) :-
662 option(all(true), Options),
663 !.
664cov_report_file(File, File, Options) :-
665 option(modules(Modules), Options),
666 file_module(File, M),
667 memberchk(M, Modules),
668 !.
669cov_report_file(File, PrintFile, Options) :-
670 option(roots(Roots), Options),
671 !,
672 must_be(list, Roots),
673 member(Root, Roots),
674 absolute_file_name(Root, Path,
675 [ file_type(directory),
676 solutions(all),
677 file_errors(fail)
678 ]),
679 ensure_slash(Path, Path1),
680 atom_concat(Path1, PrintFile, File),
681 !.
682cov_report_file(File, File, _Options) :-
683 ( file_module(File, M),
684 module_property(M, class(user))
685 -> true
686 ; forall(source_file_property(File, module(M)),
687 module_property(M, class(test)))
688 ).
689
690file_module(File, Module) :-
691 source_file_property(File, module(Module)).
692file_module(File, Module) :-
693 source_includes(Main, File),
694 file_module(Main, Module).
695
696ensure_slash(Path, Path) :-
697 sub_atom(Path, _, _, 0, /),
698 !.
699ensure_slash(Path, Path1) :-
700 atom_concat(Path, /, Path1).
701
703
704annotate_files(Options) :-
705 ( option(annotate(true), Options)
706 ; option(dir(_), Options)
707 ; option(ext(_), Options)
708 ),
709 !.
710
722
723detailed_report(Uncovered, Covered, File, Options):-
724 annotate_files(Options),
725 !,
726 convlist(line_annotation(File, uncovered), Uncovered, Annot1),
727 convlist(line_annotation(File, covered), Covered, Annot20),
728 flatten(Annot20, Annot2),
729 append(Annot1, Annot2, AnnotationsLen),
730 pairs_keys_values(AnnotationsLen, Annotations, Lens),
731 max_list(Lens, MaxLen),
732 Margin is MaxLen+1,
733 annotate_file(File, Annotations, [margin(Margin)|Options]).
734detailed_report(Uncovered, _, File, _Options):-
735 convlist(uncovered_clause_line(File), Uncovered, Pairs),
736 sort(Pairs, Pairs_sorted),
737 group_pairs_by_key(Pairs_sorted, Compact_pairs),
738 nl,
739 file_base_name(File, Base),
740 format('~2|Clauses not covered from file ~p~n', [Base]),
741 format('~4|Predicate ~59|Clauses at lines ~n', []),
742 maplist(print_clause_line, Compact_pairs),
743 nl.
744
745line_annotation(File, uncovered, Clause, Annotation) :-
746 !,
747 clause_or_set_source_location(Clause, File, Line),
748 Annotation = (Line-ansi(error,###))-3.
749line_annotation(File, covered, ClauseOrSet, [HeadAllot|CallSites]) :-
750 clause_or_set_source_location(ClauseOrSet, File, Line),
751 clause_or_set_cov_data(ClauseOrSet, Entered, Exited),
752 line_annotation_msg(line_anot(Line, 0, Entered, Exited), HeadAllot),
753 flatten([ClauseOrSet], Clauses),
754 maplist(clause_call_site_annotations, Clauses, AnnotSets),
755 append(AnnotSets, Annots),
756 join_annots(Annots, Joined),
757 maplist(line_annotation_msg, Joined, CallSites),
758 check_correct_offsets(Clauses, AnnotSets).
759
760clause_or_set_source_location([Clause|_], File, Line) =>
761 clause_property(Clause, file(File)),
762 clause_property(Clause, line_count(Line)).
763clause_or_set_source_location(Clause, File, Line) =>
764 clause_property(Clause, file(File)),
765 clause_property(Clause, line_count(Line)).
766
767clause_or_set_cov_data(Clause, Entered, Exited),
768 blob(Clause, clause) =>
769 '$cov_data'(clause(Clause), Entered, Exited).
770clause_or_set_cov_data(Clauses, Entered, Exited) =>
771 maplist(clause_or_set_cov_data, Clauses, LEntered, LExited),
772 sum_list(LEntered, Entered),
773 sum_list(LExited, Exited).
774
775line_annotation_msg(line_anot(Line, _PC, Entered, Exited), (Line-Annot)-Len) :-
776 ( Exited == Entered
777 -> format(string(Text), '++~D', [Entered]),
778 Annot = ansi(comment, Text)
779 ; Exited == 0
780 -> format(string(Text), '--~D', [Entered]),
781 Annot = ansi(warning, Text)
782 ; Exited < Entered
783 -> Failed is Entered - Exited,
784 format(string(Text), '+~D-~D', [Exited, Failed]),
785 Annot = ansi(comment, Text)
786 ; format(string(Text), '+~D*~D', [Entered, Exited]),
787 Annot = ansi(fg(cyan), Text)
788 ),
789 string_length(Text, Len).
790
791uncovered_clause_line(File, Code, Name-Line) :-
792 clause_or_set_source_location(Clause, File, Line),
793 ( Code = [Clause|_] 794 -> clause_pi(Clause, _:Name)
795 ; clause_pi(Code, Name)
796 ).
797
801
802clause_pi(Clause, Name) :-
803 clause(Module:Head, _, Clause),
804 functor(Head,F,A),
805 Name=Module:F/A.
806
807print_clause_line((Module:Name/Arity)-Lines):-
808 term_string(Module:Name, Complete_name),
809 summary(Complete_name, 54, SName),
810 format('~4|~w~t~59|~p~n', [SName/Arity, Lines]).
811
812
813 816
817join_annots(Annots, Joined) :-
818 sort(2, @=<, Annots, ByPC),
819 join_annots_(ByPC, Joined0),
820 sort(1, @=<, Joined0, Joined).
821
822join_annots_([], []).
823join_annots_([H0|T0], [H|T]) :-
824 sum_annot_counts(H0, H, T0, T1),
825 join_annots_(T1, T).
826
827sum_annot_counts(line_anot(Line, PC, Enter1, Exit1),
828 Final,
829 [line_anot(Line, PC, Enter2, Exit2)|T0],
830 T) :-
831 !,
832 Enter is Enter1 + Enter2,
833 Exit is Exit1 + Exit2,
834 sum_annot_counts(line_anot(Line, PC, Enter, Exit),
835 Final, T0, T).
836sum_annot_counts(Sum, Sum, T, T).
837
841
842clause_call_site_annotations(Clause, Annots) :-
843 findall(Annot,
844 clause_call_site_annotation(Clause, Annot),
845 Annots).
846
847clause_call_site_annotation(ClauseRef,
848 line_anot(Line, NextPC, Entered, Exited)) :-
849 clause_call_site(ClauseRef, PC-NextPC, Line:_LPos),
850 ( '$cov_data'(call_site(ClauseRef, NextPC), Entered, Exited)
851 -> true
852 ; '$fetch_vm'(ClauseRef, PC, _, VMI),
853 \+ no_annotate_call_site(VMI)
854 -> Entered = 0, Exited = 0
855 ).
856
857no_annotate_call_site(i_enter).
858no_annotate_call_site(i_exit).
859no_annotate_call_site(i_cut).
860
861clause_call_site(ClauseRef, PC-NextPC, Pos) :-
862 clause_info(ClauseRef, File, TermPos, _NameOffset),
863 '$break_pc'(ClauseRef, PC, NextPC),
864 '$clause_term_position'(ClauseRef, NextPC, List),
865 catch(prolog_breakpoints:range(List, TermPos, SubPos), E, true),
866 ( var(E)
867 -> arg(1, SubPos, A),
868 file_offset_pos(File, A, Pos)
869 ; print_message(warning, coverage(clause_info(ClauseRef))),
870 fail
871 ).
872
873file_offset_pos(File, A, Line:LPos) :-
874 file_text(File, String),
875 State = start(1, 0),
876 call_nth(sub_string(String, S, _, _, "\n"), NLine),
877 ( S >= A
878 -> !,
879 State = start(Line, SLine),
880 LPos is A-SLine
881 ; NS is S+1,
882 NLine1 is NLine+1,
883 nb_setarg(1, State, NLine1),
884 nb_setarg(2, State, NS),
885 fail
886 ).
887
888file_text(File, String) :-
889 setup_call_cleanup(
890 open(File, read, In),
891 read_string(In, _, String),
892 close(In)).
893
898
899check_correct_offsets([Clause|_], [Annots|_]) :-
900 maplist(arg(2), Annots, PCs),
901 check_covered_call_sites(Clause, PCs).
902
903check_covered_call_sites(Clause, Reported) :-
904 findall(PC, ('$cov_data'(call_site(Clause,PC), Enter, _), Enter > 0), Seen),
905 sort(Reported, SReported),
906 sort(Seen, SSeen),
907 ord_subtract(SSeen, SReported, Missed),
908 ( Missed == []
909 -> true
910 ; print_message(warning, coverage(unreported_call_sites(Clause, Missed)))
911 ).
912
913
914 917
918clean_output(Options) :-
919 option(dir(Dir), Options),
920 !,
921 option(ext(Ext), Options, cov),
922 format(atom(Pattern), '~w/*.~w', [Dir, Ext]),
923 expand_file_name(Pattern, Files),
924 maplist(delete_file, Files).
925clean_output(Options) :-
926 forall(source_file(File),
927 clean_output(File, Options)).
928
929clean_output(File, Options) :-
930 option(ext(Ext), Options, cov),
931 file_name_extension(File, Ext, CovFile),
932 ( exists_file(CovFile)
933 -> E = error(_,_),
934 catch(delete_file(CovFile), E,
935 print_message(warning, E))
936 ; true
937 ).
938
939
945
946annotate_file(Source, Annotations, Options) :-
947 option(ext(Ext), Options, cov),
948 ( option(dir(Dir), Options)
949 -> file_base_name(Source, Base),
950 file_name_extension(Base, Ext, CovFile),
951 directory_file_path(Dir, CovFile, CovPath),
952 make_directory_path(Dir)
953 ; file_name_extension(Source, Ext, CovPath)
954 ),
955 summary(Source, 30, SSource),
956 progress('Annotating ~w in ~w ... ', [SSource,CovPath]),
957 keysort(Annotations, SortedAnnotations),
958 setup_call_cleanup(
959 open(Source, read, In),
960 setup_call_cleanup(
961 open(CovPath, write, Out),
962 annotate(In, Out, SortedAnnotations, Options),
963 close(Out)),
964 close(In)).
965
966annotate(In, Out, Annotations, Options) :-
967 ( option(color(true), Options, true)
968 -> set_stream(Out, tty(true))
969 ; true
970 ),
971 annotate(In, Out, Annotations, 0, Options).
972
973annotate(In, Out, Annotations, LineNo0, Options) :-
974 read_line_to_string(In, Line),
975 ( Line == end_of_file
976 -> true
977 ; succ(LineNo0, LineNo),
978 margins(LMargin, CMargin, Options),
979 line_no(LineNo, Out, LMargin),
980 annotations(LineNo, Out, LMargin, Annotations, Annotations1),
981 format(Out, '~t~*|~s~n', [CMargin, Line]),
982 annotate(In, Out, Annotations1, LineNo, Options)
983 ).
984
985annotations(Line, Out, LMargin, [Line-Annot|T0], T) :-
986 !,
987 write_annotation(Out, Annot),
988 ( T0 = [Line-_|_]
989 -> with_output_to(Out, ansi_format(bold, ' \u2bb0~n~t~*|', [LMargin])),
990 annotations(Line, Out, LMargin, T0, T)
991 ; T = T0
992 ).
993annotations(_, _, _, Annots, Annots).
994
995write_annotation(Out, ansi(Code, Fmt-Args)) =>
996 with_output_to(Out, ansi_format(Code, Fmt, Args)).
997write_annotation(Out, ansi(Code, Fmt)) =>
998 with_output_to(Out, ansi_format(Code, Fmt, [])).
999write_annotation(Out, Fmt-Args) =>
1000 format(Out, Fmt, Args).
1001write_annotation(Out, Fmt) =>
1002 format(Out, Fmt, []).
1003
1004line_no(_, _, 0) :- !.
1005line_no(Line, Out, LMargin) :-
1006 with_output_to(Out, ansi_format(fg(127,127,127), '~t~d ~*|',
1007 [Line, LMargin])).
1008
1009margins(LMargin, Margin, Options) :-
1010 option(line_numbers(true), Options, true),
1011 !,
1012 option(line_number_margin(LMargin), Options, 6),
1013 option(margin(AMargin), Options, 4),
1014 Margin is LMargin+AMargin.
1015margins(0, Margin, Options) :-
1016 option(margin(Margin), Options, 4).
1017
1028
1029:- multifile
1030 report_hook/2. 1031
1032 1035
1055
1056:- thread_local
1057 saved_clause/2. 1058
1059cov_save_data(File, Options) :-
1060 ( option(append(true), Options)
1061 -> Mode = append
1062 ; Mode = write
1063 ),
1064 absolute_file_name(File, Path, [ access(write) ]),
1065 setup_call_cleanup(
1066 open(Path, Mode, Out,
1067 [ encoding(utf8),
1068 lock(exclusive)
1069 ]),
1070 cov_save_to_stream(Out),
1071 ( retractall(saved_clause(_,_)),
1072 close(Out))).
1073
1074cov_save_to_stream(Out) :-
1075 get_time(Now),
1076 format(Out, 'cov_begin_data(~1f).~n', [Now]),
1077 forall('$cov_data'(Site, Enter, Exit),
1078 cov_save_entry(Out, Site, Enter, Exit)),
1079 format(Out, 'cov_end_data.~n', []).
1080
1081:- det(cov_save_entry/4). 1082cov_save_entry(Out, call_site(Clause, PC), Enter, Exit) =>
1083 save_clause(Out, Clause, Ref),
1084 ( nonvar(Ref)
1085 -> format(Out, '~q.~n', [cs(Ref, PC, Enter, Exit)])
1086 ; true
1087 ).
1088cov_save_entry(Out, clause(Clause), Enter, Exit) =>
1089 save_clause(Out, Clause, Ref),
1090 ( nonvar(Ref)
1091 -> format(Out, '~q.~n', [cs(Ref, Enter, Exit)])
1092 ; true
1093 ).
1094
1095save_clause(_Out, Clause, Ref) :-
1096 saved_clause(Clause, Ref),
1097 !.
1098save_clause(Out, Clause, Ref) :-
1099 clause_property(Clause, file(File)),
1100 clause_property(Clause, line_count(Line)),
1101 clause_property(Clause, size(Bytes)),
1102 clause_property(Clause, predicate(PI)),
1103 main_source(File, Main),
1104 source_file_property(Main, load_context(Module, Location, Options)),
1105 nth_clause(_, Nth, Clause),
1106 !,
1107 ( predicate_property(saved_clause(_,_), number_of_clauses(N))
1108 -> Ref is N+1
1109 ; Ref = 1
1110 ),
1111 format(Out, '~q.~n', [cl(PI, Nth, Bytes, Main, File:Line, Module, Location, Options, Ref)]),
1112 assertz(saved_clause(Clause, Ref)).
1113save_clause(_Out, Clause, _Ref) :-
1114 debug(cov(save), 'Could not save clause ~p', [Clause]).
1115
1130
1131:- thread_local
1132 warned/1. 1133
1134cov_load_data(File, Options) :-
1135 absolute_file_name(File, Path, [ access(read) ]),
1136 setup_call_cleanup(
1137 open(Path, read, In, [encoding(utf8)]),
1138 cov_load_data_from_stream(In, Options),
1139 ( retractall(saved_clause(_,_)),
1140 retractall(warned(_)),
1141 close(In))).
1142
1143cov_load_data_from_stream(In, Options) :-
1144 read_term(In, Term, []),
1145 cov_load_data_from_stream(Term, In, Options).
1146
1147cov_load_data_from_stream(end_of_file, _, _) :-
1148 !.
1149cov_load_data_from_stream(Term, In, Options) :-
1150 cov_restore_data(Term, Options),
1151 read_term(In, Term2, []),
1152 cov_load_data_from_stream(Term2, In, Options).
1153
1154cov_restore_data(cov_begin_data(_), _Options) =>
1155 true.
1156cov_restore_data(cl(PI, Nth,
1157 Bytes, Main, File:Line, Module, _Location, LoadOptions,
1158 Ref), Options) =>
1159 ( restore_clause(PI, Nth, Bytes, File, Line, Ref)
1160 -> true
1161 ; source_file(File)
1162 -> warn(File, coverage(source_changed(File, PI)))
1163 ; option(load(true), Options)
1164 -> load_files(Module:Main, [if(not_loaded)|LoadOptions]),
1165 ( restore_clause(PI, Nth, Bytes, File, Line, Ref)
1166 -> true
1167 ; warn(File, coverage(source_changed(File, PI)))
1168 )
1169 ; option(silent(true), Options)
1170 -> true
1171 ; warn(File, coverage(no_source(File)))
1172 ).
1173cov_restore_data(cs(Ref, PC, Enter, Exit), _Options) =>
1174 ( saved_clause(Clause, Ref)
1175 -> '$cov_add'(call_site(Clause, PC), Enter, Exit)
1176 ; true
1177 ).
1178cov_restore_data(cs(Ref, Enter, Exit), _Options) =>
1179 ( saved_clause(Clause, Ref)
1180 -> '$cov_add'(clause(Clause), Enter, Exit)
1181 ; true
1182 ).
1183cov_restore_data(cov_end_data, _Options) =>
1184 retractall(saved_clause(_,_)).
1185
1186restore_clause(PI, _Nth, Bytes, File, Line, Ref) :-
1187 pi_head(PI, Head),
1188 predicate_property(Head, multifile),
1189 !,
1190 ( nth_clause(Head, _, Clause),
1191 clause_property(Clause, file(File)),
1192 clause_property(Clause, line_count(Line)),
1193 clause_property(Clause, size(Bytes))
1194 -> assertz(saved_clause(Clause, Ref))
1195 ; warn(File, coverage(no_multifile_source(File:Line, PI)))
1196 ).
1197restore_clause(PI, Nth, Bytes, File, Line, Ref) :-
1198 pi_head(PI, Head),
1199 ( nth_clause(Head, Nth, Clause)
1200 -> ( clause_property(Clause, file(File)),
1201 clause_property(Clause, line_count(Line)),
1202 clause_property(Clause, size(Bytes))
1203 -> assertz(saved_clause(Clause, Ref))
1204 ; warn(File, coverage(source_changed(File:Line, PI, Nth)))
1205 )
1206 ).
1207
1208warn(Term, _Msg) :-
1209 warned(Term),
1210 !.
1211warn(Term, Msg) :-
1212 assertz(warned(Term)),
1213 print_message(warning, Msg).
1214
1215
1220
1221cov_reset :-
1222 '$cov_reset'.
1223
1224
1233
1234cov_property(active(Level)) :-
1235 '$cov_active'(Level).
1236
1237
1238 1241
1242:- multifile
1243 prolog:message//1. 1244
1245prolog:message(coverage(Msg)) -->
1246 message(Msg).
1247
1248message(no_files_to_report) -->
1249 [ 'No coverage events in selected files'-[] ].
1250message(clause_info(ClauseRef)) -->
1251 [ 'Inconsistent clause info for '-[] ],
1252 clause_msg(ClauseRef).
1253message(unreported_call_sites(ClauseRef, PCList)) -->
1254 [ 'Failed to report call sites for '-[] ],
1255 clause_msg(ClauseRef),
1256 [ nl, ' Missed at these PC offsets: ~p'-[PCList] ].
1257message(source_changed(File, PI)) -->
1258 [ 'Predicate ', ansi(code, '~p', [PI]), ' cannot be found while file ',
1259 url(File), ' is loaded.'
1260 ].
1261message(no_source(File)) -->
1262 [ 'File ', url(File), ' is not loaded. Please re-run with ', nl,
1263 'file loaded or use the ', ansi(code, 'load(true)', []), ' option.'
1264 ].
1265message(no_multifile_source(Location, PI)) -->
1266 [ 'Could not find matching clause for multifile predicate ',
1267 ansi(code, '~p', [PI]), ' at ', url(Location)
1268 ].
1269message(source_changed(File:Line, PI, Nth)) -->
1270 [ '~D-th clause for '-[Nth], ansi(code, '~p', [PI]),
1271 ' cannot be found at ', url(File:Line), '.'
1272 ].
1273message(deprecated(show_coverage/2)) -->
1274 [ 'show_coverage/2 is deprecated. Please use coverage/2', nl,
1275 'with the same arguments.'
1276 ].
1277
1278
1279clause_msg(ClauseRef) -->
1280 { clause_pi(ClauseRef, PI),
1281 clause_property(ClauseRef, file(File)),
1282 clause_property(ClauseRef, line_count(Line))
1283 },
1284 [ '~p at'-[PI], nl, ' ', url(File:Line) ].
1285
1286
1287 1290
1291progress(_, _) :-
1292 current_prolog_flag(verbose, silent),
1293 !.
1294progress(Format, Args) :-
1295 stream_property(user_output, tty(true)),
1296 !,
1297 format(user_output, '\r\e[2K', []),
1298 ansi_format(comment, Format, Args),
1299 flush_output(user_output).
1300progress(Format, Args) :-
1301 format(Format, Args),
1302 nl.
1303
1304progress_done(_,_) :-
1305 current_prolog_flag(verbose, silent),
1306 !.
1307progress_done(Format, Args) :-
1308 stream_property(user_output, tty(true)),
1309 !,
1310 ansi_format(comment, Format, Args),
1311 nl.
1312progress_done(_, _).
1313
(Title, Width) :-
1315 hr(Width),
1316 ansi_format([bold], '~t~w~t~*|', [Title,Width]),
1317 nl.
1318
1319hr(Width) :-
1320 format('~N~`\u2015t~*|~n', [Width]).
1321
1323
1324tty_width(W, Options) :-
1325 option(width(W), Options),
1326 !.
1327:- if(current_predicate(tty_size/2)). 1328tty_width(W, _Options) :-
1329 catch(tty_size(_, TtyW), _, fail),
1330 !,
1331 W is max(60, TtyW).
1332:- endif. 1333tty_width(78, _)