1 % (c) 2014-2019 Lehrstuhl fuer Softwaretechnik und Programmiersprachen,
2 % Heinrich Heine Universitaet Duesseldorf
3 % This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html)
4
5 :- module(tcltk_tree_inspector,[
6 tti_number_of_columns/2,
7 %tti_column_name/3,
8 tti_column_info/6,
9 tti_get_node_info/6,
10 reset_tcltk_tree_inspector/0]).
11
12 :- use_module(error_manager).
13 :- use_module(sap).
14 :- use_module(library(lists)).
15 :- use_module(ast_inspector).
16
17 :- use_module(module_information,[module_info/2]).
18 :- module_info(group,tcltk).
19 :- module_info(description,'This module provides the interface to the Tcl/Tk tree_inspector.').
20
21 % The module provides the descriptions and access to various trees displayed by tree_inspector.tcl
22 % We have various TreeTypes : ast, cbc_tests, ....
23 % Each Tree has a certain number of columns for the nodes described by tti_column_name/3
24 % Each Tree node can be inspected using tti_get_node_info
25 % The Paths in the tree (TTI_Path) record the number of each child selected (starting at 0)
26
27 tti_number_of_columns(empty,Nr) :- !, Nr=0.
28 tti_number_of_columns(Type,Nr) :-
29 findall(C,(tti_column_name(Type,C,_), number(C)),L),
30 length(L,Nr).
31
32 % column name and width descriptions:
33 tti_column_name(TreeType,Column,Name) :-
34 tti_column_info(TreeType,Column,Name,_MinWidth,_Width,_Anchor).
35
36 tti_column_info(ast,header,'Node',100,300,w).
37 tti_column_info(ast,0,'Type',20,80,center).
38 tti_column_info(ast,1,'Infos',20,90,w).
39 tti_column_info(ast,2,'Quantified Ids',20,80,center).
40
41 tti_column_info(cbc_tests,header,'Event',100,400,w).
42 tti_column_info(cbc_tests,0,'Depth', 20,70,center).
43 tti_column_info(cbc_tests,1,'StateID', 25,70,center).
44 tti_column_info(cbc_tests,2,'Nr.Paths', 25,70,center).
45 tti_column_info(cbc_tests,3,'Nr.Tests', 25,70,center).
46
47 tti_column_info(_,_,'??',20,40,center).
48
49 % possible Tags are defined in file tree_inspector.tcl: error, inac, ptrue, pfalse, subst
50 % tti_get_node_info(Type,Pindex,Text,Columns,Subs,Tags) :-
51 %tti_get_node_info(Type,Pindex,Text,Columns,Subs,Tags) :- print(get(Type,Pindex,Text,Columns,Subs)),nl,fail.
52 tti_get_node_info(empty,_,'-',list([]),0,list([])) :- !.
53 tti_get_node_info(cbc_tests,Pindex,Text,list(Columns),NrOfSubs,list(Tags)) :- !,
54 cbc_test_node_info(Pindex,Text,Columns,NrOfSubs,Tags).
55 tti_get_node_info(ast,Pindex,Text,list([Type,Infos,QIDs]),NrOfSubs,list(Tags)) :-
56 tcltk_get_node_info(Pindex,Text,Type,Infos,QIDs,NrOfSubs),
57 (Type = write(pred) -> Tags = [ptrue] ; Type = write(subst) -> Tags = [pfalse]
58 ; Type = write('') -> Tags = [gray5]
59 ; Tags = [darkblue]).
60
61
62 cbc_test_node_info([],'',[0,0,0,0],1,[]) :- % top-level; not shown in view
63 assert(tti_path_to_term(cbc_tests,[],[])).
64 cbc_test_node_info([0|TTI_Path],Event,[Depth,Last,NrOfPaths,NrOfTests],NrOfSubs,Tags) :-
65 %print(find(TTI_Path)),nl,
66 cbc_path_info(TTI_Path,Event,Depth,Last,NrOfPaths,NrOfTests,NrOfSubs,Tags),
67 %print(found(TTI_Path,Event,Depth,Last,NrOfPaths,NrOfSubs)),nl,
68 true.
69
70 cbc_path_info(TTI_Path,Event,Depth,Last,NrOfPaths,NrOfTests,NrOfSubs,Tags) :-
71 translate_tti_path_to_term(cbc_tests,TTI_Path,CBC_Path),
72 %print(cbc(CBC_Path)),nl,
73 cbc_get_path(Depth,CBC_Path,Last),
74 (CBC_Path = [] -> Event = 'INITIALISATION' ; last(CBC_Path,Event)),
75 append(CBC_Path,_,Prefix),
76 findall(Last,sap:cb_path(_,Prefix,_),AllPathsWithPrefix),
77 length(AllPathsWithPrefix,NrOfPaths),
78 findall(Last,sap:stored_test_case_op_trace(_,Prefix),AllTestsWithPrefix),
79 length(AllTestsWithPrefix,NrOfTests),
80 findall(Desc,cbc_get_direct_descendant(CBC_Path,Desc),AllDirectDescPaths),
81 store_tti_paths(AllDirectDescPaths,0,TTI_Path,cbc_tests),
82 length(AllDirectDescPaths,NrOfSubs),
83 (sap:stored_test_case_op_trace(_TestNr,CBC_Path)
84 -> Tags = [ptrue] % we have generated a test-case from this path
85 ; NrOfTests>0 -> Tags = []
86 ; Tags = [darkgray]).
87
88 cbc_get_path(Depth,CBC_Path,Last) :- sap:cb_path(Depth,CBC_Path,Last).
89 cbc_get_path(Depth,CBC_Path,timeout) :- sap:cb_timeout_path(Depth,CBC_Path).
90 cbc_get_path(Depth,CBC_Path,Last) :- sap:cb_path_testcase_only(Depth,CBC_Path,Last).
91
92
93 cbc_get_direct_descendant(CBC_Path,NewPath) :-
94 append(CBC_Path,[_],NewPath),
95 cbc_get_path(_,NewPath,_).
96
97 % --------------------
98
99 % utilities of translating a TTI Path of argument positions to a Prolog Term
100 % TO DO: use term_hash or something like that + retractall after reset
101 :- dynamic tti_path_to_term/3.
102
103 store_tti_paths([],_,_,_).
104 store_tti_paths([DescendantTerm|T],ChildNr,TTI_Path,TTI_Tree_Type) :-
105 append(TTI_Path,[ChildNr],NewPath),
106 assert(tti_path_to_term(TTI_Tree_Type,NewPath,DescendantTerm)),
107 %print(stored(NewPath,DescendantTerm)),nl,
108 ChildNr1 is ChildNr+1,
109 store_tti_paths(T,ChildNr1,TTI_Path,TTI_Tree_Type).
110
111 translate_tti_path_to_term(TTI_Tree_Type,TTI_Path,PrologTerm) :-
112 (tti_path_to_term(TTI_Tree_Type,TTI_Path,R) -> PrologTerm=R
113 ; add_internal_error('Cannot translate: ',
114 translate_tti_path_to_term(TTI_Tree_Type,TTI_Path,PrologTerm)),
115 PrologTerm = []).
116
117 reset_tcltk_tree_inspector :- retractall(tti_path_to_term(_,_,_)).