1 
2 #include "calltree.h"
3 
4 #ifndef CB_PRECOMP
5     #include <manager.h>
6 #endif
7 
8 #include "tokenf.h"
9 #include "submoduletokenf.h"
10 #include "calledbydict.h"
11 
CallTree(FortranProject * forproj)12 CallTree::CallTree(FortranProject* forproj)
13 {
14     m_pCallTreeView = new CallTreeView(Manager::Get()->GetAppWindow(), forproj);
15 
16     m_FortranIntrinsicModules.insert(_T("iso_c_binding"));
17     m_FortranIntrinsicModules.insert(_T("iso_fortran_env"));
18     m_FortranIntrinsicModules.insert(_T("ieee_exceptions"));
19     m_FortranIntrinsicModules.insert(_T("ieee_arithmetic"));
20     m_FortranIntrinsicModules.insert(_T("ieee_features"));
21     m_FortranIntrinsicModules.insert(_T("omp_lib"));
22 
23     CodeBlocksDockEvent evt(cbEVT_ADD_DOCK_WINDOW);
24     evt.name = _T("FCallTree");
25     evt.title = _("Fortran Call/Called-By Tree");
26     evt.pWindow = m_pCallTreeView;
27     evt.dockSide = CodeBlocksDockEvent::dsFloating;
28     evt.desiredSize.Set(200, 250);
29     evt.floatingSize.Set(200, 250);
30     evt.minimumSize.Set(150, 150);
31     Manager::Get()->ProcessEvent(evt);
32 }
33 
~CallTree()34 CallTree::~CallTree()
35 {
36     if (m_pCallTreeView)
37     {
38         CodeBlocksDockEvent evt(cbEVT_REMOVE_DOCK_WINDOW);
39         evt.pWindow = m_pCallTreeView;
40         Manager::Get()->ProcessEvent(evt);
41         m_pCallTreeView->Destroy();
42         m_pCallTreeView = nullptr;
43     }
44 }
45 
BuildCallTree(cbEditor * ed,const wxString & NameUnderCursor,ParserF * pParser,std::set<wxString> & keywordSet,bool showCallTree)46 void CallTree::BuildCallTree(cbEditor* ed, const wxString& NameUnderCursor, ParserF* pParser, std::set< wxString>& keywordSet, bool showCallTree)
47 {
48     TokensArrayFlatClass tokensTmp;
49     TokensArrayFlat* pRoot = tokensTmp.GetTokens();
50 
51     pParser->FindMatchTokensForJump(ed, true, true, *pRoot);
52 
53     int tokenKindMask = tkFunction | tkSubroutine | tkProgram | tkInterface | tkInterfaceExplicit | tkProcedure
54                         | tkModule | tkSubmodule;
55 
56     if (pRoot->GetCount() > 1)
57     {
58         // Remove not-procedures
59         for (size_t i=0; i < pRoot->GetCount(); )
60         {
61             if (!(pRoot->Item(i)->m_TokenKind & tokenKindMask))
62             {
63                 pRoot->Item(i)->Clear();
64                 delete pRoot->Item(i);
65                 pRoot->RemoveAt(i);
66                 if (pRoot->GetCount() == 1)
67                     break;
68             }
69             else
70                 i++;
71         }
72     }
73 
74     if (pRoot->GetCount() == 1 && !(pRoot->Item(0)->m_TokenKind & tokenKindMask))
75     {
76         wxString msg = _T("\"") + NameUnderCursor + _("\" is not a procedure or a module.");
77         cbMessageBox(msg, _("Error"), wxICON_ERROR);
78         return;
79     }
80     else if (pRoot->GetCount() == 0)
81     {
82         wxString msg = _("Procedure \"") + NameUnderCursor + _("\" was not found.");
83         cbMessageBox(msg, _("Not found"), wxICON_WARNING);
84         return;
85     }
86 
87     bool isVis = IsWindowReallyShown((wxWindow*)m_pCallTreeView);
88     if (!isVis)
89     {
90         CodeBlocksDockEvent evt(cbEVT_SHOW_DOCK_WINDOW);
91         evt.pWindow = (wxWindow*) m_pCallTreeView;
92         Manager::Get()->ProcessEvent(evt);
93     }
94 
95     int explIntIdx = -1;
96     for (size_t i=0; i<pRoot->size(); i++)
97     {
98         if (pRoot->Item(i)->m_ParentTokenKind == tkInterfaceExplicit)
99         {
100             explIntIdx = i;
101             break;
102         }
103     }
104 
105     CalledByDict cByDict;
106     if (!showCallTree)
107         pParser->BuildCalledByDict(cByDict);
108 
109     TokensArrayClass tokAllTmp;
110     TokensArrayF* tokAll = tokAllTmp.GetTokens();
111 
112     for (size_t i=0; i<pRoot->size(); i++)
113     {
114         if (explIntIdx != -1 && explIntIdx != int(i))
115             continue; // take only explicitInterface if such exist
116 
117         TokenFlat* tf = pRoot->Item(i);
118         CallTreeToken* tok = new CallTreeToken(tf);
119         tokAll->Add(tok);
120 
121         if (showCallTree)
122         {
123             // Call tree
124             if (explIntIdx != -1 && explIntIdx == int(i))
125             {
126                 // it is explicitInterface
127                 ManageInterfaceExplicit(pParser, tf, tok, keywordSet);
128             }
129             else if (tf->m_TokenKind == tkProcedure && tf->m_ParentTokenKind == tkType)
130             {
131                 // it is type-bound procedure
132                 ManageTBProceduresForCallTree(pParser, tf, tok, keywordSet);
133             }
134             else if (tf->m_TokenKind == tkModule || tf->m_TokenKind == tkSubmodule)
135             {
136                 FindUsedModules(pParser, tok);
137             }
138             else
139             {
140                 FindCalledTokens(pParser, tok, keywordSet);
141             }
142         }
143         else
144         {
145             // Called By tree
146             FindCallingTokens(pParser, tok, cByDict);
147         }
148     }
149 
150     if (showCallTree)
151         m_pCallTreeView->ShowCallTree(tokAll);
152     else
153         m_pCallTreeView->ShowCalledByTree(tokAll);
154 
155 }
156 
FindUsedModules(ParserF * pParser,CallTreeToken * token)157 void CallTree::FindUsedModules(ParserF* pParser, CallTreeToken* token)
158 {
159     if (token->m_TokenKind == tkSubmodule)
160     {
161         TokenFlat ctF(token);
162         TokenF* tokSub = pParser->FindToken(ctF);
163         if (tokSub && tokSub->m_TokenKind == tkSubmodule)
164         {
165             SubmoduleTokenF* submod = static_cast<SubmoduleTokenF*>(tokSub);
166             wxString parentModName = submod->m_AncestorModuleName;
167 
168             TokensArrayFlatClass tokensMod;
169             TokensArrayFlat* resultMod = tokensMod.GetTokens();
170             int noChildrenOf = tkInterface | tkFunction | tkSubroutine | tkProgram | tkModule | tkSubmodule;
171             pParser->FindMatchTokensDeclared(parentModName, *resultMod, tkModule | tkSubmodule, false, noChildrenOf, true);
172 
173             if (resultMod->size() == 0)
174             {
175                 // Ancestor module | submodule was not found
176                 TokenFlat modFT(ctF);
177                 modFT.m_Name = parentModName;
178                 modFT.m_DisplayName = parentModName;
179                 modFT.m_TokenKind = tkModule;
180 
181                 if (!HasCallChildToken(token, &modFT))
182                 {
183                     CallTreeToken* tok2  = new CallTreeToken(&modFT, token);
184                     tok2->m_CallFilename = modFT.m_Filename;
185                     tok2->m_CallLine     = modFT.m_LineStart;
186                     tok2->m_TokenKind    = tkCallSubroutine; // to get "unknown" icon, which shows that the ancestor was not found
187 
188                     token->AddChild(tok2);
189                 }
190             }
191             else
192             {
193                 TokenFlat* tf2 = resultMod->Item(0); // take just first result
194                 if (!HasChildToken(token, tf2) && !HasInHerarchy(token, tf2))
195                 {
196                     CallTreeToken* tok2 = new CallTreeToken(tf2, token);
197                     tok2->m_CallFilename = ctF.m_Filename;
198                     tok2->m_CallLine     = ctF.m_LineStart;
199                     token->AddChild(tok2);
200 
201                     FindUsedModules(pParser, tok2);
202                 }
203             }
204         }
205     }
206 
207     TokensArrayFlatClass tokensTmp;
208     TokensArrayFlat* callChildren = tokensTmp.GetTokens();
209 
210     int callFilter = tkUse | tkInclude ;
211     TokenFlat tf = TokenFlat(token);
212     pParser->GetChildren(&tf, callFilter, *callChildren, 8);  // here levelMax should be more than enough
213     size_t ncChild = callChildren->size();
214     for (size_t j=0; j<ncChild; j++)
215     {
216         TokenFlat* oneCall = callChildren->Item(j);
217         if (oneCall->m_TokenKind == tkUse && m_FortranIntrinsicModules.count(oneCall->m_Name) != 0)
218             continue;
219         TokensArrayFlatClass tokClTmp;
220         TokensArrayFlat* resToks = tokClTmp.GetTokens();
221         FindTokenFromCall(pParser, &tf, oneCall, resToks);
222 
223         if (resToks->size() == 0)
224         {
225             if (!HasCallChildToken(token, oneCall))
226             {
227                 CallTreeToken* tok2 = new CallTreeToken(oneCall, token);
228                 tok2->m_CallFilename = oneCall->m_Filename;
229                 tok2->m_CallLine     = oneCall->m_LineStart;
230                 tok2->m_TokenKind    = tkCallSubroutine; // just to get "unknown" icon
231 
232                 token->AddChild(tok2);
233             }
234         }
235         else
236         {
237             for (size_t k=0; k<resToks->size(); k++)
238             {
239                 TokenFlat* tf2 = resToks->Item(k);
240                 if (!HasChildToken(token, tf2) && !HasInHerarchy(token, tf2))
241                 {
242                     CallTreeToken* tok2 = new CallTreeToken(tf2, token);
243                     tok2->m_CallFilename = oneCall->m_Filename;
244                     tok2->m_CallLine     = oneCall->m_LineStart;
245                     token->AddChild(tok2);
246 
247                     FindUsedModules(pParser, tok2);
248                     break; // take just first suitable result
249                 }
250             }
251         }
252     }
253 }
254 
FindCalledTokens(ParserF * pParser,CallTreeToken * token,std::set<wxString> & keywordSet)255 void CallTree::FindCalledTokens(ParserF* pParser, CallTreeToken* token, std::set< wxString>& keywordSet)
256 {
257     TokensArrayFlatClass tokensTmp;
258     TokensArrayFlat* callChildren = tokensTmp.GetTokens();
259 
260     int callFilter;
261     if (token->m_TokenKind == tkInterface)
262         callFilter = tkOther;
263     else
264         callFilter = tkCallSubroutine | tkCallFunction;
265 
266     TokenFlat tf = TokenFlat(token);
267     pParser->GetChildren(&tf, callFilter, *callChildren);
268     size_t ncChild = callChildren->size();
269 
270     for (size_t j=0; j<ncChild; j++)
271     {
272         TokenFlat* oneCall = callChildren->Item(j);
273         if (keywordSet.count(oneCall->m_Name) != 0)
274             continue;
275         TokensArrayFlatClass tokClTmp;
276         TokensArrayFlat* resToks = tokClTmp.GetTokens();
277         FindTokenFromCall(pParser, &tf, oneCall, resToks);
278 
279         if (resToks->size() == 0)
280         {
281             if (!HasCallChildToken(token, oneCall))
282             {
283                 CallTreeToken* tok2 = new CallTreeToken(oneCall, token);
284                 tok2->m_CallFilename = oneCall->m_Filename;
285                 tok2->m_CallLine     = oneCall->m_LineStart;
286 
287                 token->AddChild(tok2);
288             }
289         }
290         else
291         {
292             TokenFlat* tokType = NULL;
293             for (size_t k=0; k<resToks->size(); k++)
294             {
295                 TokenFlat* tf2 = resToks->Item(k);
296                 if (tf2->m_TokenKind == tkType)
297                 {
298                     tokType = tf2;
299                 }
300                 else if ((tf2->m_TokenKind != tkVariable) && !HasChildToken(token, tf2) && !HasInHerarchy(token, tf2))
301                 {
302                     CallTreeToken* tok2 = new CallTreeToken(tf2, token);
303                     tok2->m_CallFilename = oneCall->m_Filename;
304                     tok2->m_CallLine     = oneCall->m_LineStart;
305 
306                     token->AddChild(tok2);
307 
308                     if (tf2->m_ParentTokenKind == tkInterfaceExplicit)
309                     {
310                         ManageInterfaceExplicit(pParser, tf2, tok2, keywordSet);
311                     }
312                     else if (tf2->m_TokenKind == tkProcedure && tf2->m_ParentTokenKind == tkType)
313                     {
314                         // it is type-bound procedure
315                         ManageTBProceduresForCallTree(pParser, tf2, tok2, keywordSet);
316                     }
317                     else
318                     {
319                         FindCalledTokens(pParser, tok2, keywordSet);
320                     }
321                     tokType = NULL;
322                     break; // take just first suitable result
323                 }
324             }
325 
326             if (tokType && !HasChildToken(token, tokType) && !HasInHerarchy(token, tokType))
327             {
328                 CallTreeToken* tok2 = new CallTreeToken(tokType, token);
329                 tok2->m_CallFilename = oneCall->m_Filename;
330                 tok2->m_CallLine     = oneCall->m_LineStart;
331 
332                 token->AddChild(tok2);
333             }
334         }
335     }
336 }
337 
338 
FindTokenFromCall(ParserF * pParser,TokenFlat * parentTok,TokenFlat * oneCall,TokensArrayFlat * result)339 void CallTree::FindTokenFromCall(ParserF* pParser, TokenFlat* parentTok, TokenFlat* oneCall, TokensArrayFlat* result)
340 {
341     int tokenKindMask = tkFunction | tkSubroutine | tkInterface | tkInterfaceExplicit | tkVariable | tkType;
342 
343     if (oneCall->m_Name.Find('%') != wxNOT_FOUND && parentTok)
344     {
345         // call of type-bound procedure
346         pParser->FindMatchTypeComponents(*parentTok, oneCall->m_Name, *result);
347     }
348     else
349     {
350         wxString findName;
351         if (oneCall->m_TokenKind == tkProcedure && !oneCall->m_PartLast.IsEmpty())
352             findName = oneCall->m_PartLast;
353         else
354             findName = oneCall->m_Name;
355         pParser->FindUseAssociatedTokens(true, oneCall, findName, false, *result, tokenKindMask, false);
356     }
357     if (oneCall->m_ParentTokenKind == tkInterfaceExplicit)
358         pParser->FindImplementedProcInMySubmodules(oneCall, oneCall->m_Name, *result);
359     if (result->GetCount() > 0)
360         return;
361 
362     // Try to find global procedures
363     int noChildrenOf = tkInterface | tkFunction | tkSubroutine | tkProgram | tkModule | tkSubmodule;
364     tokenKindMask = tokenKindMask | tkModule;
365     pParser->FindMatchTokensDeclared(oneCall->m_Name, *result, tokenKindMask, false, noChildrenOf, false, true);
366 }
367 
HasChildToken(TokenF * tokParent,TokenF * tok)368 bool CallTree::HasChildToken(TokenF* tokParent, TokenF* tok)
369 {
370     TokensArrayF* tokArr = &tokParent->m_Children;
371     for (size_t i=0; i<tokArr->size(); i++)
372     {
373         TokenF* tokItem = tokArr->Item(i);
374         if (tokItem->m_TokenKind == tok->m_TokenKind &&
375             tokItem->m_Name == tok->m_Name &&
376             tokItem->m_Filename == tok->m_Filename &&
377             tokItem->m_LineStart == tok->m_LineStart &&
378             tokItem->m_LineEnd == tok->m_LineEnd &&
379             tokItem->m_TokenAccess == tok->m_TokenAccess)
380         {
381             return true;
382         }
383     }
384     return false;
385 }
386 
HasCallChildToken(TokenF * tokParent,TokenFlat * tok)387 bool CallTree::HasCallChildToken(TokenF* tokParent, TokenFlat* tok)
388 {
389     TokensArrayF* tokArr = &tokParent->m_Children;
390     for (size_t i=0; i<tokArr->size(); i++)
391     {
392         TokenF* tokItem = tokArr->Item(i);
393         if (tokItem->m_Name == tok->m_Name)
394         {
395             return true;
396         }
397     }
398     return false;
399 }
400 
HasInHerarchy(TokenF * tokParent,TokenF * tok)401 bool CallTree::HasInHerarchy(TokenF* tokParent, TokenF* tok)
402 {
403     // Used to avoid recursive calls
404     TokenF* tokIn = tokParent;
405     while(tokIn)
406     {
407         if (tokIn->m_TokenKind == tok->m_TokenKind &&
408             tokIn->m_Name == tok->m_Name &&
409             tokIn->m_Filename == tok->m_Filename &&
410             tokIn->m_LineStart == tok->m_LineStart &&
411             tokIn->m_LineEnd == tok->m_LineEnd &&
412             tokIn->m_TokenAccess == tok->m_TokenAccess)
413         {
414             return true;
415         }
416         tokIn = tokIn->m_pParent;
417     }
418     return false;
419 }
420 
ManageInterfaceExplicit(ParserF * pParser,TokenFlat * origFT,CallTreeToken * token,std::set<wxString> & keywordSet)421 void CallTree::ManageInterfaceExplicit(ParserF* pParser, TokenFlat* origFT, CallTreeToken* token, std::set<wxString>& keywordSet)
422 {
423     // Try to find global procedures
424     TokensArrayFlatClass tokGlobTmp;
425     TokensArrayFlat* resGlobOrSumb = tokGlobTmp.GetTokens();
426     int tokenKindMask = tkFunction | tkSubroutine;
427     int noChildrenOf = tkInterface | tkInterfaceExplicit | tkFunction | tkSubroutine | tkProgram | tkModule | tkSubmodule;
428     pParser->FindMatchTokensDeclared(origFT->m_Name, *resGlobOrSumb, tokenKindMask, false, noChildrenOf, false, true);
429 
430     if (resGlobOrSumb->size() == 0)
431     {
432         // Try to find implementation between submodule procedures
433         pParser->FindImplementedProcInMySubmodules(origFT, origFT->m_Name, *resGlobOrSumb);
434     }
435 
436     for (size_t l=0; l<resGlobOrSumb->size(); l++)
437     {
438         TokenFlat* tfGlob = resGlobOrSumb->Item(l);
439         if (!HasChildToken(token, tfGlob))
440         {
441             CallTreeToken* tg = new CallTreeToken(tfGlob, token);
442             tg->m_CallFilename = token->m_Filename;
443             tg->m_CallLine     = token->m_LineStart;
444 
445             token->AddChild(tg);
446 
447             FindCalledTokens(pParser, tg, keywordSet);
448         }
449     }
450 }
451 
FindCallingTokens(ParserF * pParser,CallTreeToken * token,CalledByDict & cByDict)452 void CallTree::FindCallingTokens(ParserF* pParser, CallTreeToken* token, CalledByDict& cByDict)
453 {
454     std::list<TokenF*>* tokList = cByDict.GetCallingTokens(token->m_Name);
455     if (!tokList)
456         return;
457 
458     for (std::list<TokenF*>::iterator li=tokList->begin(); li != tokList->end(); ++li)
459     {
460         TokenF* pCTok = *li;
461         TokenFlat oneCall(pCTok);
462         if (oneCall.m_TokenKind == tkSubmodule)
463         {
464             oneCall.m_Name = oneCall.m_Name.BeforeLast(':');
465         }
466         TokensArrayFlatClass tokClTmp;
467         TokensArrayFlat* resToks = tokClTmp.GetTokens();
468         TokenFlat parTokF = TokenFlat(pCTok->m_pParent);
469         FindTokenFromCall(pParser, &parTokF, &oneCall, resToks);
470 
471         for (size_t k=0; k<resToks->size(); k++)
472         {
473             TokenFlat* tf2 = resToks->Item(k);
474             if (tf2->m_TokenKind == token->m_TokenKind &&
475                 tf2->m_Name == token->m_Name &&
476                 tf2->m_Filename == token->m_Filename &&
477                 tf2->m_LineStart == token->m_LineStart)
478             {
479                 TokenF* parTok = NULL;
480                 if (pCTok->m_TokenKind == tkSubmodule)
481                 {
482                     parTok = pCTok;
483                 }
484                 else if (pCTok->m_pParent)
485                 {
486                     if (pCTok->m_pParent->m_TokenKind == tkInterfaceExplicit)
487                         parTok = pCTok;
488                     else if (pCTok->m_pParent->m_TokenKind == tkType)
489                         parTok = pCTok;
490                     else if (pCTok->m_pParent->m_TokenKind == tkAssociateConstruct)
491                     {
492                         parTok = pCTok->m_pParent;
493                         while (parTok)
494                         {
495                             if (parTok->m_TokenKind == tkAssociateConstruct)
496                             {
497                                 parTok = parTok->m_pParent;
498                             }
499                             else
500                                 break;
501                         }
502                     }
503                     else
504                         parTok = pCTok->m_pParent;
505                 }
506 
507                 if (parTok && !HasChildToken(token, parTok) && !HasInHerarchy(token, parTok))
508                 {
509                     CallTreeToken* tok2 = new CallTreeToken(parTok, token);
510                     tok2->m_CallFilename = pCTok->m_Filename;
511                     tok2->m_CallLine     = pCTok->m_LineStart;
512 
513                     token->AddChild(tok2);
514 
515                     FindCallingTokens(pParser, tok2, cByDict);
516                 }
517 
518                 break; // take only first suitable item
519             }
520         }
521     }
522 }
523 
ManageTBProceduresForCallTree(ParserF * pParser,TokenFlat * origFT,CallTreeToken * token,std::set<wxString> & keywordSet)524 void CallTree::ManageTBProceduresForCallTree(ParserF* pParser, TokenFlat* origFT, CallTreeToken* token, std::set<wxString>& keywordSet)
525 {
526     TokensArrayFlatClass resultTmp;
527     TokensArrayFlat* result = resultTmp.GetTokens();
528     FindTokenFromCall(pParser, NULL, origFT, result);
529 
530     for (size_t l=0; l<result->size(); l++)
531     {
532         TokenFlat* tf = result->Item(l);
533         if (!HasChildToken(token, tf))
534         {
535             CallTreeToken* tg = new CallTreeToken(tf, token);
536             tg->m_CallFilename = token->m_Filename;
537             tg->m_CallLine     = token->m_LineStart;
538 
539             token->AddChild(tg);
540 
541             FindCalledTokens(pParser, tg, keywordSet);
542         }
543     }
544 }
545