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-2023, 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(library(prolog_breakpoints), []).   51
   52:- set_prolog_flag(generate_debug_info, false).   53
   54/** <module> Clause coverage analysis
   55
   56The purpose of this module is to find which part of the program has been
   57used by a certain goal. Usage is defined   in terms of clauses for which
   58the _head unification_ succeeded. For each clause  we count how often it
   59succeeded and how often it  failed.  In   addition  we  track  all _call
   60sites_, creating goal-by-goal annotated clauses.
   61
   62The result is  represented  as  a   list  of  clause-references.  As the
   63references to clauses of dynamic predicates  cannot be guaranteed, these
   64are omitted from the result.
   65
   66Using  show_coverage/2  with  the  option   annotate(true),  implied  by
   67ext(Ext) or dir(Dir), the analysis creates   a  line-by-line copy of the
   68source files that is  annotated  with  how   many  times  this  line was
   69executed and with what  logical  results.   These  annotations  rely  on
   70relating executable code to source  locations   which  is  shared by the
   71source level debugger.  Source  level  rewrites   due  to  term  or goal
   72expansion may harm the results.
   73*/
   74
   75
   76:- meta_predicate
   77    show_coverage(0),
   78    show_coverage(0,+).   79
   80%!  show_coverage(:Goal) is semidet.
   81%!  show_coverage(:Goal, +Options) is semidet.
   82%!  show_coverage(:Goal, +Modules:list(atom)) is semidet.
   83%
   84%   Report on coverage by Goal. Goal is executed as in once/1. Options
   85%   processed:
   86%
   87%     - modules(+Modules)
   88%       Provide a detailed report on Modules. For backwards
   89%       compatibility this is the same as providing a list of
   90%       modules in the second argument.
   91%     - annotate(+Bool)
   92%       Create an annotated file for the detailed results.
   93%       This is implied if the `ext` or `dir` option are
   94%       specified.
   95%     - ext(+Ext)
   96%       Extension to use for the annotated file. Default is
   97%       `.cov`.
   98%     - dir(+Dir)
   99%       Dump the annotations in the given directory.  If not
  100%       given, the annotated files are created in the same
  101%       directory as the source file.   Each clause that is
  102%       related to a physical line in the file is annotated
  103%       with one of:
  104%
  105%         | ###  | Clause was never executed.                       |
  106%         | ++N  | Clause was entered N times and always succeeded  |
  107%         | --N  | Clause was entered N times and never succeeded   |
  108%         | +N-M | Clause has succeeded N times and failed M times  |
  109%         | +N*M | Clause was entered N times and succeeded M times |
  110%
  111%       All _call sites_ are annotated using the same conventions,
  112%       except that `---` is used to annotate subgoals that were
  113%       never called.
  114%     - line_numbers(Boolean)
  115%       If `true` (default), add line numbers to the annotated file.
  116%     - color(Boolean)
  117%       Controls using ANSI escape sequences to color the output
  118%       in the annotated source.  Default is `true`.
  119%
  120%   For example, run a goal and create   annotated  files in a directory
  121%   `cov` using:
  122%
  123%       ?- show_coverage(mygoal, [dir(cov)]).
  124%
  125%   @bug Color annotations are created using   ANSI escape sequences. On
  126%   most systems these are displayed  if  the   file  is  printed on the
  127%   terminal. On most systems `less` may be   used with the ``-r`` flag.
  128%   Alternatively, programs such as `ansi2html` (Linux)   may be used to
  129%   convert the files to HTML. It would  probably be better to integrate
  130%   the output generation with library(pldoc/doc_htmlsrc).
  131
  132show_coverage(Goal) :-
  133    show_coverage(Goal, []).
  134show_coverage(Goal, Modules) :-
  135    maplist(atom, Modules),
  136    !,
  137    show_coverage(Goal, [modules(Modules)]).
  138show_coverage(Goal, Options) :-
  139    clean_output(Options),
  140    setup_call_cleanup(
  141        '$cov_start',
  142        once(Goal),
  143        cleanup_trace(Options)).
  144
  145cleanup_trace(Options) :-
  146    '$cov_stop',
  147    covered(Succeeded, Failed),
  148    (   report_hook(Succeeded, Failed)
  149    ->  true
  150    ;   file_coverage(Succeeded, Failed, Options)
  151    ),
  152    '$cov_reset'.
  153
  154%!  covered(-Succeeded, -Failed) is det.
  155%
  156%   Collect failed and succeeded clauses.
  157
  158covered(Succeeded, Failed) :-
  159    findall(Cl, ('$cov_data'(clause(Cl), Enter, 0), Enter > 0), Failed0),
  160    findall(Cl, ('$cov_data'(clause(Cl), _, Exit), Exit > 0), Succeeded0),
  161    sort(Failed0, Failed),
  162    sort(Succeeded0, Succeeded).
  163
  164
  165                 /*******************************
  166                 *           REPORTING          *
  167                 *******************************/
  168
  169%!  file_coverage(+Succeeded, +Failed, +Options) is det.
  170%
  171%   Write a report on the clauses covered   organised by file to current
  172%   output. Show detailed information about   the  non-coverered clauses
  173%   defined in the modules Modules.
  174
  175file_coverage(Succeeded, Failed, Options) :-
  176    format('~N~n~`=t~78|~n'),
  177    format('~tCoverage by File~t~78|~n'),
  178    format('~`=t~78|~n'),
  179    format('~w~t~w~64|~t~w~72|~t~w~78|~n',
  180           ['File', 'Clauses', '%Cov', '%Fail']),
  181    format('~`=t~78|~n'),
  182    forall(source_file(File),
  183           file_coverage(File, Succeeded, Failed, Options)),
  184    format('~`=t~78|~n').
  185
  186file_coverage(File, Succeeded, Failed, Options) :-
  187    findall(Cl, clause_source(Cl, File, _), Clauses),
  188    sort(Clauses, All),
  189    (   ord_intersect(All, Succeeded)
  190    ->  true
  191    ;   ord_intersect(All, Failed)
  192    ),                                  % Clauses from this file are touched
  193    !,
  194    ord_intersection(All, Failed, FailedInFile),
  195    ord_intersection(All, Succeeded, SucceededInFile),
  196    ord_subtract(All, SucceededInFile, UnCov1),
  197    ord_subtract(UnCov1, FailedInFile, Uncovered),
  198
  199    clean_set(All, All_wo_system),
  200    clean_set(Uncovered, Uncovered_wo_system),
  201    clean_set(FailedInFile, Failed_wo_system),
  202
  203    length(All_wo_system, AC),
  204    length(Uncovered_wo_system, UC),
  205    length(Failed_wo_system, FC),
  206
  207    CP is 100-100*UC/AC,
  208    FCP is 100*FC/AC,
  209    summary(File, 56, SFile),
  210    format('~w~t ~D~64| ~t~1f~72| ~t~1f~78|~n', [SFile, AC, CP, FCP]),
  211    (   list_details(File, Options),
  212        clean_set(SucceededInFile, Succeeded_wo_system),
  213        ord_union(Failed_wo_system, Succeeded_wo_system, Covered)
  214    ->  detailed_report(Uncovered_wo_system, Covered, File, Options)
  215    ;   true
  216    ).
  217file_coverage(_,_,_,_).
  218
  219clean_set(Clauses, UserClauses) :-
  220    exclude(is_pldoc, Clauses, Clauses_wo_pldoc),
  221    exclude(is_system_clause, Clauses_wo_pldoc, UserClauses).
  222
  223is_system_clause(Clause) :-
  224    clause_pi(Clause, Name),
  225    Name = system:_.
  226
  227is_pldoc(Clause) :-
  228    clause_pi(Clause, _Module:Name2/_Arity),
  229    pldoc_predicate(Name2).
  230
  231pldoc_predicate('$pldoc').
  232pldoc_predicate('$mode').
  233pldoc_predicate('$pred_option').
  234pldoc_predicate('$exported_op').        % not really PlDoc ...
  235
  236summary(String, MaxLen, Summary) :-
  237    string_length(String, Len),
  238    (   Len < MaxLen
  239    ->  Summary = String
  240    ;   SLen is MaxLen - 5,
  241        sub_string(String, _, SLen, 0, End),
  242        string_concat('...', End, Summary)
  243    ).
  244
  245
  246%!  clause_source(+Clause, -File, -Line) is semidet.
  247%!  clause_source(-Clause, +File, -Line) is semidet.
  248
  249clause_source(Clause, File, Line) :-
  250    nonvar(Clause),
  251    !,
  252    clause_property(Clause, file(File)),
  253    clause_property(Clause, line_count(Line)).
  254clause_source(Clause, File, Line) :-
  255    Pred = _:_,
  256    source_file(Pred, File),
  257    \+ predicate_property(Pred, multifile),
  258    nth_clause(Pred, _Index, Clause),
  259    clause_property(Clause, line_count(Line)).
  260clause_source(Clause, File, Line) :-
  261    Pred = _:_,
  262    predicate_property(Pred, multifile),
  263    nth_clause(Pred, _Index, Clause),
  264    clause_property(Clause, file(File)),
  265    clause_property(Clause, line_count(Line)).
  266
  267%!  list_details(+File, +Options) is semidet.
  268
  269list_details(File, Options) :-
  270    option(modules(Modules), Options),
  271    source_file_property(File, module(M)),
  272    memberchk(M, Modules),
  273    !.
  274list_details(File, Options) :-
  275    (   source_file_property(File, module(M)),
  276        module_property(M, class(user))
  277    ->  true
  278    ;   forall(source_file_property(File, module(M)),
  279               module_property(M, class(test)))
  280    ),
  281    annotate_file(Options).
  282
  283annotate_file(Options) :-
  284    (   option(annotate(true), Options)
  285    ;   option(dir(_), Options)
  286    ;   option(ext(_), Options)
  287    ),
  288    !.
  289
  290%!  detailed_report(+Uncovered, +Covered, +File:atom, +Options) is det
  291%
  292%   @arg Uncovered is a list of uncovered clauses
  293%   @arg Covered is a list of covered clauses
  294
  295detailed_report(Uncovered, Covered, File, Options):-
  296    annotate_file(Options),
  297    !,
  298    convlist(line_annotation(File, uncovered), Uncovered, Annot1),
  299    convlist(line_annotation(File, covered),   Covered,   Annot20),
  300    flatten(Annot20, Annot2),
  301    append(Annot1, Annot2, AnnotationsLen),
  302    pairs_keys_values(AnnotationsLen, Annotations, Lens),
  303    max_list(Lens, MaxLen),
  304    Margin is MaxLen+1,
  305    annotate_file(File, Annotations, [margin(Margin)|Options]).
  306detailed_report(Uncovered, _, File, _Options):-
  307    convlist(uncovered_clause_line(File), Uncovered, Pairs),
  308    sort(Pairs, Pairs_sorted),
  309    group_pairs_by_key(Pairs_sorted, Compact_pairs),
  310    nl,
  311    file_base_name(File, Base),
  312    format('~2|Clauses not covered from file ~p~n', [Base]),
  313    format('~4|Predicate ~59|Clauses at lines ~n', []),
  314    maplist(print_clause_line, Compact_pairs),
  315    nl.
  316
  317line_annotation(File, uncovered, Clause, Annotation) :-
  318    !,
  319    clause_property(Clause, file(File)),
  320    clause_property(Clause, line_count(Line)),
  321    Annotation = (Line-ansi(error,###))-3.
  322line_annotation(File, covered, Clause, [(Line-Annot)-Len|CallSites]) :-
  323    clause_property(Clause, file(File)),
  324    clause_property(Clause, line_count(Line)),
  325    '$cov_data'(clause(Clause), Entered, Exited),
  326    counts_annotation(Entered, Exited, Annot, Len),
  327    findall(((CSLine-CSAnnot)-CSLen)-PC,
  328            clause_call_site_annotation(Clause, PC, CSLine, CSAnnot, CSLen),
  329            CallSitesPC),
  330    pairs_keys_values(CallSitesPC, CallSites, PCs),
  331    check_covered_call_sites(Clause, PCs).
  332
  333counts_annotation(Entered, Exited, Annot, Len) :-
  334    (   Exited == Entered
  335    ->  format(string(Text), '++~D', [Entered]),
  336        Annot = ansi(comment, Text)
  337    ;   Exited == 0
  338    ->  format(string(Text), '--~D', [Entered]),
  339        Annot = ansi(warning, Text)
  340    ;   Exited < Entered
  341    ->  Failed is Entered - Exited,
  342        format(string(Text), '+~D-~D', [Exited, Failed]),
  343        Annot = ansi(comment, Text)
  344    ;   format(string(Text), '+~D*~D', [Entered, Exited]),
  345        Annot = ansi(fg(cyan), Text)
  346    ),
  347    string_length(Text, Len).
  348
  349uncovered_clause_line(File, Clause, Name-Line) :-
  350    clause_property(Clause, file(File)),
  351    clause_pi(Clause, Name),
  352    clause_property(Clause, line_count(Line)).
  353
  354%!  clause_pi(+Clause, -Name) is det.
  355%
  356%   Return the clause predicate indicator as Module:Name/Arity.
  357
  358clause_pi(Clause, Name) :-
  359    clause(Module:Head, _, Clause),
  360    functor(Head,F,A),
  361    Name=Module:F/A.
  362
  363print_clause_line((Module:Name/Arity)-Lines):-
  364    term_string(Module:Name, Complete_name),
  365    summary(Complete_name, 54, SName),
  366    format('~4|~w~t~59|~p~n', [SName/Arity, Lines]).
  367
  368
  369		 /*******************************
  370		 *     LINE LEVEL CALL SITES	*
  371		 *******************************/
  372
  373clause_call_site_annotation(ClauseRef, NextPC, Line, Annot, Len) :-
  374    clause_call_site(ClauseRef, PC-NextPC, Line:_LPos),
  375    (   '$cov_data'(call_site(ClauseRef, NextPC, _PI), Entered, Exited)
  376    ->  counts_annotation(Entered, Exited, Annot, Len)
  377    ;   '$fetch_vm'(ClauseRef, PC, _, VMI),
  378        \+ no_annotate_call_site(VMI)
  379    ->  Annot = ansi(error, ---),
  380        Len = 3
  381    ).
  382
  383no_annotate_call_site(i_enter).
  384no_annotate_call_site(i_exit).
  385no_annotate_call_site(i_cut).
  386
  387
  388clause_call_site(ClauseRef, PC-NextPC, Pos) :-
  389    clause_info(ClauseRef, File, TermPos, _NameOffset),
  390    '$break_pc'(ClauseRef, PC, NextPC),
  391    '$clause_term_position'(ClauseRef, NextPC, List),
  392    catch(prolog_breakpoints:range(List, TermPos, SubPos), E, true),
  393    (   var(E)
  394    ->  arg(1, SubPos, A),
  395        file_offset_pos(File, A, Pos)
  396    ;   print_message(warning, coverage(clause_info(ClauseRef))),
  397        fail
  398    ).
  399
  400file_offset_pos(File, A, Line:LPos) :-
  401    file_text(File, String),
  402    State = start(1, 0),
  403    call_nth(sub_string(String, S, _, _, "\n"), NLine),
  404    (   S >= A
  405    ->  !,
  406        State = start(Line, SLine),
  407        LPos is A-SLine
  408    ;   NS is S+1,
  409        NLine1 is NLine+1,
  410        nb_setarg(1, State, NLine1),
  411        nb_setarg(2, State, NS),
  412        fail
  413    ).
  414
  415file_text(File, String) :-
  416    setup_call_cleanup(
  417        open(File, read, In),
  418        read_string(In, _, String),
  419        close(In)).
  420
  421check_covered_call_sites(Clause, Reported) :-
  422    findall(PC, ('$cov_data'(call_site(Clause,PC,_), Enter, _), Enter > 0), Seen),
  423    sort(Reported, SReported),
  424    sort(Seen, SSeen),
  425    ord_subtract(SSeen, SReported, Missed),
  426    (   Missed == []
  427    ->  true
  428    ;   print_message(warning, coverage(unreported_call_sites(Clause, Missed)))
  429    ).
  430
  431
  432		 /*******************************
  433		 *           ANNOTATE		*
  434		 *******************************/
  435
  436clean_output(Options) :-
  437    option(dir(Dir), Options),
  438    !,
  439    option(ext(Ext), Options, cov),
  440    format(atom(Pattern), '~w/*.~w', [Dir, Ext]),
  441    expand_file_name(Pattern, Files),
  442    maplist(delete_file, Files).
  443clean_output(Options) :-
  444    forall(source_file(File),
  445           clean_output(File, Options)).
  446
  447clean_output(File, Options) :-
  448    option(ext(Ext), Options, cov),
  449    file_name_extension(File, Ext, CovFile),
  450    (   exists_file(CovFile)
  451    ->  E = error(_,_),
  452        catch(delete_file(CovFile), E,
  453              print_message(warning, E))
  454    ;   true
  455    ).
  456
  457
  458%!  annotate_file(+File, +Annotations, +Options) is det.
  459%
  460%   Create  an  annotated  copy  of  File.  Annotations  is  a  list  of
  461%   `LineNo-Annotation`,  where  `Annotation`  is  atomic    or  a  term
  462%   Format-Args,  optionally  embedded   in    ansi(Code,   Annotation).
  463
  464annotate_file(Source, Annotations, Options) :-
  465    option(ext(Ext), Options, cov),
  466    (   option(dir(Dir), Options)
  467    ->  file_base_name(Source, Base),
  468        file_name_extension(Base, Ext, CovFile),
  469        directory_file_path(Dir, CovFile, CovPath),
  470        make_directory_path(Dir)
  471    ;   file_name_extension(Source, Ext, CovPath)
  472    ),
  473    keysort(Annotations, SortedAnnotations),
  474    setup_call_cleanup(
  475        open(Source, read, In),
  476        setup_call_cleanup(
  477            open(CovPath, write, Out),
  478            annotate(In, Out, SortedAnnotations, Options),
  479            close(Out)),
  480        close(In)).
  481
  482annotate(In, Out, Annotations, Options) :-
  483    (   option(color(true), Options, true)
  484    ->  set_stream(Out, tty(true))
  485    ;   true
  486    ),
  487    annotate(In, Out, Annotations, 0, Options).
  488
  489annotate(In, Out, Annotations, LineNo0, Options) :-
  490    read_line_to_string(In, Line),
  491    (   Line == end_of_file
  492    ->  true
  493    ;   succ(LineNo0, LineNo),
  494        margins(LMargin, CMargin, Options),
  495        line_no(LineNo, Out, LMargin),
  496        annotations(LineNo, Out, LMargin, Annotations, Annotations1),
  497        format(Out, '~t~*|~s~n', [CMargin, Line]),
  498        annotate(In, Out, Annotations1, LineNo, Options)
  499    ).
  500
  501annotations(Line, Out, LMargin, [Line-Annot|T0], T) :-
  502    !,
  503    write_annotation(Out, Annot),
  504    (   T0 = [Line-_|_]
  505    ->  with_output_to(Out, ansi_format(bold, ' \u2bb0~n~t~*|', [LMargin])),
  506        annotations(Line, Out, LMargin, T0, T)
  507    ;   T = T0
  508    ).
  509annotations(_, _, _, Annots, Annots).
  510
  511write_annotation(Out, ansi(Code, Fmt-Args)) =>
  512    with_output_to(Out, ansi_format(Code, Fmt, Args)).
  513write_annotation(Out, ansi(Code, Fmt)) =>
  514    with_output_to(Out, ansi_format(Code, Fmt, [])).
  515write_annotation(Out, Fmt-Args) =>
  516    format(Out, Fmt, Args).
  517write_annotation(Out, Fmt) =>
  518    format(Out, Fmt, []).
  519
  520line_no(_, _, 0) :- !.
  521line_no(Line, Out, LMargin) :-
  522    with_output_to(Out, ansi_format(fg(127,127,127), '~t~d ~*|',
  523                                    [Line, LMargin])).
  524
  525margins(LMargin, Margin, Options) :-
  526    option(line_numbers(true), Options, true),
  527    !,
  528    option(line_number_margin(LMargin), Options, 6),
  529    option(margin(AMargin), Options, 4),
  530    Margin is LMargin+AMargin.
  531margins(0, Margin, Options) :-
  532    option(margin(Margin), Options, 4).
  533
  534%!  report_hook(+Succeeded, +Failed) is semidet.
  535%
  536%   This hook is called after the data   collection. It is passed a list
  537%   of objects that have succeeded as  well   as  a list of objects that
  538%   have failed.  The objects are one of
  539%
  540%     - ClauseRef
  541%       The specified clause
  542%     - call_site(ClauseRef, PC, PI)
  543%       A call was make in ClauseRef at the given program counter to
  544%       the predicate indicated by PI.
  545
  546:- multifile
  547    report_hook/2.  548
  549
  550		 /*******************************
  551		 *             MESSAGES		*
  552		 *******************************/
  553
  554:- multifile
  555    prolog:message//1.  556
  557prolog:message(coverage(clause_info(ClauseRef))) -->
  558    [ 'Inconsistent clause info for '-[] ],
  559    clause_msg(ClauseRef).
  560prolog:message(coverage(unreported_call_sites(ClauseRef, PCList))) -->
  561    [ 'Failed to report call sites for '-[] ],
  562    clause_msg(ClauseRef),
  563    [ nl, '  Missed at these PC offsets: ~p'-[PCList] ].
  564
  565clause_msg(ClauseRef) -->
  566    { clause_pi(ClauseRef, PI),
  567      clause_property(ClauseRef, file(File)),
  568      clause_property(ClauseRef, line_count(Line))
  569    },
  570    [ '~p at'-[PI], nl, '  ', url(File:Line) ]