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).   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
   62This module relies on the  SWI-Prolog   tracer  hooks. It modifies these
   63hooks and collects the results, after   which  it restores the debugging
   64environment.  This has some limitations:
   65
   66        * The performance degrades significantly (about 10 times)
   67        * It is not possible to use the debugger during coverage analysis
   68        * The cover analysis tool is currently not thread-safe.
   69
   70The result is  represented  as  a   list  of  clause-references.  As the
   71references to clauses of dynamic predicates  cannot be guaranteed, these
   72are omitted from the result.
   73
   74@bug    Relies heavily on SWI-Prolog internals. We have considered using
   75        a meta-interpreter for this purpose, but it is nearly impossible
   76        to do 100% complete meta-interpretation of Prolog.  Example
   77        problem areas include handling cuts in control-structures
   78        and calls from non-interpreted meta-predicates.
   79*/
   80
   81
   82:- meta_predicate
   83    show_coverage(0),
   84    show_coverage(0,+).   85
   86%!  show_coverage(:Goal) is semidet.
   87%!  show_coverage(:Goal, +Options) is semidet.
   88%!  show_coverage(:Goal, +Modules:list(atom)) is semidet.
   89%
   90%   Report on coverage by Goal. Goal is executed as in once/1. Options
   91%   processed:
   92%
   93%     - modules(+Modules)
   94%       Provide a detailed report on Modules. For backwards
   95%       compatibility this is the same as providing a list of
   96%       modules in the second argument.
   97%     - annotate(+Bool)
   98%       Create an annotated file for the detailed results.
   99%       This is implied if the `ext` or `dir` option are
  100%       specified.
  101%     - ext(+Ext)
  102%       Extension to use for the annotated file. Default is
  103%       `.cov`.
  104%     - dir(+Dir)
  105%       Dump the annotations in the given directory.  If not
  106%       given, the annotated files are created in the same
  107%       directory as the source file.   Each clause that is
  108%       related to a physical line in the file is annotated
  109%       with one of:
  110%
  111%         | ###  | Clause was never executed.                       |
  112%         | ++N  | Clause was entered N times and always succeeded  |
  113%         | --N  | Clause was entered N times and never succeeded   |
  114%         | +N-M | Clause has succeeded N times and failed M times  |
  115%         | +N*M | Clause was entered N times and succeeded M times |
  116%
  117%       All _call sites_ are annotated using the same conventions,
  118%       except that `---` is used to annotate subgoals that were
  119%       never called.
  120%     - line_numbers(Boolean)
  121%       If `true` (default), add line numbers to the annotated file.
  122%     - color(Boolean)
  123%       Controls using ANSI escape sequences to color the output
  124%       in the annotated source.  Default is `true`.
  125
  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'.
  147
  148%!  covered(-Succeeded, -Failed) is det.
  149%
  150%   Collect failed and succeeded clauses.
  151
  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                 *******************************/
  162
  163%!  file_coverage(+Succeeded, +Failed, +Options) is det.
  164%
  165%   Write a report on the clauses covered   organised by file to current
  166%   output. Show detailed information about   the  non-coverered clauses
  167%   defined in the modules Modules.
  168
  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    ).
  238
  239
  240%!  clause_source(+Clause, -File, -Line) is semidet.
  241%!  clause_source(-Clause, +File, -Line) is semidet.
  242
  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)).
  260
  261%!  list_details(+File, +Options) is semidet.
  262
  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
  272    ;   forall(source_file_property(File, module(M)),
  273               module_property(M, class(test)))
  274    ),
  275    annotate_file(Options).
  276
  277annotate_file(Options) :-
  278    (   option(annotate(true), Options)
  279    ;   option(dir(_), Options)
  280    ;   option(ext(_), Options)
  281    ),
  282    !.
  283
  284%!  detailed_report(+Uncovered, +Covered, +File:atom, +Options) is det
  285%
  286%   @arg Uncovered is a list of uncovered clauses
  287%   @arg Covered is a list of covered clauses
  288
  289detailed_report(Uncovered, Covered, File, Options):-
  290    annotate_file(Options),
  291    !,
  292    convlist(line_annotation(File, uncovered), Uncovered, Annot1),
  293    convlist(line_annotation(File, covered),   Covered,   Annot20),
  294    flatten(Annot20, Annot2),
  295    append(Annot1, Annot2, AnnotationsLen),
  296    pairs_keys_values(AnnotationsLen, Annotations, Lens),
  297    max_list(Lens, MaxLen),
  298    Margin is MaxLen+1,
  299    annotate_file(File, Annotations, [margin(Margin)|Options]).
  300detailed_report(Uncovered, _, File, _Options):-
  301    convlist(uncovered_clause_line(File), Uncovered, Pairs),
  302    sort(Pairs, Pairs_sorted),
  303    group_pairs_by_key(Pairs_sorted, Compact_pairs),
  304    nl,
  305    file_base_name(File, Base),
  306    format('~2|Clauses not covered from file ~p~n', [Base]),
  307    format('~4|Predicate ~59|Clauses at lines ~n', []),
  308    maplist(print_clause_line, Compact_pairs),
  309    nl.
  310
  311line_annotation(File, uncovered, Clause, Annotation) :-
  312    !,
  313    clause_property(Clause, file(File)),
  314    clause_property(Clause, line_count(Line)),
  315    Annotation = (Line-ansi(error,###))-3.
  316line_annotation(File, covered, Clause, [(Line-Annot)-Len|CallSites]) :-
  317    clause_property(Clause, file(File)),
  318    clause_property(Clause, line_count(Line)),
  319    '$cov_data'(clause(Clause), Entered, Exited),
  320    counts_annotation(Entered, Exited, Annot, Len),
  321    findall(((CSLine-CSAnnot)-CSLen)-PC,
  322            clause_call_site_annotation(Clause, PC, CSLine, CSAnnot, CSLen),
  323            CallSitesPC),
  324    pairs_keys_values(CallSitesPC, CallSites, PCs),
  325    check_covered_call_sites(Clause, PCs).
  326
  327counts_annotation(Entered, Exited, Annot, Len) :-
  328    (   Exited == Entered
  329    ->  format(string(Text), '++~D', [Entered]),
  330        Annot = ansi(comment, Text)
  331    ;   Exited == 0
  332    ->  format(string(Text), '--~D', [Entered]),
  333        Annot = ansi(warning, Text)
  334    ;   Exited < Entered
  335    ->  Failed is Entered - Exited,
  336        format(string(Text), '+~D-~D', [Exited, Failed]),
  337        Annot = ansi(comment, Text)
  338    ;   format(string(Text), '+~D*~D', [Entered, Exited]),
  339        Annot = ansi(fg(cyan), Text)
  340    ),
  341    string_length(Text, Len).
  342
  343uncovered_clause_line(File, Clause, Name-Line) :-
  344    clause_property(Clause, file(File)),
  345    clause_pi(Clause, Name),
  346    clause_property(Clause, line_count(Line)).
  347
  348%!  clause_pi(+Clause, -Name) is det.
  349%
  350%   Return the clause predicate indicator as Module:Name/Arity.
  351
  352clause_pi(Clause, Name) :-
  353    clause(Module:Head, _, Clause),
  354    functor(Head,F,A),
  355    Name=Module:F/A.
  356
  357print_clause_line((Module:Name/Arity)-Lines):-
  358    term_string(Module:Name, Complete_name),
  359    summary(Complete_name, 54, SName),
  360    format('~4|~w~t~59|~p~n', [SName/Arity, Lines]).
  361
  362
  363		 /*******************************
  364		 *     LINE LEVEL CALL SITES	*
  365		 *******************************/
  366
  367clause_call_site_annotation(ClauseRef, NextPC, Line, Annot, Len) :-
  368    clause_call_site(ClauseRef, PC-NextPC, Line:_LPos),
  369    (   '$cov_data'(call_site(ClauseRef, NextPC, _PI), Entered, Exited)
  370    ->  counts_annotation(Entered, Exited, Annot, Len)
  371    ;   '$fetch_vm'(ClauseRef, PC, _, VMI),
  372        \+ no_annotate_call_site(VMI)
  373    ->  Annot = ansi(error, ---),
  374        Len = 3
  375    ).
  376
  377no_annotate_call_site(i_enter).
  378no_annotate_call_site(i_exit).
  379no_annotate_call_site(i_cut).
  380
  381
  382clause_call_site(ClauseRef, PC-NextPC, Pos) :-
  383    clause_info(ClauseRef, File, TermPos, _NameOffset),
  384    '$break_pc'(ClauseRef, PC, NextPC),
  385    '$clause_term_position'(ClauseRef, NextPC, List),
  386    catch(prolog_breakpoints:range(List, TermPos, SubPos), E, true),
  387    (   var(E)
  388    ->  arg(1, SubPos, A),
  389        file_offset_pos(File, A, Pos)
  390    ;   print_message(warning, coverage(clause_info(ClauseRef))),
  391        fail
  392    ).
  393
  394file_offset_pos(File, A, Line:LPos) :-
  395    file_text(File, String),
  396    State = start(1, 0),
  397    call_nth(sub_string(String, S, _, _, "\n"), NLine),
  398    (   S >= A
  399    ->  !,
  400        State = start(Line, SLine),
  401        LPos is A-SLine
  402    ;   NS is S+1,
  403        NLine1 is NLine+1,
  404        nb_setarg(1, State, NLine1),
  405        nb_setarg(2, State, NS),
  406        fail
  407    ).
  408
  409file_text(File, String) :-
  410    setup_call_cleanup(
  411        open(File, read, In),
  412        read_string(In, _, String),
  413        close(In)).
  414
  415check_covered_call_sites(Clause, Reported) :-
  416    findall(PC, ('$cov_data'(call_site(Clause,PC,_), Enter, _), Enter > 0), Seen),
  417    sort(Reported, SReported),
  418    sort(Seen, SSeen),
  419    ord_subtract(SSeen, SReported, Missed),
  420    (   Missed == []
  421    ->  true
  422    ;   print_message(warning, coverage(unreported_call_sites(Clause, Missed)))
  423    ).
  424
  425
  426		 /*******************************
  427		 *           ANNOTATE		*
  428		 *******************************/
  429
  430clean_output(Options) :-
  431    option(dir(Dir), Options),
  432    !,
  433    option(ext(Ext), Options, cov),
  434    format(atom(Pattern), '~w/*.~w', [Dir, Ext]),
  435    expand_file_name(Pattern, Files),
  436    maplist(delete_file, Files).
  437clean_output(Options) :-
  438    forall(source_file(File),
  439           clean_output(File, Options)).
  440
  441clean_output(File, Options) :-
  442    option(ext(Ext), Options, cov),
  443    file_name_extension(File, Ext, CovFile),
  444    (   exists_file(CovFile)
  445    ->  E = error(_,_),
  446        catch(delete_file(CovFile), E,
  447              print_message(warning, E))
  448    ;   true
  449    ).
  450
  451
  452%!  annotate_file(+File, +Annotations, +Options) is det.
  453%
  454%   Create  an  annotated  copy  of  File.  Annotations  is  a  list  of
  455%   `LineNo-Annotation`,  where  `Annotation`  is  atomic    or  a  term
  456%   Format-Args,  optionally  embedded   in    ansi(Code,   Annotation).
  457
  458annotate_file(Source, Annotations, Options) :-
  459    option(ext(Ext), Options, cov),
  460    (   option(dir(Dir), Options)
  461    ->  file_base_name(Source, Base),
  462        file_name_extension(Base, Ext, CovFile),
  463        directory_file_path(Dir, CovFile, CovPath),
  464        make_directory_path(Dir)
  465    ;   file_name_extension(Source, Ext, CovPath)
  466    ),
  467    keysort(Annotations, SortedAnnotations),
  468    setup_call_cleanup(
  469        open(Source, read, In),
  470        setup_call_cleanup(
  471            open(CovPath, write, Out),
  472            annotate(In, Out, SortedAnnotations, Options),
  473            close(Out)),
  474        close(In)).
  475
  476annotate(In, Out, Annotations, Options) :-
  477    (   option(color(true), Options, true)
  478    ->  set_stream(Out, tty(true))
  479    ;   true
  480    ),
  481    annotate(In, Out, Annotations, 0, Options).
  482
  483annotate(In, Out, Annotations, LineNo0, Options) :-
  484    read_line_to_string(In, Line),
  485    (   Line == end_of_file
  486    ->  true
  487    ;   succ(LineNo0, LineNo),
  488        margins(LMargin, CMargin, Options),
  489        line_no(LineNo, Out, LMargin),
  490        annotations(LineNo, Out, LMargin, Annotations, Annotations1),
  491        format(Out, '~t~*|~s~n', [CMargin, Line]),
  492        annotate(In, Out, Annotations1, LineNo, Options)
  493    ).
  494
  495annotations(Line, Out, LMargin, [Line-Annot|T0], T) :-
  496    !,
  497    write_annotation(Out, Annot),
  498    (   T0 = [Line-_|_]
  499    ->  with_output_to(Out, ansi_format(bold, ' \u2bb0~n~t~*|', [LMargin])),
  500        annotations(Line, Out, LMargin, T0, T)
  501    ;   T = T0
  502    ).
  503annotations(_, _, _, Annots, Annots).
  504
  505write_annotation(Out, ansi(Code, Fmt-Args)) =>
  506    with_output_to(Out, ansi_format(Code, Fmt, Args)).
  507write_annotation(Out, ansi(Code, Fmt)) =>
  508    with_output_to(Out, ansi_format(Code, Fmt, [])).
  509write_annotation(Out, Fmt-Args) =>
  510    format(Out, Fmt, Args).
  511write_annotation(Out, Fmt) =>
  512    format(Out, Fmt, []).
  513
  514line_no(_, _, 0) :- !.
  515line_no(Line, Out, LMargin) :-
  516    with_output_to(Out, ansi_format(fg(127,127,127), '~t~d ~*|',
  517                                    [Line, LMargin])).
  518
  519margins(LMargin, Margin, Options) :-
  520    option(line_numbers(true), Options, true),
  521    !,
  522    option(line_number_margin(LMargin), Options, 6),
  523    option(margin(AMargin), Options, 4),
  524    Margin is LMargin+AMargin.
  525margins(0, Margin, Options) :-
  526    option(margin(Margin), Options, 4).
  527
  528%!  report_hook(+Succeeded, +Failed) is semidet.
  529%
  530%   This hook is called after the data   collection. It is passed a list
  531%   of objects that have succeeded as  well   as  a list of objects that
  532%   have failed.  The objects are one of
  533%
  534%     - ClauseRef
  535%       The specified clause
  536%     - call_site(ClauseRef, PC, PI)
  537%       A call was make in ClauseRef at the given program counter to
  538%       the predicate indicated by PI.
  539
  540:- multifile
  541    report_hook/2.  542
  543
  544		 /*******************************
  545		 *             MESSAGES		*
  546		 *******************************/
  547
  548:- multifile
  549    prolog:message//1.  550
  551prolog:message(coverage(clause_info(ClauseRef))) -->
  552    [ 'Inconsistent clause info for '-[] ],
  553    clause_msg(ClauseRef).
  554prolog:message(coverage(unreported_call_sites(ClauseRef, PCList))) -->
  555    [ 'Failed to report call sites for '-[] ],
  556    clause_msg(ClauseRef),
  557    [ nl, '  Missed at these PC offsets: ~p'-[PCList] ].
  558
  559clause_msg(ClauseRef) -->
  560    { clause_pi(ClauseRef, PI),
  561      clause_property(ClauseRef, file(File)),
  562      clause_property(ClauseRef, line_count(Line))
  563    },
  564    [ '~p at'-[PI], nl, '  ', url(File:Line) ]