1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2006-2017, University of Amsterdam
    7                              VU University Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(prolog_cover,
   37          [ show_coverage/1,            % :Goal
   38            show_coverage/2
   39          ]).   40:- use_module(library(ordsets)).   41:- use_module(library(apply)).   42
   43:- set_prolog_flag(generate_debug_info, false).   44
   45/** <module> Clause cover analysis
   46
   47The purpose of this module is to find which part of the program has been
   48used by a certain goal. Usage is defined   in terms of clauses that have
   49fired, seperated in clauses that  succeeded   at  least once and clauses
   50that failed on each occasion.
   51
   52This module relies on the  SWI-Prolog   tracer  hooks. It modifies these
   53hooks and collects the results, after   which  it restores the debugging
   54environment.  This has some limitations:
   55
   56        * The performance degrades significantly (about 10 times)
   57        * It is not possible to use the debugger during coverage analysis
   58        * The cover analysis tool is currently not thread-safe.
   59
   60The result is  represented  as  a   list  of  clause-references.  As the
   61references to clauses of dynamic predicates  cannot be guaranteed, these
   62are omitted from the result.
   63
   64@bug    Relies heavily on SWI-Prolog internals. We have considered using
   65        a meta-interpreter for this purpose, but it is nearly impossible
   66        to do 100% complete meta-interpretation of Prolog.  Example
   67        problem areas include handling cuts in control-structures
   68        and calls from non-interpreted meta-predicates.
   69@tbd    Provide detailed information organised by predicate.  Possibly
   70        annotate the source with coverage information.
   71*/
   72
   73
   74:- dynamic
   75    entered/1,                      % clauses entered
   76    exited/1.                       % clauses completed
   77
   78:- meta_predicate
   79    show_coverage(0),
   80    show_coverage(0,+).   81
   82%!  show_coverage(:Goal) is semidet.
   83%!  show_coverage(:Goal, +Modules:list(atom)) is semidet.
   84%
   85%   Report on coverage by Goal. Goal is   executed  as in once/1. Report
   86%   the details of the uncovered clauses  for   each  module in the list
   87%   Modules
   88
   89show_coverage(Goal) :-
   90    show_coverage(Goal, []).
   91show_coverage(Goal, Modules):-
   92    setup_call_cleanup(
   93        setup_trace(State),
   94        once(Goal),
   95        cleanup_trace(State, Modules)).
   96
   97setup_trace(state(Visible, Leash, Ref)) :-
   98    set_prolog_flag(coverage_analysis, true),
   99    asserta((user:prolog_trace_interception(Port, Frame, _, continue) :-
  100                    prolog_cover:assert_cover(Port, Frame)), Ref),
  101    port_mask([unify,exit], Mask),
  102    '$visible'(Visible, Mask),
  103    '$leash'(Leash, Mask),
  104    trace.
  105
  106port_mask([], 0).
  107port_mask([H|T], Mask) :-
  108    port_mask(T, M0),
  109    '$syspreds':port_name(H, Bit),
  110    Mask is M0 \/ Bit.
  111
  112cleanup_trace(state(Visible, Leash, Ref), Modules) :-
  113    nodebug,
  114    '$visible'(_, Visible),
  115    '$leash'(_, Leash),
  116    erase(Ref),
  117    set_prolog_flag(coverage_analysis, false),
  118    covered(Succeeded, Failed),
  119    file_coverage(Succeeded, Failed, Modules).
  120
  121
  122%!  assert_cover(+Port, +Frame) is det.
  123%
  124%   Assert coverage of the current clause. We monitor two ports: the
  125%   _unify_ port to see which  clauses   we  entered, and the _exit_
  126%   port to see which completed successfully.
  127
  128assert_cover(unify, Frame) :-
  129    running_static_pred(Frame),
  130    prolog_frame_attribute(Frame, clause, Cl),
  131    !,
  132    assert_entered(Cl).
  133assert_cover(exit, Frame) :-
  134    running_static_pred(Frame),
  135    prolog_frame_attribute(Frame, clause, Cl),
  136    !,
  137    assert_exited(Cl).
  138assert_cover(_, _).
  139
  140%!  running_static_pred(+Frame) is semidet.
  141%
  142%   True if Frame is not running a dynamic predicate.
  143
  144running_static_pred(Frame) :-
  145    prolog_frame_attribute(Frame, goal, Goal),
  146    \+ predicate_property(Goal, dynamic).
  147
  148%!  assert_entered(+Ref) is det.
  149%!  assert_exited(+Ref) is det.
  150%
  151%   Add Ref to the set of entered or exited clauses.
  152
  153assert_entered(Cl) :-
  154    entered(Cl),
  155    !.
  156assert_entered(Cl) :-
  157    assert(entered(Cl)).
  158
  159assert_exited(Cl) :-
  160    exited(Cl),
  161    !.
  162assert_exited(Cl) :-
  163    assert(exited(Cl)).
  164
  165%!  covered(+Ref, +VisibleMask, +LeashMask, -Succeeded, -Failed) is det.
  166%
  167%   Restore state and collect failed and succeeded clauses.
  168
  169covered(Succeeded, Failed) :-
  170    findall(Cl, (entered(Cl), \+exited(Cl)), Failed0),
  171    findall(Cl, retract(exited(Cl)), Succeeded0),
  172    retractall(entered(Cl)),
  173    sort(Failed0, Failed),
  174    sort(Succeeded0, Succeeded).
  175
  176
  177                 /*******************************
  178                 *           REPORTING          *
  179                 *******************************/
  180
  181%!  file_coverage(+Succeeded, +Failed, +Modules) is det.
  182%
  183%   Write a report on the clauses covered   organised by file to current
  184%   output. Show detailed information about   the  non-coverered clauses
  185%   defined in the modules Modules.
  186
  187file_coverage(Succeeded, Failed, Modules) :-
  188    format('~N~n~`=t~78|~n'),
  189    format('~tCoverage by File~t~78|~n'),
  190    format('~`=t~78|~n'),
  191    format('~w~t~w~64|~t~w~72|~t~w~78|~n',
  192           ['File', 'Clauses', '%Cov', '%Fail']),
  193    format('~`=t~78|~n'),
  194    forall(source_file(File),
  195           file_coverage(File, Succeeded, Failed, Modules)),
  196    format('~`=t~78|~n').
  197
  198file_coverage(File, Succeeded, Failed, Modules) :-
  199    findall(Cl, clause_source(Cl, File, _), Clauses),
  200    sort(Clauses, All),
  201    (   ord_intersect(All, Succeeded)
  202    ->  true
  203    ;   ord_intersect(All, Failed)
  204    ),
  205    !,
  206    ord_intersection(All, Failed, FailedInFile),
  207    ord_intersection(All, Succeeded, SucceededInFile),
  208    ord_subtract(All, SucceededInFile, UnCov1),
  209    ord_subtract(UnCov1, FailedInFile, Uncovered),
  210
  211    %if doc_collect (from pldoc) is active, pldoc comments are recorded as
  212    % clauses but we do not want to count them in the statistics
  213    exclude(is_pldoc, All, All_wo_pldoc),
  214    exclude(is_pldoc, Uncovered, Uncovered_wo_pldoc),
  215    exclude(is_pldoc, FailedInFile, Failed_wo_pldoc),
  216
  217    %We do not want to count clauses such as :-use_module(_) in the statistics
  218    exclude(is_system_clause, All_wo_pldoc, All_wo_system),
  219    exclude(is_system_clause, Uncovered_wo_pldoc, Uncovered_wo_system),
  220    exclude(is_system_clause, Failed_wo_pldoc, Failed_wo_system),
  221
  222    length(All_wo_system, AC),
  223    length(Uncovered_wo_system, UC),
  224    length(Failed_wo_system, FC),
  225
  226    CP is 100-100*UC/AC,
  227    FCP is 100*FC/AC,
  228    summary(File, 56, SFile),
  229    format('~w~t ~D~64| ~t~1f~72| ~t~1f~78|~n', [SFile, AC, CP, FCP]),
  230    detailed_report(Uncovered_wo_system, Modules).
  231file_coverage(_,_,_,_).
  232
  233
  234is_system_clause(Clause) :-
  235    clause_name(Clause, Name),
  236    Name = system:_.
  237
  238is_pldoc(Clause) :-
  239    clause_name(Clause, _Module:Name2/_Arity),
  240    pldoc_predicate(Name2).
  241
  242pldoc_predicate('$pldoc').
  243pldoc_predicate('$mode').
  244pldoc_predicate('$pred_option').
  245
  246summary(Atom, MaxLen, Summary) :-
  247    atom_length(Atom, Len),
  248    (   Len < MaxLen
  249    ->  Summary = Atom
  250    ;   SLen is MaxLen - 5,
  251        sub_atom(Atom, _, SLen, 0, End),
  252        atom_concat('...', End, Summary)
  253    ).
  254
  255
  256%!  clause_source(+Clause, -File, -Line) is det.
  257%!  clause_source(-Clause, +File, -Line) is det.
  258
  259clause_source(Clause, File, Line) :-
  260    nonvar(Clause),
  261    !,
  262    clause_property(Clause, file(File)),
  263    clause_property(Clause, line_count(Line)).
  264clause_source(Clause, File, Line) :-
  265    Pred = _:_,
  266    source_file(Pred, File),
  267    \+ predicate_property(Pred, multifile),
  268    nth_clause(Pred, _Index, Clause),
  269    clause_property(Clause, line_count(Line)).
  270clause_source(Clause, File, Line) :-
  271    Pred = _:_,
  272    predicate_property(Pred, multifile),
  273    nth_clause(Pred, _Index, Clause),
  274    clause_property(Clause, file(File)),
  275    clause_property(Clause, line_count(Line)).
  276
  277%! detailed_report(+Uncovered:list(clause), +Modules:list(atom)) is det
  278
  279detailed_report(Uncovered, Modules):-
  280    maplist(clause_line_pair, Uncovered, Pairs),
  281    include(pair_in_modules(Modules), Pairs, Pairs_in_modules),
  282    (   Pairs_in_modules \== []
  283    ->  sort(Pairs_in_modules, Pairs_sorted),
  284        group_pairs_by_key(Pairs_sorted, Compact_pairs),
  285        nl,
  286        format('~2|Clauses not covered from modules ~p~n', [Modules]),
  287        format('~4|Predicate ~59|Clauses at lines ~n', []),
  288        maplist(print_clause_line, Compact_pairs),
  289        nl
  290    ;   true
  291    ).
  292
  293pair_in_modules(Modules,(Module:_Name)-_Line):-
  294    memberchk(Module, Modules).
  295
  296clause_line_pair(Clause, Name-Line):-
  297    clause_property(Clause, line_count(Line)),
  298    clause_name(Clause, Name).
  299
  300clause_name(Clause,Name):-
  301    clause(Module:Head, _, Clause),
  302    functor(Head,F,A),
  303    Name=Module:F/A.
  304
  305print_clause_line((Module:Name/Arity)-Lines):-
  306    term_to_atom(Module:Name, Complete_name),
  307    summary(Complete_name, 54, SName),
  308    format('~4|~w~t~59|~p~n', [SName/Arity, Lines])