View source with raw comments or as raw
    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).

Clause cover analysis

The purpose of this module is to find which part of the program has been used by a certain goal. Usage is defined in terms of clauses that have fired, separated in clauses that succeeded at least once and clauses that failed on each occasion.

This module relies on the SWI-Prolog tracer hooks. It modifies these hooks and collects the results, after which it restores the debugging environment. This has some limitations:

The result is represented as a list of clause-references. As the references to clauses of dynamic predicates cannot be guaranteed, these are omitted from the result.

bug
- Relies heavily on SWI-Prolog internals. We have considered using a meta-interpreter for this purpose, but it is nearly impossible to do 100% complete meta-interpretation of Prolog. Example problem areas include handling cuts in control-structures and calls from non-interpreted meta-predicates.
To be done
- Provide detailed information organised by predicate. Possibly annotate the source with coverage information. */
   77:- dynamic
   78    entered/1,                      % clauses entered
   79    exited/1.                       % clauses completed
   80
   81:- meta_predicate
   82    show_coverage(0),
   83    show_coverage(0,+).
 show_coverage(:Goal) is semidet
 show_coverage(:Goal, +Modules:list(atom)) is semidet
Report on coverage by Goal. Goal is executed as in once/1. Report the details of the uncovered clauses for each module in the list Modules
   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).
 assert_cover(+Port, +Frame) is det
Assert coverage of the current clause. We monitor two ports: the unify port to see which clauses we entered, and the exit port to see which completed successfully.
  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(_, _).
 running_static_pred(+Frame) is semidet
True if Frame is not running a dynamic predicate.
  147running_static_pred(Frame) :-
  148    prolog_frame_attribute(Frame, goal, Goal),
  149    \+ predicate_property(Goal, dynamic).
 assert_entered(+Ref) is det
 assert_exited(+Ref) is det
Add Ref to the set of entered or exited clauses.
  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)).
 covered(+Ref, +VisibleMask, +LeashMask, -Succeeded, -Failed) is det
Restore state and collect failed and succeeded clauses.
  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                 *******************************/
 file_coverage(+Succeeded, +Failed, +Modules) is det
Write a report on the clauses covered organised by file to current output. Show detailed information about the non-coverered clauses defined in the modules Modules.
  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    ).
 clause_source(+Clause, -File, -Line) is det
clause_source(-Clause, +File, -Line) is det
  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)).
 detailed_report(+Uncovered:list(clause), +Modules:list(atom)) is det
  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])