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(ordsets), 43 [ord_intersect/2, ord_intersection/3, ord_subtract/3]). 44:- autoload(library(pairs), [group_pairs_by_key/2]). 45:- autoload(library(ansi_term), [ansi_format/3]). 46:- autoload(library(filesex), [directory_file_path/3, make_directory_path/1]). 47:- autoload(library(lists), [append/3]). 48:- autoload(library(option), [option/2, option/3]). 49:- autoload(library(readutil), [read_line_to_string/2]). 50:- use_module(prolog_breakpoints, []). 51 52:- set_prolog_flag(generate_debug_info, false).
82:- meta_predicate
83 show_coverage( ),
84 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
.126show_coverage(Goal) :- 127 show_coverage(Goal, []). 128show_coverage(Goal, Modules) :- 129 maplist(atom, Modules), 130 !, 131 show_coverage(Goal, [modules(Modules)]). 132show_coverage(Goal, Options) :- 133 clean_output(Options), 134 setup_call_cleanup( 135 '$cov_start', 136 once(Goal), 137 cleanup_trace(Options)). 138 139cleanup_trace(Options) :- 140 '$cov_stop', 141 covered(Succeeded, Failed), 142 ( report_hook(Succeeded, Failed) 143 -> true 144 ; file_coverage(Succeeded, Failed, Options) 145 ), 146 '$cov_reset'.
152covered(Succeeded, Failed) :- 153 findall(Cl, ('$cov_data'(clause(Cl), Enter, 0), Enter > 0), Failed0), 154 findall(Cl, ('$cov_data'(clause(Cl), _, Exit), Exit > 0), Succeeded0), 155 sort(Failed0, Failed), 156 sort(Succeeded0, Succeeded). 157 158 159 /******************************* 160 * REPORTING * 161 *******************************/
169file_coverage(Succeeded, Failed, Options) :- 170 format('~N~n~`=t~78|~n'), 171 format('~tCoverage by File~t~78|~n'), 172 format('~`=t~78|~n'), 173 format('~w~t~w~64|~t~w~72|~t~w~78|~n', 174 ['File', 'Clauses', '%Cov', '%Fail']), 175 format('~`=t~78|~n'), 176 forall(source_file(File), 177 file_coverage(File, Succeeded, Failed, Options)), 178 format('~`=t~78|~n'). 179 180file_coverage(File, Succeeded, Failed, Options) :- 181 findall(Cl, clause_source(Cl, File, _), Clauses), 182 sort(Clauses, All), 183 ( ord_intersect(All, Succeeded) 184 -> true 185 ; ord_intersect(All, Failed) 186 ), % Clauses from this file are touched 187 !, 188 ord_intersection(All, Failed, FailedInFile), 189 ord_intersection(All, Succeeded, SucceededInFile), 190 ord_subtract(All, SucceededInFile, UnCov1), 191 ord_subtract(UnCov1, FailedInFile, Uncovered), 192 193 clean_set(All, All_wo_system), 194 clean_set(Uncovered, Uncovered_wo_system), 195 clean_set(FailedInFile, Failed_wo_system), 196 197 length(All_wo_system, AC), 198 length(Uncovered_wo_system, UC), 199 length(Failed_wo_system, FC), 200 201 CP is 100-100*UC/AC, 202 FCP is 100*FC/AC, 203 summary(File, 56, SFile), 204 format('~w~t ~D~64| ~t~1f~72| ~t~1f~78|~n', [SFile, AC, CP, FCP]), 205 ( list_details(File, Options), 206 clean_set(SucceededInFile, Succeeded_wo_system), 207 ord_union(Failed_wo_system, Succeeded_wo_system, Covered) 208 -> detailed_report(Uncovered_wo_system, Covered, File, Options) 209 ; true 210 ). 211file_coverage(_,_,_,_). 212 213clean_set(Clauses, UserClauses) :- 214 exclude(is_pldoc, Clauses, Clauses_wo_pldoc), 215 exclude(is_system_clause, Clauses_wo_pldoc, UserClauses). 216 217is_system_clause(Clause) :- 218 clause_pi(Clause, Name), 219 Name = system:_. 220 221is_pldoc(Clause) :- 222 clause_pi(Clause, _Module:Name2/_Arity), 223 pldoc_predicate(Name2). 224 225pldoc_predicate('$pldoc'). 226pldoc_predicate('$mode'). 227pldoc_predicate('$pred_option'). 228pldoc_predicate('$exported_op'). % not really PlDoc ... 229 230summary(String, MaxLen, Summary) :- 231 string_length(String, Len), 232 ( Len < MaxLen 233 -> Summary = String 234 ; SLen is MaxLen - 5, 235 sub_string(String, _, SLen, 0, End), 236 string_concat('...', End, Summary) 237 ).
243clause_source(Clause, File, Line) :- 244 nonvar(Clause), 245 !, 246 clause_property(Clause, file(File)), 247 clause_property(Clause, line_count(Line)). 248clause_source(Clause, File, Line) :- 249 Pred = _:_, 250 source_file(Pred, File), 251 \+ predicate_property(Pred, multifile), 252 nth_clause(Pred, _Index, Clause), 253 clause_property(Clause, line_count(Line)). 254clause_source(Clause, File, Line) :- 255 Pred = _:_, 256 predicate_property(Pred, multifile), 257 nth_clause(Pred, _Index, Clause), 258 clause_property(Clause, file(File)), 259 clause_property(Clause, line_count(Line)).
263list_details(File, Options) :- 264 option(modules(Modules), Options), 265 source_file_property(File, module(M)), 266 memberchk(M, Modules), 267 !. 268list_details(File, Options) :- 269 ( source_file_property(File, module(M)) 270 -> module_property(M, class(user)) 271 ; true % non-module file must be user file. 272 ), 273 annotate_file(Options). 274 275annotate_file(Options) :- 276 ( option(annotate(true), Options) 277 ; option(dir(_), Options) 278 ; option(ext(_), Options) 279 ), 280 !.
287detailed_report(Uncovered, Covered, File, Options):- 288 annotate_file(Options), 289 !, 290 convlist(line_annotation(File, uncovered), Uncovered, Annot1), 291 convlist(line_annotation(File, covered), Covered, Annot20), 292 flatten(Annot20, Annot2), 293 append(Annot1, Annot2, AnnotationsLen), 294 pairs_keys_values(AnnotationsLen, Annotations, Lens), 295 max_list(Lens, MaxLen), 296 Margin is MaxLen+1, 297 annotate_file(File, Annotations, [margin(Margin)|Options]). 298detailed_report(Uncovered, _, File, _Options):- 299 convlist(uncovered_clause_line(File), Uncovered, Pairs), 300 sort(Pairs, Pairs_sorted), 301 group_pairs_by_key(Pairs_sorted, Compact_pairs), 302 nl, 303 file_base_name(File, Base), 304 format('~2|Clauses not covered from file ~p~n', [Base]), 305 format('~4|Predicate ~59|Clauses at lines ~n', []), 306 maplist(print_clause_line, Compact_pairs), 307 nl. 308 309line_annotation(File, uncovered, Clause, Annotation) :- 310 !, 311 clause_property(Clause, file(File)), 312 clause_property(Clause, line_count(Line)), 313 Annotation = (Line-ansi(error,###))-3. 314line_annotation(File, covered, Clause, [(Line-Annot)-Len|CallSites]) :- 315 clause_property(Clause, file(File)), 316 clause_property(Clause, line_count(Line)), 317 '$cov_data'(clause(Clause), Entered, Exited), 318 counts_annotation(Entered, Exited, Annot, Len), 319 findall(((CSLine-CSAnnot)-CSLen)-PC, 320 clause_call_site_annotation(Clause, PC, CSLine, CSAnnot, CSLen), 321 CallSitesPC), 322 pairs_keys_values(CallSitesPC, CallSites, PCs), 323 check_covered_call_sites(Clause, PCs). 324 325counts_annotation(Entered, Exited, Annot, Len) :- 326 ( Exited == Entered 327 -> format(string(Text), '++~D', [Entered]), 328 Annot = ansi(comment, Text) 329 ; Exited == 0 330 -> format(string(Text), '--~D', [Entered]), 331 Annot = ansi(warning, Text) 332 ; Exited < Entered 333 -> Failed is Entered - Exited, 334 format(string(Text), '+~D-~D', [Exited, Failed]), 335 Annot = ansi(comment, Text) 336 ; format(string(Text), '+~D*~D', [Entered, Exited]), 337 Annot = ansi(fg(cyan), Text) 338 ), 339 string_length(Text, Len). 340 341uncovered_clause_line(File, Clause, Name-Line) :- 342 clause_property(Clause, file(File)), 343 clause_pi(Clause, Name), 344 clause_property(Clause, line_count(Line)).
350clause_pi(Clause, Name) :- 351 clause(Module:, _, Clause), 352 functor(Head,F,A), 353 Name=Module:F/A. 354 355print_clause_line((Module:Name/Arity)-Lines):- 356 term_string(Module:Name, Complete_name), 357 summary(Complete_name, 54, SName), 358 format('~4|~w~t~59|~p~n', [SName/Arity, Lines]). 359 360 361 /******************************* 362 * LINE LEVEL CALL SITES * 363 *******************************/ 364 365clause_call_site_annotation(ClauseRef, NextPC, Line, Annot, Len) :- 366 clause_call_site(ClauseRef, PC-NextPC, Line:_LPos), 367 ( '$cov_data'(call_site(ClauseRef, NextPC, _PI), Entered, Exited) 368 -> counts_annotation(Entered, Exited, Annot, Len) 369 ; '$fetch_vm'(ClauseRef, PC, _, VMI), 370 \+ no_annotate_call_site(VMI) 371 -> Annot = ansi(error, ---), 372 Len = 3 373 ). 374 375no_annotate_call_site(i_enter). 376no_annotate_call_site(i_exit). 377no_annotate_call_site(i_cut). 378 379 380clause_call_site(ClauseRef, PC-NextPC, Pos) :- 381 clause_info(ClauseRef, File, TermPos, _NameOffset), 382 '$break_pc'(ClauseRef, PC, NextPC), 383 '$clause_term_position'(ClauseRef, NextPC, List), 384 catch(prolog_breakpoints:range(List, TermPos, SubPos), E, true), 385 ( var(E) 386 -> arg(1, SubPos, A), 387 file_offset_pos(File, A, Pos) 388 ; print_message(warning, coverage(clause_info(ClauseRef))), 389 fail 390 ). 391 392file_offset_pos(File, A, Line:LPos) :- 393 file_text(File, String), 394 State = start(1, 0), 395 call_nth(sub_string(String, S, _, _, "\n"), NLine), 396 ( S >= A 397 -> !, 398 State = start(Line, SLine), 399 LPos is A-SLine 400 ; NS is S+1, 401 NLine1 is NLine+1, 402 nb_setarg(1, State, NLine1), 403 nb_setarg(2, State, NS), 404 fail 405 ). 406 407file_text(File, String) :- 408 setup_call_cleanup( 409 open(File, read, In), 410 read_string(In, _, String), 411 close(In)). 412 413check_covered_call_sites(Clause, Reported) :- 414 findall(PC, ('$cov_data'(call_site(Clause,PC,_), Enter, _), Enter > 0), Seen), 415 sort(Reported, SReported), 416 sort(Seen, SSeen), 417 ord_subtract(SSeen, SReported, Missed), 418 ( Missed == [] 419 -> true 420 ; print_message(warning, coverage(unreported_call_sites(Clause, Missed))) 421 ). 422 423 424 /******************************* 425 * ANNOTATE * 426 *******************************/ 427 428clean_output(Options) :- 429 option(dir(Dir), Options), 430 !, 431 option(ext(Ext), Options, cov), 432 format(atom(Pattern), '~w/*.~w', [Dir, Ext]), 433 expand_file_name(Pattern, Files), 434 maplist(delete_file, Files). 435clean_output(Options) :- 436 forall(source_file(File), 437 clean_output(File, Options)). 438 439clean_output(File, Options) :- 440 option(ext(Ext), Options, cov), 441 file_name_extension(File, Ext, CovFile), 442 ( exists_file(CovFile) 443 -> E = error(_,_), 444 catch(delete_file(CovFile), E, 445 print_message(warning, E)) 446 ; true 447 ).
LineNo-Annotation
, where Annotation is atomic or a term
Format-Args, optionally embedded in ansi(Code, Annotation)
.456annotate_file(Source, Annotations, Options) :- 457 option(ext(Ext), Options, cov), 458 ( option(dir(Dir), Options) 459 -> file_base_name(Source, Base), 460 file_name_extension(Base, Ext, CovFile), 461 directory_file_path(Dir, CovFile, CovPath), 462 make_directory_path(Dir) 463 ; file_name_extension(Source, Ext, CovPath) 464 ), 465 keysort(Annotations, SortedAnnotations), 466 setup_call_cleanup( 467 open(Source, read, In), 468 setup_call_cleanup( 469 open(CovPath, write, Out), 470 annotate(In, Out, SortedAnnotations, Options), 471 close(Out)), 472 close(In)). 473 474annotate(In, Out, Annotations, Options) :- 475 ( option(color(true), Options, true) 476 -> set_stream(Out, tty(true)) 477 ; true 478 ), 479 annotate(In, Out, Annotations, 0, Options). 480 481annotate(In, Out, Annotations, LineNo0, Options) :- 482 read_line_to_string(In, Line), 483 ( Line == end_of_file 484 -> true 485 ; succ(LineNo0, LineNo), 486 margins(LMargin, CMargin, Options), 487 line_no(LineNo, Out, LMargin), 488 annotations(LineNo, Out, LMargin, Annotations, Annotations1), 489 format(Out, '~t~*|~s~n', [CMargin, Line]), 490 annotate(In, Out, Annotations1, LineNo, Options) 491 ). 492 493annotations(Line, Out, LMargin, [Line-Annot|T0], T) :- 494 !, 495 write_annotation(Out, Annot), 496 ( T0 = [Line-_|_] 497 -> with_output_to(Out, ansi_format(bold, ' \u2bb0~n~t~*|', [LMargin])), 498 annotations(Line, Out, LMargin, T0, T) 499 ; T = T0 500 ). 501annotations(_, _, _, Annots, Annots). 502 503write_annotation(Out, ansi(Code, Fmt-Args)) => 504 with_output_to(Out, ansi_format(Code, Fmt, Args)). 505write_annotation(Out, ansi(Code, Fmt)) => 506 with_output_to(Out, ansi_format(Code, Fmt, [])). 507write_annotation(Out, Fmt-Args) => 508 format(Out, Fmt, Args). 509write_annotation(Out, Fmt) => 510 format(Out, Fmt, []). 511 512line_no(_, _, 0) :- !. 513line_no(Line, Out, LMargin) :- 514 with_output_to(Out, ansi_format(fg(127,127,127), '~t~d ~*|', 515 [Line, LMargin])). 516 517margins(LMargin, Margin, Options) :- 518 option(line_numbers(true), Options, true), 519 !, 520 option(line_number_margin(LMargin), Options, 6), 521 option(margin(AMargin), Options, 4), 522 Margin is LMargin+AMargin. 523margins(0, Margin, Options) :- 524 option(margin(Margin), Options, 4).
538:- multifile 539 report_hook/2. 540 541 542 /******************************* 543 * MESSAGES * 544 *******************************/ 545 546:- multifile 547 prolog:message//1. 548 549prologmessage(coverage(clause_info(ClauseRef))) --> 550 [ 'Inconsistent clause info for '-[] ], 551 clause_msg(ClauseRef). 552prologmessage(coverage(unreported_call_sites(ClauseRef, PCList))) --> 553 [ 'Failed to report call sites for '-[] ], 554 clause_msg(ClauseRef), 555 [ nl, ' Missed at these PC offsets: ~p'-[PCList] ]. 556 557clause_msg(ClauseRef) --> 558 { clause_pi(ClauseRef, PI), 559 clause_property(ClauseRef, file(File)), 560 clause_property(ClauseRef, line_count(Line)) 561 }, 562 [ '~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.