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-2021, 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
   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 that have
   58fired, separated in clauses that  succeeded   at  least once and clauses
   59that failed on each occasion.
   60
   61This module relies on the  SWI-Prolog   tracer  hooks. It modifies these
   62hooks and collects the results, after   which  it restores the debugging
   63environment.  This has some limitations:
   64
   65        * The performance degrades significantly (about 10 times)
   66        * It is not possible to use the debugger during coverage analysis
   67        * The cover analysis tool is currently not thread-safe.
   68
   69The result is  represented  as  a   list  of  clause-references.  As the
   70references to clauses of dynamic predicates  cannot be guaranteed, these
   71are omitted from the result.
   72
   73@bug    Relies heavily on SWI-Prolog internals. We have considered using
   74        a meta-interpreter for this purpose, but it is nearly impossible
   75        to do 100% complete meta-interpretation of Prolog.  Example
   76        problem areas include handling cuts in control-structures
   77        and calls from non-interpreted meta-predicates.
   78@tbd    Provide detailed information organised by predicate.  Possibly
   79        annotate the source with coverage information.
   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 executed N times and always succeeded |
  114%         | --N | Clause was executed N times and never succeeded  |
  115%         | +N-M | Clause was succeeded N times and failed M times |
  116
  117show_coverage(Goal) :-
  118    show_coverage(Goal, []).
  119show_coverage(Goal, Modules) :-
  120    maplist(atom, Modules),
  121    !,
  122    show_coverage(Goal, [modules(Modules)]).
  123show_coverage(Goal, Options) :-
  124    clean_output(Options),
  125    setup_call_cleanup(
  126        setup_trace(State),
  127        once(Goal),
  128        cleanup_trace(State, Options)).
  129
  130setup_trace(state(Visible, Leash, Ref)) :-
  131    nb_setval(cover_count, 0),
  132    nb_setval(cover_enter, [](0)),
  133    nb_setval(cover_exits, [](0)),
  134    set_prolog_flag(coverage_analysis, true),
  135    asserta((user:prolog_trace_interception(Port, Frame, _, continue) :-
  136                    prolog_cover:assert_cover(Port, Frame)), Ref),
  137    port_mask([unify,exit], Mask),
  138    '$visible'(Visible, Mask),
  139    '$leash'(Leash, Mask),
  140    trace.
  141
  142port_mask([], 0).
  143port_mask([H|T], Mask) :-
  144    port_mask(T, M0),
  145    '$syspreds':port_name(H, Bit),
  146    Mask is M0 \/ Bit.
  147
  148cleanup_trace(state(Visible, Leash, Ref), Options) :-
  149    nodebug,
  150    '$visible'(_, Visible),
  151    '$leash'(_, Leash),
  152    erase(Ref),
  153    set_prolog_flag(coverage_analysis, false),
  154    covered(Succeeded, Failed),
  155    file_coverage(Succeeded, Failed, Options),
  156    clean_data.
  157
  158%!  assert_cover(+Port, +Frame) is det.
  159%
  160%   Assert coverage of the current clause. We monitor two ports: the
  161%   _unify_ port to see which  clauses   we  entered, and the _exit_
  162%   port to see which completed successfully.
  163
  164:- public assert_cover/2.  165
  166assert_cover(unify, Frame) :-
  167    running_static_pred(Frame),
  168    prolog_frame_attribute(Frame, clause, Cl),
  169    !,
  170    assert_entered(Cl).
  171assert_cover(exit, Frame) :-
  172    running_static_pred(Frame),
  173    prolog_frame_attribute(Frame, clause, Cl),
  174    !,
  175    assert_exited(Cl).
  176assert_cover(_, _).
  177
  178%!  running_static_pred(+Frame) is semidet.
  179%
  180%   True if Frame is not running a dynamic predicate.
  181
  182running_static_pred(Frame) :-
  183    prolog_frame_attribute(Frame, goal, Goal),
  184    \+ '$get_predicate_attribute'(Goal, (dynamic), 1).
  185%   \+ predicate_property(Goal, dynamic).
  186
  187%!  assert_entered(+Ref) is det.
  188%!  assert_exited(+Ref) is det.
  189%
  190%   Add Ref to the set of entered or exited clauses.
  191
  192assert_entered(Cl) :-
  193    add_clause(Cl, I),
  194    bump(cover_enter, I).
  195
  196assert_exited(Cl) :-
  197    add_clause(Cl, I),
  198    bump(cover_exits, I).
  199
  200bump(Var, I) :-
  201    nb_getval(Var, Array),
  202    arg(I, Array, Old),
  203    New is Old+1,
  204    nb_setarg(I, Array, New).
  205
  206:- dynamic
  207    clause_index/2.  208
  209add_clause(Cl, I) :-
  210    clause_index(Cl, I),
  211    !.
  212add_clause(Cl, I) :-
  213    nb_getval(cover_count, I0),
  214    I is I0+1,
  215    nb_setval(cover_count, I),
  216    assertz(clause_index(Cl, I)),
  217    expand_arrays(I).
  218
  219expand_arrays(I) :-
  220    nb_getval(cover_enter, Array),
  221    functor(Array, _, Arity),
  222    I =< Arity,
  223    !.
  224expand_arrays(_) :-
  225    grow_array(cover_enter),
  226    grow_array(cover_exits).
  227
  228grow_array(Name) :-
  229    nb_getval(Name, Array),
  230    functor(Array, F, Arity),
  231    NewSize is Arity*2,
  232    functor(NewArray, F, NewSize),
  233    copy_args(1, Arity, Array, NewArray),
  234    FillStart is Arity+1,
  235    fill_args(FillStart, NewSize, NewArray),
  236    nb_setval(Name, NewArray).
  237
  238copy_args(I, End, From, To) :-
  239    I =< End,
  240    !,
  241    arg(I, From, A),
  242    arg(I, To, A),
  243    I2 is I+1,
  244    copy_args(I2, End, From, To).
  245copy_args(_, _, _, _).
  246
  247fill_args(I, End, To) :-
  248    I =< End,
  249    !,
  250    arg(I, To, 0),
  251    I2 is I+1,
  252    fill_args(I2, End, To).
  253fill_args(_, _, _).
  254
  255clean_data :-
  256    nb_delete(cover_count),
  257    nb_delete(cover_enter),
  258    nb_delete(cover_exits),
  259    retractall(clause_index(_,_)).
  260
  261%!  count(+Which, +Clause, -Count) is semidet.
  262%
  263%   Get event counts for Clause.
  264
  265count(Which, Cl, Count) :-
  266    clause_index(Cl, I),
  267    nb_getval(Which, Array),
  268    arg(I, Array, Count).
  269
  270entered(Cl) :-
  271    count(cover_enter, Cl, Count),
  272    Count > 0.
  273exited(Cl) :-
  274    count(cover_exits, Cl, Count),
  275    Count > 0.
  276
  277entered(Cl, Count) :-
  278    count(cover_enter, Cl, Count).
  279exited(Cl, Count) :-
  280    count(cover_exits, Cl, Count).
  281
  282%!  covered(-Succeeded, -Failed) is det.
  283%
  284%   Collect failed and succeeded clauses.
  285
  286covered(Succeeded, Failed) :-
  287    findall(Cl, (entered(Cl), \+exited(Cl)), Failed0),
  288    findall(Cl, exited(Cl), Succeeded0),
  289    sort(Failed0, Failed),
  290    sort(Succeeded0, Succeeded).
  291
  292
  293                 /*******************************
  294                 *           REPORTING          *
  295                 *******************************/
  296
  297%!  file_coverage(+Succeeded, +Failed, +Options) is det.
  298%
  299%   Write a report on the clauses covered   organised by file to current
  300%   output. Show detailed information about   the  non-coverered clauses
  301%   defined in the modules Modules.
  302
  303file_coverage(Succeeded, Failed, Options) :-
  304    format('~N~n~`=t~78|~n'),
  305    format('~tCoverage by File~t~78|~n'),
  306    format('~`=t~78|~n'),
  307    format('~w~t~w~64|~t~w~72|~t~w~78|~n',
  308           ['File', 'Clauses', '%Cov', '%Fail']),
  309    format('~`=t~78|~n'),
  310    forall(source_file(File),
  311           file_coverage(File, Succeeded, Failed, Options)),
  312    format('~`=t~78|~n').
  313
  314file_coverage(File, Succeeded, Failed, Options) :-
  315    findall(Cl, clause_source(Cl, File, _), Clauses),
  316    sort(Clauses, All),
  317    (   ord_intersect(All, Succeeded)
  318    ->  true
  319    ;   ord_intersect(All, Failed)
  320    ),                                  % Clauses from this file are touched
  321    !,
  322    ord_intersection(All, Failed, FailedInFile),
  323    ord_intersection(All, Succeeded, SucceededInFile),
  324    ord_subtract(All, SucceededInFile, UnCov1),
  325    ord_subtract(UnCov1, FailedInFile, Uncovered),
  326
  327    clean_set(All, All_wo_system),
  328    clean_set(Uncovered, Uncovered_wo_system),
  329    clean_set(FailedInFile, Failed_wo_system),
  330
  331    length(All_wo_system, AC),
  332    length(Uncovered_wo_system, UC),
  333    length(Failed_wo_system, FC),
  334
  335    CP is 100-100*UC/AC,
  336    FCP is 100*FC/AC,
  337    summary(File, 56, SFile),
  338    format('~w~t ~D~64| ~t~1f~72| ~t~1f~78|~n', [SFile, AC, CP, FCP]),
  339    (   list_details(File, Options),
  340        clean_set(SucceededInFile, Succeeded_wo_system),
  341        ord_union(Failed_wo_system, Succeeded_wo_system, Covered)
  342    ->  detailed_report(Uncovered_wo_system, Covered, File, Options)
  343    ;   true
  344    ).
  345file_coverage(_,_,_,_).
  346
  347clean_set(Clauses, UserClauses) :-
  348    exclude(is_pldoc, Clauses, Clauses_wo_pldoc),
  349    exclude(is_system_clause, Clauses_wo_pldoc, UserClauses).
  350
  351is_system_clause(Clause) :-
  352    clause_name(Clause, Name),
  353    Name = system:_.
  354
  355is_pldoc(Clause) :-
  356    clause_name(Clause, _Module:Name2/_Arity),
  357    pldoc_predicate(Name2).
  358
  359pldoc_predicate('$pldoc').
  360pldoc_predicate('$mode').
  361pldoc_predicate('$pred_option').
  362pldoc_predicate('$exported_op').        % not really PlDoc ...
  363
  364summary(String, MaxLen, Summary) :-
  365    string_length(String, Len),
  366    (   Len < MaxLen
  367    ->  Summary = String
  368    ;   SLen is MaxLen - 5,
  369        sub_string(String, _, SLen, 0, End),
  370        string_concat('...', End, Summary)
  371    ).
  372
  373
  374%!  clause_source(+Clause, -File, -Line) is det.
  375%!  clause_source(-Clause, +File, -Line) is det.
  376
  377clause_source(Clause, File, Line) :-
  378    nonvar(Clause),
  379    !,
  380    clause_property(Clause, file(File)),
  381    clause_property(Clause, line_count(Line)).
  382clause_source(Clause, File, Line) :-
  383    Pred = _:_,
  384    source_file(Pred, File),
  385    \+ predicate_property(Pred, multifile),
  386    nth_clause(Pred, _Index, Clause),
  387    clause_property(Clause, line_count(Line)).
  388clause_source(Clause, File, Line) :-
  389    Pred = _:_,
  390    predicate_property(Pred, multifile),
  391    nth_clause(Pred, _Index, Clause),
  392    clause_property(Clause, file(File)),
  393    clause_property(Clause, line_count(Line)).
  394
  395%!  list_details(+File, +Options) is semidet.
  396
  397list_details(File, Options) :-
  398    option(modules(Modules), Options),
  399    source_file_property(File, module(M)),
  400    memberchk(M, Modules),
  401    !.
  402list_details(File, Options) :-
  403    (   source_file_property(File, module(M))
  404    ->  module_property(M, class(user))
  405    ;   true     % non-module file must be user file.
  406    ),
  407    annotate_file(Options).
  408
  409annotate_file(Options) :-
  410    (   option(annotate(true), Options)
  411    ;   option(dir(_), Options)
  412    ;   option(ext(_), Options)
  413    ),
  414    !.
  415
  416%! detailed_report(+Uncovered, +Covered, +File:atom, +Options) is det
  417
  418detailed_report(Uncovered, Covered, File, Options):-
  419    annotate_file(Options),
  420    !,
  421    convlist(line_annotation(File, uncovered), Uncovered, Annot1),
  422    convlist(line_annotation(File, covered),   Covered,   Annot2),
  423    append(Annot1, Annot2, AnnotationsLen),
  424    pairs_keys_values(AnnotationsLen, Annotations, Lens),
  425    max_list(Lens, MaxLen),
  426    Margin is MaxLen+1,
  427    annotate_file(File, Annotations, [margin(Margin)|Options]).
  428detailed_report(Uncovered, _, File, _Options):-
  429    convlist(uncovered_clause_line(File), Uncovered, Pairs),
  430    sort(Pairs, Pairs_sorted),
  431    group_pairs_by_key(Pairs_sorted, Compact_pairs),
  432    nl,
  433    file_base_name(File, Base),
  434    format('~2|Clauses not covered from file ~p~n', [Base]),
  435    format('~4|Predicate ~59|Clauses at lines ~n', []),
  436    maplist(print_clause_line, Compact_pairs),
  437    nl.
  438
  439line_annotation(File, Class, Clause, (Line-Annot)-Len) :-
  440    clause_property(Clause, file(File)),
  441    clause_property(Clause, line_count(Line)),
  442    annot(Class, Clause, Annot, Len).
  443
  444annot(uncovered, _Clause, ansi(error,###), 3).
  445annot(covered,    Clause, Annot, Len) :-
  446    entered(Clause, Entered),
  447    exited(Clause, Exited),
  448    (   Exited == Entered
  449    ->  format(string(Text), '++~D', [Entered]),
  450        Annot = ansi(comment, Text)
  451    ;   Exited == 0
  452    ->  format(string(Text), '--~D', [Entered]),
  453        Annot = ansi(warning, Text)
  454    ;   Failed is Entered - Exited,
  455        format(string(Text), '+~D-~D', [Exited, Failed]),
  456        Annot = ansi(comment, Text)
  457    ),
  458    string_length(Text, Len).
  459
  460uncovered_clause_line(File, Clause, Name-Line) :-
  461    clause_property(Clause, file(File)),
  462    clause_name(Clause, Name),
  463    clause_property(Clause, line_count(Line)).
  464
  465%!  clause_name(+Clause, -Name) is det.
  466%
  467%   Return the clause predicate indicator as Module:Name/Arity.
  468
  469clause_name(Clause, Name) :-
  470    clause(Module:Head, _, Clause),
  471    functor(Head,F,A),
  472    Name=Module:F/A.
  473
  474print_clause_line((Module:Name/Arity)-Lines):-
  475    term_string(Module:Name, Complete_name),
  476    summary(Complete_name, 54, SName),
  477    format('~4|~w~t~59|~p~n', [SName/Arity, Lines]).
  478
  479
  480		 /*******************************
  481		 *           ANNOTATE		*
  482		 *******************************/
  483
  484clean_output(Options) :-
  485    option(dir(Dir), Options),
  486    !,
  487    option(ext(Ext), Options, cov),
  488    format(atom(Pattern), '~w/*.~w', [Dir, Ext]),
  489    expand_file_name(Pattern, Files),
  490    maplist(delete_file, Files).
  491clean_output(Options) :-
  492    forall(source_file(File),
  493           clean_output(File, Options)).
  494
  495clean_output(File, Options) :-
  496    option(ext(Ext), Options, cov),
  497    file_name_extension(File, Ext, CovFile),
  498    (   exists_file(CovFile)
  499    ->  E = error(_,_),
  500        catch(delete_file(CovFile), E,
  501              print_message(warning, E))
  502    ;   true
  503    ).
  504
  505
  506%!  annotate_file(+File, +Annotations, +Options) is det.
  507%
  508%   Create  an  annotated  copy  of  File.  Annotations  is  a  list  of
  509%   `LineNo-Annotation`,  where  `Annotation`  is  atomic    or  a  term
  510%   Format-Args,  optionally  embedded   in    ansi(Code,   Annotation).
  511
  512annotate_file(Source, Annotations, Options) :-
  513    option(ext(Ext), Options, cov),
  514    (   option(dir(Dir), Options)
  515    ->  file_base_name(Source, Base),
  516        file_name_extension(Base, Ext, CovFile),
  517        directory_file_path(Dir, CovFile, CovPath),
  518        make_directory_path(Dir)
  519    ;   file_name_extension(Source, Ext, CovPath)
  520    ),
  521    keysort(Annotations, SortedAnnotations),
  522    setup_call_cleanup(
  523        open(Source, read, In),
  524        setup_call_cleanup(
  525            open(CovPath, write, Out),
  526            annotate(In, Out, SortedAnnotations, Options),
  527            close(Out)),
  528        close(In)).
  529
  530annotate(In, Out, Annotations, Options) :-
  531    set_stream(Out, tty(true)),
  532    annotate(In, Out, Annotations, 0, Options).
  533
  534annotate(In, Out, Annotations, LineNo0, Options) :-
  535    read_line_to_string(In, Line),
  536    (   Line == end_of_file
  537    ->  true
  538    ;   succ(LineNo0, LineNo),
  539        option(margin(Margin), Options, 4),
  540        (   annotation(LineNo, Annotations, Annot, Annotations1)
  541        ->  write_annotation(Out, Annot)
  542        ;   Annotations1 = Annotations
  543        ),
  544        format(Out, '~t~*|~s~n', [Margin, Line]),
  545        annotate(In, Out, Annotations1, LineNo, Options)
  546    ).
  547
  548annotation(Line, [Line-Annot|T], Annot, T).
  549
  550write_annotation(Out, ansi(Code, Fmt-Args)) =>
  551    with_output_to(Out, ansi_format(Code, Fmt, Args)).
  552write_annotation(Out, ansi(Code, Fmt)) =>
  553    with_output_to(Out, ansi_format(Code, Fmt, [])).
  554write_annotation(Out, Fmt-Args) =>
  555    format(Out, Fmt, Args).
  556write_annotation(Out, Fmt) =>
  557    format(Out, Fmt, [])