1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: J.Wielemaker@vu.nl 5 WWW: https://www.swi-prolog.org 6 Copyright (c) 2006-2022, University of Amsterdam 7 VU University Amsterdam 8 SWI-Prolog Solutions b.v. 9 All rights reserved. 10 11 Redistribution and use in source and binary forms, with or without 12 modification, are permitted provided that the following conditions 13 are met: 14 15 1. Redistributions of source code must retain the above copyright 16 notice, this list of conditions and the following disclaimer. 17 18 2. Redistributions in binary form must reproduce the above copyright 19 notice, this list of conditions and the following disclaimer in 20 the documentation and/or other materials provided with the 21 distribution. 22 23 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 24 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 25 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 26 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 27 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 28 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 29 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 30 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 31 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 32 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 33 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 34 POSSIBILITY OF SUCH DAMAGE. 35*/ 36 37:- module(prolog_cover, 38 [ show_coverage/1, % :Goal 39 show_coverage/2 % :Goal, +Modules 40 ]). 41:- autoload(library(apply), [exclude/3, maplist/2, convlist/3]). 42:- autoload(library(edinburgh), [nodebug/0]). 43:- autoload(library(ordsets), 44 [ord_intersect/2, ord_intersection/3, ord_subtract/3]). 45:- autoload(library(pairs), [group_pairs_by_key/2]). 46:- autoload(library(ansi_term), [ansi_format/3]). 47:- autoload(library(filesex), [directory_file_path/3, make_directory_path/1]). 48:- autoload(library(lists), [append/3]). 49:- autoload(library(option), [option/2, option/3]). 50:- autoload(library(readutil), [read_line_to_string/2]). 51:- use_module(prolog_breakpoints, []). 52 53:- set_prolog_flag(generate_debug_info, false).
83:- meta_predicate
84 show_coverage( ),
85 show_coverage( , ).
ext
or dir
option are
specified.### | Clause was never executed. |
++N | Clause was entered N times and always succeeded |
--N | Clause was entered N times and never succeeded |
+N-M | Clause has succeeded N times and failed M times |
+N*M | Clause was entered N times and succeeded M times |
All call sites are annotated using the same conventions,
except that ---
is used to annotate subgoals that were
never called.
true
(default), add line numbers to the annotated file.true
.127show_coverage(Goal) :- 128 show_coverage(Goal, []). 129show_coverage(Goal, Modules) :- 130 maplist(atom, Modules), 131 !, 132 show_coverage(Goal, [modules(Modules)]). 133show_coverage(Goal, Options) :- 134 clean_output(Options), 135 setup_call_cleanup( 136 '$cov_start', 137 once(Goal), 138 cleanup_trace(Options)). 139 140cleanup_trace(Options) :- 141 '$cov_stop', 142 covered(Succeeded, Failed), 143 ( report_hook(Succeeded, Failed) 144 -> true 145 ; file_coverage(Succeeded, Failed, Options) 146 ), 147 '$cov_reset'.
153covered(Succeeded, Failed) :- 154 findall(Cl, ('$cov_data'(clause(Cl), Enter, 0), Enter > 0), Failed0), 155 findall(Cl, ('$cov_data'(clause(Cl), _, Exit), Exit > 0), Succeeded0), 156 sort(Failed0, Failed), 157 sort(Succeeded0, Succeeded). 158 159 160 /******************************* 161 * REPORTING * 162 *******************************/
170file_coverage(Succeeded, Failed, Options) :- 171 format('~N~n~`=t~78|~n'), 172 format('~tCoverage by File~t~78|~n'), 173 format('~`=t~78|~n'), 174 format('~w~t~w~64|~t~w~72|~t~w~78|~n', 175 ['File', 'Clauses', '%Cov', '%Fail']), 176 format('~`=t~78|~n'), 177 forall(source_file(File), 178 file_coverage(File, Succeeded, Failed, Options)), 179 format('~`=t~78|~n'). 180 181file_coverage(File, Succeeded, Failed, Options) :- 182 findall(Cl, clause_source(Cl, File, _), Clauses), 183 sort(Clauses, All), 184 ( ord_intersect(All, Succeeded) 185 -> true 186 ; ord_intersect(All, Failed) 187 ), % Clauses from this file are touched 188 !, 189 ord_intersection(All, Failed, FailedInFile), 190 ord_intersection(All, Succeeded, SucceededInFile), 191 ord_subtract(All, SucceededInFile, UnCov1), 192 ord_subtract(UnCov1, FailedInFile, Uncovered), 193 194 clean_set(All, All_wo_system), 195 clean_set(Uncovered, Uncovered_wo_system), 196 clean_set(FailedInFile, Failed_wo_system), 197 198 length(All_wo_system, AC), 199 length(Uncovered_wo_system, UC), 200 length(Failed_wo_system, FC), 201 202 CP is 100-100*UC/AC, 203 FCP is 100*FC/AC, 204 summary(File, 56, SFile), 205 format('~w~t ~D~64| ~t~1f~72| ~t~1f~78|~n', [SFile, AC, CP, FCP]), 206 ( list_details(File, Options), 207 clean_set(SucceededInFile, Succeeded_wo_system), 208 ord_union(Failed_wo_system, Succeeded_wo_system, Covered) 209 -> detailed_report(Uncovered_wo_system, Covered, File, Options) 210 ; true 211 ). 212file_coverage(_,_,_,_). 213 214clean_set(Clauses, UserClauses) :- 215 exclude(is_pldoc, Clauses, Clauses_wo_pldoc), 216 exclude(is_system_clause, Clauses_wo_pldoc, UserClauses). 217 218is_system_clause(Clause) :- 219 clause_pi(Clause, Name), 220 Name = system:_. 221 222is_pldoc(Clause) :- 223 clause_pi(Clause, _Module:Name2/_Arity), 224 pldoc_predicate(Name2). 225 226pldoc_predicate('$pldoc'). 227pldoc_predicate('$mode'). 228pldoc_predicate('$pred_option'). 229pldoc_predicate('$exported_op'). % not really PlDoc ... 230 231summary(String, MaxLen, Summary) :- 232 string_length(String, Len), 233 ( Len < MaxLen 234 -> Summary = String 235 ; SLen is MaxLen - 5, 236 sub_string(String, _, SLen, 0, End), 237 string_concat('...', End, Summary) 238 ).
244clause_source(Clause, File, Line) :- 245 nonvar(Clause), 246 !, 247 clause_property(Clause, file(File)), 248 clause_property(Clause, line_count(Line)). 249clause_source(Clause, File, Line) :- 250 Pred = _:_, 251 source_file(Pred, File), 252 \+ predicate_property(Pred, multifile), 253 nth_clause(Pred, _Index, Clause), 254 clause_property(Clause, line_count(Line)). 255clause_source(Clause, File, Line) :- 256 Pred = _:_, 257 predicate_property(Pred, multifile), 258 nth_clause(Pred, _Index, Clause), 259 clause_property(Clause, file(File)), 260 clause_property(Clause, line_count(Line)).
264list_details(File, Options) :- 265 option(modules(Modules), Options), 266 source_file_property(File, module(M)), 267 memberchk(M, Modules), 268 !. 269list_details(File, Options) :- 270 ( source_file_property(File, module(M)) 271 -> module_property(M, class(user)) 272 ; true % non-module file must be user file. 273 ), 274 annotate_file(Options). 275 276annotate_file(Options) :- 277 ( option(annotate(true), Options) 278 ; option(dir(_), Options) 279 ; option(ext(_), Options) 280 ), 281 !.
288detailed_report(Uncovered, Covered, File, Options):- 289 annotate_file(Options), 290 !, 291 convlist(line_annotation(File, uncovered), Uncovered, Annot1), 292 convlist(line_annotation(File, covered), Covered, Annot20), 293 flatten(Annot20, Annot2), 294 append(Annot1, Annot2, AnnotationsLen), 295 pairs_keys_values(AnnotationsLen, Annotations, Lens), 296 max_list(Lens, MaxLen), 297 Margin is MaxLen+1, 298 annotate_file(File, Annotations, [margin(Margin)|Options]). 299detailed_report(Uncovered, _, File, _Options):- 300 convlist(uncovered_clause_line(File), Uncovered, Pairs), 301 sort(Pairs, Pairs_sorted), 302 group_pairs_by_key(Pairs_sorted, Compact_pairs), 303 nl, 304 file_base_name(File, Base), 305 format('~2|Clauses not covered from file ~p~n', [Base]), 306 format('~4|Predicate ~59|Clauses at lines ~n', []), 307 maplist(print_clause_line, Compact_pairs), 308 nl. 309 310line_annotation(File, uncovered, Clause, Annotation) :- 311 !, 312 clause_property(Clause, file(File)), 313 clause_property(Clause, line_count(Line)), 314 Annotation = (Line-ansi(error,###))-3. 315line_annotation(File, covered, Clause, [(Line-Annot)-Len|CallSites]) :- 316 clause_property(Clause, file(File)), 317 clause_property(Clause, line_count(Line)), 318 '$cov_data'(clause(Clause), Entered, Exited), 319 counts_annotation(Entered, Exited, Annot, Len), 320 findall(((CSLine-CSAnnot)-CSLen)-PC, 321 clause_call_site_annotation(Clause, PC, CSLine, CSAnnot, CSLen), 322 CallSitesPC), 323 pairs_keys_values(CallSitesPC, CallSites, PCs), 324 check_covered_call_sites(Clause, PCs). 325 326counts_annotation(Entered, Exited, Annot, Len) :- 327 ( Exited == Entered 328 -> format(string(Text), '++~D', [Entered]), 329 Annot = ansi(comment, Text) 330 ; Exited == 0 331 -> format(string(Text), '--~D', [Entered]), 332 Annot = ansi(warning, Text) 333 ; Exited < Entered 334 -> Failed is Entered - Exited, 335 format(string(Text), '+~D-~D', [Exited, Failed]), 336 Annot = ansi(comment, Text) 337 ; format(string(Text), '+~D*~D', [Entered, Exited]), 338 Annot = ansi(fg(cyan), Text) 339 ), 340 string_length(Text, Len). 341 342uncovered_clause_line(File, Clause, Name-Line) :- 343 clause_property(Clause, file(File)), 344 clause_pi(Clause, Name), 345 clause_property(Clause, line_count(Line)).
351clause_pi(Clause, Name) :- 352 clause(Module:, _, Clause), 353 functor(Head,F,A), 354 Name=Module:F/A. 355 356print_clause_line((Module:Name/Arity)-Lines):- 357 term_string(Module:Name, Complete_name), 358 summary(Complete_name, 54, SName), 359 format('~4|~w~t~59|~p~n', [SName/Arity, Lines]). 360 361 362 /******************************* 363 * LINE LEVEL CALL SITES * 364 *******************************/ 365 366clause_call_site_annotation(ClauseRef, NextPC, Line, Annot, Len) :- 367 clause_call_site(ClauseRef, PC-NextPC, Line:_LPos), 368 ( '$cov_data'(call_site(ClauseRef, NextPC, _PI), Entered, Exited) 369 -> counts_annotation(Entered, Exited, Annot, Len) 370 ; '$fetch_vm'(ClauseRef, PC, _, VMI), 371 \+ no_annotate_call_site(VMI) 372 -> Annot = ansi(error, ---), 373 Len = 3 374 ). 375 376no_annotate_call_site(i_enter). 377no_annotate_call_site(i_exit). 378no_annotate_call_site(i_cut). 379 380 381clause_call_site(ClauseRef, PC-NextPC, Pos) :- 382 clause_info(ClauseRef, File, TermPos, _NameOffset), 383 '$break_pc'(ClauseRef, PC, NextPC), 384 '$clause_term_position'(ClauseRef, NextPC, List), 385 catch(prolog_breakpoints:range(List, TermPos, SubPos), E, true), 386 ( var(E) 387 -> arg(1, SubPos, A), 388 file_offset_pos(File, A, Pos) 389 ; print_message(warning, coverage(clause_info(ClauseRef))), 390 fail 391 ). 392 393file_offset_pos(File, A, Line:LPos) :- 394 file_text(File, String), 395 State = start(1, 0), 396 call_nth(sub_string(String, S, _, _, "\n"), NLine), 397 ( S >= A 398 -> !, 399 State = start(Line, SLine), 400 LPos is A-SLine 401 ; NS is S+1, 402 NLine1 is NLine+1, 403 nb_setarg(1, State, NLine1), 404 nb_setarg(2, State, NS), 405 fail 406 ). 407 408file_text(File, String) :- 409 setup_call_cleanup( 410 open(File, read, In), 411 read_string(In, _, String), 412 close(In)). 413 414check_covered_call_sites(Clause, Reported) :- 415 findall(PC, ('$cov_data'(call_site(Clause,PC,_), Enter, _), Enter > 0), Seen), 416 sort(Reported, SReported), 417 sort(Seen, SSeen), 418 ord_subtract(SSeen, SReported, Missed), 419 ( Missed == [] 420 -> true 421 ; print_message(warning, coverage(unreported_call_sites(Clause, Missed))) 422 ). 423 424 425 /******************************* 426 * ANNOTATE * 427 *******************************/ 428 429clean_output(Options) :- 430 option(dir(Dir), Options), 431 !, 432 option(ext(Ext), Options, cov), 433 format(atom(Pattern), '~w/*.~w', [Dir, Ext]), 434 expand_file_name(Pattern, Files), 435 maplist(delete_file, Files). 436clean_output(Options) :- 437 forall(source_file(File), 438 clean_output(File, Options)). 439 440clean_output(File, Options) :- 441 option(ext(Ext), Options, cov), 442 file_name_extension(File, Ext, CovFile), 443 ( exists_file(CovFile) 444 -> E = error(_,_), 445 catch(delete_file(CovFile), E, 446 print_message(warning, E)) 447 ; true 448 ).
LineNo-Annotation
, where Annotation is atomic or a term
Format-Args, optionally embedded in ansi(Code, Annotation)
.457annotate_file(Source, Annotations, Options) :- 458 option(ext(Ext), Options, cov), 459 ( option(dir(Dir), Options) 460 -> file_base_name(Source, Base), 461 file_name_extension(Base, Ext, CovFile), 462 directory_file_path(Dir, CovFile, CovPath), 463 make_directory_path(Dir) 464 ; file_name_extension(Source, Ext, CovPath) 465 ), 466 keysort(Annotations, SortedAnnotations), 467 setup_call_cleanup( 468 open(Source, read, In), 469 setup_call_cleanup( 470 open(CovPath, write, Out), 471 annotate(In, Out, SortedAnnotations, Options), 472 close(Out)), 473 close(In)). 474 475annotate(In, Out, Annotations, Options) :- 476 ( option(color(true), Options, true) 477 -> set_stream(Out, tty(true)) 478 ; true 479 ), 480 annotate(In, Out, Annotations, 0, Options). 481 482annotate(In, Out, Annotations, LineNo0, Options) :- 483 read_line_to_string(In, Line), 484 ( Line == end_of_file 485 -> true 486 ; succ(LineNo0, LineNo), 487 margins(LMargin, CMargin, Options), 488 line_no(LineNo, Out, LMargin), 489 annotations(LineNo, Out, LMargin, Annotations, Annotations1), 490 format(Out, '~t~*|~s~n', [CMargin, Line]), 491 annotate(In, Out, Annotations1, LineNo, Options) 492 ). 493 494annotations(Line, Out, LMargin, [Line-Annot|T0], T) :- 495 !, 496 write_annotation(Out, Annot), 497 ( T0 = [Line-_|_] 498 -> with_output_to(Out, ansi_format(bold, ' \u2bb0~n~t~*|', [LMargin])), 499 annotations(Line, Out, LMargin, T0, T) 500 ; T = T0 501 ). 502annotations(_, _, _, Annots, Annots). 503 504write_annotation(Out, ansi(Code, Fmt-Args)) => 505 with_output_to(Out, ansi_format(Code, Fmt, Args)). 506write_annotation(Out, ansi(Code, Fmt)) => 507 with_output_to(Out, ansi_format(Code, Fmt, [])). 508write_annotation(Out, Fmt-Args) => 509 format(Out, Fmt, Args). 510write_annotation(Out, Fmt) => 511 format(Out, Fmt, []). 512 513line_no(_, _, 0) :- !. 514line_no(Line, Out, LMargin) :- 515 with_output_to(Out, ansi_format(fg(127,127,127), '~t~d ~*|', 516 [Line, LMargin])). 517 518margins(LMargin, Margin, Options) :- 519 option(line_numbers(true), Options, true), 520 !, 521 option(line_number_margin(LMargin), Options, 6), 522 option(margin(AMargin), Options, 4), 523 Margin is LMargin+AMargin. 524margins(0, Margin, Options) :- 525 option(margin(Margin), Options, 4).
539:- multifile 540 report_hook/2. 541 542 543 /******************************* 544 * MESSAGES * 545 *******************************/ 546 547:- multifile 548 prolog:message//1. 549 550prologmessage(coverage(clause_info(ClauseRef))) --> 551 [ 'Inconsistent clause info for '-[] ], 552 clause_msg(ClauseRef). 553prologmessage(coverage(unreported_call_sites(ClauseRef, PCList))) --> 554 [ 'Failed to report call sites for '-[] ], 555 clause_msg(ClauseRef), 556 [ nl, ' Missed at these PC offsets: ~p'-[PCList] ]. 557 558clause_msg(ClauseRef) --> 559 { clause_pi(ClauseRef, PI), 560 clause_property(ClauseRef, file(File)), 561 clause_property(ClauseRef, line_count(Line)) 562 }, 563 [ '~p at'-[PI], nl, ' ', url(File:Line) ]
Clause coverage analysis
The purpose of this module is to find which part of the program has been used by a certain goal. Usage is defined in terms of clauses for which the head unification succeeded. For each clause we count how often it succeeded and how often it failed. In addition we track all call sites, creating goal-by-goal annotated clauses.
This module relies on the SWI-Prolog tracer hooks. It modifies these hooks and collects the results, after which it restores the debugging environment. This has some limitations:
The result is represented as a list of clause-references. As the references to clauses of dynamic predicates cannot be guaranteed, these are omitted from the result.