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).   54
   55/** <module> Clause coverage analysis
   56
   57The purpose of this module is to find which part of the program has been
   58used by a certain goal. Usage is defined   in terms of clauses for which
   59the _head unification_ succeeded. For each clause  we count how often it
   60succeeded and how often it  failed.  In   addition  we  track  all _call
   61sites_, creating goal-by-goal annotated clauses.
   62
   63This module relies on the  SWI-Prolog   tracer  hooks. It modifies these
   64hooks and collects the results, after   which  it restores the debugging
   65environment.  This has some limitations:
   66
   67        * The performance degrades significantly (about 10 times)
   68        * It is not possible to use the debugger during coverage analysis
   69        * The cover analysis tool is currently not thread-safe.
   70
   71The result is  represented  as  a   list  of  clause-references.  As the
   72references to clauses of dynamic predicates  cannot be guaranteed, these
   73are omitted from the result.
   74
   75@bug    Relies heavily on SWI-Prolog internals. We have considered using
   76        a meta-interpreter for this purpose, but it is nearly impossible
   77        to do 100% complete meta-interpretation of Prolog.  Example
   78        problem areas include handling cuts in control-structures
   79        and calls from non-interpreted meta-predicates.
   80*/
   81
   82
   83:- meta_predicate
   84    show_coverage(0),
   85    show_coverage(0,+).   86
   87%!  show_coverage(:Goal) is semidet.
   88%!  show_coverage(:Goal, +Options) is semidet.
   89%!  show_coverage(:Goal, +Modules:list(atom)) is semidet.
   90%
   91%   Report on coverage by Goal. Goal is executed as in once/1. Options
   92%   processed:
   93%
   94%     - modules(+Modules)
   95%       Provide a detailed report on Modules. For backwards
   96%       compatibility this is the same as providing a list of
   97%       modules in the second argument.
   98%     - annotate(+Bool)
   99%       Create an annotated file for the detailed results.
  100%       This is implied if the `ext` or `dir` option are
  101%       specified.
  102%     - ext(+Ext)
  103%       Extension to use for the annotated file. Default is
  104%       `.cov`.
  105%     - dir(+Dir)
  106%       Dump the annotations in the given directory.  If not
  107%       given, the annotated files are created in the same
  108%       directory as the source file.   Each clause that is
  109%       related to a physical line in the file is annotated
  110%       with one of:
  111%
  112%         | ###  | Clause was never executed.                       |
  113%         | ++N  | Clause was entered N times and always succeeded  |
  114%         | --N  | Clause was entered N times and never succeeded   |
  115%         | +N-M | Clause has succeeded N times and failed M times  |
  116%         | +N*M | Clause was entered N times and succeeded M times |
  117%
  118%       All _call sites_ are annotated using the same conventions,
  119%       except that `---` is used to annotate subgoals that were
  120%       never called.
  121%     - line_numbers(Boolean)
  122%       If `true` (default), add line numbers to the annotated file.
  123%     - color(Boolean)
  124%       Controls using ANSI escape sequences to color the output
  125%       in the annotated source.  Default is `true`.
  126
  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'.
  148
  149%!  covered(-Succeeded, -Failed) is det.
  150%
  151%   Collect failed and succeeded clauses.
  152
  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                 *******************************/
  163
  164%!  file_coverage(+Succeeded, +Failed, +Options) is det.
  165%
  166%   Write a report on the clauses covered   organised by file to current
  167%   output. Show detailed information about   the  non-coverered clauses
  168%   defined in the modules Modules.
  169
  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    ).
  239
  240
  241%!  clause_source(+Clause, -File, -Line) is det.
  242%!  clause_source(-Clause, +File, -Line) is det.
  243
  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)).
  261
  262%!  list_details(+File, +Options) is semidet.
  263
  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    !.
  282
  283%!  detailed_report(+Uncovered, +Covered, +File:atom, +Options) is det
  284%
  285%   @arg Uncovered is a list of uncovered clauses
  286%   @arg Covered is a list of covered clauses
  287
  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)).
  346
  347%!  clause_pi(+Clause, -Name) is det.
  348%
  349%   Return the clause predicate indicator as Module:Name/Arity.
  350
  351clause_pi(Clause, Name) :-
  352    clause(Module:Head, _, 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    ).
  449
  450
  451%!  annotate_file(+File, +Annotations, +Options) is det.
  452%
  453%   Create  an  annotated  copy  of  File.  Annotations  is  a  list  of
  454%   `LineNo-Annotation`,  where  `Annotation`  is  atomic    or  a  term
  455%   Format-Args,  optionally  embedded   in    ansi(Code,   Annotation).
  456
  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).
  526
  527%!  report_hook(+Succeeded, +Failed) is semidet.
  528%
  529%   This hook is called after the data   collection. It is passed a list
  530%   of objects that have succeeded as  well   as  a list of objects that
  531%   have failed.  The objects are one of
  532%
  533%     - ClauseRef
  534%       The specified clause
  535%     - call_site(ClauseRef, PC, PI)
  536%       A call was make in ClauseRef at the given program counter to
  537%       the predicate indicated by PI.
  538
  539:- multifile
  540    report_hook/2.  541
  542
  543		 /*******************************
  544		 *             MESSAGES		*
  545		 *******************************/
  546
  547:- multifile
  548    prolog:message//1.  549
  550prolog:message(coverage(clause_info(ClauseRef))) -->
  551    [ 'Inconsistent clause info for '-[] ],
  552    clause_msg(ClauseRef).
  553prolog:message(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) ]