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:- autoload(library(apply),[exclude/3,maplist/3,include/3,maplist/2]).   41:- autoload(library(edinburgh),[nodebug/0]).   42:- autoload(library(ordsets),
   43	    [ord_intersect/2,ord_intersection/3,ord_subtract/3]).   44:- autoload(library(pairs),[group_pairs_by_key/2]).   45
   46:- set_prolog_flag(generate_debug_info, false).   47
   48/** <module> Clause cover analysis
   49
   50The purpose of this module is to find which part of the program has been
   51used by a certain goal. Usage is defined   in terms of clauses that have
   52fired, separated in clauses that  succeeded   at  least once and clauses
   53that failed on each occasion.
   54
   55This module relies on the  SWI-Prolog   tracer  hooks. It modifies these
   56hooks and collects the results, after   which  it restores the debugging
   57environment.  This has some limitations:
   58
   59        * The performance degrades significantly (about 10 times)
   60        * It is not possible to use the debugger during coverage analysis
   61        * The cover analysis tool is currently not thread-safe.
   62
   63The result is  represented  as  a   list  of  clause-references.  As the
   64references to clauses of dynamic predicates  cannot be guaranteed, these
   65are omitted from the result.
   66
   67@bug    Relies heavily on SWI-Prolog internals. We have considered using
   68        a meta-interpreter for this purpose, but it is nearly impossible
   69        to do 100% complete meta-interpretation of Prolog.  Example
   70        problem areas include handling cuts in control-structures
   71        and calls from non-interpreted meta-predicates.
   72@tbd    Provide detailed information organised by predicate.  Possibly
   73        annotate the source with coverage information.
   74*/
   75
   76
   77:- dynamic
   78    entered/1,                      % clauses entered
   79    exited/1.                       % clauses completed
   80
   81:- meta_predicate
   82    show_coverage(0),
   83    show_coverage(0,+).   84
   85%!  show_coverage(:Goal) is semidet.
   86%!  show_coverage(:Goal, +Modules:list(atom)) is semidet.
   87%
   88%   Report on coverage by Goal. Goal is   executed  as in once/1. Report
   89%   the details of the uncovered clauses  for   each  module in the list
   90%   Modules
   91
   92show_coverage(Goal) :-
   93    show_coverage(Goal, []).
   94show_coverage(Goal, Modules):-
   95    setup_call_cleanup(
   96        setup_trace(State),
   97        once(Goal),
   98        cleanup_trace(State, Modules)).
   99
  100setup_trace(state(Visible, Leash, Ref)) :-
  101    set_prolog_flag(coverage_analysis, true),
  102    asserta((user:prolog_trace_interception(Port, Frame, _, continue) :-
  103                    prolog_cover:assert_cover(Port, Frame)), Ref),
  104    port_mask([unify,exit], Mask),
  105    '$visible'(Visible, Mask),
  106    '$leash'(Leash, Mask),
  107    trace.
  108
  109port_mask([], 0).
  110port_mask([H|T], Mask) :-
  111    port_mask(T, M0),
  112    '$syspreds':port_name(H, Bit),
  113    Mask is M0 \/ Bit.
  114
  115cleanup_trace(state(Visible, Leash, Ref), Modules) :-
  116    nodebug,
  117    '$visible'(_, Visible),
  118    '$leash'(_, Leash),
  119    erase(Ref),
  120    set_prolog_flag(coverage_analysis, false),
  121    covered(Succeeded, Failed),
  122    file_coverage(Succeeded, Failed, Modules).
  123
  124
  125%!  assert_cover(+Port, +Frame) is det.
  126%
  127%   Assert coverage of the current clause. We monitor two ports: the
  128%   _unify_ port to see which  clauses   we  entered, and the _exit_
  129%   port to see which completed successfully.
  130
  131assert_cover(unify, Frame) :-
  132    running_static_pred(Frame),
  133    prolog_frame_attribute(Frame, clause, Cl),
  134    !,
  135    assert_entered(Cl).
  136assert_cover(exit, Frame) :-
  137    running_static_pred(Frame),
  138    prolog_frame_attribute(Frame, clause, Cl),
  139    !,
  140    assert_exited(Cl).
  141assert_cover(_, _).
  142
  143%!  running_static_pred(+Frame) is semidet.
  144%
  145%   True if Frame is not running a dynamic predicate.
  146
  147running_static_pred(Frame) :-
  148    prolog_frame_attribute(Frame, goal, Goal),
  149    \+ predicate_property(Goal, dynamic).
  150
  151%!  assert_entered(+Ref) is det.
  152%!  assert_exited(+Ref) is det.
  153%
  154%   Add Ref to the set of entered or exited clauses.
  155
  156assert_entered(Cl) :-
  157    entered(Cl),
  158    !.
  159assert_entered(Cl) :-
  160    assert(entered(Cl)).
  161
  162assert_exited(Cl) :-
  163    exited(Cl),
  164    !.
  165assert_exited(Cl) :-
  166    assert(exited(Cl)).
  167
  168%!  covered(+Ref, +VisibleMask, +LeashMask, -Succeeded, -Failed) is det.
  169%
  170%   Restore state and collect failed and succeeded clauses.
  171
  172covered(Succeeded, Failed) :-
  173    findall(Cl, (entered(Cl), \+exited(Cl)), Failed0),
  174    findall(Cl, retract(exited(Cl)), Succeeded0),
  175    retractall(entered(Cl)),
  176    sort(Failed0, Failed),
  177    sort(Succeeded0, Succeeded).
  178
  179
  180                 /*******************************
  181                 *           REPORTING          *
  182                 *******************************/
  183
  184%!  file_coverage(+Succeeded, +Failed, +Modules) is det.
  185%
  186%   Write a report on the clauses covered   organised by file to current
  187%   output. Show detailed information about   the  non-coverered clauses
  188%   defined in the modules Modules.
  189
  190file_coverage(Succeeded, Failed, Modules) :-
  191    format('~N~n~`=t~78|~n'),
  192    format('~tCoverage by File~t~78|~n'),
  193    format('~`=t~78|~n'),
  194    format('~w~t~w~64|~t~w~72|~t~w~78|~n',
  195           ['File', 'Clauses', '%Cov', '%Fail']),
  196    format('~`=t~78|~n'),
  197    forall(source_file(File),
  198           file_coverage(File, Succeeded, Failed, Modules)),
  199    format('~`=t~78|~n').
  200
  201file_coverage(File, Succeeded, Failed, Modules) :-
  202    findall(Cl, clause_source(Cl, File, _), Clauses),
  203    sort(Clauses, All),
  204    (   ord_intersect(All, Succeeded)
  205    ->  true
  206    ;   ord_intersect(All, Failed)
  207    ),
  208    !,
  209    ord_intersection(All, Failed, FailedInFile),
  210    ord_intersection(All, Succeeded, SucceededInFile),
  211    ord_subtract(All, SucceededInFile, UnCov1),
  212    ord_subtract(UnCov1, FailedInFile, Uncovered),
  213
  214    %if doc_collect (from pldoc) is active, pldoc comments are recorded as
  215    % clauses but we do not want to count them in the statistics
  216    exclude(is_pldoc, All, All_wo_pldoc),
  217    exclude(is_pldoc, Uncovered, Uncovered_wo_pldoc),
  218    exclude(is_pldoc, FailedInFile, Failed_wo_pldoc),
  219
  220    %We do not want to count clauses such as :-use_module(_) in the statistics
  221    exclude(is_system_clause, All_wo_pldoc, All_wo_system),
  222    exclude(is_system_clause, Uncovered_wo_pldoc, Uncovered_wo_system),
  223    exclude(is_system_clause, Failed_wo_pldoc, Failed_wo_system),
  224
  225    length(All_wo_system, AC),
  226    length(Uncovered_wo_system, UC),
  227    length(Failed_wo_system, FC),
  228
  229    CP is 100-100*UC/AC,
  230    FCP is 100*FC/AC,
  231    summary(File, 56, SFile),
  232    format('~w~t ~D~64| ~t~1f~72| ~t~1f~78|~n', [SFile, AC, CP, FCP]),
  233    detailed_report(Uncovered_wo_system, Modules).
  234file_coverage(_,_,_,_).
  235
  236
  237is_system_clause(Clause) :-
  238    clause_name(Clause, Name),
  239    Name = system:_.
  240
  241is_pldoc(Clause) :-
  242    clause_name(Clause, _Module:Name2/_Arity),
  243    pldoc_predicate(Name2).
  244
  245pldoc_predicate('$pldoc').
  246pldoc_predicate('$mode').
  247pldoc_predicate('$pred_option').
  248
  249summary(Atom, MaxLen, Summary) :-
  250    atom_length(Atom, Len),
  251    (   Len < MaxLen
  252    ->  Summary = Atom
  253    ;   SLen is MaxLen - 5,
  254        sub_atom(Atom, _, SLen, 0, End),
  255        atom_concat('...', End, Summary)
  256    ).
  257
  258
  259%!  clause_source(+Clause, -File, -Line) is det.
  260%!  clause_source(-Clause, +File, -Line) is det.
  261
  262clause_source(Clause, File, Line) :-
  263    nonvar(Clause),
  264    !,
  265    clause_property(Clause, file(File)),
  266    clause_property(Clause, line_count(Line)).
  267clause_source(Clause, File, Line) :-
  268    Pred = _:_,
  269    source_file(Pred, File),
  270    \+ predicate_property(Pred, multifile),
  271    nth_clause(Pred, _Index, Clause),
  272    clause_property(Clause, line_count(Line)).
  273clause_source(Clause, File, Line) :-
  274    Pred = _:_,
  275    predicate_property(Pred, multifile),
  276    nth_clause(Pred, _Index, Clause),
  277    clause_property(Clause, file(File)),
  278    clause_property(Clause, line_count(Line)).
  279
  280%! detailed_report(+Uncovered:list(clause), +Modules:list(atom)) is det
  281
  282detailed_report(Uncovered, Modules):-
  283    maplist(clause_line_pair, Uncovered, Pairs),
  284    include(pair_in_modules(Modules), Pairs, Pairs_in_modules),
  285    (   Pairs_in_modules \== []
  286    ->  sort(Pairs_in_modules, Pairs_sorted),
  287        group_pairs_by_key(Pairs_sorted, Compact_pairs),
  288        nl,
  289        format('~2|Clauses not covered from modules ~p~n', [Modules]),
  290        format('~4|Predicate ~59|Clauses at lines ~n', []),
  291        maplist(print_clause_line, Compact_pairs),
  292        nl
  293    ;   true
  294    ).
  295
  296pair_in_modules(Modules,(Module:_Name)-_Line):-
  297    memberchk(Module, Modules).
  298
  299clause_line_pair(Clause, Name-Line):-
  300    clause_property(Clause, line_count(Line)),
  301    clause_name(Clause, Name).
  302
  303clause_name(Clause,Name):-
  304    clause(Module:Head, _, Clause),
  305    functor(Head,F,A),
  306    Name=Module:F/A.
  307
  308print_clause_line((Module:Name/Arity)-Lines):-
  309    term_to_atom(Module:Name, Complete_name),
  310    summary(Complete_name, 54, SName),
  311    format('~4|~w~t~59|~p~n', [SName/Arity, Lines])