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     % 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    !.
  281
  282%!  detailed_report(+Uncovered, +Covered, +File:atom, +Options) is det
  283%
  284%   @arg Uncovered is a list of uncovered clauses
  285%   @arg Covered is a list of covered clauses
  286
  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)).
  345
  346%!  clause_pi(+Clause, -Name) is det.
  347%
  348%   Return the clause predicate indicator as Module:Name/Arity.
  349
  350clause_pi(Clause, Name) :-
  351    clause(Module:Head, _, 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    ).
  448
  449
  450%!  annotate_file(+File, +Annotations, +Options) is det.
  451%
  452%   Create  an  annotated  copy  of  File.  Annotations  is  a  list  of
  453%   `LineNo-Annotation`,  where  `Annotation`  is  atomic    or  a  term
  454%   Format-Args,  optionally  embedded   in    ansi(Code,   Annotation).
  455
  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).
  525
  526%!  report_hook(+Succeeded, +Failed) is semidet.
  527%
  528%   This hook is called after the data   collection. It is passed a list
  529%   of objects that have succeeded as  well   as  a list of objects that
  530%   have failed.  The objects are one of
  531%
  532%     - ClauseRef
  533%       The specified clause
  534%     - call_site(ClauseRef, PC, PI)
  535%       A call was make in ClauseRef at the given program counter to
  536%       the predicate indicated by PI.
  537
  538:- multifile
  539    report_hook/2.  540
  541
  542		 /*******************************
  543		 *             MESSAGES		*
  544		 *******************************/
  545
  546:- multifile
  547    prolog:message//1.  548
  549prolog:message(coverage(clause_info(ClauseRef))) -->
  550    [ 'Inconsistent clause info for '-[] ],
  551    clause_msg(ClauseRef).
  552prolog:message(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) ]