15.4.26  src/app/debug/test-coverage.pkg

## test-coverage.pkg

# Compiled by:
#     src/app/debug/plugins.lib

#   Using the generic trace/debug/profile framework for test coverage.


stipulate
    package ctl =  global_controls;                     # global_controls       is from   src/lib/compiler/toplevel/main/global-controls.pkg
    package im  =  int_red_black_map;                   # int_red_black_map     is from   src/lib/src/int-red-black-map.pkg
    package lms =  list_mergesort;                      # list_mergesort        is from   src/lib/src/list-mergesort.pkg
    package pfc =  printf_combinator;                   # printf_combinator     is from   src/lib/src/printf-combinator.pkg
    package rwv =  rw_vector;                           # rw_vector             is from   src/lib/std/src/rw-vector.pkg
    package tdp =  runtime_internals::tdp;              # runtime_internals     is from   src/lib/std/src/nj/runtime-internals.pkg
herein

    package test_coverage
    : (weak)
    api {
        Kind;

        functions:      Kind;
        tail_calls:     Kind;
        non_tail_calls: Kind;

        not_covered:    List( Kind ) -> Void;
        hot_spots:      List( Kind ) -> Int -> Void;

        install:  Void -> Void;
    }
    {
        Kind = Int;

        functions      = tdp::idk_entry_point;
        tail_calls     = tdp::idk_tail_call;
        non_tail_calls = tdp::idk_non_tail_call;

        Record = { kind:  Int, descr: String };

        records = REF (im::empty:  im::Map( Record ));

        counters = REF (rwv::from_list [0]);

        fun count idx
            =
            rwv::get (*counters, idx)
            except
                exceptions::INDEX_OUT_OF_BOUNDS = 0;

        fun bump (module, id)
            =
            {   idx = module + id;
                a = *counters;

                rwv::set (a, idx, rwv::get (a, idx) + 1)
                except
                    exceptions::INDEX_OUT_OF_BOUNDS
                        =
                        {  olen = rwv::length a;
                           nlen = int::min (idx + 1, olen + olen);

                           fun cp i
                               =
                               if   (i < olen)  rwv::get (a, i);
                               elif (i == idx)  1;
                               else             0;
                               fi;

                           counters := rwv::from_fn (nlen, cp);
                        };
            };

        enter = bump;
        fun push mi = { bump mi;   \\ () = (); };
        nopush = bump;

        fun register (module, kind, id, s)
            =
            {   idx = module + id;
                r = { kind, descr => s };

                records := im::set (*records, idx, r);
            };

        fun save () () = ();

        name = "test_coverage";


        fun install ()
            =
            addto  tdp::active_plugins  plugin
            where
                plugin = { name, save,
                           push, nopush,
                           enter, register
                         };

                fun addto r x
                    =
                    r := x ! *r;
            end;


        fun not_covered kinds
            =
            im::apply  tell  zrecords
            where
                fun zerocnt (idx, r: Record)
                    =
                    count idx == 0
                    and
                    list::exists
                        (\\ k =   k == r.kind)
                        kinds;

                zrecords = im::keyed_filter zerocnt *records;

                fun tell { descr, kind }
                    =
                    ctl::print::say (descr + "\n");
            end;


        fun hot_spots kinds n
            =
            loop (sortedcountlist, n)
            where
                fun getcount (idx, r: Record)
                    =
                    if  (list::exists
                             (\\ k =  k == r.kind)
                             kinds
                        )

                        THE (r.descr, count idx);
                    else
                        NULL;
                    fi;

                countmap  =  im::keyed_map'  getcount  *records;
                countlist =  im::vals_list countmap;

                fun lt ( (_, c ),
                         (_, c') )
                    =
                    c < c';

                sortedcountlist =  lms::sort_list  lt  countlist;

                fun loop ([], _) => ();
                    loop ( _, 0) => ();
                    loop ((descr, count) ! rest, n)
                        =>
                        {   ctl::print::say (pfc::format (pfc::padl 3 pfc::int o pfc::sp 1 o pfc::string o pfc::nl) count descr);
                            loop (rest, n - 1);
                        };
                end;
            end;
    };
end;