1 {
2  ***************************************************************************
3  *                                                                         *
4  *   This source is free software; you can redistribute it and/or modify   *
5  *   it under the terms of the GNU General Public License as published by  *
6  *   the Free Software Foundation; either version 2 of the License, or     *
7  *   (at your option) any later version.                                   *
8  *                                                                         *
9  *   This code is distributed in the hope that it will be useful, but      *
10  *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
11  *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
12  *   General Public License for more details.                              *
13  *                                                                         *
14  *   A copy of the GNU General Public License is available on the World    *
15  *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
16  *   obtain it by writing to the Free Software Foundation,                 *
17  *   Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
18  *                                                                         *
19  ***************************************************************************
20 
21   Author: Mattias Gaertner
22 
23   Abstract:
24     TFindDeclarationTool enhances the TPascalReaderTool with the ability
25     to find the source position or code tree node of a declaration.
26 
27 
28   ToDo:
29     - high type expression evaluation
30       (i.e. at the moment: integer+integer=longint
31                    wanted: integer+integer=integer)
32     - make @Proc context sensitive (started, but not complete)
33     - operator overloading
34     - ppu, dcu files
35     - many things, search for 'ToDo'
36 }
37 unit FindDeclarationTool;
38 
39 {$ifdef FPC}{$mode objfpc}{$endif}{$H+}
40 
41 interface
42 
43 {$I codetools.inc}
44 
45 // activate for debugging:
46 
47 // mem check
48 { $DEFINE MEM_CHECK}
49 
50 // verbosity
51 { $DEFINE CTDEBUG}
52 { $DEFINE ShowTriedFiles}
53 { $DEFINE ShowTriedContexts}
54 { $DEFINE ShowTriedBaseContexts}
55 { $DEFINE ShowTriedParentContexts}
56 { $DEFINE ShowTriedIdentifiers}
57 { $DEFINE ShowTriedUnits}
58 { $DEFINE ShowExprEval}
59 { $DEFINE ShowForInEval}
60 { $DEFINE ShowFoundIdentifier}
61 { $DEFINE ShowNodeCache}
62 { $DEFINE ShowBaseTypeCache}
63 { $DEFINE ShowCacheDependencies}
64 { $DEFINE ShowCollect}
65 { $DEFINE ShowProcSearch}
66 { $DEFINE VerboseFindDeclarationFail}
67 { $DEFINE DebugAddToolDependency}
68 { $DEFINE VerboseCPS}
69 { $DEFINE VerboseFindDeclarationAndOverload}
70 { $DEFINE VerboseFindFileAtCursor}
71 
72 {$IFDEF CTDEBUG}{$DEFINE DebugPrefix}{$ENDIF}
73 {$IFDEF ShowTriedIdentifiers}{$DEFINE DebugPrefix}{$ENDIF}
74 {$IFDEF ShowTriedContexts}{$DEFINE DebugPrefix}{$ENDIF}
75 {$IFDEF ShowExprEval}{$DEFINE ShowForInEval}{$ENDIF}
76 
77 uses
78   {$IFDEF MEM_CHECK}
79   MemCheck,
80   {$ENDIF}
81   Classes, SysUtils, Laz_AVL_Tree,
82   // LazUtils
83   LazFileUtils, LazUtilities,
84   // Codetools
85   CodeToolsStrConsts, CodeTree, CodeAtom, CustomCodeTool,
86   SourceLog, KeywordFuncLists, BasicCodeTools, LinkScanner, CodeCache,
87   DirectoryCacher, PascalParserTool, PascalReaderTool, FileProcs,
88   DefineTemplates, FindDeclarationCache;
89 
90 type
91   TFindDeclarationTool = class;
92 
93   //----------------------------------------------------------------------------
94   // variable atoms
95 
96   TVariableAtomType = (
97     vatNone,             // undefined
98     vatSpace,            // empty or space
99     vatIdentifier,       // an identifier
100     vatPreDefIdentifier, // an identifier with special meaning to the compiler
101     vatPoint,            // .
102     vatAS,               // AS keyword
103     vatINHERITED,        // INHERITED keyword
104     vatUp,               // ^
105     vatRoundBracketOpen, // (
106     vatRoundBracketClose,// )
107     vatEdgedBracketOpen, // [
108     vatEdgedBracketClose,// ]
109     vatAddrOp,           // @
110     vatKeyword,          // other keywords
111     vatNumber,           // decimal, & octal, % binary, $ hex
112     vatStringConstant    // '' or #
113     );
114 
115 const
116   // for nicer debugging output
117   VariableAtomTypeNames: array[TVariableAtomType] of string =
118     ('<None>',
119      'Space',
120      'Ident',
121      'PreDefIdent',
122      'Point',
123      'AS',
124      'INHERITED',
125      'Up^ ',
126      'Bracket(',
127      'Bracket)',
128      'Bracket[',
129      'Bracket]',
130      'AddrOperator@ ',
131      'Keyword',
132      'Number',
133      'StringConstant'
134      );
135 
136 type
137   //----------------------------------------------------------------------------
138   // searchpath delimiter is semicolon
endernull139   TOnGetSearchPath = function(Sender: TObject): string of object;
140   TOnGetSrcPathForCompiledUnit =
endernull141     function(Sender: TObject; const Filename: string): string of object;
142 
143   //----------------------------------------------------------------------------
onstnull144   TOnGetMethodName = function(const AMethod: TMethod;
145                               CheckOwner: TObject): string of object;
146 
147   //----------------------------------------------------------------------------
148   // flags/states for searching
149   TFindDeclarationFlag = (
150     fdfSearchInAncestors,   // if context is a class, search also in
151                             //    ancestors/interfaces
152     fdfSearchInParentNodes, // if identifier not found in current context,
153                             //    proceed in prior nodes on same lvl and parents
154     fdfIgnoreCurContextNode,// skip context and proceed in prior/parent context
155     fdfIgnoreUsedUnits,     // stay in current source
156     fdfSearchForward,       // instead of searching in prior nodes, search in
157                             //    next nodes (successors)
158 
159     fdfExceptionOnNotFound, // raise exception if identifier not found
160                             //    predefined identifiers will not raise
161     fdfExceptionOnPredefinedIdent,// raise an exception even if the identifier
162                             // is a predefined identifier
163 
164     fdfIgnoreClassVisibility,//find inaccessible private+protected fields
165 
166     fdfIgnoreMissingParams, // found proc fits, even if parameters are missing
167     fdfOnlyCompatibleProc,  // incompatible procs are ignored
168     fdfIgnoreOverloadedProcs,// ignore param lists and take the first proc found
169 
170     fdfFindVariable,        // do not search for the base type of a variable,
171                             //   instead return the variable declaration
isnull172     fdfFunctionResult,      // if function is found, return result type
173     fdfEnumIdentifier,      // do not resolve enum to its enum type
174     fdfFindChildren,        // search the class of a 'class of', the interface of a unit
175     fdfSkipClassForward,    // when a class forward was found search the class
176 
177     fdfCollect,             // return every reachable identifier
178     fdfTopLvlResolving,     // set, when searching for an identifier of the
179                             //   top lvl variable. Calling DoOnIdentifierFound.
180     fdfDoNotCache,          // result will not be cached
181     fdfExtractOperand,      // operand will be extracted
182     fdfPropertyResolving,   // used with fdfExtractOperand to resolve properties to getters
183 
184     fdfSearchInHelpers,     // search in class/record/type helpers too
185     fdfSearchInHelpersInTheEnd, // search in helpers after current class (used with inherited call in helper)
186     fdfTypeType,            // do not resolve TMyString = type string;
187     fdfIgnoreOperatorError, // return expression type even if an operator error was found
188     fdfOverrideStringTypesWithFirstParamType  // if you search for an expression result type of a "function A(B: string): string", override the result type with type of B expression
189     );
190   TFindDeclarationFlags = set of TFindDeclarationFlag;
191 
192 const
193   // masks to pass flags to sub searches
194   fdfGlobals = [fdfExceptionOnNotFound, fdfTopLvlResolving,
195                 fdfExtractOperand, fdfPropertyResolving,
196                 fdfOverrideStringTypesWithFirstParamType];
197   fdfGlobalsSameIdent = fdfGlobals+[fdfExceptionOnPredefinedIdent,
198                 fdfIgnoreMissingParams, fdfIgnoreUsedUnits, fdfDoNotCache,
199                 fdfOnlyCompatibleProc, fdfSearchInAncestors, fdfCollect, fdfSearchInHelpers];
200   // initial flags for searches
201   fdfDefaultForExpressions = [fdfSearchInParentNodes, fdfSearchInAncestors, fdfSearchInHelpers,
202                               fdfExceptionOnNotFound,fdfIgnoreCurContextNode];
203 
204 type
205   // flags/states for result
206   TFoundDeclarationFlag = (
207     fodDoNotCache
208     );
209   TFoundDeclarationFlags = set of TFoundDeclarationFlag;
210 
211   //----------------------------------------------------------------------------
212 type
213   TFindDeclarationParams = class;
214 
215   TFindContext = record
216     Node: TCodeTreeNode;
217     Tool: TFindDeclarationTool;
218   end;
219   PFindContext = ^TFindContext;
220 
221 const
222   CleanFindContext: TFindContext = (Node:nil; Tool:nil);
223 
224 type
225   //----------------------------------------------------------------------------
226   { TExpressionTypeDesc describes predefined types
227     The Freepascal compiler can automatically convert them
228   }
229   TExpressionTypeDesc = (
230     xtNone,        // undefined
231     xtContext,     // a node
232     xtChar,        // char
233     xtWideChar,    // widechar
234     xtReal,        // real
235     xtSingle,      // single
236     xtDouble,      // double
237     xtExtended,    // extended
238     xtCExtended,   // cextended
239     xtCurrency,    // currency
240     xtComp,        // comp
241     xtInt64,       // int64
242     xtCardinal,    // cardinal
243     xtQWord,       // qword
244     xtBoolean,     // boolean
245     xtByteBool,    // bytebool
246     xtWordBool,    // wordbool
247     xtLongBool,    // longbool
248     xtQWordBool,   // qwordbool
249     xtString,      // string
250     xtAnsiString,  // ansistring
251     xtShortString, // shortstring
252     xtWideString,  // widestring
253     xtUnicodeString,// unicodestring
254     xtPChar,       // pchar
255     xtPointer,     // pointer
256     xtFile,        // file
257     xtText,        // text
258     xtConstOrdInteger,// enum, number, integer
259     xtConstString, // string, string constant, char constant
260     xtConstReal,   // real number
261     xtConstSet,    // [] set
262     xtConstBoolean,// true, false
263     xtLongint,     // longint
264     xtLongWord,    // longword
265     xtWord,        // word
266     xtSmallInt,    // smallint
267     xtShortInt,    // shortint
268     xtByte,        // byte
269     xtNativeInt,   // depends on compiler and platform
270     xtNativeUInt,  // depends on compiler and platform
271     xtCompilerFunc,// SUCC, PREC, LOW, HIGH, ORD, LENGTH, COPY (1.1), ...
272     xtVariant,     // variant
273     xtJSValue,     // jsvalue only in Pas2JS, similar to variant
274     xtNil          // nil  = pointer, class, procedure, method, ...
275     );
276   // Do not define: TExpressionTypeDescs = set of TExpressionTypeDesc;
277   // There are too many enums, so the set would be big and slow
278 
279 var
280   ExpressionTypeDescNames: array[TExpressionTypeDesc] of string = (
281     'None',
282     'Context',
283     'Char',
284     'WideChar',
285     'Real',
286     'Single',
287     'Double',
288     'Extended',
289     'CExtended',
290     'Currency',
291     'Comp',
292     'Int64',
293     'Cardinal',
294     'QWord',
295     'Boolean',
296     'ByteBool',
297     'WordBool',
298     'LongBool',
299     'QWordBool',
300     'String',
301     'AnsiString',
302     'ShortString',
303     'WideString',
304     'UnicodeString',
305     'PChar',
306     'Pointer',
307     'File',
308     'TextFile',
309     'ConstOrdInt',
310     'ConstString',
311     'ConstReal',
312     'ConstSet',
313     'ConstBoolean',
314     'LongInt',
315     'LongWord',
316     'Word',
317     'SmallInt',
318     'ShortInt',
319     'Byte',
320     'NativeInt',
321     'NativeUInt',
322     'CompilerFunc',
323     'Variant',
324     'JSValue',
325     'Nil'
326   );
327 
328 const
329   xtAllTypes = [Low(TExpressionTypeDesc)..High(TExpressionTypeDesc)]-[xtNone];
330   xtAllPredefinedTypes = xtAllTypes-[xtContext];
331   xtAllConstTypes = [xtConstOrdInteger,xtConstBoolean,xtConstReal,
332                      xtConstString,xtConstSet,xtCompilerFunc,xtNil];
333   xtAllIdentTypes = xtAllTypes - xtAllConstTypes;
334   xtAllIdentPredefinedTypes = xtAllIdentTypes - [xtContext];
335   xtAllIntegerTypes = [xtInt64, xtQWord, xtConstOrdInteger, xtLongint,
336                        xtLongWord, xtWord, xtCardinal, xtSmallInt, xtShortInt,
337                        xtByte,xtNativeInt,xtNativeUInt];
338   xtAllBooleanTypes = [xtBoolean, xtByteBool, xtWordBool, xtLongBool,xtQWordBool];
339   xtAllRealTypes = [xtReal, xtConstReal, xtSingle, xtDouble,
340                     xtExtended, xtCExtended, xtCurrency, xtComp];
341   xtAllStringTypes = [xtConstString, xtShortString, xtString, xtAnsiString];
342   xtAllWideStringTypes = [xtConstString, xtWideString, xtUnicodeString];
343   xtAllPointerTypes = [xtPointer, xtNil];
344   xtAllTypeHelperTypes = xtAllPredefinedTypes-[xtCompilerFunc,xtVariant,xtJSValue,xtNil];
345 
346   xtAllStringCompatibleTypes = xtAllStringTypes+[xtChar,xtJSValue];
347   xtAllWideStringCompatibleTypes = xtAllWideStringTypes+[xtWideChar,xtChar];
348 
349   xtAllIntegerConvertibles = xtAllIntegerTypes;
350   xtAllRealConvertibles = xtAllRealTypes+xtAllIntegerTypes;
351   xtAllStringConvertibles = xtAllStringCompatibleTypes+[xtPChar];
352   xtAllWideStringConvertibles = xtAllWideStringCompatibleTypes+[xtPChar];
353   xtAllBooleanConvertibles = xtAllBooleanTypes+[xtConstBoolean];
354   xtAllPointerConvertibles = xtAllPointerTypes+[xtPChar];
355   xtAllPas2JSExtraTypes = [xtJSValue,xtNativeInt,xtNativeUInt];
356 
357 type
358   { TExpressionType is used for compatibility check
359     A compatibility check is done by comparing two TExpressionType
360 
361     if Desc = xtConstSet, SubDesc contains the type of the set
362     if Context.Node<>nil, it contains the corresponding codetree node
363     if Desc = xtPointer then SubDesc contains the type e.g. xtChar
364   }
365   TExpressionType = record
366     Desc: TExpressionTypeDesc;
367     SubDesc: TExpressionTypeDesc;
368     Context: TFindContext;
369   end;
370   PExpressionType = ^TExpressionType;
371 
372 const
373   CleanExpressionType : TExpressionType =
374     (Desc:xtNone; SubDesc:xtNone; Context:(Node:nil; Tool:nil));
375 
376 type
377   //----------------------------------------------------------------------------
378   // TTypeCompatibility is the result of a compatibility check
379   TTypeCompatibility = (
380     tcExact,        // exactly same type, can be used for var parameters
381     tcCompatible,   // type can be auto converted, can not be used for var parameters
382     tcIncompatible  // type is incompatible
383     );
384   TTypeCompatibilityList = ^TTypeCompatibility;
385 
386 const
387   TypeCompatibilityNames: array[TTypeCompatibility] of string = (
388        'Exact',
389        'Compatible', // convertable, but not allowed for var params
390        'Incompatible'
391      );
392 
393 type
394   //----------------------------------------------------------------------------
395   // TExprTypeList is used for compatibility checks of whole parameter lists
396   TExprTypeList = class
397   private
398     FCapacity: integer;
399     procedure SetCapacity(const AValue: integer);
400   protected
401     procedure Grow;
402   public
403     Count: integer;
404     Items: PExpressionType;
405     AliasTypes: PFindContext;
406     procedure Add(const ExprType: TExpressionType);
407     procedure Add(const ExprType: TExpressionType; const AliasType: TFindContext);
408     procedure AddFirst(const ExprType: TExpressionType);
409     property Capacity: integer read FCapacity write SetCapacity;
410     destructor Destroy; override;
AsStringnull411     function AsString: string;
CalcMemSizenull412     function CalcMemSize: PtrUInt;
413   end;
414 
415 type
416 
417   { TOperand }
418 
419   TOperand = record
420     Expr: TExpressionType;
421     AliasType: TFindContext;
422   end;
423 
424   //----------------------------------------------------------------------------
425   // TTypeAliasOrderList is used for comparing type aliases in binary operators
426 
427   TTypeAliasItem = class
428   public
429     AliasName: string;
430     Position: Integer;
431   end;
432 
433   TTypeAliasOrderList = class
434   private
435     FTree: TAVLTree;
436   public
437     constructor Create(const AliasNames: array of string);
438     destructor Destroy; override;
439 
440     procedure Add(const AliasName: string);
441     procedure Add(const AliasNames: array of string);
442     procedure Insert(const AliasName: string; const Pos: Integer);
443     procedure InsertBefore(const AliasName, BeforeAlias: string);
444     procedure InsertAfter(const AliasName, AfterAlias: string);
445     procedure Delete(const Pos: Integer);
446     procedure Delete(const AliasName: string);
IndexOfnull447     function IndexOf(const AliasName: string): Integer;
Comparenull448     function Compare(const AliasName1, AliasName2: string): Integer;
Comparenull449     function Compare(const Operand1, Operand2: TOperand;
450       Tool: TFindDeclarationTool; CleanPos: Integer): TOperand;
451   end;
452 
CompareTypeAliasItemsnull453   function CompareTypeAliasItems(Item1, Item2: Pointer): Integer;
CompareTypeAliasItemStringnull454   function CompareTypeAliasItemString(AliasName, Item: Pointer): Integer;
455 
456 type
457   //----------------------------------------------------------------------------
458   // TFoundProc is used for comparing overloaded procs
459   PFoundProc = ^TFoundProc;
460   TFoundProc = record
461     // the expression input list, which should fit into the searched proc
462     ExprInputList: TExprTypeList;
463     // the best proc found till now
464     Context: TFindContext;
465     // if the proc was already compared (CacheValid=true), then some of the
466     // compatibility check results are cached.
467     CacheValid: boolean;
468     ProcCompatibility: TTypeCompatibility;
469     ParamCompatibilityList: TTypeCompatibilityList;
470     // each TFindDeclarationParams has a list of PFoundProc
471     Owner: TObject;
472     Next, Prior: PFoundProc;
473   end;
474 
475   //---------------------------------------------------------------------------
476 type
477   TIdentifierFoundResult = (ifrProceedSearch, ifrAbortSearch, ifrSuccess);
478 
479 const
480   IdentifierFoundResultNames: array[TIdentifierFoundResult] of string =
481     ('ProceedSearch', 'AbortSearch', 'Success');
482 
483 type
aramsnull484   TOnIdentifierFound = function(Params: TFindDeclarationParams;
485     const FoundContext: TFindContext): TIdentifierFoundResult of object;
rcToolnull486   TOnFindUsedUnit = function(SrcTool: TFindDeclarationTool;
487     const TheUnitName, TheUnitInFilename: string): TCodeBuffer of object;
endernull488   TOnGetCodeToolForBuffer = function(Sender: TObject;
489     Code: TCodeBuffer; GoToMainCode: boolean): TFindDeclarationTool of object;
onstnull490   TOnGetDirectoryCache = function(const ADirectory: string
491                                   ): TCTDirectoryCache of object;
492 
493   TFDHelpersListKind = (
494     fdhlkDelphiHelper,
495     fdhlkObjCCategory
496     );
497 
498   { TFDHelpersListItem }
499 
500   TFDHelpersListItem = class(TObject)
501     ForExprType: TExpressionType;
502     HelperContext: TFindContext; // Node.Desc (ctnClassHelper, ctnRecordHelper, ctnTypeHelper) or (ctnObjCCategory)
CalcMemSizenull503     function CalcMemSize: PtrUInt;
504   end;
505 
506   { TFDHelpersListRec }
507 
508   TFDHelpersListRec = record
509     ForExprType: TExpressionType;
510     HelperContext: TFindContext;
511   end;
512 
513   { TFDHelpersList }
514 
515   TFDHelpersList = class
516   private
517     FKind: TFDHelpersListKind;
518     FTree: TAVLTree; { tree of TFDHelpersListItem sorted for CompareHelpersList.
519        Nodes with same key (ForExprType) are chronologically ordered from left to right. }
520      procedure AddChronologically(Item: TFDHelpersListItem);
521   public
AddFromHelperNodenull522     function AddFromHelperNode(HelperNode: TCodeTreeNode;
523       Tool: TFindDeclarationTool; Replace: Boolean): TFDHelpersListItem;
524     procedure AddFromList(const ExtList: TFDHelpersList);
IterateFromClassNodenull525     function IterateFromClassNode(ClassNode: TCodeTreeNode;
526       Tool: TFindDeclarationTool; out HelperContext: TFindContext; out Iterator: TAVLTreeNode): boolean; // returns newest (rightmost)
GetNextnull527     function GetNext(out HelperContext: TFindContext; var Iterator: TAVLTreeNode): boolean;
FindFromExprTypenull528     function FindFromExprType(const ExprType: TExpressionType): TFindContext; // returns newest (rightmost)
529     procedure DeleteHelperNode(HelperNode: TCodeTreeNode; Tool: TFindDeclarationTool);
530     constructor Create(aKind: TFDHelpersListKind);
531     destructor Destroy; override;
532     procedure Clear;
Countnull533     function Count: Integer;
CalcMemSizenull534     function CalcMemSize: PtrUInt;
535     procedure WriteDebugReport;
536     property Kind: TFDHelpersListKind read FKind;
537     property Tree: TAVLTree read FTree;
538   end;
539 
540   { TGenericParamValueMapping }
541 
542   TGenericParamValueMapping = packed class
543     NextBrother: TGenericParamValueMapping;
544     GenericParamNode,
545     SpecializeValueNode: TCodeTreeNode;
546     constructor Create(pPrevBrother: TGenericParamValueMapping; pParam, pValue: TCodeTreeNode);
547     destructor Destroy; override;
548   end;
549 
550   { TGenericParamValueMappings }
551 
552   TGenericParamValueMappings = record
553     SpecializeParamsTool: TFindDeclarationTool;
554     SpecializeParamsNode: TCodeTreeNode;
555     SpecializeValuesTool: TFindDeclarationTool;
556     FirstParamValueMapping: TGenericParamValueMapping;
557   end;
558 
559   { TGenericParams }
560 
561   TGenericParams = record
562     ParamValuesTool: TFindDeclarationTool;
563     SpecializeParamsNode: TCodeTreeNode;
564   end;
565 
566   TFindDeclarationInput = record
567     Flags: TFindDeclarationFlags;
568     Identifier: PChar;
569     ContextNode: TCodeTreeNode;
570     OnIdentifierFound: TOnIdentifierFound;
571     IdentifierTool: TFindDeclarationTool;
572     FoundProc: PFoundProc;
573   end;
574 
575   { TFindDeclarationParams
576     This contains the parameters for find declaration, the result, the hooks
577     and the memory management for dynamic search data.
578     It can be re-used. That means, the search parameters can be saved, changed
579     and restored (load).
580     The static parameters are stored on the stack, while the dynamic data
581     (e.g. FoundProc) is stored in a private list (FirstFoundProc).
582     For speed reasons the find declaration does not use try..finally and that's
583     why some saved data is not explicitely freed. Therefore the Load method
584     frees all dynamic data, that was later saved too.
585     That's why the following code is forbidden:
586       Save(Data1);
587       Save(Data2);
588       Load(Data1); // this will free Data2
589       Load(Data2);
590 
591     When searching a procedure, the parameter list must be compared.
592     The parameter list of the currently best fitting procedure is stored in
593     FoundProc.
594       }
595 
596   TFindDeclarationParams = class(TObject)
597   private
598     FFoundProcStackFirst: PFoundProc;//list of all saved PFoundProc
599     FFoundProcStackLast: PFoundProc;
600     FExtractedOperand: string;
601     FHelpers: array[TFDHelpersListKind] of TFDHelpersList;
602     FFreeHelpers: array[TFDHelpersListKind] of Boolean;
603     FNeedHelpers: Boolean;
604     GenParamValueMappings: TGenericParamValueMappings;
605     procedure ClearFoundProc;
606     procedure FreeFoundProc(aFoundProc: PFoundProc; FreeNext: boolean);
607     procedure RemoveFoundProcFromList(aFoundProc: PFoundProc);
608   private
609     procedure SetFoundProc(const ProcContext: TFindContext);
610     procedure ChangeFoundProc(const ProcContext: TFindContext;
611                               ProcCompatibility: TTypeCompatibility;
612                               ParamCompatibilityList: TTypeCompatibilityList);
613   private
614     procedure SetGenericParamValues(SpecializeParamsTool: TFindDeclarationTool;
615                 SpecializeNode: TCodeTreeNode);
616     procedure UpdateGenericParamMapping(SpecializeParamsTool: TFindDeclarationTool;
617                 SpecializeParamsNode: TCodeTreeNode; GenericParamsNode: TCodeTreeNode);
618     procedure UpdateContexWithGenParamValue(var SpecializeParamContext: TFindContext);
FindGenericParamTypenull619     function FindGenericParamType: Boolean;
620     procedure AddOperandPart(aPart: string);
621     property ExtractedOperand: string read FExtractedOperand;
IsFoundProcFinalnull622     function IsFoundProcFinal: boolean;
623     procedure PrettifyResult;
624     procedure ConvertResultCleanPosToCaretPos;
625     procedure ClearResult(CopyCacheFlags: boolean);
626     procedure ClearInput;
627   public
628     // input parameters:
629     Flags: TFindDeclarationFlags;
630     Identifier: PChar;
631     StartTool: TFindDeclarationTool;
632     StartNode: TCodeTreeNode;
633     Parent: TFindDeclarationParams;
634     ContextNode: TCodeTreeNode;
635     OnIdentifierFound: TOnIdentifierFound;
636     IdentifierTool: TFindDeclarationTool;
637     FoundProc: PFoundProc;
638     Data: Pointer;
639     // global params
640     OnTopLvlIdentifierFound: TOnIdentifierFound;
641     GenParams: TGenericParams;
642     // results:
643     NewNode: TCodeTreeNode;
644     NewCleanPos: integer;
645     NewCodeTool: TFindDeclarationTool;
646     NewPos: TCodeXYPosition;
647     NewTopLine: integer;
648     NewFlags: TFoundDeclarationFlags;
649     constructor Create(ParentParams: TFindDeclarationParams = nil);
650     constructor Create(Tool: TFindDeclarationTool; AContextNode: TCodeTreeNode);
651     destructor Destroy; override;
652     procedure Clear;
653     procedure Save(out Input: TFindDeclarationInput);
654     procedure Load(Input: TFindDeclarationInput; FreeInput: boolean);
655     procedure SetResult(const AFindContext: TFindContext);
656     procedure SetResult(ANewCodeTool: TFindDeclarationTool;
657                         ANewNode: TCodeTreeNode);
658     procedure SetResult(ANewCodeTool: TFindDeclarationTool;
659                         ANewNode: TCodeTreeNode;  ANewCleanPos: integer);
660     procedure SetResult(NodeCacheEntry: PCodeTreeNodeCacheEntry);
661     procedure SetIdentifier(NewIdentifierTool: TFindDeclarationTool;
662                 NewIdentifier: PChar; NewOnIdentifierFound: TOnIdentifierFound);
663     procedure WriteDebugReport;
GetHelpersnull664     function GetHelpers(HelperKind: TFDHelpersListKind; CreateIfNotExists: boolean = false): TFDHelpersList;
665   end;
666 
667 
668   //----------------------------------------------------------------------------
669   // TFindDeclarationTool is source based and can therefore search for more
670   // than declarations:
671 type
672   TFindSmartFlag = (
673     fsfIncludeDirective, // search for include file
674     fsfFindMainDeclaration, // stop if already on a declaration
675     fsfSearchSourceName, // if searching for a unit name, return the source name node
676     fsfSkipClassForward  // when a forward class was found, jump further to the class
677     );
678   TFindSmartFlags = set of TFindSmartFlag;
679 const
680   DefaultFindSmartFlags = [fsfIncludeDirective];
681   DefaultFindSmartHintFlags = DefaultFindSmartFlags+[fsfFindMainDeclaration];
682 
683 type
684   TFindSrcStartType = (
685     fsstIdentifier
686     );
687 
688   TFindDeclarationListFlag = (
689     fdlfWithoutEmptyProperties, // omit properties without type and attributes
690     fdlfWithoutForwards,        // omit foward classes and procedures
691     fdlfIfStartIsDefinitionStop,// omit overloads when start is a definition
692     fdlfOneOverloadPerUnit      // ignore other overloads of an identifier within the same unit
693     );
694   TFindDeclarationListFlags = set of TFindDeclarationListFlag;
695 
696   TFindOperatorEnumerator = (
697     foeProcNode, // proc node of operator
698     foeResultClassNode, // classnode of result type of operator
ornull699     foeEnumeratorCurrentNode, // function or property with modifier 'enumerator Current'
700     foeEnumeratorCurrentExprType // expression type of 'enumerator Current'
701     );
702 
703   TFindFileAtCursorFlag = (
704     ffatNone,
705     ffatUsedUnit,
706     ffatIncludeFile,
707     ffatDisabledIncludeFile,
708     ffatResource,
709     ffatDisabledResource,
710     ffatLiteral,
711     ffatComment,
712     ffatUnit // unit by name
713     );
714   TFindFileAtCursorFlags = set of TFindFileAtCursorFlag;
715 const
716   DefaultFindFileAtCursorAllowed = [Low(TFindFileAtCursorFlag)..high(TFindFileAtCursorFlag)];
717 
718 type
719   //----------------------------------------------------------------------------
720   ECodeToolUnitNotFound = class(ECodeToolFileNotFound)
721   end;
722 
723   //----------------------------------------------------------------------------
724 
725   TFindIdentifierInUsesSection_FindMissingFPCUnit = class;
726 
727   //----------------------------------------------------------------------------
728 
729   { TFindDeclarationTool }
730 
731   TFindDeclarationTool = class(TPascalReaderTool)
732   private
733     FAdjustTopLineDueToComment: boolean;
734     FDirectoryCache: TCTDirectoryCache;
735     FFindMissingFPCUnits: TFindIdentifierInUsesSection_FindMissingFPCUnit;
736     FInterfaceIdentifierCache: TInterfaceIdentifierCache;
737     FInterfaceHelperCache: array[TFDHelpersListKind] of TFDHelpersList;
738     FOnFindUsedUnit: TOnFindUsedUnit;
739     FOnGetCodeToolForBuffer: TOnGetCodeToolForBuffer;
740     FOnGetDirectoryCache: TOnGetDirectoryCache;
741     FOnGetMethodName: TOnGetMethodname;
742     FOnGetSrcPathForCompiledUnit: TOnGetSrcPathForCompiledUnit;
743     FOnGetUnitSourceSearchPath: TOnGetSearchPath;
744     FFirstNodeCache: TCodeTreeNodeCache;
745     FOnRescanFPCDirectoryCache: TNotifyEvent;
746     FRootNodeCache: TCodeTreeNodeCache;
747     FFirstBaseTypeCache: TBaseTypeCache;
748     FDependentCodeTools: TAVLTree;// the codetools, that depend on this codetool
749     FDependsOnCodeTools: TAVLTree;// the codetools, that this codetool depends on
750     FClearingDependentNodeCaches: boolean;
751     FCheckingNodeCacheDependencies: boolean;
752     FSourcesChangeStep, FFilesChangeStep: int64;
753     FInitValuesChangeStep: integer;
754     {$IFDEF DebugPrefix}
755     DebugPrefix: string;
756     procedure IncPrefix;
757     procedure DecPrefix;
758     {$ENDIF}
FindDeclarationInUsesSectionnull759     function FindDeclarationInUsesSection(UsesNode: TCodeTreeNode;
760       CleanPos: integer;
761       out NewPos: TCodeXYPosition; out NewTopLine: integer): boolean;
FindUnitFileInUsesSectionnull762     function FindUnitFileInUsesSection(UsesNode: TCodeTreeNode;
763       const AFilename: string): TCodeTreeNode;
FindUnitFileInAllUsesSectionsnull764     function FindUnitFileInAllUsesSections(const AFilename: string;
765       CheckMain: boolean = true; CheckImplementation: boolean = true): TCodeTreeNode;
FindEnumInContextnull766     function FindEnumInContext(Params: TFindDeclarationParams): boolean;
767     // sub methods for FindIdentifierInContext
DoOnIdentifierFoundnull768     function DoOnIdentifierFound(Params: TFindDeclarationParams;
769       FoundNode: TCodeTreeNode): TIdentifierFoundResult;
FindIdentifierInProcContextnull770     function FindIdentifierInProcContext(ProcContextNode: TCodeTreeNode;
771       Params: TFindDeclarationParams): TIdentifierFoundResult;
FindIdentifierInClassOfMethodnull772     function FindIdentifierInClassOfMethod(ProcContextNode: TCodeTreeNode;
773       Params: TFindDeclarationParams): boolean;
FindIdentifierInWithVarContextnull774     function FindIdentifierInWithVarContext(WithVarNode: TCodeTreeNode;
775       Params: TFindDeclarationParams): boolean;
FindIdentifierInAncestorsnull776     function FindIdentifierInAncestors(ClassNode: TCodeTreeNode;
777       Params: TFindDeclarationParams; var IdentFoundResult: TIdentifierFoundResult): boolean;
FindIdentifierInAncestorsnull778     function FindIdentifierInAncestors(ClassNode: TCodeTreeNode;
779       Params: TFindDeclarationParams): boolean;
FindIdentifierInUsesSectionnull780     function FindIdentifierInUsesSection(UsesNode: TCodeTreeNode;
781       Params: TFindDeclarationParams; FindMissingFPCUnits: Boolean): boolean;
FindIdentifierInHiddenUsedUnitsnull782     function FindIdentifierInHiddenUsedUnits(
783       Params: TFindDeclarationParams): boolean;
FindIdentifierInUsedUnitnull784     function FindIdentifierInUsedUnit(const AnUnitName: string;
785       Params: TFindDeclarationParams; ErrorPos: integer): boolean;
FindIdentifierInTypeOfConstantnull786     function FindIdentifierInTypeOfConstant(VarConstNode: TCodeTreeNode;
787       Params: TFindDeclarationParams): boolean;
788   protected
789     WordIsPredefinedIdentifier: TKeyWordFunctionList;
790     procedure RaiseUsesExpected(id: int64);
791     procedure RaiseStrConstExpected(id: int64);
792   protected
793     // node caches
794     procedure DoDeleteNodes(StartNode: TCodeTreeNode); override;
CheckDependsOnNodeCachesnull795     function CheckDependsOnNodeCaches(CheckedTools: TAVLTree = nil): boolean;
796     procedure ClearNodeCaches;
797     procedure ClearDependentNodeCaches;
798     procedure ClearDependsOnToolRelationships;
799     procedure AddToolDependency(DependOnTool: TFindDeclarationTool);
CreateNewNodeCachenull800     function CreateNewNodeCache(Node: TCodeTreeNode): TCodeTreeNodeCache;
CreateNewBaseTypeCachenull801     function CreateNewBaseTypeCache(Tool: TFindDeclarationTool;
802                                     Node: TCodeTreeNode): TBaseTypeCache;
803     procedure CreateBaseTypeCaches(NodeStack: PCodeTreeNodeStack;
804       const Result: TFindContext);
GetNodeCachenull805     function GetNodeCache(Node: TCodeTreeNode;
806       CreateIfNotExists: boolean): TCodeTreeNodeCache;
807     procedure AddResultToNodeCaches(
808       StartNode, EndNode: TCodeTreeNode; SearchedForward: boolean;
809       Params: TFindDeclarationParams; SearchRangeFlags: TNodeCacheEntryFlags);
810   protected
811     // expressions, operands, variables
GetCurrentAtomTypenull812     function GetCurrentAtomType: TVariableAtomType;
FindEndOfTermnull813     function FindEndOfTerm(StartPos: integer;
814       ExceptionIfNoVariableStart, WithAsOperator: boolean): integer; // read one operand
FindStartOfTermnull815     function FindStartOfTerm(EndPos: integer; InType: boolean): integer;
NodeTermInTypenull816     function NodeTermInType(Node: TCodeTreeNode): boolean;
FindExpressionTypeOfTermnull817     function FindExpressionTypeOfTerm(StartPos, EndPos: integer;
818       Params: TFindDeclarationParams; WithAsOperator: boolean;
819       AliasType: PFindContext = nil): TExpressionType;
FindEndOfExpressionnull820     function FindEndOfExpression(StartPos: integer): integer; // read all operands and operators
ReadOperandTypeAtCursornull821     function ReadOperandTypeAtCursor(Params: TFindDeclarationParams;
822       MaxEndPos: integer = -1; AliasType: PFindContext = nil): TExpressionType;
FindExpressionTypeOfPredefinedIdentifiernull823     function FindExpressionTypeOfPredefinedIdentifier(StartPos: integer;
824       Params: TFindDeclarationParams; AliasType: PFindContext = nil): TExpressionType;
FindExpressionTypeOfConstSetnull825     function FindExpressionTypeOfConstSet(Node: TCodeTreeNode): TExpressionType;
GetDefaultStringTypenull826     function GetDefaultStringType: TExpressionTypeDesc;
CalculateBinaryOperatornull827     function CalculateBinaryOperator(LeftOperand, RightOperand: TOperand;
828       BinaryOperator: TAtomPosition;
829       Params: TFindDeclarationParams): TOperand;
GetParameterNodenull830     function GetParameterNode(Node: TCodeTreeNode): TCodeTreeNode;
GetExpressionTypeOfTypeIdentifiernull831     function GetExpressionTypeOfTypeIdentifier(
832       Params: TFindDeclarationParams): TExpressionType;
FindTermTypeAsStringnull833     function FindTermTypeAsString(TermPos: TAtomPosition;
834       Params: TFindDeclarationParams; out ExprType: TExpressionType): string;
FindForInTypeAsStringnull835     function FindForInTypeAsString(TermPos: TAtomPosition;
836       CursorNode: TCodeTreeNode; Params: TFindDeclarationParams;
837       out ExprType: TExpressionType): string;
FindEnumeratorOfClassnull838     function FindEnumeratorOfClass(ClassNode: TCodeTreeNode;
839       ExceptionOnNotFound: boolean; out ExprType: TExpressionType;
840       AliasType: PFindContext = nil; ParentParams: TFindDeclarationParams = nil): boolean;
FindOperatorEnumeratornull841     function FindOperatorEnumerator(Node: TCodeTreeNode;
842       ExprType: TExpressionType; Need: TFindOperatorEnumerator;
843       out ResultExprType: TExpressionType): boolean;
FindEnumerationTypeOfSetTypenull844     function FindEnumerationTypeOfSetType(SetTypeNode: TCodeTreeNode;
845       out Context: TFindContext): boolean;
FindElementTypeOfArrayTypenull846     function FindElementTypeOfArrayType(ArrayNode: TCodeTreeNode;
847       out ExprType: TExpressionType; AliasType: PFindContext;
848       ParentParams: TFindDeclarationParams = nil): boolean;
CheckOperatorEnumeratornull849     function CheckOperatorEnumerator(Params: TFindDeclarationParams;
850       const FoundContext: TFindContext): TIdentifierFoundResult;
CheckModifierEnumeratorCurrentnull851     function CheckModifierEnumeratorCurrent({%H-}Params: TFindDeclarationParams;
852       const FoundContext: TFindContext): TIdentifierFoundResult;
IsTermEdgedBracketnull853     function IsTermEdgedBracket(TermPos: TAtomPosition;
854       out EdgedBracketsStartPos: integer): boolean;
IsTermNamedPointernull855     function IsTermNamedPointer(TermPos: TAtomPosition;
856       out ExprType: TExpressionType): boolean;
FindSetOfEnumerationTypenull857     function FindSetOfEnumerationType(EnumNode: TCodeTreeNode): TCodeTreeNode;
FindPointerOfIdentifiernull858     function FindPointerOfIdentifier(TypeNode: TCodeTreeNode): TCodeTreeNode;
FindExprTypeAsStringnull859     function FindExprTypeAsString(const ExprType: TExpressionType;
860       TermCleanPos: integer;
861       AliasType: PFindContext = nil): string;
862   protected
CheckSrcIdentifiernull863     function CheckSrcIdentifier(Params: TFindDeclarationParams;
864       const FoundContext: TFindContext): TIdentifierFoundResult;
FindDeclarationOfIdentAtParamnull865     function FindDeclarationOfIdentAtParam(
866       Params: TFindDeclarationParams; out ExprType: TExpressionType): boolean;
FindDeclarationOfIdentAtParamnull867     function FindDeclarationOfIdentAtParam(
868       Params: TFindDeclarationParams): boolean;
IdentifierIsDefinednull869     function IdentifierIsDefined(const IdentAtom: TAtomPosition;
870       ContextNode: TCodeTreeNode; Params: TFindDeclarationParams): boolean;
FindContextNodeAtCursornull871     function FindContextNodeAtCursor(
872       Params: TFindDeclarationParams): TFindContext;
FindClassOfMethodnull873     function FindClassOfMethod(ProcNode: TCodeTreeNode;
874       FindClassContext, ExceptionOnNotFound: boolean): TCodeTreeNode;
FindClassMembernull875     function FindClassMember(aClassNode: TCodeTreeNode; Identifier: PChar): TCodeTreeNode;
FindForwardIdentifiernull876     function FindForwardIdentifier(Params: TFindDeclarationParams;
877       out IsForward: boolean): boolean;
FindNonForwardClassnull878     function FindNonForwardClass(ForwardNode: TCodeTreeNode): TCodeTreeNode;
FindNonForwardClassnull879     function FindNonForwardClass(Params: TFindDeclarationParams): boolean;
FindIdentifierInInterfacenull880     function FindIdentifierInInterface(AskingTool: TFindDeclarationTool;
881       Params: TFindDeclarationParams): boolean;
CompareNodeIdentifiernull882     function CompareNodeIdentifier(Node: TCodeTreeNode;
883       Params: TFindDeclarationParams): boolean;
GetInterfaceNodenull884     function GetInterfaceNode: TCodeTreeNode;
CompatibilityList1IsBetternull885     function CompatibilityList1IsBetter(List1, List2: TTypeCompatibilityList;
886       ListCount: integer): boolean;
IsParamExprListCompatibleToNodeListnull887     function IsParamExprListCompatibleToNodeList(
888       FirstTargetParameterNode: TCodeTreeNode;
889       SourceExprParamList: TExprTypeList; IgnoreMissingParameters: boolean;
890       Params: TFindDeclarationParams;
891       CompatibilityList: TTypeCompatibilityList): TTypeCompatibility;
IsParamNodeListCompatibleToParamNodeListnull892     function IsParamNodeListCompatibleToParamNodeList(FirstTargetParameterNode,
893       FirstSourceParameterNode: TCodeTreeNode;
894       Params: TFindDeclarationParams;
895       CompatibilityList: TTypeCompatibilityList): TTypeCompatibility;
CreateParamExprListFromStatementnull896     function CreateParamExprListFromStatement(StartPos: integer;
897       Params: TFindDeclarationParams; GetAlias: boolean = false): TExprTypeList;
ContextIsDescendOfnull898     function ContextIsDescendOf(
899       const DescendContext, AncestorContext: TFindContext;
900       Params: TFindDeclarationParams): boolean;
IsCompatiblenull901     function IsCompatible(TargetNode: TCodeTreeNode;
902       const ExpressionType: TExpressionType;
903       Params: TFindDeclarationParams): TTypeCompatibility;
IsCompatiblenull904     function IsCompatible(TargetType, ExpressionType: TExpressionType;
905       Params: TFindDeclarationParams): TTypeCompatibility;
IsBaseCompatiblenull906     function IsBaseCompatible(const TargetType, ExpressionType: TExpressionType;
907       Params: TFindDeclarationParams): TTypeCompatibility;
CheckParameterSyntaxnull908     function CheckParameterSyntax(StartPos, CleanCursorPos: integer;
909       out ParameterAtom, ProcNameAtom: TAtomPosition;
910       out ParameterIndex: integer): boolean;
911     procedure OnFindUsedUnitIdentifier(Sender: TPascalParserTool;
912       IdentifierCleanPos: integer; Range: TEPRIRange;
913       Node: TCodeTreeNode; Data: Pointer; var {%H-}Abort: boolean);
914   public
915     constructor Create;
916     destructor Destroy; override;
917     procedure ConsistencyCheck; override;
918     procedure CalcMemSize(Stats: TCTMemStats); override;
919 
920     procedure BeginParsing(Range: TLinkScannerRange); override;
921     procedure ValidateToolDependencies; override;
BuildInterfaceIdentifierCachenull922     function BuildInterfaceIdentifierCache(ExceptionOnNotUnit: boolean): boolean;
FindDeclarationnull923     function FindDeclaration(const CursorPos: TCodeXYPosition;
924       out NewPos: TCodeXYPosition; out NewTopLine: integer): boolean;
FindMainDeclarationnull925     function FindMainDeclaration(const CursorPos: TCodeXYPosition;
926       out NewPos: TCodeXYPosition; out NewTopLine: integer): boolean;
FindDeclarationOfIdentifiernull927     function FindDeclarationOfIdentifier(const CursorPos: TCodeXYPosition;
928       Identifier: PChar;
929       out NewPos: TCodeXYPosition; out NewTopLine: integer): boolean;
FindDeclarationnull930     function FindDeclaration(const CursorPos: TCodeXYPosition;
931       SearchSmartFlags: TFindSmartFlags;
932       out NewTool: TFindDeclarationTool; out NewNode: TCodeTreeNode;
933       out NewPos: TCodeXYPosition; out NewTopLine: integer): boolean;
FindDeclarationnull934     function FindDeclaration(const CursorPos: TCodeXYPosition;
935       SearchSmartFlags: TFindSmartFlags;
936       out NewTool: TFindDeclarationTool; out NewNode: TCodeTreeNode;
937       out NewPos: TCodeXYPosition; out NewTopLine, BlockTopLine, BlockBottomLine: integer): boolean;
FindDeclarationnull938     function FindDeclaration(const CursorPos: TCodeXYPosition;
939       SearchSmartFlags: TFindSmartFlags;
940       out NewExprType: TExpressionType;
941       out NewPos: TCodeXYPosition; out NewTopLine: integer): boolean;
FindDeclarationnull942     function FindDeclaration(const CursorPos: TCodeXYPosition;
943       SearchSmartFlags: TFindSmartFlags;
944       out NewExprType: TExpressionType;
945       out NewPos: TCodeXYPosition; out NewTopLine,BlockTopLine,BlockBottomLine: integer): boolean;
FindDeclarationInInterfacenull946     function FindDeclarationInInterface(const Identifier: string;
947       out NewPos: TCodeXYPosition; out NewTopLine, BlockTopLine, BlockBottomLine: integer): boolean;
FindDeclarationWithMainUsesSectionnull948     function FindDeclarationWithMainUsesSection(const Identifier: string;
949       out NewPos: TCodeXYPosition; out NewTopLine: integer): boolean;
FindClassMembernull950     function FindClassMember(aClassNode: TCodeTreeNode;
951       const Identifier: String; SearchInAncestors: boolean): TFindContext;
FindDeclarationOfPropertyPathnull952     function FindDeclarationOfPropertyPath(const PropertyPath: string;
953       out NewContext: TFindContext; IgnoreTypeLess: boolean = false): boolean;
FindDeclarationOfPropertyPathnull954     function FindDeclarationOfPropertyPath(const PropertyPath: string;
955       out NewPos: TCodeXYPosition; out NewTopLine: integer;
956       IgnoreTypeLess: boolean = false): boolean;
FindDeclarationNodeInInterfacenull957     function FindDeclarationNodeInInterface(const Identifier: string;
958       BuildTheTree: Boolean): TCodeTreeNode;// search for type, const, var, proc, prop
FindDeclarationNodeInImplementationnull959     function FindDeclarationNodeInImplementation(Identifier: string;
960       BuildTheTree: Boolean): TCodeTreeNode;// search for type, const, var, proc, prop
FindSubDeclarationnull961     function FindSubDeclaration(Identifier: string; ParentNode: TCodeTreeNode
962       ): TCodeTreeNode; // search for type, const, var, proc, prop
FindNameInUsesSectionnull963     function FindNameInUsesSection(UsesNode: TCodeTreeNode; const AUnitName: string): TCodeTreeNode;
FindUnitInUsesSectionnull964     function FindUnitInUsesSection(UsesNode: TCodeTreeNode; const AnUnitName: string;
965           out NamePos, InPos: TAtomPosition): boolean;
FindUnitInAllUsesSectionsnull966     function FindUnitInAllUsesSections(const AnUnitName: string;
967           out NamePos, InPos: TAtomPosition): boolean;
GetUnitNameForUsesSectionnull968     function GetUnitNameForUsesSection(TargetTool: TFindDeclarationTool): string;
IsHiddenUsedUnitnull969     function IsHiddenUsedUnit(TheUnitName: PChar): boolean;
970 
FindCodeToolForUsedUnitnull971     function FindCodeToolForUsedUnit(const AnUnitName, AnUnitInFilename: string;
972       ExceptionOnNotFound: boolean): TFindDeclarationTool;
FindUnitSourcenull973     function FindUnitSource(const AnUnitName,
974       AnUnitInFilename: string; ExceptionOnNotFound: boolean;
975       ErrorPos: integer = 0): TCodeBuffer;
FindUnitCaseInsensitivenull976     function FindUnitCaseInsensitive(var AnUnitName,
977                                      AnUnitInFilename: string): string;
978     procedure GatherUnitAndSrcPath(var UnitPath, CompleteSrcPath: string);
SearchUnitInUnitSetnull979     function SearchUnitInUnitSet(const TheUnitName: string): string;
GetNameSpacesnull980     function GetNameSpaces: string;
981 
IsIncludeDirectiveAtPosnull982     function IsIncludeDirectiveAtPos(CleanPos, CleanCodePosInFront: integer;
983       out IncludeCode: TCodeBuffer): boolean;
FindFileAtCursornull984     function FindFileAtCursor(const CursorPos: TCodeXYPosition;
985       out Found: TFindFileAtCursorFlag; out FoundFilename: string;
986       SearchFor: TFindFileAtCursorFlags = DefaultFindFileAtCursorAllowed;
987       StartPos: PCodeXYPosition = nil): boolean;
988 
FindSmartHintnull989     function FindSmartHint(const CursorPos: TCodeXYPosition;
990                     Flags: TFindSmartFlags = DefaultFindSmartHintFlags): string;
GetSmartHintnull991     function GetSmartHint(Node: TCodeTreeNode; XYPos: TCodeXYPosition;
992                           WithPosition: boolean; WithDefinition: boolean = True): string;
993 
BaseTypeOfNodeHasSubIdentsnull994     function BaseTypeOfNodeHasSubIdents(ANode: TCodeTreeNode): boolean;
FindBaseTypeOfNodenull995     function FindBaseTypeOfNode(Params: TFindDeclarationParams;
996       Node: TCodeTreeNode; AliasType: PFindContext = nil;
997       NodeStack: PCodeTreeNodeStack = nil): TFindContext;
ConvertNodeToExpressionTypenull998     function ConvertNodeToExpressionType(Node: TCodeTreeNode;
999       Params: TFindDeclarationParams; AliasType: PFindContext = nil): TExpressionType;
FindExpressionResultTypenull1000     function FindExpressionResultType(Params: TFindDeclarationParams;
1001       StartPos, EndPos: integer; AliasType: PFindContext = nil): TExpressionType;
1002 
FindDeclarationAndOverloadnull1003     function FindDeclarationAndOverload(const CursorPos: TCodeXYPosition;
1004       out ListOfPCodeXYPosition: TFPList;
1005       Flags: TFindDeclarationListFlags): boolean;
FindIdentifierContextsAtStatementnull1006     function FindIdentifierContextsAtStatement(CleanPos: integer;
1007       out IsSubIdentifier: boolean; out ListOfPFindContext: TFPList): boolean;
1008 
1009     // ancestors
FindClassAndAncestorsnull1010     function FindClassAndAncestors(ClassNode: TCodeTreeNode;
1011       var ListOfPFindContext: TFPList; ExceptionOnNotFound: boolean
1012       ): boolean; // without interfaces, recursive
FindContextClassAndAncestorsAndExtendedClassOfHelpernull1013     function FindContextClassAndAncestorsAndExtendedClassOfHelper(const CursorPos: TCodeXYPosition;
1014       var ListOfPFindContext: TFPList): boolean; // without interfaces
FindAncestorOfClassnull1015     function FindAncestorOfClass(ClassNode: TCodeTreeNode;
1016       Params: TFindDeclarationParams; FindClassContext: boolean): boolean; // returns false for TObject, IInterface, IUnknown
FindDefaultAncestorOfClassnull1017     function FindDefaultAncestorOfClass(ClassNode: TCodeTreeNode;
1018       Params: TFindDeclarationParams; FindClassContext: boolean): boolean; // returns false for TObject, IInterface, IUnknown
FindAncestorOfClassInheritancenull1019     function FindAncestorOfClassInheritance(IdentifierNode: TCodeTreeNode;
1020       ResultParams: TFindDeclarationParams; FindClassContext: boolean): boolean;
FindAncestorsOfClassnull1021     function FindAncestorsOfClass(ClassNode: TCodeTreeNode;
1022       var ListOfPFindContext: TFPList;
1023       Params: TFindDeclarationParams; FindClassContext: boolean;
1024       ExceptionOnNotFound: boolean = true): boolean; // with interfaces, not recursive
1025 
FindExtendedExprOfHelpernull1026     function FindExtendedExprOfHelper(HelperNode: TCodeTreeNode): TExpressionType;
1027 
FindReferencesnull1028     function FindReferences(const CursorPos: TCodeXYPosition;
1029       SkipComments: boolean; out ListOfPCodeXYPosition: TFPList): boolean;
FindUnitReferencesnull1030     function FindUnitReferences(UnitCode: TCodeBuffer;
1031       SkipComments: boolean; out ListOfPCodeXYPosition: TFPList): boolean; // searches unitname of UnitCode
1032     procedure FindUsedUnitReferences(const CursorPos: TCodeXYPosition;
1033       SkipComments: boolean; out UsedUnitFilename: string;
1034       out ListOfPCodeXYPosition: TFPList); // searches all references of unit in uses clause
1035     procedure FindUsedUnitReferences(TargetTool: TFindDeclarationTool;
1036       SkipComments: boolean;
1037       out ListOfPCodeXYPosition: TFPList); // searches all references of TargetTool
1038 
CleanPosIsDeclarationIdentifiernull1039     function CleanPosIsDeclarationIdentifier(CleanPos: integer;
1040                                              Node: TCodeTreeNode): boolean;
1041 
1042     procedure FindHelpersInContext(Params: TFindDeclarationParams);
1043     procedure FindHelpersInUsesSection(UsesNode: TCodeTreeNode;
1044       Params: TFindDeclarationParams);
1045     procedure FindHelpersInInterface(AskingTool: TFindDeclarationTool;
1046       Params: TFindDeclarationParams);
FindIdentifierInContextnull1047     function FindIdentifierInContext(Params: TFindDeclarationParams;
1048       var IdentFoundResult: TIdentifierFoundResult): boolean;
FindIdentifierInContextnull1049     function FindIdentifierInContext(Params: TFindDeclarationParams): boolean;
FindIdentifierInBasicTypeHelpersnull1050     function FindIdentifierInBasicTypeHelpers(ExprType: TExpressionTypeDesc;
1051       Params: TFindDeclarationParams): Boolean;
FindNthParameterNodenull1052     function FindNthParameterNode(Node: TCodeTreeNode;
1053                                   ParameterIndex: integer): TCodeTreeNode;
GetFirstParameterNodenull1054     function GetFirstParameterNode(Node: TCodeTreeNode): TCodeTreeNode;
IsParamNodeListCompatibleToExprListnull1055     function IsParamNodeListCompatibleToExprList(
1056       TargetExprParamList: TExprTypeList;
1057       FirstSourceParameterNode: TCodeTreeNode;
1058       Params: TFindDeclarationParams;
1059       CompatibilityList: TTypeCompatibilityList = nil): TTypeCompatibility;
CreateParamExprListFromProcNodenull1060     function CreateParamExprListFromProcNode(ProcNode: TCodeTreeNode;
1061       Params: TFindDeclarationParams): TExprTypeList;
1062 
JumpToNodenull1063     function JumpToNode(ANode: TCodeTreeNode;
1064         out NewPos: TCodeXYPosition; out NewTopLine: integer;
1065         IsCodeBlock: boolean): boolean;
JumpToNodenull1066     function JumpToNode(ANode: TCodeTreeNode;
1067         out NewPos: TCodeXYPosition; out NewTopLine, BlockTopLine, BlockBottomLine: integer;
1068         IsCodeBlock: boolean): boolean;
JumpToCleanPosnull1069     function JumpToCleanPos(NewCleanPos, NewTopLineCleanPos,
1070         NewBottomLineCleanPos: integer;
1071         out NewPos: TCodeXYPosition; out NewTopLine: integer;
1072         IsCodeBlock: boolean): boolean;
JumpToCleanPosnull1073     function JumpToCleanPos(NewCleanPos, NewTopLineCleanPos,
1074         NewBottomLineCleanPos: integer;
1075         out NewPos: TCodeXYPosition; out NewTopLine, BlockTopLine, BlockBottomLine: integer;
1076         IsCodeBlock: boolean): boolean;
NodeIsForwardDeclarationnull1077     function NodeIsForwardDeclaration(Node: TCodeTreeNode): boolean;
1078 
GetExpandedOperandnull1079     function GetExpandedOperand(const CursorPos: TCodeXYPosition;
1080           out Operand: string; ResolveProperty: Boolean): Boolean;
1081 
1082     property InterfaceIdentifierCache: TInterfaceIdentifierCache
1083                                                  read FInterfaceIdentifierCache;
1084     property OnGetUnitSourceSearchPath: TOnGetSearchPath
1085                read FOnGetUnitSourceSearchPath write FOnGetUnitSourceSearchPath;
1086     property OnFindUsedUnit: TOnFindUsedUnit
1087                                      read FOnFindUsedUnit write FOnFindUsedUnit;
1088     property OnGetCodeToolForBuffer: TOnGetCodeToolForBuffer
1089                      read FOnGetCodeToolForBuffer write FOnGetCodeToolForBuffer;
1090     property OnGetDirectoryCache: TOnGetDirectoryCache read FOnGetDirectoryCache
1091                                                      write FOnGetDirectoryCache;
1092     property OnGetSrcPathForCompiledUnit: TOnGetSrcPathForCompiledUnit
1093            read FOnGetSrcPathForCompiledUnit write fOnGetSrcPathForCompiledUnit;
1094     property OnGetMethodName: TOnGetMethodname read FOnGetMethodName
1095                                                write FOnGetMethodName;
1096     property AdjustTopLineDueToComment: boolean
1097                read FAdjustTopLineDueToComment write FAdjustTopLineDueToComment;
1098     property DirectoryCache: TCTDirectoryCache read FDirectoryCache write FDirectoryCache;
1099 
1100     property OnRescanFPCDirectoryCache: TNotifyEvent read FOnRescanFPCDirectoryCache write FOnRescanFPCDirectoryCache;
1101   end;
1102 
1103   TFindIdentifierInUsesSection_FindMissingFPCUnit = class
1104   private
1105     FUnitName: string;
1106     FFound: Boolean;
1107     FResults: TStringList;
1108 
1109     procedure Iterate(const AFilename: string);
1110   public
1111     constructor Create;
1112     destructor Destroy; override;
Findnull1113     function Find(const AUnitName: string; const ADirectoryCache: TCTDirectoryCache): Boolean;
IsInResultsnull1114     function IsInResults(const AUnitName: string): Boolean;
1115   end;
1116 
ExprTypeToStringnull1117 function ExprTypeToString(const ExprType: TExpressionType): string;
CreateExpressionTypenull1118 function CreateExpressionType(const Desc, SubDesc: TExpressionTypeDesc;
1119   const Context: TFindContext): TExpressionType;
1120 
FindContextToStringnull1121 function FindContextToString(const FindContext: TFindContext; RelativeFilename: boolean = true): string; overload;
FindContextToStringnull1122 function FindContextToString(const FindContext: PFindContext; RelativeFilename: boolean = true): string; overload;
CreateFindContextnull1123 function CreateFindContext(NewTool: TFindDeclarationTool;
1124   NewNode: TCodeTreeNode): TFindContext;
CreateFindContextnull1125 function CreateFindContext(Params: TFindDeclarationParams): TFindContext;
CreateFindContextnull1126 function CreateFindContext(BaseTypeCache: TBaseTypeCache): TFindContext;
FindContextAreEqualnull1127 function FindContextAreEqual(const Context1, Context2: TFindContext): boolean;
CompareFindContextsnull1128 function CompareFindContexts(const Context1, Context2: PFindContext): integer;
1129 procedure AddFindContext(var ListOfPFindContext: TFPList;
1130   const NewContext: TFindContext);
IndexOfFindContextnull1131 function IndexOfFindContext(var ListOfPFindContext: TFPList;
1132   const AContext: PFindContext): integer;
1133 procedure FreeListOfPFindContext(var ListOfPFindContext: TFPList);
1134 
ListOfPFindContextToStrnull1135 function ListOfPFindContextToStr(const ListOfPFindContext: TFPList): string;
dbgsFCnull1136 function dbgsFC(const Context: TFindContext): string;
1137 
PredefinedIdentToExprTypeDescnull1138 function PredefinedIdentToExprTypeDesc(Identifier: PChar; Compiler: TPascalCompiler): TExpressionTypeDesc;
dbgsnull1139 function dbgs(const Flags: TFindDeclarationFlags): string; overload;
dbgsnull1140 function dbgs(const Flags: TFoundDeclarationFlags): string; overload;
dbgsnull1141 function dbgs(const vat: TVariableAtomType): string; overload;
dbgsnull1142 function dbgs(const Kind: TFDHelpersListKind): string; overload;
1143 
1144 
BooleanTypesOrderListnull1145 function BooleanTypesOrderList: TTypeAliasOrderList;
IntegerTypesOrderListnull1146 function IntegerTypesOrderList: TTypeAliasOrderList;
RealTypesOrderListnull1147 function RealTypesOrderList: TTypeAliasOrderList;
StringTypesOrderListnull1148 function StringTypesOrderList: TTypeAliasOrderList;
1149 
1150 implementation
1151 
1152 var
1153   FBooleanTypesOrderList: TTypeAliasOrderList;
1154   FIntegerTypesOrderList: TTypeAliasOrderList;
1155   FRealTypesOrderList: TTypeAliasOrderList;
1156   FStringTypesOrderList: TTypeAliasOrderList;
1157 
1158 type
1159 
1160   { TFindUsedUnitReferences }
1161 
1162   TFindUsedUnitReferences = class
1163   public
1164     TargetTool: TFindDeclarationTool;
1165     TargetUnitName: string;
1166     ListOfPCodeXYPosition: TFPList;
1167     Params: TFindDeclarationParams;
1168     constructor Create(Tool: TFindDeclarationTool; AContextNode: TCodeTreeNode);
1169     destructor Destroy; override;
1170   end;
1171 
dbgsnull1172 function dbgs(const Flags: TFindDeclarationFlags): string;
1173 var
1174   Flag: TFindDeclarationFlag;
1175   s: string;
1176 begin
1177   Result:='';
1178   for Flag:=Low(TFindDeclarationFlag) to High(TFindDeclarationFlag) do begin
1179     if Flag in Flags then begin
1180       if Result<>'' then
1181         Result:=Result+', ';
1182       WriteStr(s, Flag);
1183       Result:=Result+s;
1184     end;
1185   end;
1186 end;
1187 
dbgsnull1188 function dbgs(const Flags: TFoundDeclarationFlags): string;
1189 var
1190   Flag: TFoundDeclarationFlag;
1191   s: string;
1192 begin
1193   Result:='';
1194   for Flag:=Low(TFoundDeclarationFlag) to High(TFoundDeclarationFlag) do begin
1195     if Flag in Flags then begin
1196       if Result<>'' then
1197         Result:=Result+', ';
1198       WriteStr(s, Flag);
1199       Result:=Result+s;
1200     end;
1201   end;
1202 end;
1203 
dbgsnull1204 function dbgs(const vat: TVariableAtomType): string;
1205 begin
1206   Result:=VariableAtomTypeNames[vat];
1207 end;
1208 
dbgsnull1209 function dbgs(const Kind: TFDHelpersListKind): string;
1210 begin
1211   WriteStr(Result, Kind);
1212 end;
1213 
BooleanTypesOrderListnull1214 function BooleanTypesOrderList: TTypeAliasOrderList;
1215 begin
1216   if FBooleanTypesOrderList=nil then
1217     FBooleanTypesOrderList:=TTypeAliasOrderList.Create([
1218        'LongBool', 'WordBool', 'Boolean', 'ByteBool']);
1219 
1220   Result := FBooleanTypesOrderList;
1221 end;
1222 
IntegerTypesOrderListnull1223 function IntegerTypesOrderList: TTypeAliasOrderList;
1224 begin
1225   if FIntegerTypesOrderList=nil then
1226     FIntegerTypesOrderList:=TTypeAliasOrderList.Create([
1227        'Int64', 'QWord',
1228        'NativeInt', 'IntPtr', 'SizeInt', 'NativeUInt', 'UIntPtr',
1229        'Int32', 'Integer', 'LongInt', 'UInt32', 'Cardinal', 'LongWord',
1230        'Int16', 'SmallInt', 'UInt16', 'Word',
1231        'Int8', 'ShortInt', 'UInt8', 'Byte']);
1232 
1233   Result := FIntegerTypesOrderList;
1234 end;
1235 
RealTypesOrderListnull1236 function RealTypesOrderList: TTypeAliasOrderList;
1237 begin
1238   if FRealTypesOrderList=nil then
1239     FRealTypesOrderList:=TTypeAliasOrderList.Create([
1240        'Extended', 'Real', 'Double', 'Single']);
1241 
1242   Result := FRealTypesOrderList;
1243 end;
1244 
StringTypesOrderListnull1245 function StringTypesOrderList: TTypeAliasOrderList;
1246 begin
1247   if FStringTypesOrderList=nil then
1248     FStringTypesOrderList:=TTypeAliasOrderList.Create([
1249        'string', 'AnsiString', 'WideString', 'ShortString', 'Char', 'WideChar', 'AnsiChar']);
1250 
1251   Result := FStringTypesOrderList;
1252 end;
1253 
ListOfPFindContextToStrnull1254 function ListOfPFindContextToStr(const ListOfPFindContext: TFPList): string;
1255 var
1256   Context: TFindContext;
1257   i: Integer;
1258 begin
1259   if ListOfPFindContext=nil then
1260     Result:='nil'
1261   else begin
1262     Result:='';
1263     for i:=0 to ListOfPFindContext.Count-1 do begin
1264       Context:=PFindContext(ListOfPFindContext[i])^;
1265       Result:=Result+'  '+DbgsFC(Context)+LineEnding;
1266     end;
1267   end;
1268 end;
1269 
dbgsFCnull1270 function dbgsFC(const Context: TFindContext): string;
1271 var
1272   CursorPos: TCodeXYPosition;
1273 begin
1274   if Context.Tool=nil then
1275     Result:='nil'
1276   else begin
1277     Result:=Context.Tool.MainFilename;
1278     if Context.Node=nil then
1279       Result:=Result+'()'
1280     else begin
1281       Context.Tool.CleanPosToCaret(Context.Node.StartPos,CursorPos);
1282       Result:=Result+'(y='+dbgs(CursorPos.Y)+',x='+dbgs(CursorPos.X)+')';
1283     end;
1284   end;
1285 end;
1286 
PredefinedIdentToExprTypeDescnull1287 function PredefinedIdentToExprTypeDesc(Identifier: PChar;
1288   Compiler: TPascalCompiler): TExpressionTypeDesc;
1289 begin
1290   // predefined identifiers
1291   if CompareIdentifiers(Identifier,'NIL')=0 then
1292     Result:=xtNil
1293   else if CompareIdentifiers(Identifier,'POINTER')=0 then
1294     Result:=xtPointer
1295   else if (CompareIdentifiers(Identifier,'TRUE')=0)
1296   or (CompareIdentifiers(Identifier,'FALSE')=0) then
1297     Result:=xtConstBoolean
1298   else if CompareIdentifiers(Identifier,'STRING')=0 then
1299     Result:=xtString
1300   else if CompareIdentifiers(Identifier,'SHORTSTRING')=0 then
1301     Result:=xtShortString
1302   else if CompareIdentifiers(Identifier,'ANSISTRING')=0 then
1303     Result:=xtAnsiString
1304   else if CompareIdentifiers(Identifier,'WIDESTRING')=0 then
1305     Result:=xtWideString
1306   else if CompareIdentifiers(Identifier,'UNICODESTRING')=0 then
1307     Result:=xtUnicodeString
1308   else if CompareIdentifiers(Identifier,'INT64')=0 then
1309     Result:=xtInt64
1310   else if CompareIdentifiers(Identifier,'CARDINAL')=0 then
1311     Result:=xtCardinal
1312   else if CompareIdentifiers(Identifier,'QWORD')=0 then
1313     Result:=xtQWord
1314   else if CompareIdentifiers(Identifier,'BOOLEAN')=0 then
1315     Result:=xtBoolean
1316   else if CompareIdentifiers(Identifier,'BYTEBOOL')=0 then
1317     Result:=xtByteBool
1318   else if CompareIdentifiers(Identifier,'WORDBOOL')=0 then
1319     Result:=xtWordBool
1320   else if CompareIdentifiers(Identifier,'LONGBOOL')=0 then
1321     Result:=xtLongBool
1322   else if CompareIdentifiers(Identifier,'QWORDBOOL')=0 then
1323     Result:=xtQWordBool
1324   else if CompareIdentifiers(Identifier,'CHAR')=0 then
1325     Result:=xtChar
1326   else if CompareIdentifiers(Identifier,'WIDECHAR')=0 then
1327     Result:=xtWideChar
1328   else if CompareIdentifiers(Identifier,'REAL')=0 then
1329     Result:=xtReal
1330   else if CompareIdentifiers(Identifier,'SINGLE')=0 then
1331     Result:=xtSingle
1332   else if CompareIdentifiers(Identifier,'DOUBLE')=0 then
1333     Result:=xtDouble
1334   else if CompareIdentifiers(Identifier,'EXTENDED')=0 then
1335     Result:=xtExtended
1336   else if CompareIdentifiers(Identifier,'CEXTENDED')=0 then
1337     Result:=xtCExtended
1338   else if CompareIdentifiers(Identifier,'COMP')=0 then
1339     Result:=xtComp
1340   else if CompareIdentifiers(Identifier,'FILE')=0 then
1341     Result:=xtFile
1342   else if CompareIdentifiers(Identifier,'TEXT')=0 then
1343     Result:=xtText
1344   else if CompareIdentifiers(Identifier,'SIZEOF')=0 then
1345     Result:=xtConstOrdInteger
1346   else if CompareIdentifiers(Identifier,'ORD')=0 then
1347     Result:=xtConstOrdInteger
1348   else if CompareIdentifiers(Identifier,'ASSIGNED')=0 then
1349     Result:=xtConstBoolean
1350   else if CompareIdentifiers(Identifier,'VARIANT')=0 then
1351     Result:=xtVariant
1352   else if CompareIdentifiers(Identifier,'CURRENCY')=0 then
1353     Result:=xtCurrency
1354   else if CompareIdentifiers(Identifier,'LONGINT')=0 then
1355     Result:=xtLongInt
1356   else if CompareIdentifiers(Identifier,'LONGWORD')=0 then
1357     Result:=xtLongWord
1358   else if CompareIdentifiers(Identifier,'WORD')=0 then
1359     Result:=xtWord
1360   else if CompareIdentifiers(Identifier,'LONGWORD')=0 then
1361     Result:=xtCardinal
1362   else if CompareIdentifiers(Identifier,'SMALLINT')=0 then
1363     Result:=xtSmallInt
1364   else if CompareIdentifiers(Identifier,'SHORTINT')=0 then
1365     Result:=xtShortInt
1366   else if CompareIdentifiers(Identifier,'BYTE')=0 then
1367     Result:=xtByte
1368   else if CompareIdentifiers(Identifier,'PCHAR')=0 then
1369     Result:=xtPChar
1370   else if IsWordBuiltInFunc.DoItCaseInsensitive(Identifier) then
1371     Result:=xtCompilerFunc
1372   else begin
1373     // compiler specific
1374     if (Compiler=pcPas2js) then begin
1375       if CompareIdentifiers(Identifier,'JSVALUE')=0 then
1376         exit(xtJSValue);
1377       if CompareIdentifiers(Identifier,'NATIVEINT')=0 then
1378         exit(xtNativeInt);
1379       if CompareIdentifiers(Identifier,'NATIVEUINT')=0 then
1380        exit(xtNativeUInt);
1381     end;
1382     if (Compiler=pcDelphi) then begin
1383       if CompareIdentifiers(Identifier,'NATIVEINT')=0 then
1384         exit(xtNativeInt);
1385       if CompareIdentifiers(Identifier,'NATIVEUINT')=0 then
1386        exit(xtNativeUInt);
1387     end;
1388     Result:=xtNone;
1389   end;
1390 end;
1391 
CompareTypeAliasItemsnull1392 function CompareTypeAliasItems(Item1, Item2: Pointer): Integer;
1393 var
1394   xItem1: TTypeAliasItem absolute Item1;
1395   xItem2: TTypeAliasItem absolute Item2;
1396 begin
1397   Result := CompareIdentifiers(PChar(xItem1.AliasName), PChar(xItem2.AliasName));
1398 end;
1399 
CompareTypeAliasItemStringnull1400 function CompareTypeAliasItemString(AliasName, Item: Pointer): Integer;
1401 var
1402   xAliasName: PChar absolute AliasName;
1403   xItem: TTypeAliasItem absolute Item;
1404 begin
1405   Result := CompareIdentifiers(xAliasName, PChar(xItem.AliasName));
1406 end;
1407 
ExprTypeToStringnull1408 function ExprTypeToString(const ExprType: TExpressionType): string;
1409 begin
1410   Result:='Desc='+ExpressionTypeDescNames[ExprType.Desc]
1411          +' SubDesc='+ExpressionTypeDescNames[ExprType.SubDesc]
1412          +' '+FindContextToString(ExprType.Context);
1413 end;
1414 
CreateExpressionTypenull1415 function CreateExpressionType(const Desc, SubDesc: TExpressionTypeDesc;
1416   const Context: TFindContext): TExpressionType;
1417 begin
1418   Result.Desc:=Desc;
1419   Result.SubDesc:=SubDesc;
1420   Result.Context:=Context;
1421 end;
1422 
1423 { TFindContext }
1424 
FindContextToStringnull1425 function FindContextToString(const FindContext: TFindContext;
1426   RelativeFilename: boolean): string;
1427 var
1428   IdentNode: TCodeTreeNode;
1429 begin
1430   Result:='';
1431   if FindContext.Node<>nil then begin
1432     Result:=Result+'Node="'+FindContext.Node.DescAsString+'"';
1433     IdentNode:=FindContext.Node;
1434     while IdentNode<>nil do begin
1435       if IdentNode.Desc in AllSimpleIdentifierDefinitions
1436         +[ctnIdentifier,ctnEnumIdentifier,ctnLabel]
1437       then begin
1438         Result:=Result+' Ident="'+
1439           FindContext.Tool.ExtractIdentifier(IdentNode.StartPos)+'"';
1440         break;
1441       end else if IdentNode.Desc=ctnGenericType then begin
1442         if IdentNode.FirstChild<>nil then
1443           Result:=Result+' Generic="'+
1444             FindContext.Tool.ExtractIdentifier(IdentNode.FirstChild.StartPos)+'"'
1445         else
1446           Result:=Result+' Generic=?';
1447       end else if IdentNode.Desc in [ctnProperty,ctnGlobalProperty] then begin
1448         Result:=Result+' PropName="'+
1449           FindContext.Tool.ExtractPropName(IdentNode,false)+'"';
1450         break;
1451       end else if IdentNode.Desc=ctnProcedure then begin
1452         Result:=Result+' Proc="'+FindContext.Tool.ExtractProcName(IdentNode,[])+'"';
1453         break;
1454       end;
1455       IdentNode:=IdentNode.Parent;
1456     end;
1457     if RelativeFilename then
1458       Result:=Result+' at "'+FindContext.Tool.CleanPosToStr(FindContext.Node.StartPos,true)+'"'
1459     else
1460       Result:=Result+' at "'+FindContext.Tool.CleanPosToRelativeStr(FindContext.Node.StartPos,'')+'"'
1461   end else
1462     Result:='nil';
1463 end;
1464 
FindContextToStringnull1465 function FindContextToString(const FindContext: PFindContext;
1466   RelativeFilename: boolean): string;
1467 begin
1468   if FindContext=nil then
1469     Result:='-'
1470   else
1471     Result:=FindContextToString(FindContext^,RelativeFilename);
1472 end;
1473 
CreateFindContextnull1474 function CreateFindContext(NewTool: TFindDeclarationTool;
1475   NewNode: TCodeTreeNode): TFindContext;
1476 begin
1477   Result.Node:=NewNode;
1478   Result.Tool:=NewTool;
1479 end;
1480 
CreateFindContextnull1481 function CreateFindContext(Params: TFindDeclarationParams): TFindContext;
1482 begin
1483   Result.Node:=Params.NewNode;
1484   Result.Tool:=TFindDeclarationTool(Params.NewCodeTool);
1485 end;
1486 
CreateFindContextnull1487 function CreateFindContext(BaseTypeCache: TBaseTypeCache): TFindContext;
1488 begin
1489   Result.Node:=BaseTypeCache.BaseNode;
1490   Result.Tool:=TFindDeclarationTool(BaseTypeCache.BaseTool);
1491 end;
1492 
FindContextAreEqualnull1493 function FindContextAreEqual(const Context1, Context2: TFindContext): boolean;
1494 begin
1495   Result:=(Context1.Tool=Context2.Tool) and (Context1.Node=Context2.Node);
1496 end;
1497 
CompareFindContextsnull1498 function CompareFindContexts(const Context1, Context2: PFindContext): integer;
1499 begin
1500   if Pointer(Context1^.Tool)>Pointer(Context2^.Tool) then
1501     Result:=1
1502   else if Pointer(Context1^.Tool)<Pointer(Context2^.Tool) then
1503     Result:=-1
1504   else if Pointer(Context1^.Node)>Pointer(Context2^.Node) then
1505     Result:=1
1506   else if Pointer(Context1^.Node)<Pointer(Context2^.Node) then
1507     Result:=-1
1508   else
1509     Result:=0;
1510 end;
1511 
1512 procedure AddFindContext(var ListOfPFindContext: TFPList;
1513   const NewContext: TFindContext);
1514 var
1515   AddContext: PFindContext;
1516 begin
1517   if ListOfPFindContext=nil then ListOfPFindContext:=TFPList.Create;
1518   New(AddContext);
1519   AddContext^:=NewContext;
1520   ListOfPFindContext.Add(AddContext);
1521 end;
1522 
IndexOfFindContextnull1523 function IndexOfFindContext(var ListOfPFindContext: TFPList;
1524   const AContext: PFindContext): integer;
1525 begin
1526   if ListOfPFindContext=nil then
1527     Result:=-1
1528   else begin
1529     Result:=ListOfPFindContext.Count-1;
1530     while (Result>=0)
1531     and (CompareFindContexts(AContext,
1532                              PFindContext(ListOfPFindContext[Result]))<>0)
1533     do
1534       dec(Result);
1535   end;
1536 end;
1537 
1538 procedure FreeListOfPFindContext(var ListOfPFindContext: TFPList);
1539 var
1540   CurContext: PFindContext;
1541   i: Integer;
1542 begin
1543   if ListOfPFindContext=nil then exit;
1544   for i:=0 to ListOfPFindContext.Count-1 do begin
1545     CurContext:=PFindContext(ListOfPFindContext[i]);
1546     Dispose(CurContext);
1547   end;
1548   ListOfPFindContext.Free;
1549   ListOfPFindContext:=nil;
1550 end;
1551 
1552 { TGenericParamValueMapping }
1553 
1554 constructor TGenericParamValueMapping.Create(pPrevBrother: TGenericParamValueMapping; pParam, pValue: TCodeTreeNode);
1555 begin
1556   if pPrevBrother <> nil then
1557     pPrevBrother.NextBrother := Self;
1558   GenericParamNode := pParam;
1559   SpecializeValueNode := pValue;
1560 end;
1561 
1562 destructor TGenericParamValueMapping.Destroy;
1563 begin
1564   if NextBrother <> nil then
1565     NextBrother.Free;
1566   inherited Destroy;
1567 end;
1568 
1569 { TFindIdentifierInUsesSection_FindMissingFPCUnit }
1570 
1571 constructor TFindIdentifierInUsesSection_FindMissingFPCUnit.Create;
1572 begin
1573   inherited;
1574   FResults := TStringList.Create;
1575   FResults.CaseSensitive := True;
1576   FResults.Duplicates := dupIgnore;
1577   FResults.Sorted := True;
1578 end;
1579 
1580 destructor TFindIdentifierInUsesSection_FindMissingFPCUnit.Destroy;
1581 begin
1582   FResults.Free;
1583 
1584   inherited Destroy;
1585 end;
1586 
TFindIdentifierInUsesSection_FindMissingFPCUnit.Findnull1587 function TFindIdentifierInUsesSection_FindMissingFPCUnit.Find(
1588   const AUnitName: string; const ADirectoryCache: TCTDirectoryCache): Boolean;
1589 var
1590   IRes: Integer;
1591 begin
1592   IRes := FResults.IndexOf(AUnitName);
1593   if IRes>=0 then
1594     Exit(Boolean(PtrInt(FResults.Objects[IRes])));
1595   FUnitName := AUnitName;
1596   ADirectoryCache.IterateFPCUnitsInSet(@Iterate);
1597   Result := FFound;
1598   FResults.AddObject(AUnitName, TObject(PtrInt(Result)));
1599 end;
1600 
TFindIdentifierInUsesSection_FindMissingFPCUnit.IsInResultsnull1601 function TFindIdentifierInUsesSection_FindMissingFPCUnit.IsInResults(
1602   const AUnitName: string): Boolean;
1603 begin
1604   Result := FResults.IndexOf(AUnitName)>=0;
1605 end;
1606 
1607 procedure TFindIdentifierInUsesSection_FindMissingFPCUnit.Iterate(
1608   const AFilename: string);
1609 begin
1610   FFound := FFound or SameFileName(FUnitName, ExtractFileNameOnly(AFilename));
1611 end;
1612 
1613 { TTypeAliasOrderList }
1614 
1615 constructor TTypeAliasOrderList.Create(const AliasNames: array of string);
1616 begin
1617   inherited Create;
1618 
1619   FTree := TAVLTree.Create(@CompareTypeAliasItems);
1620   Add(AliasNames);
1621 end;
1622 
1623 procedure TTypeAliasOrderList.Add(const AliasNames: array of string);
1624 var
1625   AliasName: string;
1626 begin
1627   for AliasName in AliasNames do
1628     Add(AliasName);
1629 end;
1630 
1631 procedure TTypeAliasOrderList.Add(const AliasName: string);
1632 var
1633   NewItem: TTypeAliasItem;
1634 begin
1635   if IndexOf(AliasName) > -1 then Exit;
1636 
1637   NewItem := TTypeAliasItem.Create;
1638   NewItem.AliasName := AliasName;
1639   NewItem.Position := FTree.Count;
1640   FTree.Add(NewItem);
1641 end;
1642 
TTypeAliasOrderList.Comparenull1643 function TTypeAliasOrderList.Compare(const AliasName1, AliasName2: string
1644   ): Integer;
1645 var
1646   xAliasIndex1, xAliasIndex2: Integer;
1647 begin
1648   xAliasIndex1 := IndexOf(AliasName1);
1649   xAliasIndex2 := IndexOf(AliasName2);
1650   if (xAliasIndex1=-1) and (xAliasIndex2=-1) then
1651     Exit(0)
1652   else if (xAliasIndex2=-1) then
1653     Exit(-1)
1654   else if (xAliasIndex1=-1) then
1655     Exit(1)
1656   else
1657     Result := xAliasIndex1-xAliasIndex2;
1658 end;
1659 
TTypeAliasOrderList.Comparenull1660 function TTypeAliasOrderList.Compare(const Operand1,
1661   Operand2: TOperand; Tool: TFindDeclarationTool; CleanPos: Integer
1662   ): TOperand;
1663 var
1664   xCompRes: Integer;
1665 begin
1666   // first check if one of the operands is a constant -> if yes, automatically
1667   // return the other
1668   // (x := f + 1; should return always type of f)
1669   if (Operand1.Expr.Desc in xtAllConstTypes) and not (Operand2.Expr.Desc in xtAllConstTypes) then
1670     Exit(Operand2)
1671   else
1672   if (Operand2.Expr.Desc in xtAllConstTypes) and not (Operand1.Expr.Desc in xtAllConstTypes) then
1673     Exit(Operand1);
1674 
1675   // then compare base types
1676   xCompRes := Compare(
1677     Tool.FindExprTypeAsString(Operand1.Expr, CleanPos, nil),
1678     Tool.FindExprTypeAsString(Operand2.Expr, CleanPos, nil));
1679   // if base types are same, compare aliases
1680   if xCompRes = 0 then
1681     xCompRes := Compare(
1682       Tool.FindExprTypeAsString(Operand1.Expr, CleanPos, @Operand1.AliasType),
1683       Tool.FindExprTypeAsString(Operand2.Expr, CleanPos, @Operand2.AliasType));
1684   if xCompRes > 0 then
1685     Result := Operand2
1686   else
1687     Result := Operand1;
1688 end;
1689 
1690 procedure TTypeAliasOrderList.Delete(const Pos: Integer);
1691 var
1692   xAVItem, xDelItem: TAVLTreeNode;
1693   xItem: TTypeAliasItem;
1694 begin
1695   xDelItem := nil;
1696   for xAVItem in FTree do
1697   begin
1698     xItem := TTypeAliasItem(xAVItem.Data);
1699     if xItem.Position = Pos then
1700       xDelItem := xAVItem
1701     else if xItem.Position > Pos then
1702       Dec(xItem.Position);
1703   end;
1704 
1705   if xDelItem<>nil then
1706     FTree.FreeAndDelete(xDelItem);
1707 end;
1708 
1709 procedure TTypeAliasOrderList.Delete(const AliasName: string);
1710 var
1711   xIndex: Integer;
1712 begin
1713   xIndex := IndexOf(AliasName);
1714   if xIndex<0 then Exit;
1715   Delete(xIndex);
1716 end;
1717 
1718 destructor TTypeAliasOrderList.Destroy;
1719 begin
1720   FTree.FreeAndClear;
1721   FTree.Free;
1722 
1723   inherited Destroy;
1724 end;
1725 
IndexOfnull1726 function TTypeAliasOrderList.IndexOf(const AliasName: string): Integer;
1727 var
1728   xAVNode: TAVLTreeNode;
1729 begin
1730   xAVNode := FTree.FindKey(PChar(AliasName), @CompareTypeAliasItemString);
1731   if xAVNode<>nil then
1732     Result := TTypeAliasItem(xAVNode.Data).Position
1733   else
1734     Result := -1;
1735 end;
1736 
1737 procedure TTypeAliasOrderList.Insert(const AliasName: string; const Pos: Integer
1738   );
1739 var
1740   xAVItem: TAVLTreeNode;
1741   xItem, NewItem: TTypeAliasItem;
1742 begin
1743   for xAVItem in FTree do
1744   begin
1745     xItem := TTypeAliasItem(xAVItem.Data);
1746     if xItem.Position >= Pos then
1747       Inc(xItem.Position);
1748   end;
1749 
1750   NewItem := TTypeAliasItem.Create;
1751   NewItem.AliasName := AliasName;
1752   NewItem.Position := Pos;
1753   FTree.Add(NewItem);
1754 end;
1755 
1756 procedure TTypeAliasOrderList.InsertAfter(const AliasName, AfterAlias: string);
1757 var
1758   xIndex: Integer;
1759 begin
1760   if IndexOf(AliasName) = -1 then
1761   begin
1762     xIndex := IndexOf(AfterAlias);
1763     if xIndex >= 0 then
1764       Insert(AliasName, xIndex+1)
1765     else
1766       Add(AliasName);
1767   end;
1768 end;
1769 
1770 procedure TTypeAliasOrderList.InsertBefore(const AliasName, BeforeAlias: string
1771   );
1772 var
1773   xIndex: Integer;
1774 begin
1775   if IndexOf(AliasName) = -1 then
1776   begin
1777     xIndex := IndexOf(BeforeAlias);
1778     if xIndex >= 0 then
1779       Insert(AliasName, xIndex)
1780     else
1781       Add(AliasName);
1782   end;
1783 end;
1784 
1785 { TFDHelpersListItem }
1786 
CalcMemSizenull1787 function TFDHelpersListItem.CalcMemSize: PtrUInt;
1788 begin
1789   Result := InstanceSize;
1790 end;
1791 
1792 { TFDHelpersList }
1793 
CompareHelpersListnull1794 function CompareHelpersList(Item1, Item2: Pointer): Integer;
1795 var
1796   I1: TFDHelpersListItem absolute Item1;
1797   I2: TFDHelpersListItem absolute Item2;
1798 begin
1799   Result := ord(I1.ForExprType.Desc)-ord(I2.ForExprType.Desc);
1800   if Result<>0 then exit;
1801   Result := ComparePointers(I1.ForExprType.Context.Node, I2.ForExprType.Context.Node);
1802 end;
1803 
CompareHelpersListExprTypenull1804 function CompareHelpersListExprType(Item1, Item2: Pointer): Integer;
1805 var
1806   I1: PExpressionType absolute Item1;
1807   I2: TFDHelpersListItem absolute Item2;
1808 begin
1809   Result := ord(I1^.Desc)-ord(I2.ForExprType.Desc);
1810   if Result<>0 then exit;
1811   Result := ComparePointers(I1^.Context.Node, I2.ForExprType.Context.Node);
1812 end;
1813 
1814 procedure TFDHelpersList.AddFromList(const ExtList: TFDHelpersList);
CopyNodenull1815   function CopyNode(ANode: TAVLTreeNode): TFDHelpersListItem;
1816   var
1817     FromNode: TFDHelpersListItem;
1818   begin
1819     FromNode := TFDHelpersListItem(ANode.Data);
1820     if Kind=fdhlkDelphiHelper then
1821       if FTree.FindKey(FromNode, @CompareHelpersList) <> nil then
1822         Exit(nil); //FPC & Delphi don't support duplicate class helpers!
1823     Result := TFDHelpersListItem.Create;
1824     Result.HelperContext := FromNode.HelperContext;
1825     Result.ForExprType := FromNode.ForExprType;
1826     AddChronologically(Result);
1827   end;
1828 var
1829   Node: TAVLTreeNode;
1830 begin
1831   for Node in ExtList.FTree do
1832     CopyNode(Node);
1833 end;
1834 
CalcMemSizenull1835 function TFDHelpersList.CalcMemSize: PtrUInt;
1836 var
1837   Node: TAVLTreeNode;
1838 begin
1839   Result:=PtrUInt(InstanceSize)+PtrUInt(FTree.InstanceSize);
1840   for Node in FTree do
1841     Inc(Result, TFDHelpersListItem(Node.Data).CalcMemSize);
1842 end;
1843 
1844 procedure TFDHelpersList.WriteDebugReport;
1845 var
1846   Node: TAVLTreeNode;
1847   Item: TFDHelpersListItem;
1848 begin
1849   debugln(['TFDHelpersList.WriteDebugReport ',dbgs(Kind),' Count=',FTree.Count]);
1850   Node:=FTree.FindLowest;
1851   while Node<>nil do begin
1852     Item:=TFDHelpersListItem(Node.Data);
1853     debugln(['  ForExprType=[',ExprTypeToString(Item.ForExprType),']',
1854       ' Helper=[',FindContextToString(Item.HelperContext),']']);
1855     Node:=FTree.FindSuccessor(Node);
1856   end;
1857 end;
1858 
1859 procedure TFDHelpersList.AddChronologically(Item: TFDHelpersListItem);
1860 begin
1861   with Item.ForExprType.Context do begin
1862     // Note: ObjCCategory allows multiple helpers for a class (here: ForExprType)
1863     // => there can be multiple items with the same key in the tree which
1864     //    must be chronologically sorted
1865     // -> append the new item rightmost by slightly increasing the key
1866     Node:=TCodeTreeNode(Pointer(Node)-SizeOf(Pointer));
1867     FTree.Add(Item);
1868     Node:=TCodeTreeNode(Pointer(Node)+SizeOf(Pointer));
1869   end;
1870 end;
1871 
AddFromHelperNodenull1872 function TFDHelpersList.AddFromHelperNode(HelperNode: TCodeTreeNode;
1873   Tool: TFindDeclarationTool; Replace: Boolean): TFDHelpersListItem;
1874 var
1875   OldKey: TAVLTreeNode;
1876   ExprType: TExpressionType;
1877 begin
1878   //debugln(['TFDHelpersList.AddFromHelperNode Start ',Tool.CleanPosToStr(HelperNode.StartPos,true),' ',Tool.ExtractCode(HelperNode.StartPos,HelperNode.StartPos+20,[])]);
1879   ExprType:=Tool.FindExtendedExprOfHelper(HelperNode);
1880   //debugln(['TFDHelpersList.AddFromHelperNode ExprType=',ExprTypeToString(ExprType)]);
1881 
1882   if ExprType.Desc in xtAllIdentTypes then
1883   begin
1884     if Kind=fdhlkDelphiHelper then begin
1885       // class/type/record helpers only allow one helper per class
1886       OldKey := FTree.FindKey(@ExprType, @CompareHelpersListExprType);
1887       if OldKey <> nil then
1888       begin
1889         Result:=TFDHelpersListItem(OldKey.Data);
1890         if Replace then begin
1891           // keep AVLNode, it may be in use by the iterator of SearchInHelpers
1892           Result.HelperContext.Node := HelperNode;
1893           Result.HelperContext.Tool := Tool;
1894         end;
1895         exit;
1896       end;
1897     end;
1898 
1899     Result := TFDHelpersListItem.Create;
1900     Result.ForExprType := ExprType;
1901     Result.HelperContext.Node := HelperNode;
1902     Result.HelperContext.Tool := Tool;
1903     AddChronologically(Result);
1904   end else
1905     Result := nil;
1906 end;
1907 
1908 procedure TFDHelpersList.Clear;
1909 begin
1910   FTree.FreeAndClear;
1911 end;
1912 
Countnull1913 function TFDHelpersList.Count: Integer;
1914 begin
1915   Result := FTree.Count;
1916 end;
1917 
1918 constructor TFDHelpersList.Create(aKind: TFDHelpersListKind);
1919 begin
1920   inherited Create;
1921   FKind:=aKind;
1922   FTree:=TAVLTree.Create(@CompareHelpersList);
1923 end;
1924 
1925 procedure TFDHelpersList.DeleteHelperNode(HelperNode: TCodeTreeNode;
1926   Tool: TFindDeclarationTool);
1927 var
1928   OldKey: TAVLTreeNode;
1929   ExprType: TExpressionType;
1930 begin
1931   ExprType:=Tool.FindExtendedExprOfHelper(HelperNode);
1932 
1933   if ExprType.Desc in xtAllIdentTypes then
1934   begin
1935     OldKey := FTree.FindKey(@ExprType, @CompareHelpersListExprType);
1936     if OldKey <> nil then
1937       FTree.FreeAndDelete(OldKey);
1938   end;
1939 end;
1940 
1941 destructor TFDHelpersList.Destroy;
1942 begin
1943   Clear;
1944   FTree.Free;
1945   inherited Destroy;
1946 end;
1947 
IterateFromClassNodenull1948 function TFDHelpersList.IterateFromClassNode(ClassNode: TCodeTreeNode;
1949   Tool: TFindDeclarationTool; out HelperContext: TFindContext; out
1950   Iterator: TAVLTreeNode): boolean;
1951 var
1952   ExprType: TExpressionType;
1953 begin
1954   ExprType.Desc:=xtContext;
1955   ExprType.Context.Node:=ClassNode;
1956   ExprType.Context.Tool:=Tool;
1957   Iterator := FTree.FindRightMostKey(@ExprType, @CompareHelpersListExprType);
1958   if Iterator=nil then exit(false);
1959   HelperContext:=TFDHelpersListItem(Iterator.Data).HelperContext;
1960   Result:=true;
1961 end;
1962 
GetNextnull1963 function TFDHelpersList.GetNext(out HelperContext: TFindContext;
1964   var Iterator: TAVLTreeNode): boolean;
1965 var
1966   NextNode: TAVLTreeNode;
1967 begin
1968   NextNode:=FTree.FindPrecessor(Iterator);
1969   if (NextNode=nil) or (CompareHelpersList(NextNode.Data,Iterator.Data)<>0) then
1970     exit(false);
1971   // found an older compatible helper
1972   Iterator:=NextNode;
1973   HelperContext:=TFDHelpersListItem(Iterator.Data).HelperContext;
1974   Result:=true;
1975 end;
1976 
FindFromExprTypenull1977 function TFDHelpersList.FindFromExprType(const ExprType: TExpressionType
1978   ): TFindContext;
1979 var
1980   Node: TAVLTreeNode;
1981 begin
1982   Node := FTree.FindRightMostKey(@ExprType, @CompareHelpersListExprType);
1983   if Node<>nil then
1984     Result := TFDHelpersListItem(Node.Data).HelperContext
1985   else
1986     Result := CleanFindContext;
1987 end;
1988 
1989 constructor TFindUsedUnitReferences.Create(Tool: TFindDeclarationTool; AContextNode: TCodeTreeNode);
1990 begin
1991   inherited Create;
1992   Params:=TFindDeclarationParams.Create(Tool, AContextNode);
1993 end;
1994 
1995 destructor TFindUsedUnitReferences.Destroy;
1996 begin
1997   FreeAndNil(Params);
1998   inherited Destroy;
1999 end;
2000 
2001 { TFindDeclarationTool }
2002 
FindDeclarationnull2003 function TFindDeclarationTool.FindDeclaration(const CursorPos: TCodeXYPosition;
2004   out NewPos: TCodeXYPosition; out NewTopLine: integer): boolean;
2005 var
2006   NewTool: TFindDeclarationTool;
2007   NewNode: TCodeTreeNode;
2008 begin
2009   Result:=FindDeclaration(CursorPos,DefaultFindSmartFlags,NewTool,NewNode,
2010                           NewPos,NewTopLine);
2011 end;
2012 
FindMainDeclarationnull2013 function TFindDeclarationTool.FindMainDeclaration(
2014   const CursorPos: TCodeXYPosition; out NewPos: TCodeXYPosition; out
2015   NewTopLine: integer): boolean;
2016 var
2017   NewTool: TFindDeclarationTool;
2018   NewNode: TCodeTreeNode;
2019 begin
2020   Result:=FindDeclaration(CursorPos,[fsfFindMainDeclaration],NewTool,NewNode,
2021                           NewPos,NewTopLine);
2022 end;
2023 
FindDeclarationOfIdentifiernull2024 function TFindDeclarationTool.FindDeclarationOfIdentifier(
2025   const CursorPos: TCodeXYPosition; Identifier: PChar;
2026   out NewPos: TCodeXYPosition; out NewTopLine: integer): boolean;
2027 var
2028   CleanCursorPos: integer;
2029   CursorNode: TCodeTreeNode;
2030   Params: TFindDeclarationParams;
2031 begin
2032   Result:=false;
2033   ActivateGlobalWriteLock;
2034   Params:=nil;
2035   try
2036     // build code tree
2037     {$IFDEF CTDEBUG}
2038     DebugLn('TFindDeclarationTool.FindDeclarationOfIdentifier A CursorPos=X',dbgs(CursorPos.X),',Y',dbgs(CursorPos.Y));
2039     {$ENDIF}
2040     BuildTreeAndGetCleanPos(trTillCursor,lsrEnd,CursorPos,CleanCursorPos,
2041                             [btSetIgnoreErrorPos]);
2042     {$IFDEF CTDEBUG}
2043     DebugLn('TFindDeclarationTool.FindDeclarationOfIdentifier B CleanCursorPos=',dbgs(CleanCursorPos));
2044     {$ENDIF}
2045     // find CodeTreeNode at cursor
2046     CursorNode:=BuildSubTreeAndFindDeepestNodeAtPos(CleanCursorPos,true);
2047     // search
2048     Params:=TFindDeclarationParams.Create(Self, CursorNode);
2049     Params.SetIdentifier(Self,Identifier,nil);
2050     Params.Flags:=[fdfSearchInParentNodes,fdfExceptionOnNotFound,
2051                    fdfExceptionOnPredefinedIdent,
2052                    fdfTopLvlResolving,fdfSearchInAncestors,fdfSearchInHelpers,
2053                    fdfIgnoreCurContextNode];
2054     FindIdentifierInContext(Params);
2055     // convert result to nice source position
2056     Params.PrettifyResult;
2057     Params.ConvertResultCleanPosToCaretPos;
2058     NewPos:=Params.NewPos;
2059     NewTopLine:=Params.NewTopLine;
2060     Result:=true;
2061   finally
2062     Params.Free;
2063     DeactivateGlobalWriteLock;
2064   end;
2065 end;
2066 
FindDeclarationnull2067 function TFindDeclarationTool.FindDeclaration(const CursorPos: TCodeXYPosition;
2068   SearchSmartFlags: TFindSmartFlags; out NewExprType: TExpressionType; out
2069   NewPos: TCodeXYPosition; out NewTopLine, BlockTopLine,
2070   BlockBottomLine: integer): boolean;
2071 var
2072   CleanCursorPos: integer;
2073   CursorNode, ClassNode: TCodeTreeNode;
2074   DirectSearch, SkipChecks, SearchForward: boolean;
2075 
2076   function CheckIfNodeIsForwardDefinedClass(ANode: TCodeTreeNode;
2077     ATool: TFindDeclarationTool): Boolean;
2078   var
2079     TypeNode: TCodeTreeNode;
2080   begin
2081     Result := False;
2082     if not (ANode.Desc in [ctnTypeDefinition,ctnGenericType]) then exit;
2083     TypeNode:=ATool.FindTypeNodeOfDefinition(ANode);
2084     if (TypeNode<>nil)
2085     and (TypeNode.Desc in AllClasses)
2086     and ((TypeNode.SubDesc and ctnsForwardDeclaration)>0)
2087     then
2088       Result := True;
2089   end;
2090 
2091   procedure CheckIfCursorOnAForwardDefinedClass;
2092   begin
2093     if SkipChecks then exit;
2094     if CheckIfNodeIsForwardDefinedClass(CursorNode, Self) then
2095     begin
2096       DirectSearch:=true;
2097       SearchForward:=true;
2098       SkipChecks:=true;
2099     end;
2100   end;
2101 
2102   procedure CheckIfCursorInClassNode;
2103   begin
2104     if SkipChecks then exit;
2105     ClassNode:=CursorNode;
2106     while (ClassNode<>nil)
2107     and (not (ClassNode.Desc in AllClasses))
2108     do
2109       ClassNode:=ClassNode.Parent;
2110     if ClassNode=nil then exit;
2111     // cursor is in class/object/class interface definition
2112     if (ClassNode.SubDesc and ctnsForwardDeclaration)>0 then exit;
2113     // parse class and build CodeTreeNodes for all properties/methods
2114     CursorNode:=FindDeepestNodeAtPos(ClassNode,CleanCursorPos,true);
2115     if CursorNode.GetNodeOfType(ctnClassInheritance)=nil then exit;
2116     // identifier is an ancestor/interface identifier
2117     CursorNode:=ClassNode.Parent;
2118     DirectSearch:=true;
2119     SkipChecks:=true;
2120   end;
2121 
2122   procedure CheckIfCursorInProcNode;
2123   var IsMethod: boolean;
2124   begin
2125     if SkipChecks then exit;
2126     if CursorNode.Desc=ctnProcedureHead then
2127       CursorNode:=CursorNode.Parent;
2128     if CursorNode.Desc<>ctnProcedure then exit;
2129     BuildSubTreeForProcHead(CursorNode);
2130     CursorNode:=FindDeepestNodeAtPos(CursorNode,CleanCursorPos,true);
2131     // check if cursor on proc name
2132     if (CursorNode.Desc=ctnProcedureHead)
2133     and (CleanCursorPos>=CursorNode.StartPos) then begin
2134       MoveCursorToNodeStart(CursorNode);
2135       ReadNextAtom;
2136       IsMethod:=false;
2137       if AtomIsIdentifier then begin
2138         ReadNextAtom;
2139         if AtomIsChar('.') then begin
2140           ReadNextAtom;
2141           ReadNextAtom;
2142           IsMethod:=true;
2143         end;
2144       end;
2145       if (CurPos.StartPos>CleanCursorPos) and (not IsMethod) then begin
2146         // cursor on proc name
2147         // -> ignore proc name and search overloaded identifier
2148         DirectSearch:=true;
2149         SkipChecks:=true;
2150       end;
2151     end;
2152     if CursorNode.Desc=ctnProcedureHead then
2153       CursorNode:=CursorNode.Parent;
2154   end;
2155 
2156   procedure CheckIfCursorInPropertyNode;
2157   begin
2158     if SkipChecks then exit;
2159     if not (CursorNode.Desc in [ctnProperty,ctnGlobalProperty]) then exit;
2160     MoveCursorToNodeStart(CursorNode);
2161     if (CursorNode.Desc=ctnProperty) then begin
2162       ReadNextAtom; // read 'property'
2163       if UpAtomIs('CLASS') then ReadNextAtom;
2164     end;
2165     ReadNextAtom; // read property name
2166     if CleanCursorPos<CurPos.EndPos then begin
2167       DirectSearch:=true;
2168       SkipChecks:=true;
2169     end;
2170   end;
2171 
2172   function FindSourceName(ACode: TCodeBuffer): boolean;
2173   var
2174     NamePos: TAtomPosition;
2175   begin
2176     Result:=false;
2177     NewExprType :=CleanExpressionType;
2178     if Assigned(FOnGetCodeToolForBuffer) then
2179       NewExprType.Context.Tool:=FOnGetCodeToolForBuffer(Self,ACode,false);
2180     if NewExprType.Context.Tool=nil then exit;
2181     NewExprType.Context.Tool.BuildTree(lsrSourceName);
2182     if not NewExprType.Context.Tool.GetSourceNamePos(NamePos) then exit;
2183     NewExprType.Context.Node:=NewExprType.Context.Tool.Tree.Root;
2184     if not NewExprType.Context.Tool.JumpToCleanPos(NamePos.StartPos,NamePos.StartPos,
2185                                   NamePos.StartPos,NewPos,NewTopLine,BlockTopLine,BlockBottomLine,false)
2186     then exit;
2187     Result:=true;
2188     NewExprType.Desc:=xtContext;
2189   end;
2190 
2191   {$IFDEF VerboseFindDeclarationFail}
2192   procedure WriteFailReport;
2193   var
2194     CodePos: integer;
2195     LinkIndex: Integer;
2196     Link: TSourceLink;
2197     i: Integer;
2198     SrcCodes: TAVLTree;
2199     SrcNode: TAVLTreeNode;
2200   begin
2201     debugln(['TFindDeclarationTool.FindDeclaration failed',
2202       ' CursorPos=X=',CursorPos.X,',Y=',CursorPos.Y,
2203       ',File=',CursorPos.Code.Filename,
2204       ',LineCount=',CursorPos.Code.LineCount]);
2205     if CursorPos.Y<=CursorPos.Code.LineCount then
2206       debugln([' Line="',dbgstr(CursorPos.Code.GetLine(CursorPos.Y-1),1,CursorPos.X-1),'|',dbgstr(CursorPos.Code.GetLine(CursorPos.Y-1),CursorPos.X,1000),'"']);
2207     if CleanCursorPos>0 then begin
2208       debugln([ ' CleanCursorPos=',CleanCursorPos,' CleanCode="',dbgstr(Src,CleanCursorPos-40,40),'|',dbgstr(Src,CleanCursorPos,30),'"']);
2209     end;
2210     CursorPos.Code.LineColToPosition(CursorPos.Y,CursorPos.X,CodePos);
2211     LinkIndex:=Scanner.LinkIndexAtCursorPos(CodePos,CursorPos.Code);
2212     dbgout([' CodePos=',CodePos,' LinkIndex=',LinkIndex]);
2213     if LinkIndex>=0 then begin
2214       Link:=Scanner.Links[LinkIndex];
2215       dbgout([',CleanedPos=',Link.CleanedPos,',Size=',Scanner.LinkSize(LinkIndex),',SrcPos=',Link.SrcPos,',Kind=',dbgs(Link.Kind),',CodeSame=',Link.Code=Pointer(CursorPos.Code)]);
2216     end else begin
2217       dbgout([' LinkCount=',Scanner.LinkCount]);
2218       i:=0;
2219       while (i<Scanner.LinkCount-1) do begin
2220         Link:=Scanner.Links[i];
2221         if Link.Code=Pointer(CursorPos.Code) then begin
2222           if LinkIndex<0 then
2223             dbgout([', First Link of Code: ID=',i,',CleanedPos=',Link.CleanedPos,',Size=',Scanner.LinkSize(i),',SrcPos=',Link.SrcPos,',Kind=',dbgs(Link.Kind)]);
2224           LinkIndex:=i;
2225         end;
2226         inc(i);
2227       end;
2228       if LinkIndex>=0 then begin
2229         Link:=Scanner.Links[LinkIndex];
2230         dbgout([', Last Link of Code: ID=',LinkIndex,',CleanedPos=',Link.CleanedPos,',Size=',Scanner.LinkSize(i),',SrcPos=',Link.SrcPos,',Kind=',dbgs(Link.Kind)]);
2231       end else begin
2232         SrcCodes:=Scanner.CreateTreeOfSourceCodes;
2233         try
2234           for SrcNode in SrcCodes do begin
2235             dbgout(',LinkFile="',TCodeBuffer(SrcNode.Data).Filename,'"');
2236           end;
2237         finally
2238           SrcCodes.Free;
2239         end;
2240       end;
2241     end;
2242     debugln;
2243   end;
2244   {$ENDIF}
2245 
2246 var
2247   IdentStartPos: Integer;
2248 
2249   function TrySkipClassForward(Params: TFindDeclarationParams): Boolean;
2250   var
2251     ForwardXY, NewSkipPos: TCodeXYPosition;
2252     NewSkipExprType: TExpressionType;
2253     NewSkipTopLine, NewSkipCleanPos, NewSkipBlockTopLine,
2254       NewSkipBlockBottomLine: integer;
2255   begin
2256     // if we skip forward class definitions and we found one -> proceed search!
2257     Result :=
2258          (fsfSkipClassForward in SearchSmartFlags)
2259       and CheckIfNodeIsForwardDefinedClass(Params.NewNode, Params.NewCodeTool)
2260       and Params.NewCodeTool.CleanPosToCaret(Params.NewNode.StartPos, ForwardXY)
2261       and Params.NewCodeTool.FindDeclaration(ForwardXY, SearchSmartFlags-[fsfSkipClassForward],
2262         NewSkipExprType, NewSkipPos, NewSkipTopLine, NewSkipBlockTopLine, NewSkipBlockBottomLine);
2263 
2264     if Result
2265       and (NewSkipExprType.Desc=xtContext)
2266       and (NewSkipExprType.Context.Tool=Self)
2267       and (NewSkipExprType.Context.Tool.CaretToCleanPos(NewSkipPos, NewSkipCleanPos)=0)
2268       and (IdentStartPos = GetIdentStartPosition(Src,NewSkipCleanPos))
2269     then begin
2270       // the old startpos and the skipclass startpos are the same -> we want to
2271       // jump to the forward declaration because we jump from the actual one
2272       Result := False;
2273     end;
2274 
2275     if Result then
2276     begin
2277       NewExprType := NewSkipExprType;
2278       NewPos := NewSkipPos;
2279       NewTopLine := NewSkipTopLine;
2280       BlockTopLine := NewSkipBlockTopLine;
2281       BlockBottomLine := NewSkipBlockBottomLine;
2282     end;
2283   end;
2284 
2285 var
2286   CleanPosInFront: integer;
2287   CursorAtIdentifier: boolean;
2288   IdentifierStart: PChar;
2289   LineRange: TLineRange;
2290   Params: TFindDeclarationParams;
2291 begin
2292   Result:=false;
2293   NewExprType:=CleanExpressionType;
2294   NewPos.X:=-1;
2295   NewPos.Y:=-1;
2296   SkipChecks:=false;
2297   // check cursor in source
2298   if (CursorPos.Y<1) or (CursorPos.Y>CursorPos.Code.LineCount)
2299   or (CursorPos.X<1) then begin
2300     {$IFDEF VerboseFindDeclarationFail}
2301     debugln(['TFindDeclarationTool.FindDeclaration invalid CursorPos=X=',CursorPos.X,' Y=',CursorPos.Y,' File=',CursorPos.Code.Filename,' LineCount=',CursorPos.Code.LineCount]);
2302     {$ENDIF}
2303     exit;
2304   end;
2305   CursorPos.Code.GetLineRange(CursorPos.Y-1,LineRange);
2306   if LineRange.EndPos-LineRange.StartPos+1<CursorPos.X then begin
2307     // beyond end of line
2308     {$IFDEF VerboseFindDeclarationFail}
2309     debugln(['TFindDeclarationTool.FindDeclaration beyond end of line: CursorPos=X=',CursorPos.X,' Y=',CursorPos.Y,' File=',CursorPos.Code.Filename,' LineLen=',LineRange.EndPos-LineRange.StartPos]);
2310     {$ENDIF}
2311     exit;
2312   end;
2313 
2314   CleanCursorPos:=0;
2315   ActivateGlobalWriteLock;
2316   try
2317     // build code tree
2318     {$IFDEF CTDEBUG}
2319     DebugLn('TFindDeclarationTool.FindDeclaration A CursorPos=X',dbgs(CursorPos.X),',Y',dbgs(CursorPos.Y),' ',CursorPos.Code.Filename);
2320     debugln(['TFindDeclarationTool.FindDeclaration B ',dbgtext(copy(CursorPos.Code.GetLine(CursorPos.Y),1,CursorPos.X-1)),'|',dbgtext(copy(CursorPos.Code.GetLine(CursorPos.Y),CursorPos.X,120))]);
2321     {$ENDIF}
2322     BuildTreeAndGetCleanPos(trTillCursor,lsrEnd,CursorPos,CleanCursorPos,
2323                   [btSetIgnoreErrorPos,btCursorPosOutAllowed]);
2324     {$IFDEF CTDEBUG}
2325     debugLn('TFindDeclarationTool.FindDeclaration B CleanCursorPos=',dbgs(CleanCursorPos));
2326     debugln(['TFindDeclarationTool.FindDeclaration C ',dbgtext(copy(Src,CleanCursorPos-30,30)),'|',dbgtext(copy(Src,CleanCursorPos,30))]);
2327     {$ENDIF}
2328 
2329     // find CodeTreeNode at cursor
2330     if (Tree.Root<>nil) and (Tree.Root.StartPos<=CleanCursorPos) then begin
2331       CursorNode:=BuildSubTreeAndFindDeepestNodeAtPos(CleanCursorPos,true);
2332       if (fsfFindMainDeclaration in SearchSmartFlags)
2333       and CleanPosIsDeclarationIdentifier(CleanCursorPos,CursorNode)
2334       then begin
2335         //DebugLn(['TFindDeclarationTool.FindDeclaration CleanPosIsDeclarationIdentifier']);
2336         NewExprType.Desc:=xtContext;
2337         NewExprType.Context.Tool:=Self;
2338         NewExprType.Context.Node:=CursorNode;
2339         CleanCursorPos:=GetIdentStartPosition(Src,CleanCursorPos);
2340         if CursorNode.Desc=ctnVarDefinition then begin
2341           // if this is a parameter, try to find the corresponding declaration
2342           NewExprType.Context.Node:=FindCorrespondingProcParamNode(NewExprType.Context.Node);
2343           if (NewExprType.Context.Node<>nil) and (NewExprType.Context.Node.StartPos<CursorNode.StartPos) then
2344             CleanCursorPos:=NewExprType.Context.Node.StartPos
2345           else
2346             NewExprType.Context.Node:=CursorNode;
2347         end;
2348         if (CursorNode.Desc=ctnProcedureHead)
2349         and (NodeIsMethodBody(CursorNode.Parent)) then begin
2350           // if this is a procedure body, try to find the corresponding declaration
2351           NewExprType.Context.Node:=FindCorrespondingProcNode(CursorNode.Parent);
2352           if (NewExprType.Context.Node<>nil) and (NewExprType.Context.Node.Desc=ctnProcedure) then
2353             NewExprType.Context.Node:=NewExprType.Context.Node.FirstChild;
2354           if (NewExprType.Context.Node<>nil) and (NewExprType.Context.Node.StartPos<CursorNode.StartPos) then begin
2355             CleanCursorPos:=NewExprType.Context.Node.StartPos;
2356           end
2357           else
2358             NewExprType.Context.Node:=CursorNode;
2359         end;
2360 
2361         Result:=JumpToCleanPos(CleanCursorPos,CleanCursorPos,CleanCursorPos,
2362                                NewPos,NewTopLine,BlockTopLine,BlockBottomLine,false);
2363         {$IFDEF VerboseFindDeclarationFail}
2364         if not Result then begin
2365           debugln(['TFindDeclarationTool.FindDeclaration cursor at declaration, but JumpToCleanPos failed']);
2366         end;
2367         {$ENDIF}
2368         exit;
2369       end;
2370       CleanPosInFront:=CursorNode.StartPos;
2371     end else begin
2372       CleanPosInFront:=1;
2373       CursorNode:=nil;
2374     end;
2375     if IsIncludeDirectiveAtPos(CleanCursorPos,CleanPosInFront,NewPos.Code)
2376     then begin
2377       // include directive
2378       //DebugLn(['TFindDeclarationTool.FindDeclaration IsIncludeDirectiveAtPos']);
2379       NewPos.X:=1;
2380       NewPos.Y:=1;
2381       NewTopLine:=1;
2382       BlockTopLine:=NewPos.Y;
2383       BlockBottomLine:=NewPos.Y;
2384       NewExprType.Desc:=xtContext;
2385       NewExprType.Context.Node:=nil;
2386       NewExprType.Context.Tool:=Self;
2387       Result:=(fsfIncludeDirective in SearchSmartFlags);
2388       {$IFDEF VerboseFindDeclarationFail}
2389       if not Result then begin
2390         debugln(['TFindDeclarationTool.FindDeclaration cursor at include directive and fsfIncludeDirective not set']);
2391       end;
2392       {$ENDIF}
2393       exit;
2394     end;
2395     if CursorNode=nil then begin
2396       // raise exception
2397       RaiseCursorOutsideCode(CursorPos);
2398     end;
2399     {$IFDEF CTDEBUG}
2400     DbgOut(['TFindDeclarationTool.FindDeclaration D CursorNode=',NodeDescriptionAsString(CursorNode.Desc),' HasChildren=',dbgs(CursorNode.FirstChild<>nil)]);
2401     if CursorNode.Parent<>nil then
2402       DbgOut(' Parent="',CursorNode.Parent.DescAsString,'"');
2403     Debugln;
2404     {$ENDIF}
2405     if (CursorNode.Desc = ctnUseUnitNamespace) then begin
2406       NewExprType.Desc:=xtContext;
2407       NewExprType.Context.Node:=CursorNode;
2408       NewExprType.Context.Tool:=Self;
2409       CleanPosToCaret(CursorNode.StartPos, NewPos);
2410       NewTopLine := NewPos.Y;
2411       BlockTopLine := NewTopLine;
2412       CleanPosToCaret(CursorNode.EndPos, NewPos);
2413       BlockBottomLine := NewPos.Y;
2414       Result := True;
2415       Exit;
2416     end else
2417     if (CursorNode.Desc in [ctnUsesSection,ctnUseUnitClearName]) then begin
2418       // in uses section
2419       //DebugLn(['TFindDeclarationTool.FindDeclaration IsUsesSection']);
2420       Result:=FindDeclarationInUsesSection(CursorNode,CleanCursorPos,
2421                                            NewPos,NewTopLine);
2422       BlockTopLine:=NewPos.Y;
2423       BlockBottomLine:=NewPos.Y;
2424       NewExprType:=CleanExpressionType;
2425       {$IFDEF VerboseFindDeclarationFail}
2426       if not Result then begin
2427         debugln(['TFindDeclarationTool.FindDeclaration cursor in uses and FindDeclarationInUsesSection failed']);
2428       end;
2429       {$ENDIF}
2430       if Result and (fsfSearchSourceName in SearchSmartFlags) then begin
2431         Result:=FindSourceName(NewPos.Code);
2432         {$IFDEF VerboseFindDeclarationFail}
2433         if not Result then begin
2434           debugln(['TFindDeclarationTool.FindDeclaration cursor in uses and FindSourceName failed']);
2435         end;
2436         {$ENDIF}
2437       end;
2438       exit;
2439     end;
2440     DirectSearch:=false;
2441     SearchForward:=false;
2442     CheckIfCursorOnAForwardDefinedClass;
2443     CheckIfCursorInClassNode;
2444     CheckIfCursorInProcNode;
2445     CheckIfCursorInPropertyNode;
2446     // set cursor on identifier
2447     MoveCursorToCleanPos(CleanCursorPos);
2448     GetIdentStartEndAtPosition(Src,CleanCursorPos,
2449                                CurPos.StartPos,CurPos.EndPos);
2450     IdentStartPos:=CurPos.StartPos;
2451     CursorAtIdentifier:=CurPos.StartPos<CurPos.EndPos;
2452     if CursorAtIdentifier then
2453       IdentifierStart:=@Src[CurPos.StartPos]
2454     else
2455       IdentifierStart:=PChar(Src);
2456     if CursorAtIdentifier then begin
2457       // find declaration of identifier
2458       Params:=TFindDeclarationParams.Create(Self, CursorNode);
2459       try
2460         Params.SetIdentifier(Self,IdentifierStart,@CheckSrcIdentifier);
2461         Params.Flags:=[fdfSearchInParentNodes,fdfExceptionOnNotFound,
2462                        fdfExceptionOnPredefinedIdent,
2463                        fdfTopLvlResolving,fdfSearchInAncestors,fdfSearchInHelpers];
2464         if fsfSkipClassForward in SearchSmartFlags then
2465           Include(Params.Flags,fdfSkipClassForward);
2466         if not DirectSearch then begin
2467           Result:=FindDeclarationOfIdentAtParam(Params, NewExprType);
2468           {$IFDEF VerboseFindDeclarationFail}
2469           if not Result then begin
2470             debugln(['TFindDeclarationTool.FindDeclaration FindDeclarationOfIdentAtParam failed']);
2471           end;
2472           {$ENDIF}
2473           if Result and TrySkipClassForward(Params) then
2474             Exit(True);
2475         end else begin
2476           Include(Params.Flags,fdfIgnoreCurContextNode);
2477           if SearchForward then
2478             Include(Params.Flags,fdfSearchForward);
2479           //debugln(['TFindDeclarationTool.FindDeclaration Flags=',dbgs(Params.Flags),' FindIdentifierInContext ...']);
2480           Result:=FindIdentifierInContext(Params);
2481           if Result then
2482           begin
2483             if TrySkipClassForward(Params) then
2484               Exit(True);
2485 
2486             NewExprType.Desc:=xtContext;
2487             NewExprType.Context.Node:=Params.NewNode;
2488             NewExprType.Context.Tool:=Params.NewCodeTool;
2489           end;
2490           {$IFDEF VerboseFindDeclarationFail}
2491           if not Result then begin
2492             debugln(['TFindDeclarationTool.FindDeclaration FindIdentifierInContext failed']);
2493           end;
2494           {$ENDIF}
2495         end;
2496         if Result then begin
2497           Params.PrettifyResult;
2498           Params.ConvertResultCleanPosToCaretPos;
2499           NewPos:=Params.NewPos;
2500           NewTopLine:=Params.NewTopLine;
2501           BlockTopLine:=NewPos.Y;
2502           BlockBottomLine:=NewPos.Y;
2503           if (NewExprType.Desc=xtContext) and
2504              ((NewPos.Code=nil) or (NewExprType.Context.Node=nil))
2505           then begin
2506             if Params.IdentifierTool.IsPCharInSrc(Params.Identifier) then
2507               Params.IdentifierTool.MoveCursorToCleanPos(Params.Identifier)
2508             else
2509               MoveCursorToCleanPos(CleanCursorPos);
2510             Params.IdentifierTool.RaiseExceptionFmt(20170421200024,ctsIdentifierNotFound,
2511                                           [GetIdentifier(Params.Identifier)]);
2512           end;
2513         end;
2514       finally
2515         Params.Free;
2516       end;
2517     end else begin
2518       // find declaration of non identifier, e.g. numeric label
2519       {$IFDEF VerboseFindDeclarationFail}
2520       if not Result then begin
2521         debugln(['TFindDeclarationTool.FindDeclaration cursor at non identifier']);
2522       end;
2523       {$ENDIF}
2524     end;
2525   finally
2526     ClearIgnoreErrorAfter;
2527     DeactivateGlobalWriteLock;
2528     {$IFDEF VerboseFindDeclarationFail}
2529     WriteFailReport;
2530     {$ENDIF}
2531   end;
2532 end;
2533 
FindDeclarationnull2534 function TFindDeclarationTool.FindDeclaration(const CursorPos: TCodeXYPosition;
2535   SearchSmartFlags: TFindSmartFlags; out NewExprType: TExpressionType; out
2536   NewPos: TCodeXYPosition; out NewTopLine: integer): boolean;
2537 var
2538   BlockTopLine, BlockBottomLine: integer;
2539 begin
2540   Result := FindDeclaration(CursorPos, SearchSmartFlags, NewExprType, NewPos,
2541     NewTopLine, BlockTopLine, BlockBottomLine);
2542 end;
2543 
FindDeclarationnull2544 function TFindDeclarationTool.FindDeclaration(const CursorPos: TCodeXYPosition;
2545   SearchSmartFlags: TFindSmartFlags; out NewTool: TFindDeclarationTool; out
2546   NewNode: TCodeTreeNode; out NewPos: TCodeXYPosition; out NewTopLine,
2547   BlockTopLine, BlockBottomLine: integer): boolean;
2548 var
2549   ExprType: TExpressionType;
2550 begin
2551   Result := FindDeclaration(CursorPos, SearchSmartFlags, ExprType, NewPos, NewTopLine, BlockTopLine, BlockBottomLine) and
2552     (NewPos.X >= 0) and (NewPos.Y >= 0);
2553   if Result then begin
2554     NewTool := ExprType.Context.Tool;
2555     NewNode := ExprType.Context.Node;
2556   end else begin
2557     NewTool := nil;
2558     NewNode := nil;
2559   end;
2560 end;
2561 
FindDeclarationnull2562 function TFindDeclarationTool.FindDeclaration(const CursorPos: TCodeXYPosition;
2563   SearchSmartFlags: TFindSmartFlags; out NewTool: TFindDeclarationTool; out
2564   NewNode: TCodeTreeNode; out NewPos: TCodeXYPosition; out NewTopLine: integer
2565   ): boolean;
2566 var
2567   BlockTopLine, BlockBottomLine: integer;
2568 begin
2569   Result := FindDeclaration(CursorPos, SearchSmartFlags, NewTool, NewNode, NewPos,
2570     NewTopLine, BlockTopLine, BlockBottomLine);
2571 end;
2572 
FindDeclarationInInterfacenull2573 function TFindDeclarationTool.FindDeclarationInInterface(
2574   const Identifier: string; out NewPos: TCodeXYPosition; out NewTopLine,
2575   BlockTopLine, BlockBottomLine: integer): boolean;
2576 var
2577   Node: TCodeTreeNode;
2578 begin
2579   Result:=false;
2580   if Identifier='' then exit;
2581   Node:=FindDeclarationNodeInInterface(Identifier,true);
2582   if Node<>nil then
2583     Result:=JumpToNode(Node,NewPos,NewTopLine,BlockTopLine,BlockBottomLine,false);
2584 end;
2585 
FindDeclarationWithMainUsesSectionnull2586 function TFindDeclarationTool.FindDeclarationWithMainUsesSection(
2587   const Identifier: string; out NewPos: TCodeXYPosition; out NewTopLine: integer
2588   ): boolean;
2589 var
2590   UsesNode: TCodeTreeNode;
2591   Params: TFindDeclarationParams;
2592 begin
2593   Result:=false;
2594   if Identifier='' then exit;
2595   BuildTree(lsrMainUsesSectionEnd);
2596   UsesNode:=FindMainUsesNode;
2597   if UsesNode=nil then exit;
2598 
2599   Params:=TFindDeclarationParams.Create(Self, FindLastNode);
2600   ActivateGlobalWriteLock;
2601   try
2602     Params.Flags:=[fdfExceptionOnNotFound];
2603     Params.SetIdentifier(Self,PChar(Pointer(Identifier)),nil);
2604     if FindIdentifierInUsesSection(UsesNode,Params,True) then begin
2605       if Params.NewNode=nil then exit;
2606       Result:=Params.NewCodeTool.JumpToNode(Params.NewNode,NewPos,
2607                                             NewTopLine,false);
2608     end;
2609   finally
2610     Params.Free;
2611     DeactivateGlobalWriteLock;
2612   end;
2613 end;
2614 
FindDeclarationOfPropertyPathnull2615 function TFindDeclarationTool.FindDeclarationOfPropertyPath(
2616   const PropertyPath: string; out NewContext: TFindContext;
2617   IgnoreTypeLess: boolean): boolean;
2618 // example: PropertyPath='TForm1.Font.Color'
2619 var
2620   StartPos: Integer;
2621 
2622   function GetNextIdentifier: string;
2623   var
2624     EndPos: LongInt;
2625   begin
2626     EndPos:=StartPos;
2627     while (EndPos<=length(PropertyPath)) and (IsIdentChar[PropertyPath[EndPos]])
2628     do inc(EndPos);
2629     if (EndPos<=length(PropertyPath)) and (PropertyPath[EndPos]<>'.') then
2630       Result:=''
2631     else begin
2632       Result:=copy(PropertyPath,StartPos,EndPos-StartPos);
2633       StartPos:=EndPos+1;
2634     end;
2635   end;
2636 
2637 var
2638   Params: TFindDeclarationParams;
2639   Identifier: String;
2640   IsLastProperty: Boolean;
2641   Context: TFindContext;
2642   IsTypeLess: Boolean;
2643   Node: TCodeTreeNode;
2644 begin
2645   Result:=false;
2646   NewContext:=CleanFindContext;
2647   //DebugLn('TFindDeclarationTool.FindDeclarationOfPropertyPath ',MainFilename,' PropertyPath="',PropertyPath,'"');
2648   if PropertyPath='' then exit;
2649   ActivateGlobalWriteLock;
2650   Params:=TFindDeclarationParams.Create(Self, FindLastNode);
2651   try
2652     BuildTree(lsrInitializationStart);
2653 
2654     //DebugLn(['TFindDeclarationTool.FindDeclarationOfPropertyPath ',Src]);
2655 
2656     // first search the class/variable in the interface
2657     StartPos:=1;
2658     Identifier:=GetNextIdentifier;
2659     if Identifier='' then exit;
2660     Context.Tool:=Self;
2661     Context.Node:=FindDeclarationNodeInInterface(Identifier,true);
2662     if Context.Node=nil then begin
2663       DebugLn(['TFindDeclarationTool.FindDeclarationOfPropertyPath Identifier not found in interface ',Identifier]);
2664       exit;
2665     end;
2666     Context:=FindBaseTypeOfNode(Params,Context.Node);
2667     if Context.Node=nil then begin
2668       DebugLn(['TFindDeclarationTool.FindDeclarationOfPropertyPath context not found']);
2669       exit;
2670     end;
2671     // then search the properties
2672     repeat
2673       Identifier:=GetNextIdentifier;
2674       IsLastProperty:=StartPos>length(PropertyPath);
2675       //DebugLn('TFindDeclarationTool.FindDeclarationOfPropertyPath Context=',Context.Node.DescAsString,' Identifier=',Identifier);
2676       if Identifier='' then begin
2677         NewContext:=Context;
2678         exit(true);
2679       end;
2680       if Context.Node.Desc=ctnSetType then begin
2681         // set
2682         if not IsLastProperty then exit;
2683         Node:=Context.Node.FirstChild;
2684         if (Node=nil) or (Node.Desc<>ctnIdentifier) then exit;
2685 
2686         // search enum type
2687         Params.Flags:=[fdfExceptionOnNotFound,fdfSearchInParentNodes,fdfFindChildren];
2688         Params.SetIdentifier(Self,@Context.Tool.Src[Node.StartPos],nil);
2689         Params.ContextNode:=Node;
2690         if not Context.Tool.FindIdentifierInContext(Params) then exit;
2691 
2692         Context.Tool:=Params.NewCodeTool;
2693         Context.Node:=Params.NewNode;
2694         // search enum base type
2695         Context:=Context.Tool.FindBaseTypeOfNode(Params,Context.Node);
2696         //debugln(['TFindDeclarationTool.FindDeclarationOfPropertyPath enum base type ',FindContextToString(Context)]);
2697         if (Context.Node=nil) or (Context.Node.Desc<>ctnEnumerationType) then
2698           exit;
2699         // search enum
2700         Node:=Context.Node.FirstChild;
2701         while Node<>nil do begin
2702           if CompareIdentifiers(PChar(Pointer(Identifier)),@Context.Tool.Src[Node.StartPos])=0
2703           then begin
2704             //debugln(['TFindDeclarationTool.FindDeclarationOfPropertyPath identifier=',Identifier]);
2705             NewContext.Tool:=Context.Tool;
2706             NewContext.Node:=Node;
2707             //debugln(['TFindDeclarationTool.FindDeclarationOfPropertyPath FOUND ',FindContextToString(NewContext)]);
2708             exit(true);
2709           end;
2710           Node:=Node.NextBrother;
2711         end;
2712         exit;
2713       end;
2714 
2715       if (not (Context.Node.Desc in AllClasses)) then begin
2716         debugln(['TFindDeclarationTool.FindDeclarationOfPropertyPath failed Context=',Context.Node.DescAsString]);
2717         exit;
2718       end;
2719       //DebugLn('TFindDeclarationTool.FindDeclarationOfPropertyPath Identifier="',identifier,'"');
2720       Params.Flags:=[fdfExceptionOnNotFound,fdfSearchInAncestors,fdfSearchInHelpers];
2721       Params.SetIdentifier(Self,PChar(Pointer(Identifier)),nil);
2722       Params.ContextNode:=Context.Node;
2723       if IsLastProperty then
2724         Params.Flags:=Params.Flags+[fdfFindVariable]
2725       else
2726         Params.Flags:=Params.Flags-[fdfFindVariable]+[fdfFunctionResult,fdfFindChildren];
2727       if not Context.Tool.FindIdentifierInContext(Params) then exit;
2728       Context.Tool:=Params.NewCodeTool;
2729       Context.Node:=Params.NewNode;
2730       if Context.Node=nil then exit;
2731       if IsLastProperty then begin
2732         if IgnoreTypeLess then begin
2733           repeat
2734             IsTypeLess:=false;
2735             if (Context.Node.Desc=ctnProperty)
2736             and Context.Tool.PropNodeIsTypeLess(Context.Node) then
2737               IsTypeLess:=true;
2738             if not IsTypeLess then break;
2739             //DebugLn(['TFindDeclarationTool.FindDeclarationOfPropertyPath has no type, searching next ...']);
2740             Params.SetIdentifier(Self,PChar(Pointer(Identifier)),nil);
2741             Params.ContextNode:=Context.Tool.FindClassOrInterfaceNode(Context.Node);
2742             if Params.ContextNode=nil then
2743               Params.ContextNode:=Context.Node;
2744             Params.Flags:=[fdfExceptionOnNotFound,fdfSearchInAncestors,fdfSearchInHelpers,
2745                            fdfFindVariable,fdfIgnoreCurContextNode];
2746             //DebugLn(['TFindDeclarationTool.FindDeclarationOfPropertyPath ',Context.Tool.MainFilename,' ',Params.ContextNode.DescAsString,' ',Context.Tool.CleanPosToStr(Params.ContextNode.StartPos)]);
2747             if not Context.Tool.FindIdentifierInContext(Params) then exit;
2748             Context.Tool:=Params.NewCodeTool;
2749             Context.Node:=Params.NewNode;
2750             if Context.Node=nil then exit;
2751           until false;
2752         end;
2753         //DebugLn(['TFindDeclarationTool.FindDeclarationOfPropertyPath FOUND']);
2754         NewContext:=Context;
2755         Result:=true;
2756         exit;
2757       end else begin
2758         Context:=Context.Tool.FindBaseTypeOfNode(Params,Context.Node);
2759         if Context.Node=nil then exit;
2760       end;
2761     until false;
2762   finally
2763     Params.Free;
2764     DeactivateGlobalWriteLock;
2765   end;
2766 end;
2767 
FindDeclarationOfPropertyPathnull2768 function TFindDeclarationTool.FindDeclarationOfPropertyPath(
2769   const PropertyPath: string;
2770   out NewPos: TCodeXYPosition; out NewTopLine: integer;
2771   IgnoreTypeLess: boolean): boolean;
2772 var
2773   Context: TFindContext;
2774 begin
2775   Result:=FindDeclarationOfPropertyPath(PropertyPath,Context,IgnoreTypeLess);
2776   if not Result then exit;
2777   Result:=Context.Tool.JumpToNode(Context.Node,NewPos,NewTopLine,false);
2778 end;
2779 
FindDeclarationNodeInInterfacenull2780 function TFindDeclarationTool.FindDeclarationNodeInInterface(
2781   const Identifier: string; BuildTheTree: Boolean): TCodeTreeNode;
2782 var
2783   CacheEntry: PInterfaceIdentCacheEntry;
2784 begin
2785   Result:=nil;
2786   if Identifier='' then exit;
2787   if BuildTheTree and (not BuildInterfaceIdentifierCache(true)) then
2788     exit;
2789   CacheEntry:=FInterfaceIdentifierCache.FindIdentifier(PChar(Identifier));
2790   if CacheEntry=nil then exit;
2791   Result:=CacheEntry^.Node;
2792 end;
2793 
FindDeclarationNodeInImplementationnull2794 function TFindDeclarationTool.FindDeclarationNodeInImplementation(
2795   Identifier: string; BuildTheTree: Boolean): TCodeTreeNode;
2796 begin
2797   Result:=nil;
2798   if Identifier='' then exit;
2799   if BuildTheTree then
2800     BuildTree(lsrInitializationStart);
2801   Result:=FindSubDeclaration(Identifier,FindImplementationNode);
2802 end;
2803 
FindSubDeclarationnull2804 function TFindDeclarationTool.FindSubDeclaration(Identifier: string;
2805   ParentNode: TCodeTreeNode): TCodeTreeNode;
2806 var
2807   LastNode: TCodeTreeNode;
2808 begin
2809   Result:=nil;
2810   if ParentNode=nil then exit;
2811   if Identifier='' then exit;
2812   Identifier:=UpperCaseStr(Identifier);
2813   LastNode:=ParentNode.NextSkipChilds;
2814   Result:=ParentNode.Next;
2815   while Result<>LastNode do begin
2816     // ToDo: check enums
2817     if Result.Desc in AllIdentifierDefinitions then begin
2818       if CompareNodeIdentChars(Result,Identifier)=0 then
2819         exit;
2820       Result:=Result.NextSkipChilds;
2821     end else if Result.Desc=ctnProcedure then begin
2822       if CompareIdentifiers(PChar(ExtractProcName(Result,[])),PChar(Pointer(Identifier)))=0 then
2823         exit;
2824       Result:=Result.NextSkipChilds;
2825     end else
2826       Result:=Result.Next;
2827   end;
2828   Result:=nil;
2829 end;
2830 
FindNameInUsesSectionnull2831 function TFindDeclarationTool.FindNameInUsesSection(UsesNode: TCodeTreeNode;
2832   const AUnitName: string): TCodeTreeNode;
2833 var
2834   CurUnitName: string;
2835 begin
2836   Result:=UsesNode.FirstChild;
2837   while (Result<>nil) do begin
2838     CurUnitName:=ExtractUsedUnitName(Result);
2839     if CompareDottedIdentifiers(PChar(CurUnitName),PChar(AUnitName))=0 then exit;
2840     Result:=Result.NextBrother;
2841   end;
2842 end;
2843 
FindUnitInUsesSectionnull2844 function TFindDeclarationTool.FindUnitInUsesSection(UsesNode: TCodeTreeNode;
2845   const AnUnitName: string; out NamePos, InPos: TAtomPosition): boolean;
2846 var
2847   CurUnitName: String;
2848   StartPos: Integer;
2849 begin
2850   Result:=false;
2851   NamePos:=CleanAtomPosition;
2852   InPos:=CleanAtomPosition;
2853   if (UsesNode=nil) or (not IsDottedIdentifier(AnUnitName))
2854   or (UsesNode.Desc<>ctnUsesSection) then begin
2855     DebugLn(['TFindDeclarationTool.FindUnitInUsesSection invalid AnUnitName']);
2856     exit;
2857   end;
2858   MoveCursorToNodeStart(UsesNode);
2859   ReadNextAtom; // read 'uses'
2860   repeat
2861     ReadNextAtom; // read name
2862     if CurPos.Flag=cafSemicolon then break;
2863     if (CurPos.StartPos>SrcLen) then break;
2864     StartPos:=CurPos.StartPos;
2865     CurUnitName:=ExtractUsedUnitNameAtCursor;
2866     if CompareDottedIdentifiers(PChar(CurUnitName),PChar(AnUnitName))=0 then
2867     begin
2868       MoveCursorToCleanPos(StartPos);
2869       ReadNextAtom;
2870       ReadNextUsedUnit(NamePos,InPos);
2871       Result:=true;
2872       exit;
2873     end;
2874     if CurPos.Flag=cafSemicolon then break;
2875     if CurPos.Flag<>cafComma then break;
2876   until (CurPos.StartPos>SrcLen);
2877 end;
2878 
FindUnitInAllUsesSectionsnull2879 function TFindDeclarationTool.FindUnitInAllUsesSections(
2880   const AnUnitName: string; out NamePos, InPos: TAtomPosition): boolean;
2881 
2882   procedure RaiseInvalidUnitName;
2883   begin
2884     raise Exception.Create('invalid unit name '+AnUnitName);
2885   end;
2886 
2887   function FindInSection(UsesNode: TCodeTreeNode): boolean;
2888   begin
2889     Result:=(UsesNode<>nil)
2890            and FindUnitInUsesSection(UsesNode,AnUnitName,NamePos,InPos);
2891   end;
2892 
2893 begin
2894   Result:=false;
2895   NamePos.StartPos:=-1;
2896   InPos.StartPos:=-1;
2897   if not IsDottedIdentifier(AnUnitName) then
2898     RaiseInvalidUnitName;
2899   BuildTree(lsrImplementationUsesSectionEnd);
2900   if FindInSection(FindMainUsesNode) then exit;
2901   if FindInSection(FindImplementationUsesNode) then exit;
2902 end;
2903 
GetUnitNameForUsesSectionnull2904 function TFindDeclarationTool.GetUnitNameForUsesSection(
2905   TargetTool: TFindDeclarationTool): string;
2906 // if unit is already used return ''
2907 // else return nice name
2908 var
2909   UsesNode: TCodeTreeNode;
2910   Alternative: String;
2911 begin
2912   Result:='';
2913   if (TargetTool=nil) or (TargetTool.MainFilename='') or (TargetTool=Self) then
2914     exit;
2915   Result:=ExtractFileNameOnly(TargetTool.MainFilename);
2916   if Result='' then exit;
2917 
2918   // check if system unit
2919   if IsHiddenUsedUnit(PChar(Result)) then begin
2920     Result:='';
2921     exit;
2922   end;
2923 
2924   // check if already there
2925   UsesNode:=FindMainUsesNode;
2926   if (UsesNode<>nil) and (FindNameInUsesSection(UsesNode,Result)<>nil)
2927   then begin
2928     Result:='';
2929     exit;
2930   end;
2931   UsesNode:=FindImplementationUsesNode;
2932   if (UsesNode<>nil) and (FindNameInUsesSection(UsesNode,Result)<>nil)
2933   then begin
2934     Result:='';
2935     exit;
2936   end;
2937 
2938   // beautify
2939   if Result=lowercase(Result) then begin
2940     Alternative:=TargetTool.GetSourceName(false);
2941     if Alternative<>'' then
2942       Result:=Alternative;
2943   end;
2944 end;
2945 
IsHiddenUsedUnitnull2946 function TFindDeclarationTool.IsHiddenUsedUnit(TheUnitName: PChar): boolean;
2947 var
2948   HiddenUnits: String;
2949   p: PChar;
2950 begin
2951   if TheUnitName=nil then exit(false);
2952   HiddenUnits:=Scanner.GetHiddenUsedUnits;
2953   if HiddenUnits<>'' then begin
2954     p:=PChar(HiddenUnits);
2955     while p^<>#0 do begin
2956       if CompareDottedIdentifiers(TheUnitName,p)=0 then
2957         exit(true);
2958       while not (p^ in [',',#0]) do inc(p);
2959       while p^=',' do inc(p);
2960     end;
2961   end;
2962   Result:=false;
2963 end;
2964 
FindDeclarationInUsesSectionnull2965 function TFindDeclarationTool.FindDeclarationInUsesSection(
2966   UsesNode: TCodeTreeNode; CleanPos: integer;
2967   out NewPos: TCodeXYPosition; out NewTopLine: integer): boolean;
2968 var AUnitName, UnitInFilename: string;
2969   UnitNamePos, UnitInFilePos: TAtomPosition;
2970 begin
2971   Result:=false;
2972   {$IFDEF ShowTriedContexts}
2973   DebugLn('TFindDeclarationTool.FindDeclarationInUsesSection A');
2974   {$ENDIF}
2975   {$IFDEF CheckNodeTool}CheckNodeTool(UsesNode);{$ENDIF}
2976   // reparse uses section, ignore errors after CleanPos
2977   MoveCursorToNodeStart(UsesNode);
2978   if (UsesNode.Desc=ctnUsesSection) then begin
2979     ReadNextAtom;
2980     if not UpAtomIs('USES') then
2981       RaiseUsesExpected(20170421200506);
2982   end else
2983   if (UsesNode.Desc = ctnUseUnitClearName) then
2984     MoveCursorToNodeStart(UsesNode.Parent);
2985 
2986   repeat
2987     ReadNextAtom;  // read name
2988     if CurPos.StartPos>CleanPos then break;
2989     if CurPos.Flag=cafSemicolon then break;
2990     ReadNextUsedUnit(UnitNamePos,UnitInFilePos);
2991     if CleanPos<=CurPos.StartPos then begin
2992       // cursor is on an used unit -> try to locate it
2993       MoveCursorToCleanPos(UnitNamePos.StartPos);
2994       ReadNextAtom;
2995       AUnitName:=ExtractUsedUnitNameAtCursor(@UnitInFilename);
2996       NewPos.Code:=FindUnitSource(AUnitName,UnitInFilename,true,UnitNamePos.StartPos);
2997       NewPos.X:=1;
2998       NewPos.Y:=1;
2999       NewTopLine:=1;
3000       Result:=true;
3001       exit;
3002     end;
3003     if CurPos.Flag=cafSemicolon then break;
3004     if CurPos.Flag<>cafComma then
3005       RaiseExceptionFmt(20170421200032,ctsStrExpectedButAtomFound,[';',GetAtom])
3006   until (CurPos.StartPos>SrcLen);
3007   {$IFDEF ShowTriedContexts}
3008   DebugLn('TFindDeclarationTool.FindDeclarationInUsesSection END cursor not on AUnitName');
3009   {$ENDIF}
3010 end;
3011 
FindUnitFileInUsesSectionnull3012 function TFindDeclarationTool.FindUnitFileInUsesSection(
3013   UsesNode: TCodeTreeNode; const AFilename: string): TCodeTreeNode;
3014 var
3015   TargetLoUnitName: string;
3016   TargetLoShortFilename: string;
3017 
3018   function CheckUseNode(Node: TCodeTreeNode): boolean;
3019   var
3020     Code: TCodeBuffer;
3021     UnitInFilename: string;
3022     AUnitName: string;
3023   begin
3024     Result:=false;
3025     MoveCursorToNodeStart(Node);
3026     ReadNextAtom;
3027     AUnitName:=ExtractUsedUnitNameAtCursor(@UnitInFilename);
3028     if AUnitName='' then exit;
3029 
3030     // quick check: compare unitname
3031     if UnitInFilename<>'' then begin
3032       if lowercase(ExtractFilename(UnitInFilename))<>TargetLoShortFilename then
3033         exit;
3034     end else if LowerCase(AUnitName)<>TargetLoUnitName then
3035       exit;
3036 
3037     // search in search paths
3038     Code:=FindUnitSource(AUnitName,UnitInFilename,false,Node.StartPos);
3039     Result:=(Code<>nil) and (CompareFilenames(Code.Filename,AFilename)=0);
3040   end;
3041 
3042 begin
3043   Result:=nil;
3044   if (UsesNode=nil) or (UsesNode.Desc<>ctnUsesSection) then exit;
3045   TargetLoUnitName:=LowerCase(ExtractFileNameOnly(AFilename));
3046   TargetLoShortFilename:=LowerCase(ExtractFileName(AFilename));
3047   if TargetLoShortFilename='' then exit;
3048   Result:=UsesNode.LastChild;
3049   while Result<>nil do begin
3050     if CheckUseNode(Result) then exit;
3051     Result:=Result.PriorBrother;
3052   end;
3053 end;
3054 
FindUnitFileInAllUsesSectionsnull3055 function TFindDeclarationTool.FindUnitFileInAllUsesSections(
3056   const AFilename: string; CheckMain: boolean; CheckImplementation: boolean
3057   ): TCodeTreeNode;
3058 begin
3059   Result:=nil;
3060   //debugln(['TFindDeclarationTool.FindUnitFileInAllUsesSections Self=',ExtractFilename(MainFilename),' Search=',ExtractFilename(AFilename)]);
3061   if AFilename='' then exit;
3062   if CheckMain then begin
3063     Result:=FindUnitFileInUsesSection(FindMainUsesNode,AFilename);
3064     //debugln(['TFindDeclarationTool.FindUnitFileInAllUsesSections Self=',ExtractFilename(MainFilename),' Search=',ExtractFilename(AFilename),' used in main uses=',Result<>nil]);
3065     if Result<>nil then exit;
3066   end;
3067   if CheckImplementation then
3068     Result:=FindUnitFileInUsesSection(FindImplementationUsesNode,AFilename);
3069 end;
3070 
FindUnitSourcenull3071 function TFindDeclarationTool.FindUnitSource(const AnUnitName,
3072   AnUnitInFilename: string; ExceptionOnNotFound: boolean; ErrorPos: integer
3073   ): TCodeBuffer;
3074 var
3075   CompiledFilename: string;
3076   AFilename: String;
3077   NewUnitName: String;
3078   NewInFilename: String;
3079   NewCompiledUnitname: String;
3080   ErrMsg: string;
3081 begin
3082   {$IF defined(ShowTriedFiles) or defined(ShowTriedUnits)}
3083   DebugLn('TFindDeclarationTool.FindUnitSource Self="',MainFilename,'" AnUnitName="',AnUnitName,'" AnUnitInFilename="',AnUnitInFilename,'"');
3084   {$ENDIF}
3085   Result:=nil;
3086   if (AnUnitName='') or (Scanner=nil) then
3087     RaiseException(20171214184503,'TFindDeclarationTool.FindUnitSource Invalid Data');
3088   if (Scanner.MainCode=nil) then
3089     RaiseException(20171214184512,'TFindDeclarationTool.FindUnitSource Invalid Data');
3090   if (not (TObject(Scanner.MainCode) is TCodeBuffer)) then
3091     RaiseException(20171214184519,'TFindDeclarationTool.FindUnitSource Invalid Data');
3092   if (Scanner.OnLoadSource=nil) then
3093     RaiseException(20171214184527,'TFindDeclarationTool.FindUnitSource Invalid Data');
3094 
3095   NewUnitName:=AnUnitName;
3096   NewInFilename:=AnUnitInFilename;
3097 
3098   AFilename:=DirectoryCache.FindUnitSourceInCompletePath(
3099                           NewUnitName,NewInFilename,false,false,AddedNameSpace);
3100   Result:=TCodeBuffer(Scanner.OnLoadSource(Self,AFilename,true));
3101 
3102   if (Result=nil) and Assigned(OnFindUsedUnit) then begin
3103     // no unit found
3104     Result:=OnFindUsedUnit(Self,AnUnitName,AnUnitInFilename);
3105   end;
3106 
3107   if Result=nil then begin
3108     // search .ppu
3109     NewCompiledUnitname:=AnUnitName+'.ppu';
3110     CompiledFilename:=DirectoryCache.FindCompiledUnitInCompletePath(
3111                                                      NewCompiledUnitname,false);
3112     //debugln(['TFindDeclarationTool.FindUnitSource UnitName=',NewUnitName,' ',NewCompiledUnitname,' CompiledFilename=',CompiledFilename]);
3113   end else begin
3114     CompiledFilename:='';
3115   end;
3116 
3117   if (Result=nil) and ExceptionOnNotFound then begin
3118     ErrMsg:='';
3119     if ErrorPos>0 then
3120       MoveCursorToCleanPos(ErrorPos)
3121     else if ErrorPos=0 then begin
3122       CurPos.StartPos:=-1;
3123     end else begin
3124       CurPos.StartPos:=-1;
3125       ErrMsg:=Format(ctsNeededByMode, [CompilerModeNames[Scanner.CompilerMode]]);
3126     end;
3127     if CompiledFilename<>'' then begin
3128       // there is a compiled unit, only the source was not found
3129       RaiseExceptionInstance(
3130         ECodeToolUnitNotFound.Create(Self,20170421200052,
3131           Format(ctsSourceNotFoundUnit+ErrMsg, [CompiledFilename]),
3132           AnUnitName));
3133     end else begin
3134       // nothing found
3135       RaiseExceptionInstance(
3136         ECodeToolUnitNotFound.Create(Self,20170421200056,
3137           Format(ctsUnitNotFound+ErrMsg,[AnUnitName]),
3138           AnUnitInFilename));
3139     end;
3140   end;
3141 end;
3142 
FindUnitCaseInsensitivenull3143 function TFindDeclarationTool.FindUnitCaseInsensitive(var AnUnitName,
3144   AnUnitInFilename: string): string;
3145 begin
3146   Result:=DirectoryCache.FindUnitSourceInCompletePath(
3147                          AnUnitName,AnUnitInFilename,true,false,AddedNameSpace);
3148 end;
3149 
3150 procedure TFindDeclarationTool.GatherUnitAndSrcPath(var UnitPath,
3151   CompleteSrcPath: string);
3152 begin
3153   UnitPath:='';
3154   CompleteSrcPath:='';
3155   UnitPath:=DirectoryCache.Strings[ctdcsUnitPath];
3156   CompleteSrcPath:=DirectoryCache.Strings[ctdcsCompleteSrcPath];
3157   //DebugLn('TFindDeclarationTool.GatherUnitAndSrcPath UnitPath="',UnitPath,'" CompleteSrcPath="',CompleteSrcPath,'"');
3158 end;
3159 
SearchUnitInUnitSetnull3160 function TFindDeclarationTool.SearchUnitInUnitSet(const TheUnitName: string): string;
3161 begin
3162   Result:=DirectoryCache.FindUnitInUnitSet(TheUnitName);
3163 end;
3164 
GetNameSpacesnull3165 function TFindDeclarationTool.GetNameSpaces: string;
3166 begin
3167   Result:=DirectoryCache.Strings[ctdcsNamespaces];
3168   if AddedNameSpace<>'' then begin
3169     if Result<>'' then Result:=';'+Result;
3170     Result:=AddedNameSpace+Result;
3171   end;
3172 end;
3173 
FindSmartHintnull3174 function TFindDeclarationTool.FindSmartHint(const CursorPos: TCodeXYPosition;
3175   Flags: TFindSmartFlags): string;
3176 var
3177   NewTool: TFindDeclarationTool;
3178   NewNode: TCodeTreeNode;
3179   NewPos: TCodeXYPosition;
3180   NewTopLine: integer;
3181 begin
3182   Result:='';
3183   if not FindDeclaration(CursorPos,Flags,NewTool,NewNode,NewPos,NewTopLine) then
3184   begin
3185     // identifier not found
3186     exit;
3187   end;
3188   Result:=NewTool.GetSmartHint(NewNode,NewPos,true);
3189 end;
3190 
GetSmartHintnull3191 function TFindDeclarationTool.GetSmartHint(Node: TCodeTreeNode;
3192   XYPos: TCodeXYPosition; WithPosition: boolean; WithDefinition: boolean
3193   ): string;
3194 
3195   function ReadIdentifierWithDots: String;
3196   begin
3197     Result := '';
3198     repeat
3199       ReadNextAtom;
3200       Result := Result + GetAtom;
3201       ReadNextAtom;
3202       if CurPos.Flag = cafPoint then
3203         Result := Result + '.'
3204       else
3205         break;
3206     until false;
3207   end;
3208 
3209   function MoveToLastIdentifierThroughDots(ExtTool: TFindDeclarationTool): Boolean;
3210   var
3211     LastPos: TAtomPosition;
3212   begin
3213     LastPos := ExtTool.CurPos;
3214     ExtTool.ReadNextAtom;
3215     if ExtTool.CurPos.Flag = cafWord then
3216       ExtTool.ReadNextAtom;
3217     while ExtTool.CurPos.Flag = cafPoint do
3218     begin
3219       ExtTool.ReadNextAtom;
3220       LastPos := ExtTool.CurPos;
3221       ExtTool.ReadNextAtom;
3222     end;
3223     ExtTool.CurPos := LastPos;
3224     Result := True;
3225   end;
3226 
3227   function ProceedWithSmartHint(ExtTool: TFindDeclarationTool): string;
3228   var
3229     CTExprType: TExpressionType;
3230     CTXYPos: TCodeXYPosition;
3231     CTTopLine: integer;
3232     CTCursorPos: TCodeXYPosition;
3233   begin
3234     MoveToLastIdentifierThroughDots(ExtTool);
3235     if ExtTool.CleanPosToCaret(ExtTool.CurPos.StartPos,CTCursorPos)
3236     and ExtTool.FindDeclaration(CTCursorPos,
3237          DefaultFindSmartHintFlags+[fsfSearchSourceName],CTExprType,CTXYPos,CTTopLine)
3238     and not((CTExprType.Desc=xtContext) and (CTExprType.Context.Node=nil) and (CTExprType.Context.Tool=nil))
3239     and not((CTExprType.Context.Tool=Self) and (CTXYPos.X=XYPos.X) and (CTXYPos.Y=XYPos.Y)) // prevent endless loop
3240     then
3241       Result := CTExprType.Context.Tool.GetSmartHint(CTExprType.Context.Node, CTXYPos, False, False)
3242     else
3243       Result := '';
3244   end;
3245 var
3246   IdentNode, TypeNode, ANode: TCodeTreeNode;
3247   ClassStr, NodeStr, SetStr: String;
3248   Params: TFindDeclarationParams;
3249   Tool: TFindDeclarationTool;
3250   HelperForNode: TCodeTreeNode;
3251   SubNode: TCodeTreeNode;
3252 begin
3253   Result:='';
3254 
3255   { Examples:
3256       var i: integer
3257       /home/.../codetools/finddeclarationtools.pas(1224,7)
3258   }
3259   // identifier category and identifier
3260   if Node<>nil then begin
3261     // class visibility
3262     if Node.Parent<>nil then begin
3263       ANode:=Node.Parent;
3264       while ANode<>nil do begin
3265         case ANode.Desc of
3266         ctnClassPrivate:
3267           Result+='private ';
3268         ctnClassProtected:
3269           Result+='protected ';
3270         ctnClassPublic:
3271           Result+='public ';
3272         ctnClassPublished:
3273           Result+='published ';
3274         ctnClassClassVar:
3275           Result+='class ';
3276         else
3277           break;
3278         end;
3279         ANode:=ANode.Parent;
3280       end;
3281     end;
3282 
3283     if Node.Desc = ctnGenericName then
3284       Node := Node.Parent;
3285     case Node.Desc of
3286     ctnIdentifier:
3287       if Assigned(Node.Parent) and (Node.Parent.Desc = ctnProcedureHead) then
3288         // function result
3289         Result := 'var Result: ' + ExtractNode(Node, []);
3290 
3291     ctnVarDefinition, ctnTypeDefinition, ctnConstDefinition,
3292     ctnEnumIdentifier, ctnLabel, ctnGenericType:
3293       begin
3294         case Node.Desc of
3295         ctnVarDefinition: Result+='var ';
3296         ctnTypeDefinition: Result+='type ';
3297         ctnConstDefinition: Result+='const ';
3298         ctnEnumIdentifier: Result+='enum ';
3299         ctnLabel: Result+='label ';
3300         ctnGenericType: Result+='generic type ';
3301         end;
3302 
3303         // add class name
3304         ClassStr := ExtractClassPath(Node.Parent);
3305         if ClassStr <> '' then Result += ClassStr + '.';
3306 
3307         Result:=Result+ExtractDefinitionName(Node);
3308         TypeNode:=FindTypeNodeOfDefinition(Node);
3309         if not WithDefinition then Result := '';
3310         if TypeNode<>nil then begin
3311           case Node.Desc of
3312             ctnTypeDefinition, ctnGenericType:
3313               Result+=' = ';
3314             ctnConstDefinition:
3315               if TypeNode.Desc = ctnConstant then
3316                 Result += ' = '
3317               else
3318                 Result += ': ';
3319             ctnEnumIdentifier,ctnLabel: ;
3320             else
3321               Result += ': ';
3322           end;
3323           case TypeNode.Desc of
3324           ctnSetType:
3325             begin
3326               Result += ExtractNode(TypeNode, [phpCommentsToSpace]);
3327               MoveCursorToNodeStart(TypeNode);
3328               ReadNextAtom;
3329               if ReadNextUpAtomIs('OF') then
3330               begin
3331                 if (Length(Result) > 0) and (Result[Length(Result)] = ';') then//delete last ";" from set
3332                   Delete(Result, Length(Result), 1);
3333                 ReadNextAtom;
3334                 SetStr := ProceedWithSmartHint(Self);
3335                 if (Length(SetStr) > 2) and (SetStr[2] = '=') then
3336                   SetStr := Copy(SetStr, 4, High(Integer));
3337                 if (SetStr <> '') then
3338                   Result += ' = ['+SetStr+']';
3339               end;
3340             end;
3341           ctnIdentifier, ctnSpecialize, ctnSpecializeType,
3342           ctnPointerType, ctnRangeType, ctnFileType, ctnClassOfType:
3343             begin
3344               Result += ExtractNode(TypeNode, [phpCommentsToSpace]);
3345               MoveCursorToNodeStart(TypeNode);
3346               Result += ProceedWithSmartHint(Self);
3347             end;
3348           ctnClass, ctnClassInterface, ctnDispinterface,
3349           ctnClassHelper, ctnTypeHelper, ctnRecordHelper,
3350           ctnObject, ctnRangedArrayType, ctnOpenArrayType,
3351           ctnObjCClass, ctnObjCCategory, ctnObjCProtocol, ctnCPPClass:
3352             begin
3353               MoveCursorToNodeStart(TypeNode);
3354               case TypeNode.Desc of
3355               ctnClass: Result:=Result+'class';
3356               ctnClassHelper: Result:=Result+'class helper';
3357               ctnRecordHelper: Result:=Result+'record helper';
3358               ctnTypeHelper: Result:=Result+'type helper';
3359               ctnObject: Result:=Result+'object';
3360               ctnObjCClass: Result:=Result+'objcclass';
3361               ctnObjCCategory: Result:=Result+'objccategory';
3362               ctnCPPClass: Result:=Result+'cppclass';
3363               ctnClassInterface: Result:=Result+'interface';
3364               ctnObjCProtocol: Result:=Result+'objcprotocol';
3365               ctnDispinterface: Result:=Result+'dispinterface';
3366               ctnRangedArrayType, ctnOpenArrayType: Result:=Result+'array';
3367               end;
3368               try
3369                 BuildSubTree(TypeNode);
3370               except
3371                 on ECodeToolError do ;
3372               end;
3373               SubNode:=FindInheritanceNode(TypeNode);
3374               if SubNode<>nil then
3375                 Result:=Result+ExtractNode(SubNode,[]);
3376 
3377               if TypeNode.Desc in [ctnClassHelper, ctnRecordHelper, ctnTypeHelper] then
3378                 HelperForNode := FindHelperForNode(TypeNode)
3379               else
3380                 HelperForNode := nil;
3381               if HelperForNode<>nil then
3382                 Result:=Result+' '+ExtractNode(HelperForNode,[]);
3383             end;
3384           ctnRecordType:
3385             Result:=Result+'record';
3386           ctnTypeType:
3387             begin
3388               Result:=Result+'type';
3389               if TypeNode.FirstChild <> nil then
3390                 Result:=Result+' '+ExtractNode(TypeNode.FirstChild,[]);
3391             end;
3392           ctnConstant:
3393             begin
3394               NodeStr:=ExtractNode(TypeNode,[phpCommentsToSpace]);
3395               Result+=copy(NodeStr,1,50);
3396             end;
3397           ctnEnumerationType:
3398             begin
3399               if Assigned(Node.FirstChild) then
3400               begin
3401                 NodeStr:=ExtractCode(Node.FirstChild.StartPos,Node.FirstChild.EndPos,[phpCommentsToSpace]);
3402                 if Length(NodeStr) > 50 then
3403                   NodeStr:=Copy(NodeStr, 1, 50) + ' ...';
3404                 Result += NodeStr;
3405               end else
3406                 Result += 'enum';
3407             end;
3408           end;
3409         end else begin
3410           case Node.Desc of
3411           ctnConstDefinition:
3412             begin
3413               DebugLn('TFindDeclarationTool.GetSmartHint const without subnode "',ExtractNode(Node,[]),'"');
3414               NodeStr:=ExtractCode(Node.StartPos
3415                                  +GetIdentLen(@Src[Node.StartPos]),
3416                                  Node.EndPos,[phpCommentsToSpace]);
3417               Result+=copy(NodeStr,1,50);
3418             end;
3419           end;
3420         end;
3421       end;
3422 
3423     ctnProcedure,ctnProcedureHead:
3424       begin
3425 
3426         // ToDo: ppu, dcu files
3427 
3428         Result+=ExtractProcHead(Node,
3429           [phpAddClassName,phpWithStart,phpWithVarModifiers,phpWithParameterNames,
3430            phpWithDefaultValues,phpWithResultType,phpWithOfObject,phpCommentsToSpace]);
3431       end;
3432 
3433     ctnProperty,ctnGlobalProperty:
3434       begin
3435         IdentNode:=Node;
3436 
3437         // ToDo: ppu, dcu files
3438 
3439         Result+='property ';
3440         MoveCursorToNodeStart(IdentNode);
3441         ReadNextAtom;
3442         if Node.Desc = ctnProperty then begin
3443           // e.g. property Caption: string;
3444           // skip keyword
3445           ReadNextAtom;
3446           // add class name
3447           ClassStr := ExtractClassName(Node, False, True);
3448           if ClassStr <> '' then Result += ClassStr + '.';
3449         end else begin
3450           // global property starts with identifier
3451         end;
3452         // add name
3453         Result+=GetAtom;
3454 
3455         Tool:=Self;
3456         while (Node.Desc=ctnProperty)
3457         and not Tool.MoveCursorToPropType(Node) do begin
3458           // property without type
3459           // -> search ancestor property
3460           if not Tool.MoveCursorToPropName(Node) then break;
3461           Params:=TFindDeclarationParams.Create(Tool, Node);
3462           try
3463             Params.SetIdentifier(Tool,@Tool.Src[Tool.CurPos.StartPos],nil);
3464             Params.Flags:=[fdfSearchInAncestors,fdfSearchInHelpers];
3465             if not Tool.FindIdentifierInAncestors(Node.Parent.Parent,Params) then break;
3466             Tool:=Params.NewCodeTool;
3467             Node:=Params.NewNode;
3468           finally
3469             Params.Free;
3470           end;
3471         end;
3472         if (Node<>nil) then begin
3473           if (Node.Desc in [ctnProperty,ctnGlobalProperty]) then begin
3474             Result += Tool.ExtractProperty(Node,
3475                 [phpWithoutName,phpWithParameterNames,phpWithResultType]);
3476           end;
3477 
3478           if Tool.MoveCursorToPropType(Node) then
3479             Result += ProceedWithSmartHint(Tool);
3480         end;
3481       end;
3482 
3483     ctnProgram,ctnUnit,ctnPackage,ctnLibrary:
3484       begin
3485         IdentNode:=Node;
3486 
3487         // ToDo: ppu, dcu files
3488 
3489         MoveCursorToNodeStart(IdentNode);
3490         ReadNextAtom;
3491         if (IdentNode.Desc=ctnProgram) and not UpAtomIs('PROGRAM') then begin
3492           // program without source name
3493           Result:='program '+ExtractFileNameOnly(MainFilename)+' ';
3494         end else begin
3495           Result+=GetAtom+' '; // keyword
3496           Result := Result + ReadIdentifierWithDots + ' ';
3497         end;
3498       end;
3499 
3500     ctnUseUnitNamespace:
3501       begin
3502         // hint for unit namespace in "uses" section
3503         Result += 'namespace ';
3504         MoveCursorToNodeStart(Node);
3505         ReadNextAtom;
3506         Result := Result + GetAtom;
3507       end;
3508 
3509     ctnUseUnitClearName:
3510       begin
3511         // hint for unit in "uses" section
3512         Result += 'unit ';
3513         MoveCursorToNodeStart(Node.Parent);
3514         Result := Result + ReadIdentifierWithDots;
3515       end
3516 
3517     else
3518       DebugLn('ToDo: TFindDeclarationTool.GetSmartHint ',Node.DescAsString);
3519     end;
3520   end;
3521   if WithPosition then begin
3522     // filename
3523     if Result<>'' then Result:=Result+LineEnding;
3524     if XYPos.Code=nil then
3525       CleanPosToCaret(Node.StartPos,XYPos);
3526     Result+=XYPos.Code.Filename;
3527     // file position
3528     if XYPos.Y>=1 then begin
3529       Result+='('+IntToStr(XYPos.Y);
3530       if XYPos.X>=1 then begin
3531         Result+=','+IntToStr(XYPos.X);
3532       end;
3533       Result+=')';
3534     end;
3535   end;
3536 end;
3537 
BaseTypeOfNodeHasSubIdentsnull3538 function TFindDeclarationTool.BaseTypeOfNodeHasSubIdents(ANode: TCodeTreeNode
3539   ): boolean;
3540 var
3541   FindContext: TFindContext;
3542   Params: TFindDeclarationParams;
3543 begin
3544   {$IFDEF CheckNodeTool}CheckNodeTool(ANode);{$ENDIF}
3545   Result:=false;
3546   if (ANode=nil) then exit;
3547   ActivateGlobalWriteLock;
3548   Params:=TFindDeclarationParams.Create(Self, ANode);
3549   try
3550     Params.Flags:=Params.Flags+[fdfFunctionResult,fdfFindChildren];
3551     FindContext:=FindBaseTypeOfNode(Params,ANode);
3552     if (FindContext.Node<>nil)
3553     and ((FindContext.Node.Desc in ([ctnEnumerationType]+AllClasses)))
3554     and (FindContext.Node.FirstChild<>nil)
3555     then
3556       Result:=true;
3557   finally
3558     Params.Free;
3559     DeactivateGlobalWriteLock;
3560   end;
3561 end;
3562 
IsIncludeDirectiveAtPosnull3563 function TFindDeclarationTool.IsIncludeDirectiveAtPos(CleanPos,
3564   CleanCodePosInFront: integer; out IncludeCode: TCodeBuffer): boolean;
3565 var LinkIndex, CommentStart, CommentEnd: integer;
3566   SrcLink: TSourceLink;
3567 begin
3568   Result:=false;
3569   IncludeCode:=nil;
3570   if (Scanner=nil) then exit;
3571   LinkIndex:=Scanner.LinkIndexAtCleanPos(CleanPos);
3572   if (LinkIndex<0) or (LinkIndex>=Scanner.LinkCount-1) then exit;
3573   SrcLink:=Scanner.Links[LinkIndex+1];
3574   if (SrcLink.Code=nil) or (SrcLink.Code=Scanner.Links[LinkIndex].Code) then
3575     exit;
3576   //DebugLn(['TFindDeclarationTool.IsIncludeDirectiveAtPos CleanPos=',CleanPos,' CleanCodePosInFront=',CleanCodePosInFront,' ',copy(Src,CleanCodePosInFront,10)]);
3577   if CleanPosIsInComment(CleanPos,CleanCodePosInFront,CommentStart,CommentEnd)
3578   and (CommentEnd=SrcLink.CleanedPos) then begin
3579     //DebugLn(['TFindDeclarationTool.IsIncludeDirectiveAtPos CommentStart=',CommentStart,' CommentEnd=',CommentEnd,' ',copy(Src,CommentStart,CommentEnd-CommentStart)]);
3580     IncludeCode:=TCodeBuffer(SrcLink.Code);
3581     Result:=true;
3582     exit;
3583   end;
3584 end;
3585 
FindFileAtCursornull3586 function TFindDeclarationTool.FindFileAtCursor(
3587   const CursorPos: TCodeXYPosition; out Found: TFindFileAtCursorFlag; out
3588   FoundFilename: string; SearchFor: TFindFileAtCursorFlags;
3589   StartPos: PCodeXYPosition): boolean;
3590 var
3591   CleanPos: integer;
3592 
3593   function CheckComment(CommentStart, CommentEnd: integer; Enabled: boolean): boolean;
3594   var
3595     DirectiveName, Param: string;
3596     NewCode: TCodeBuffer;
3597     MissingIncludeFile: TMissingIncludeFile;
3598     NewCodePtr: Pointer;
3599   begin
3600     Result:=false;
3601     // cursor in comment in parsed code
3602     {$IFDEF VerboseFindFileAtCursor}
3603     debugln(['TFindDeclarationTool.FindFileAtCursor.CheckComment']);
3604     {$ENDIF}
3605     if CommentStart=CommentEnd then exit;
3606     if ExtractLongParamDirective(Src,CommentStart,DirectiveName,Param) then begin
3607       DirectiveName:=lowercase(DirectiveName);
3608       if ((Enabled and (ffatIncludeFile in SearchFor))
3609       or (not Enabled and (ffatDisabledIncludeFile in SearchFor)))
3610         and (DirectiveName='i') or (DirectiveName='include')
3611       then begin
3612         // include directive
3613         if (Param<>'') and (Param[1]<>'%') then begin
3614           // include file directive
3615           Result:=true;
3616           if Enabled then
3617             Found:=ffatIncludeFile
3618           else
3619             Found:=ffatDisabledIncludeFile;
3620           if Enabled and IsIncludeDirectiveAtPos(CleanPos,CommentStart,NewCode) then
3621           begin
3622             FoundFilename:=NewCode.Filename;
3623           end else begin
3624             FoundFilename:=ResolveDots(GetForcedPathDelims(Param));
3625             // search include file
3626             MissingIncludeFile:=nil;
3627             if Scanner.SearchIncludeFile(FoundFilename,NewCodePtr,
3628               MissingIncludeFile)
3629             then
3630               FoundFilename:=TCodeBuffer(NewCodePtr).Filename;
3631           end;
3632           exit;
3633         end;
3634       end else if ((Enabled and (ffatResource in SearchFor))
3635       or (not Enabled and (ffatDisabledResource in SearchFor)))
3636         and ((DirectiveName='r') or (DirectiveName='resource'))
3637       then begin
3638         // resource directive
3639         Result:=true;
3640         if Enabled then
3641           Found:=ffatResource
3642         else
3643           Found:=ffatDisabledResource;
3644         FoundFilename:=ResolveDots(GetForcedPathDelims(Param));
3645         if (FoundFilename<>'') and (copy(FoundFilename,1,2)='*.') then begin
3646           Delete(FoundFilename,1,1);
3647           FoundFilename:=ChangeFileExt(MainFilename,FoundFilename);
3648         end else if not FilenameIsAbsolute(FoundFilename) then begin
3649           FoundFilename:=ResolveDots(ExtractFilePath(MainFilename)+FoundFilename);
3650         end;
3651         exit;
3652       end;
3653     end;
3654   end;
3655 
3656   function CheckPlainComments(Source: string; CurAbsPos: integer): boolean;
3657   var
3658     Filename: String;
3659     p, EndPos, FileStartPos, FileEndPos, MinPos, MaxPos: Integer;
3660   begin
3661     // check if cursor in a comment (ignoring directives)
3662     Result:=false;
3663     CursorPos.Code.LineColToPosition(CursorPos.Y,CursorPos.X,CurAbsPos);
3664     Source:=CursorPos.Code.Source;
3665     if (CurAbsPos<1) or (CurAbsPos>length(Source)) then exit;
3666     p:=1;
3667     repeat
3668       p:=FindNextComment(Source,p);
3669       if p>CurAbsPos then break;
3670       EndPos:=FindCommentEnd(Source,p,Scanner.NestedComments);
3671       if EndPos>CurAbsPos then begin
3672         // cursor in comment
3673         MinPos:=p+1;
3674         MaxPos:=EndPos-1;
3675         if Source[p]<>'{' then begin
3676           inc(MinPos);
3677           dec(MaxPos);
3678         end;
3679         FileStartPos:=CurAbsPos;
3680         while (FileStartPos>MinPos) and not (Source[FileStartPos-1] in [#0..#32]) do
3681           dec(FileStartPos);
3682         FileEndPos:=CurAbsPos;
3683         while (FileEndPos<MaxPos) and not (Source[FileEndPos] in [#0..#32]) do
3684           inc(FileEndPos);
3685         Filename:=TrimFilename(copy(Source,FileStartPos,FileEndPos-FileStartPos));
3686         if not FilenameIsAbsolute(Filename) then
3687           Filename:=ResolveDots(ExtractFilePath(MainFilename)+Filename);
3688         if Scanner.OnLoadSource(Scanner,Filename,false)<>nil then begin
3689           Found:=ffatComment;
3690           FoundFilename:=Filename;
3691           exit(true);
3692         end;
3693         exit;
3694       end;
3695       p:=EndPos;
3696     until false;
3697   end;
3698 
3699   function CheckUnitByWordAtCursor(Source: string; CurAbsPos: integer): boolean;
3700   // e.g. 'Sy|sUtils.CompareText'
3701   var
3702     AnUnitName: String;
3703     Code: TCodeBuffer;
3704     p: Integer;
3705   begin
3706     Result:=false;
3707     p:=FindStartOfAtom(Source,CurAbsPos);
3708     if p<1 then exit;
3709     AnUnitName:=GetIdentifier(@Source[p]);
3710     Code:=FindUnitSource(AnUnitName,'',false);
3711     if Code=nil then exit;
3712     Found:=ffatUnit;
3713     FoundFilename:=Code.Filename;
3714     Result:=true;
3715   end;
3716 
3717 var
3718   CommentStart, CommentEnd, Col, StartCol, CurAbsPos: integer;
3719   Node: TCodeTreeNode;
3720   aUnitName, UnitInFilename, Line, Literal, aSource: string;
3721   NewCode: TCodeBuffer;
3722   p, StartP: PChar;
3723 begin
3724   {$IFDEF VerboseFindFileAtCursor}
3725   debugln(['TFindDeclarationTool.FindFileAtCursor START']);
3726   {$ENDIF}
3727   Result:=false;
3728   Found:=ffatNone;
3729   FoundFilename:='';
3730   if StartPos<>nil then
3731     StartPos^:=CleanCodeXYPosition;
3732   if CursorPos.Code.LineColIsOutside(CursorPos.Y,CursorPos.X) then begin
3733     {$IFDEF VerboseFindFileAtCursor}
3734     debugln(['TFindDeclarationTool.FindFileAtCursor LineColIsOutside ',dbgs(CursorPos)]);
3735     {$ENDIF}
3736     exit;
3737   end;
3738   if CursorPos.Code.LineColIsSpace(CursorPos.Y,CursorPos.X) then begin
3739     {$IFDEF VerboseFindFileAtCursor}
3740     debugln(['TFindDeclarationTool.FindFileAtCursor LineColIsSpace ',dbgs(CursorPos)]);
3741     {$ENDIF}
3742     exit;
3743   end;
3744   if (CursorPos.Y<1) or (CursorPos.Y>CursorPos.Code.LineCount) then begin
3745     {$IFDEF VerboseFindFileAtCursor}
3746     debugln(['TFindDeclarationTool.FindFileAtCursor outside Line ',dbgs(CursorPos)]);
3747     {$ENDIF}
3748     exit;
3749   end;
3750   if [ffatUsedUnit,ffatIncludeFile,ffatDisabledIncludeFile]*SearchFor<>[]
3751   then begin
3752     try
3753       {$IFDEF VerboseFindFileAtCursor}
3754       debugln(['TFindDeclarationTool.FindFileAtCursor search in nodes']);
3755       {$ENDIF}
3756       BuildTreeAndGetCleanPos(trTillCursor,lsrEnd,CursorPos,CleanPos,
3757                     [btSetIgnoreErrorPos,btCursorPosOutAllowed]);
3758       Node:=FindDeepestNodeAtPos(CleanPos,false);
3759       {$IFDEF VerboseFindFileAtCursor}
3760       debugln(['TFindDeclarationTool.FindFileAtCursor has node: ',Node<>nil]);
3761       {$ENDIF}
3762       if Node<>nil then begin
3763         {$IFDEF VerboseFindFileAtCursor}
3764         debugln(['TFindDeclarationTool.FindFileAtCursor in node "',Node.DescAsString,'"']);
3765         {$ENDIF}
3766         // cursor in parsed code
3767         if CleanPosIsInComment(CleanPos,Node.StartPos,CommentStart,CommentEnd,true)
3768         then begin
3769           //debugln(['TFindDeclarationTool.FindFileAtCursor Comment="',copy(Src,CommentStart,CommentEnd-CommentStart),'"']);
3770           if (CommentEnd-CommentStart>4)
3771           and (Src[CommentStart]='{') and (Src[CommentStart+1]=#3) then begin
3772             // cursor in disabled code
3773             if CleanPosIsInComment(CleanPos,CommentStart+2,CommentStart,CommentEnd,true)
3774             then begin
3775               // cursor in disabled comment
3776               if CheckComment(CommentStart,CommentEnd,false) then
3777                 exit(true);
3778             end;
3779           end else begin
3780             // cursor in enabled comment
3781             if CheckComment(CommentStart,CommentEnd,true) then
3782               exit(true);
3783           end;
3784         end else begin
3785           {$IFDEF VerboseFindFileAtCursor}
3786           debugln(['TFindDeclarationTool.FindFileAtCursor in parsed code, not in comment Node=',Node.DescAsString]);
3787           {$ENDIF}
3788           if Node.Desc in [ctnUseUnitClearName,ctnUseUnitNamespace] then begin
3789             Node:=Node.Parent;
3790             {$IFDEF VerboseFindFileAtCursor}
3791             debugln(['TFindDeclarationTool.FindFileAtCursor node="',Node.DescAsString,'"']);
3792             {$ENDIF}
3793           end;
3794           if Node.Desc=ctnUseUnit then begin
3795             {$IFDEF VerboseFindFileAtCursor}
3796             debugln(['TFindDeclarationTool.FindFileAtCursor in use unit CleanPos=',CleanPos,' Node=',Node.StartPos,'-',Node.EndPos]);
3797             {$ENDIF}
3798             if (CleanPos>=Node.StartPos) and (CleanPos<Node.EndPos) then begin
3799               // cursor on used unit
3800               Found:=ffatUsedUnit;
3801               if StartPos<>nil then
3802                 CleanPosToCaret(Node.StartPos,StartPos^);
3803               MoveCursorToNodeStart(Node);
3804               ReadNextAtom;
3805               aUnitName:=ExtractUsedUnitNameAtCursor(@UnitInFilename);
3806               NewCode:=FindUnitSource(aUnitName,UnitInFilename,false);
3807               {$IFDEF VerboseFindFileAtCursor}
3808               debugln(['TFindDeclarationTool.FindFileAtCursor cursor on used unit "',aUnitName,'" in "',UnitInFilename,'" Found=',NewCode<>nil]);
3809               {$ENDIF}
3810               if NewCode<>nil then begin
3811                 FoundFilename:=NewCode.Filename;
3812                 Result:=true;
3813               end else begin
3814                 FoundFilename:=UnitInFilename;
3815                 Result:=false;
3816               end;
3817               exit;
3818             end;
3819           end;
3820         end;
3821       end;
3822     except
3823       on ELinkScannerError do ;
3824       on ECodeToolError do ;
3825     end;
3826   end;
3827 
3828   // fallback: ignore parsed code and read the line at cursor directly
3829   if (CursorPos.Y<1) or (CursorPos.Y>CursorPos.Code.LineCount) then exit;
3830   Line:=CursorPos.Code.GetLine(CursorPos.Y-1,false);
3831   {$IFDEF VerboseFindFileAtCursor}
3832   debugln(['TFindDeclarationTool.FindFileAtCursor Line="',copy(Line,1,CursorPos.X-1),'|',copy(Line,CursorPos.X,200),'"']);
3833   {$ENDIF}
3834   if CursorPos.X>length(Line) then exit;
3835   if ffatLiteral in SearchFor then begin
3836     // check literal
3837     p:=PChar(Line);
3838     repeat
3839       case p^ of
3840       #0:
3841         break;
3842       '''':
3843         begin
3844           StartCol:=p-PChar(Line)+1;
3845           inc(p);
3846           StartP:=p;
3847           repeat
3848             case p^ of
3849             #0,'''': break;
3850             else inc(p);
3851             end;
3852           until false;
3853           Col:=p-PChar(Line)+1;
3854           //debugln(['TFindDeclarationTool.FindFileAtCursor Col=',Col,' CursorCol=',CursorPos.X,' Literal=',copy(Line,StartCol+1,p-StartP)]);
3855           if (p>StartP) and (CursorPos.X>=StartCol) and (CursorPos.X<=Col) then begin
3856             Literal:=copy(Line,StartCol+1,p-StartP);
3857             if not FilenameIsAbsolute(Literal) then
3858               Literal:=TrimFilename(ExtractFilePath(Scanner.MainFilename)+Literal);
3859             Found:=ffatLiteral;
3860             FoundFilename:=Literal;
3861             exit(true);
3862           end;
3863           if p^=#0 then break;
3864           // p is now on the ending '
3865         end;
3866       end;
3867       inc(p);
3868       inc(Col);
3869     until false;
3870   end;
3871 
3872   // search without node tree with basic tools
3873   CursorPos.Code.LineColToPosition(CursorPos.Y,CursorPos.X,CurAbsPos);
3874   aSource:=CursorPos.Code.Source;
3875   if (CurAbsPos<1) or (CurAbsPos>length(aSource)) then exit;
3876 
3877   if ffatComment in SearchFor then begin
3878     // ignore syntax and only read comments
3879     if CheckPlainComments(aSource,CurAbsPos) then exit(true);
3880   end;
3881 
3882   if ffatUnit in SearchFor then begin
3883     if CheckUnitByWordAtCursor(aSource,CurAbsPos) then exit(true);
3884   end;
3885 end;
3886 
FindDeclarationOfIdentAtParamnull3887 function TFindDeclarationTool.FindDeclarationOfIdentAtParam(
3888   Params: TFindDeclarationParams): boolean;
3889 var
3890   ExprType: TExpressionType;
3891 begin
3892   Result := FindDeclarationOfIdentAtParam(Params, ExprType) and (Params.NewNode<>nil);
3893 end;
3894 
FindDeclarationOfIdentAtParamnull3895 function TFindDeclarationTool.FindDeclarationOfIdentAtParam(
3896   Params: TFindDeclarationParams; out ExprType: TExpressionType): boolean;
3897 { searches an identifier in clean code, parses code in front and after the
3898   identifier
3899 
3900   Params:
3901     Identifier in clean source
3902     ContextNode  // = DeepestNode at Cursor
3903 
3904   Result:
3905     true, if found
3906 
3907   Examples:
3908     A^.B().C[].Identifier
3909     inherited Identifier(p1,p2)
3910     'Hello'.identifier
3911 }
3912 var
3913   StartPos, EndPos: integer;
3914   SkipForward: boolean;
3915 begin
3916   {$IFDEF CTDEBUG}
3917   DebugLn('[TFindDeclarationTool.FindDeclarationOfIdentAtParam] Identifier=',
3918     '"',GetIdentifier(Params.Identifier),'"',
3919     ' ContextNode=',NodeDescriptionAsString(Params.ContextNode.Desc),
3920     ' "',dbgstr(copy(Src,Params.ContextNode.StartPos,20)),'"');
3921   {$ENDIF}
3922   Result:=false;
3923   // search in cleaned source
3924 
3925   MoveCursorToCleanPos(Params.Identifier);
3926   StartPos:=FindStartOfTerm(CurPos.StartPos,NodeTermInType(Params.ContextNode));
3927   MoveCursorToCleanPos(Params.Identifier);
3928   ReadNextAtom;
3929   EndPos:=CurPos.EndPos;
3930   if (Params.ContextNode.Desc=ctnIdentifier)
3931   and (Params.ContextNode.Parent.Desc=ctnAttribParam) then begin
3932     // parameters don't matter for the attribute name
3933   end else begin
3934     ReadNextAtom;
3935     if CurPos.Flag=cafRoundBracketOpen then begin
3936       ReadTilBracketClose(true);
3937       EndPos:=CurPos.EndPos;
3938     end;
3939   end;
3940   {$IFDEF ShowExprEval}
3941   debugln(['TFindDeclarationTool.FindDeclarationOfIdentAtParam Term=',dbgstr(Src,StartPos,EndPos-StartPos)]);
3942   {$ENDIF}
3943   SkipForward:=fdfSkipClassForward in Params.Flags;
3944   Include(Params.Flags,fdfFindVariable);
3945   ExprType:=FindExpressionTypeOfTerm(StartPos,EndPos,Params,false);
3946   if (ExprType.Desc=xtContext) then
3947     Params.SetResult(ExprType.Context)
3948   else
3949     Params.SetResult(CleanFindContext);
3950   if SkipForward and (Params.NewNode<>nil) then
3951     Params.NewCodeTool.FindNonForwardClass(Params);
3952   {$IFDEF ShowExprEval}
3953   DbgOut('[TFindDeclarationTool.FindDeclarationOfIdentAtParam] Ident=',
3954     '"',GetIdentifier(Params.Identifier),'" ');
3955   if Params.NewNode<>nil then
3956     DebugLn('Node=',Params.NewNode.DescAsString,' ',Params.NewCodeTool.MainFilename)
3957   else
3958     DebugLn('NOT FOUND');
3959   {$ENDIF}
3960   Result:=ExprType.Desc<>xtNone;
3961 end;
3962 
TFindDeclarationTool.IdentifierIsDefinednull3963 function TFindDeclarationTool.IdentifierIsDefined(const IdentAtom: TAtomPosition;
3964   ContextNode: TCodeTreeNode; Params: TFindDeclarationParams): boolean;
3965 var
3966   Identifier: PChar;
3967   Node: TCodeTreeNode;
3968 begin
3969   {$IFDEF CheckNodeTool}CheckNodeTool(ContextNode);{$ENDIF}
3970   // find declaration of identifier
3971   Identifier:=@Src[IdentAtom.StartPos];
3972   //DebugLn(['TFindDeclarationTool.IdentifierIsDefined BEGIN Params IdentAtom.StartPos=',IdentAtom.StartPos,'=',GetIdentifier(Identifier),', ContextNode.StartPos=',ContextNode.StartPos,'=',ContextNode.DescAsString,' "',ExtractNode(ContextNode,[]),'"']);
3973   if (CompareIdentifiers(Identifier,'Self')=0) then begin
3974     Node:=ContextNode;
3975     while (Node<>nil) do begin
3976       if NodeIsMethodBody(Node) then
3977         exit(true);
3978       Node:=Node.Parent;
3979     end;
3980   end;
3981   if (cmsResult in FLastCompilerModeSwitches)
3982   and (CompareIdentifiers(Identifier,'Result')=0) then begin
3983     Node:=ContextNode;
3984     while (Node<>nil) do begin
odenull3985       if NodeIsFunction(Node) then
3986         exit(true);
3987       Node:=Node.Parent;
3988     end;
3989   end;
3990   Params.ContextNode:=ContextNode;
3991   Params.SetIdentifier(Self,Identifier,nil);
3992   Params.Flags:=[fdfSearchInParentNodes,fdfSearchInAncestors,fdfSearchInHelpers,
3993                  fdfTopLvlResolving,fdfFindVariable,fdfIgnoreCurContextNode];
3994   Result:=FindIdentifierInContext(Params);
3995   //DebugLn(['TFindDeclarationTool.IdentifierIsDefined END Result=',Result]);
3996 end;
3997 
TFindDeclarationTool.FindIdentifierInContextnull3998 function TFindDeclarationTool.FindIdentifierInContext(
3999   Params: TFindDeclarationParams; var IdentFoundResult: TIdentifierFoundResult
4000   ): boolean;
4001 { searches an identifier in context node
4002   It does not care about code in front of the identifier like 'a.Identifier'.
4003 
4004   Params:
4005     Identifier
4006     ContextNode  // = DeepestNode at Cursor
4007 
4008   Result:
4009     true, if NewPos+NewTopLine valid
4010 }
4011 var
4012   LastContextNode, StartContextNode, FirstSearchedNode, LastSearchedNode,
4013   ContextNode: TCodeTreeNode;
4014   IsForward: boolean;
4015   IdentifierFoundResult: TIdentifierFoundResult;
4016   LastNodeCache: TCodeTreeNodeCache;
4017   LastCacheEntry: PCodeTreeNodeCacheEntry;
4018   SearchRangeFlags: TNodeCacheEntryFlags;
4019   NodeCacheEntryFlags: TNodeCacheEntryFlags;
4020   Flags: TFindDeclarationFlags;
4021   OldFlags: TFindDeclarationFlags;
4022   SearchInHelpersInTheEnd: Boolean;
4023 
4024   procedure InitNodesAndCacheAccess;
4025 
4026     procedure RaiseInternalError;
4027     begin
4028       RaiseException(20170421200059,'[TFindDeclarationTool.FindIdentifierInContext] '
4029         +' internal error: Params.ContextNode=nil');
4030     end;
4031 
4032   begin
4033     ContextNode:=Params.ContextNode;
4034     if ContextNode=nil then RaiseInternalError;
4035     {$IFDEF CheckNodeTool}
4036     CheckNodeTool(ContextNode);
4037     {$ENDIF}
4038     StartContextNode:=ContextNode;
4039     FirstSearchedNode:=nil;
4040     LastSearchedNode:=nil;
4041     SearchRangeFlags:=[];
4042     Flags:=Params.Flags;
4043     if fdfSearchInParentNodes in Flags then
4044       Include(SearchRangeFlags,ncefSearchedInParents);
4045     if fdfSearchInAncestors in Flags then
4046     Include(SearchRangeFlags,ncefSearchedInAncestors);
4047     LastNodeCache:=nil;
4048     LastCacheEntry:=nil;
4049     NodeCacheEntryFlags:=[];
4050     if fdfSearchInParentNodes in Flags then
4051       Include(NodeCacheEntryFlags,ncefSearchedInParents);
4052     if fdfSearchInAncestors in Flags then
4053       Include(NodeCacheEntryFlags,ncefSearchedInAncestors);
4054   end;
4055 
FindInNodeCachenull4056   function FindInNodeCache: boolean;
4057   var
4058     NodeCache: TCodeTreeNodeCache;
4059   begin
4060     Result:=false;
4061     // the node cache is identifier based
4062     if ([fdfCollect,fdfExtractOperand]*Flags<>[]) then exit;
4063 
4064     NodeCache:=GetNodeCache(ContextNode,false);
4065     if (NodeCache<>LastNodeCache) then begin
4066       // NodeCache changed -> search nearest cache entry for the identifier
4067       LastNodeCache:=NodeCache;
4068       if NodeCache<>nil then begin
4069         LastCacheEntry:=NodeCache.FindNearest(Params.Identifier,
4070                     ContextNode.StartPos,ContextNode.EndPos,
4071                     not (fdfSearchForward in Flags));
4072       end else
4073         LastCacheEntry:=nil;
4074     end;
4075     if (LastCacheEntry<>nil)
4076     and (LastCacheEntry^.CleanStartPos<=ContextNode.StartPos)
4077     and (LastCacheEntry^.CleanEndPos>=ContextNode.EndPos)
4078     and ((NodeCacheEntryFlags-LastCacheEntry^.Flags)=[])
4079     then begin
4080       // cached result found
4081       Params.SetResult(LastCacheEntry);
4082       {$IFDEF ShowNodeCache}
4083       DbgOut(':::: TFindDeclarationTool.FindIdentifierInContext.FindInNodeCache');
4084       DebugLn(' Ident=',GetIdentifier(Params.Identifier),
4085                ' Wanted=[',NodeCacheEntryFlagsAsString(NodeCacheEntryFlags),']',
4086                ' Cache=[',NodeCacheEntryFlagsAsString(LastCacheEntry^.Flags),']'
4087              );
4088       DebugLn('    ContextNode=',ContextNode.DescAsString,
4089               ' StartPos=',DbgS(ContextNode.StartPos),
4090               ' EndPos=',DbgS(ContextNode.EndPos),
4091               ' Self=',MainFilename);
4092       DebugLn('  LastCacheEntry(Pos=',DbgS(LastCacheEntry^.CleanStartPos),
4093               '-',DbgS(LastCacheEntry^.CleanEndPos),')');
4094       if (Params.NewNode<>nil) then
4095         DebugLn('   NewTool=',Params.NewCodeTool.MainFilename,
4096                 ' NewNode=',Params.NewNode.DescAsString)
4097       else
4098         DebugLn('   cache says: identifier does NOT exist');
4099       if CompareSrcIdentifiers(Params.Identifier,'TDefineAction') then begin
4100         NodeCache.WriteDebugReport('NANUNANA: ');
4101       end;
4102       {$ENDIF}
4103       Result:=true;
4104     end;
4105   end;
4106 
4107   procedure CacheResult(Found: boolean; EndNode: TCodeTreeNode);
4108   begin
4109     if not Found then exit;
4110     FindIdentifierInContext:=true;
4111     {$IFDEF ShowCollect}
4112     if fdfCollect in Flags then
4113       raise Exception.Create('fdfCollect must never return true');
4114     {$ENDIF}
4115     {$IFDEF ShowFoundIdentifier}
4116     debugln(['CacheResult FOUND ',GetIdentifier(Params.Identifier)]);
4117     Params.WriteDebugReport;
4118     {$ENDIF}
4119     if (FirstSearchedNode=nil) then exit;
4120     if ([fdfDoNotCache,fdfCollect,fdfExtractOperand]*Flags<>[]) then exit;
4121     if ([fodDoNotCache]*Params.NewFlags<>[]) then exit;
4122     if (Params.OnIdentifierFound<>@CheckSrcIdentifier) then exit;
4123     if (Params.FoundProc<>nil) then exit; // do not cache proc searches
4124     // cache result
4125     if (Params.NewNode<>nil) and (Params.NewNode.Desc=ctnProcedure) then begin
4126       DebugLn('NOTE: TFindDeclarationTool.FindIdentifierInContext.CacheResult Node is proc');
4127       // ToDo:
4128       // The search range is from start to end of search.
4129       // This does not work for overloaded procs.
4130       // -> do not cache
4131       exit;
4132     end;
4133     AddResultToNodeCaches(FirstSearchedNode,EndNode,
4134                       fdfSearchForward in Flags,Params,SearchRangeFlags);
4135   end;
4136 
CheckResultnull4137   function CheckResult(NewResult, CallOnIdentifierFound: boolean): boolean;
4138   // returns: true to stop search
4139   //          false if search should continue
4140 
4141     procedure RaiseNotFound;
4142     var
4143       Identifier: string;
4144     begin
4145       Identifier:=GetIdentifier(Params.Identifier);
4146       if (Identifier='') and (Params.Identifier<>nil)
4147       and (Params.Identifier[0]<>#0) then begin
4148         Identifier:=Params.Identifier[0];
4149         if Identifier='[' then begin
4150           Params.IdentifierTool.RaiseException(20170421200103,ctsDefaultPropertyNotFound);
4151         end;
4152       end;
4153       Params.IdentifierTool.RaiseExceptionFmt(20170421200105,ctsIdentifierNotFound,
4154                                               [Identifier]);
4155     end;
4156 
4157   begin
4158     Result:=true;
4159     FindIdentifierInContext:=NewResult and (not (fdfCollect in Flags));
4160     {$IFDEF ShowCollect}
4161     if fdfCollect in Flags then begin
4162       DebugLn('[TFindDeclarationTool.FindIdentifierInContext.CheckResult] COLLECT CheckResult Ident=',
4163       '"',GetIdentifier(Params.Identifier),'"',
4164       ' File="',ExtractFilename(MainFilename)+'"',
4165       ' Flags=[',dbgs(Flags)+']',
4166       ' NewResult=',DbgS(NewResult),
4167       ' CallOnIdentifierFound=',DbgS(CallOnIdentifierFound));
4168     end;
4169     {$ENDIF}
4170     if NewResult then begin
4171       // identifier found
4172       {$IFDEF ShowFoundIdentifier}
4173       debugln(['CheckResult FOUND ',GetIdentifier(Params.Identifier)]);
4174       Params.WriteDebugReport;
4175       {$ENDIF}
4176 
4177       if fdfExtractOperand in Flags then
4178         case Params.NewNode.Desc of
4179           ctnVarDefinition, ctnConstDefinition:
4180             with Params do
4181               AddOperandPart(GetIdentifier(@NewCodeTool.Src[NewNode.StartPos]));
4182           ctnProperty,ctnGlobalProperty:
4183             begin
4184               if fdfPropertyResolving in Flags then begin
4185                 if not PropNodeIsTypeLess(Params.NewNode)
4186                 and ReadTilGetterOfProperty(Params.NewNode) then begin
4187                   // continue searching of getter
4188                   Params.Identifier := @Src[CurPos.StartPos];
4189                 end;
4190                 ContextNode := Params.NewNode;
4191                 Exit(False);
4192               end else
4193                 Params.AddOperandPart(GetIdentifier(Params.Identifier));
4194             end;
4195           ctnProcedure:
4196             begin
4197               Params.AddOperandPart(ExtractProcName(Params.NewNode,[]));
4198               // ToDo: add default parameters
4199             end;
4200         end;
4201 
4202       if CallOnIdentifierFound then begin
4203         {debugln(['[TFindDeclarationTool.FindIdentifierInContext.CheckResult] CallOnIdentifierFound Ident=',
4204         '"',GetIdentifier(Params.Identifier),'"',
4205         ' StartContext="',StartContextNode.DescAsString,'" "',copy(Src,StartContextNode.StartPos,20),'"',
4206         ' File="',ExtractFilename(MainFilename)+'"',
4207         ' Flags=[',dbgs(Flags),']'
4208         ]);}
4209 
4210         IdentFoundResult:=Params.NewCodeTool.DoOnIdentifierFound(Params,
4211                                                                 Params.NewNode);
4212         {$IFDEF ShowProcSearch}
4213         DebugLn(['[TFindDeclarationTool.FindIdentifierInContext.CheckResult] DoOnIdentifierFound=',IdentifierFoundResultNames[IdentFoundResult]]);
4214         {$ENDIF}
4215         if (IdentFoundResult=ifrSuccess) then
4216           CacheResult(true,ContextNode);
4217         Result:=IdentFoundResult<>ifrProceedSearch;
4218         if IdentFoundResult<>ifrAbortSearch then exit;
4219       end else begin
4220         if fdfCollect in Flags then
4221           Result:=false;
4222         CacheResult(true,ContextNode);
4223         exit;
4224       end;
4225     end;
4226     if Params.FoundProc<>nil then begin
4227       // there was a proc,
4228       // either the search for the overloaded proc was unsuccessful
4229       // or the searched proc was found in a recursive sub search
4230       // -> return the found proc
4231       if Params.FoundProc^.CacheValid
4232       and (Params.FoundProc^.ProcCompatibility=tcExact) then begin
4233         // stop the search
4234         Result:=true;
4235       end;
4236       FindIdentifierInContext:=true;
4237       {$IFDEF ShowCollect}
4238       if fdfCollect in Flags then
4239         raise Exception.Create('fdfCollect must never return true');
4240       {$ENDIF}
4241       Params.SetResult(Params.FoundProc^.Context.Tool,
4242                        Params.FoundProc^.Context.Node);
4243       {$IF defined(ShowProcSearch) or defined(ShowFoundIdentifier)}
4244       DebugLn('[TFindDeclarationTool.FindIdentifierInContext] PROC Search ended with only one proc (normal when searching every used unit):');
4245       Params.WriteDebugReport;
4246       {$ENDIF}
4247       exit;
4248     end;
4249     // identifier was not found
4250     if not (fdfExceptionOnNotFound in Flags) then exit;
4251     if (Params.Identifier<>nil)
4252     and not (fdfExceptionOnPredefinedIdent in Flags)
4253     and WordIsPredefinedIdentifier.DoItCaseInsensitive(Params.Identifier)
4254     then begin
4255       Params.SetResult(nil,nil);
4256       exit;
4257     end;
4258     // identifier was not found and exception is wanted
4259     // -> raise exception
4260     if Params.IdentifierTool.IsPCharInSrc(Params.Identifier) then
4261       Params.IdentifierTool.MoveCursorToCleanPos(Params.Identifier);
4262     RaiseNotFound;
4263   end;
4264 
4265   procedure MoveContextNodeToChildren;
4266   begin
4267     if (ContextNode.LastChild<>nil) then begin
4268       if not (fdfSearchForward in Flags) then begin
4269         RaiseLastErrorIfInFrontOfCleanedPos(ContextNode.EndPos);
4270         ContextNode:=ContextNode.LastChild;
4271       end else
4272         ContextNode:=ContextNode.FirstChild;
4273     end;
4274   end;
4275 
SearchInGenericParamsnull4276   function SearchInGenericParams(GenParamsNode: TCodeTreeNode): boolean;
4277   var
4278     Node: TCodeTreeNode;
4279   begin
4280     Result:=false;
4281     if (GenParamsNode=nil) or (GenParamsNode.Desc<>ctnGenericParams) then exit;
4282     Node:=GenParamsNode.FirstChild;
4283     while Node<>nil do begin
4284       if (fdfCollect in Flags)
4285       or CompareSrcIdentifiers(Node.StartPos,Params.Identifier)
4286       then begin
4287         {$IFDEF ShowTriedIdentifiers}
4288         DebugLn('  SearchInGenericParams Identifier found="',GetIdentifier(@Src[Node.StartPos]),'" at '+CleanPosToStr(Node.StartPos));
4289         {$ENDIF}
4290         // identifier found
4291         Params.SetResult(Self,Node);
4292         Result:=CheckResult(true,true);
4293         if not (fdfCollect in Flags) then
4294           exit;
4295       end;
4296       Node:=Node.NextBrother;
4297     end;
4298   end;
4299 
SearchInTypeVarConstGlobPropDefinitionnull4300   function SearchInTypeVarConstGlobPropDefinition: boolean;
4301   // returns: true if ok to exit
4302   //          false if search should continue
4303   var
4304     NameNode: TCodeTreeNode;
4305   begin
4306     Result:=false;
4307     NameNode:=ContextNode;
4308     if ContextNode.Desc=ctnGenericType then begin
4309       NameNode:=ContextNode.FirstChild;
4310       if NameNode=nil then exit;
4311     end;
4312 
4313     if (fdfCollect in Flags)
4314     or CompareSrcIdentifiers(NameNode.StartPos,Params.Identifier)
4315     then begin
4316       {$IFDEF ShowTriedIdentifiers}
4317       DebugLn('  Definition Identifier found="',GetIdentifier(Params.Identifier),'"');
4318       {$ENDIF}
4319       // identifier found
4320       Params.SetResult(Self,ContextNode);
4321       Result:=CheckResult(true,true);
4322       if not (fdfCollect in Flags) then begin
4323         if (fdfSkipClassForward in Flags)
4324         and (ContextNode.FirstChild<>nil)
4325         and (ContextNode.FirstChild.Desc in AllClasses)
4326         and ((ctnsForwardDeclaration and ContextNode.FirstChild.SubDesc)<>0)
4327         then begin
4328           FindNonForwardClass(Params);
4329         end;
4330         exit;
4331       end;
4332     end;
4333     // search for enums
4334     Params.ContextNode:=ContextNode;
4335     if FindEnumInContext(Params) then begin
4336       Result:=CheckResult(true,false);
4337     end;
4338   end;
4339 
SearchInGenericTypenull4340   function SearchInGenericType: boolean;
4341   // returns: true if ok to exit
4342   //          false if search should continue
4343   var
4344     NameNode: TCodeTreeNode;
4345   begin
4346     Result:=false;
4347     NameNode:=ContextNode.FirstChild;
4348     if NameNode=nil then exit;
4349 
4350     // try type name
4351     if (fdfCollect in Flags)
4352     or CompareSrcIdentifiers(NameNode.StartPos,Params.Identifier)
4353     then begin
4354       {$IFDEF ShowTriedIdentifiers}
4355       DebugLn('  Definition Identifier found="',GetIdentifier(Params.Identifier),'"');
4356       {$ENDIF}
4357       // identifier found
4358       Params.SetResult(Self,ContextNode);
4359       Result:=CheckResult(true,true);
4360       if not (fdfCollect in Flags) then begin
4361         if (fdfSkipClassForward in Flags)
4362         and (ContextNode.LastChild.Desc in AllClasses)
4363         and ((ctnsForwardDeclaration and ContextNode.LastChild.SubDesc)<>0)
4364         then begin
4365           FindNonForwardClass(Params);
4366         end;
4367         exit;
4368       end;
4369     end;
4370 
4371     // search for enums
4372     Params.ContextNode:=ContextNode;
4373     if FindEnumInContext(Params) then begin
4374       Result:=CheckResult(true,false);
4375     end;
4376   end;
4377 
SearchInTypeOfVarConstnull4378   function SearchInTypeOfVarConst: boolean;
4379   // returns: true if ok to exit
4380   //          false if search should continue
4381   begin
4382     Result:=false;
4383     //debugln(['SearchInTypeOfVarConst ',ContextNode.Parent.DescAsString]);
4384     if (ContextNode.Parent.Desc in [ctnConstDefinition,ctnVarDefinition])
4385     and (Src[ContextNode.StartPos]='(') then
4386     begin
4387       if FindIdentifierInTypeOfConstant(ContextNode.Parent,Params) then begin
4388         Result:=CheckResult(true,false);
4389       end;
4390     end;
4391   end;
4392 
SearchInEnumLabelDefinitionnull4393   function SearchInEnumLabelDefinition: boolean;
4394   // returns: true if ok to exit
4395   //          false if search should continue
4396   begin
4397     Result:=false;
4398     if (fdfCollect in Flags)
4399     or CompareSrcIdentifiers(ContextNode.StartPos,Params.Identifier)
4400     then begin
4401       {$IFDEF ShowTriedIdentifiers}
4402       DebugLn('  Enum/Label Identifier found="',GetIdentifier(Params.Identifier),'"');
4403       {$ENDIF}
4404       // identifier found
4405       Params.SetResult(Self,ContextNode);
4406       Result:=CheckResult(true,true);
4407       if not (fdfCollect in Flags) then begin
4408         exit;
4409       end;
4410     end;
4411   end;
4412 
SearchInOnBlockDefinitionnull4413   function SearchInOnBlockDefinition: boolean;
4414   begin
4415     Result:=false;
4416     if ContextNode.FirstChild=nil then exit;
4417     //debugln('SearchInOnBlockDefinition B ',GetIdentifier(@Src[ContextNode.StartPos]));
4418     if (fdfCollect in Flags)
4419     or CompareSrcIdentifiers(ContextNode.FirstChild.StartPos,Params.Identifier)
4420     then begin
4421       {$IFDEF ShowTriedIdentifiers}
4422       DebugLn('  ON Identifier found="',GetIdentifier(Params.Identifier),'"');
4423       {$ENDIF}
4424       // identifier found
4425       Params.SetResult(Self,ContextNode.FirstChild);
4426       Result:=CheckResult(true,true);
4427       if not (fdfCollect in Flags) then
4428         exit;
4429     end;
4430   end;
4431 
SearchInSourceNamenull4432   function SearchInSourceName: boolean;
4433   // returns: true if ok to exit
4434   //          false if search should continue
4435   var
4436     SrcNode: TCodeTreeNode;
4437   begin
4438     Result:=false;
4439     SrcNode:=Tree.Root;
4440     MoveCursorToNodeStart(SrcNode);
4441     ReadNextAtom; // read keyword
4442     if (SrcNode.Desc=ctnProgram) and (not UpAtomIs('PROGRAM')) then exit;
4443     ReadNextAtom; // read name
4444     if (fdfCollect in Flags)
4445     or CompareSrcIdentifiers(CurPos.StartPos,Params.Identifier) then
4446     begin
4447       // identifier found
4448       {$IFDEF ShowTriedIdentifiers}
4449       if not (fdfCollect in Flags) then
4450         DebugLn('  Source Name Identifier found="',GetIdentifier(Params.Identifier),'"');
4451       {$ENDIF}
4452       Params.SetResult(Self,SrcNode,CurPos.StartPos);
4453       Result:=CheckResult(true,true);
4454       if not (fdfCollect in Flags) then
4455         exit;
4456     end;
4457   end;
4458 
SearchDefaultnull4459   function SearchDefault: boolean;
4460   begin
4461     Result:=false;
4462     if SearchInSourceName then
4463       exit(true);
4464     if (not (fdfIgnoreUsedUnits in Flags))
4465     and FindIdentifierInHiddenUsedUnits(Params) then begin
4466       Result:=CheckResult(true,false);
4467     end;
4468   end;
4469 
SearchInPropertynull4470   function SearchInProperty: boolean;
4471   // search in ctnProperty, not ctnGlobalProperty
4472   // returns: true if ok to exit
4473   //          false if search should continue
4474   begin
4475     Result:=false;
4476     if (fdfCollect in Flags)
4477     or (Params.Identifier[0]<>'[') then begin
4478       MoveCursorToNodeStart(ContextNode);
4479       ReadNextAtom; // read keyword 'property'
4480       if UpAtomIs('CLASS') then ReadNextAtom;
4481       ReadNextAtom; // read name
4482       if (fdfCollect in Flags)
4483       or CompareSrcIdentifiers(CurPos.StartPos,Params.Identifier) then begin
4484         // identifier found
4485         {$IFDEF ShowTriedIdentifiers}
4486         DebugLn('  Property Identifier found="',GetIdentifier(Params.Identifier),'"');
4487         {$ENDIF}
4488         Params.SetResult(Self,ContextNode,CurPos.StartPos);
4489         Result:=CheckResult(true,true);
4490       end;
4491     end else begin
4492       // the default property is searched
4493       if PropertyIsDefault(ContextNode) then begin
4494         Params.SetResult(Self,ContextNode);
4495         Result:=CheckResult(true,true);
4496       end;
4497     end;
4498   end;
4499 
LeavingContextIsPermittednull4500   function LeavingContextIsPermitted: boolean;
4501   begin
4502     Result:=true;
4503     if (not ContextNode.HasAsParent(StartContextNode)) then begin
4504       // searching in a prior node, will leave the start context
4505       if (not (fdfSearchInParentNodes in Flags)) then begin
4506         // searching in any parent context is not permitted
4507         if not ((fdfSearchInAncestors in Flags)
4508         and (ContextNode.Desc in AllClasses)) then begin
4509           // even searching in ancestors contexts is not permitted
4510           // -> there is no prior context accessible any more
4511           // -> identifier not found
4512           {$IFDEF ShowTriedContexts}
4513           DebugLn('[TFindDeclarationTool.FindIdentifierInContext] no prior node accessible ',
4514           ' ContextNode=',ContextNode.DescAsString,
4515           ' "',StringToPascalConst(copy(Src,ContextNode.StartPos,15)),'"'
4516           );
4517           {$ENDIF}
4518           ContextNode:=nil;
4519           Result:=false;
4520         end;
4521       end;
4522     end;
4523   end;
4524 
SearchInHelpersnull4525   function SearchInHelpers: Boolean;
4526   var
4527     HelperContext: TFindContext;
4528     Helpers: TFDHelpersList;
4529     HelperKind: TFDHelpersListKind;
4530     HelperIterator: TAVLTreeNode;
4531   begin
4532     Result := False;
4533     SearchInHelpersInTheEnd := False;
4534     if StartContextNode.Desc=ctnObjCClass then
4535       HelperKind:=fdhlkObjCCategory
4536     else
4537       HelperKind:=fdhlkDelphiHelper;
4538     Helpers:=Params.GetHelpers(HelperKind);
4539     if Helpers=nil then exit;
4540     if not Helpers.IterateFromClassNode(StartContextNode,Self,
4541       HelperContext,HelperIterator) then exit;
4542     //debugln(['SearchInHelpers START at least one helper found, iterating...']);
4543     //Helpers.WriteDebugReport;
4544     repeat
4545       //debugln(['SearchInHelpers searching in Helper=',FindContextToString(HelperContext),'...']);
4546       OldFlags := Params.Flags;
4547       try
4548         Params.Flags:=Params.Flags
4549           -[fdfExceptionOnNotFound,fdfIgnoreCurContextNode,fdfSearchInHelpers]
4550           +[fdfIgnoreUsedUnits];
4551         Params.ContextNode := HelperContext.Node;
4552 
4553         if HelperContext.Tool.FindIdentifierInContext(Params, IdentFoundResult) then
4554         begin
4555           if (IdentFoundResult = ifrAbortSearch)
4556             or ((IdentFoundResult = ifrSuccess) and CheckResult(true,False))
4557           then
4558             Result := True;
4559         end;
4560       finally
4561         Params.Flags := OldFlags;
4562       end;
4563     until (HelperKind=fdhlkDelphiHelper) or (not Helpers.GetNext(HelperContext,HelperIterator));
4564     //debugln(['SearchInHelpers END']);
4565   end;
4566 
SearchInNamespacesnull4567   function SearchInNamespaces(SourceNamespaceNode: TCodeTreeNode): Boolean;
4568   // SourceNamespaceNode.Desc = ctnUseUnitNamespace
4569   // search all use-unit nodes with the same namespace prefix as SourceNamespaceNode
4570   var
4571     UnitNode, ThisNamespaceNode, TargetNamespaceNode, UsesNode: TCodeTreeNode;
4572     Level, CurLevel: Integer;
4573     InFilename, AnUnitName, FoundNames, FoundName: String;
4574     NewCodeTool: TFindDeclarationTool;
4575   begin
4576     Result := False;
4577     if SourceNamespaceNode.Desc<>ctnUseUnitNamespace then
4578       RaiseException(20170426102058,'');
4579     //debugln(['SearchInNamespaces ',ExtractNode(SourceNamespaceNode.Parent,[]),' ',fdfCollect in Flags]);
4580     if not (fdfCollect in Flags) then begin
4581       // search a specific identifier within a use-unit name
4582       if (SourceNamespaceNode.NextBrother<>nil)
4583          and (
4584            (Params.Identifier=nil) or
4585             CompareSrcIdentifiers(SourceNamespaceNode.NextBrother.StartPos,Params.Identifier))
4586       then begin
4587         Params.SetResult(Self,SourceNamespaceNode.NextBrother);
4588         Result:=CheckResult(true,true);
4589       end;
4590       exit;
4591     end;
4592     // collect all uses-units with same namespace
4593 
4594     UsesNode:=SourceNamespaceNode.Parent.Parent;
4595 
4596     Level:=1;
4597     while SourceNamespaceNode.PriorBrother<>nil do begin
4598       inc(Level);
4599       SourceNamespaceNode:=SourceNamespaceNode.PriorBrother;
4600     end;
4601 
4602     FoundNames:='';
4603     UnitNode := UsesNode.LastChild;
4604     while UnitNode<>nil do
4605     begin
4606       ThisNamespaceNode := SourceNamespaceNode;
4607       TargetNamespaceNode := UnitNode.FirstChild;
4608       CurLevel:=0;
4609       while (ThisNamespaceNode<>nil) and (TargetNamespaceNode<>nil) do
4610       begin
4611         if CompareIdentifierPtrs(
4612           @Src[ThisNamespaceNode.StartPos],
4613           @Src[TargetNamespaceNode.StartPos]) <> 0
4614         then Break;
4615         inc(CurLevel);
4616         if CurLevel=Level then break;
4617 
4618         ThisNamespaceNode := ThisNamespaceNode.NextBrother;
4619         TargetNamespaceNode := TargetNamespaceNode.NextBrother;
4620       end;
4621       if CurLevel=Level then
4622       begin
4623         // namespace paths match
4624         //debugln(['SearchInNamespaces Match ',ExtractNode(TargetNamespaceNode.Parent,[])]);
4625         if (TargetNamespaceNode.NextBrother<>nil) then begin
4626           // prefix matches
4627           FoundName:='('+GetIdentifier(@Src[TargetNamespaceNode.NextBrother.StartPos])+')';
4628           if (Pos(FoundName,FoundNames)<1)
4629           and ((Params.Identifier=nil)
4630             or CompareSrcIdentifiers(TargetNamespaceNode.NextBrother.StartPos,Params.Identifier))
4631           then begin
4632             FoundNames:=FoundNames+FoundName;
4633             Params.SetResult(Self,TargetNamespaceNode.NextBrother);
4634             Result:=CheckResult(true,true);
4635           end;
4636         end else begin
4637           // whole unit name matches -> list all interface identifiers
4638           AnUnitName:=ExtractUsedUnitName(UnitNode,@InFilename);
4639           NewCodeTool:=FindCodeToolForUsedUnit(AnUnitName,InFilename,true);
4640           NewCodeTool.FindIdentifierInInterface(Params.IdentifierTool,Params);
4641         end;
4642       end;
4643 
4644       if UnitNode.PriorBrother<>nil then
4645         UnitNode := UnitNode.PriorBrother
4646       else if UnitNode.Parent.Desc=ctnImplementation then begin
4647         UnitNode:=FindMainUsesNode;
4648         if UnitNode=nil then break;
4649         UnitNode:=UnitNode.LastChild;
4650       end else
4651         break;
4652     end;
4653   end;
4654 
SearchNextNodenull4655   function SearchNextNode: boolean;
4656   const
4657     AbortNoCacheResult = false;
4658     Proceed = true;
4659   begin
4660     repeat
4661       // search for prior node
4662       {$IFDEF ShowTriedIdentifiers}
4663       DebugLn('[TFindDeclarationTool.FindIdentifierInContext.SearchNextNode] Searching prior node of ',ContextNode.DescAsString,' ',dbgstr(copy(Src,ContextNode.StartPos,ContextNode.EndPos-ContextNode.StartPos)));
4664       {$ENDIF}
4665       LastSearchedNode:=ContextNode;
4666 
4667       if (ContextNode.Desc in AllClasses) then begin
4668         // after searching in a class definition ...
4669 
4670         if (ContextNode.PriorBrother<>nil) and (ContextNode.PriorBrother.Desc=ctnGenericParams)
4671         then begin
4672           // before searching in the ancestors, search in the generic parameters
4673           if SearchInGenericParams(ContextNode.PriorBrother) then begin
4674             FindIdentifierInContext:=true;
4675             {$IFDEF ShowCollect}
4676             if fdfCollect in Flags then
4677               raise Exception.Create('fdfCollect must never return true');
4678             {$ENDIF}
4679             exit(AbortNoCacheResult);
4680           end;
4681         end;
4682 
4683         //allow ctnRecordType and ctnTypeTypeBeforeHelper: they can have helpers!
4684         if (fdfSearchInAncestors in Flags) then begin
4685           // after searching in a class definition, search in its ancestors
4686           // ToDo: check for cycles in ancestors
4687 
4688           OldFlags := Params.Flags;
4689           Params.Flags:=Params.Flags-[fdfExceptionOnNotFound,fdfSearchInHelpersInTheEnd];
4690 
4691           // leaving current class -> check if search in helpers in the end
4692           if SearchInHelpersInTheEnd then
4693           begin
4694             Result := SearchInHelpers;
4695             Params.Flags := OldFlags;
4696             if Result then
4697             begin
4698               FindIdentifierInContext:=true;
4699               Exit(AbortNoCacheResult);
4700             end;
4701           end;
4702 
4703           Exclude(Params.Flags,fdfExceptionOnNotFound);
4704           Result:=FindIdentifierInAncestors(ContextNode,Params,IdentFoundResult);
4705           Params.Flags := OldFlags;
4706           if Result then begin
4707             FindIdentifierInContext:=true;
4708             {$IFDEF ShowCollect}
4709             if fdfCollect in Flags then
4710               raise Exception.Create('fdfCollect must never return true');
4711             {$ENDIF}
4712             exit(AbortNoCacheResult);
4713           end;
4714         end;
4715         // if this was a nested class, the identifier can be in the ancestors
4716         // of the enclosing class
4717         Flags:=Flags+[fdfSearchInAncestors];
4718       end else if ContextNode.Desc=ctnClassInheritance then begin
4719         if (StartContextNode=ContextNode)
4720         or StartContextNode.HasAsParent(ContextNode) then
4721           // searching an ancestor => don't search within ancestors
4722           Exclude(Flags,fdfSearchInAncestors);
4723       end;
4724 
4725       if (ContextNode=StartContextNode)
4726       and (not (fdfSearchInParentNodes in Flags)) then begin
4727         // startcontext completed => not searching in parents or ancestors
4728         ContextNode:=nil;
4729         exit(Proceed);
4730       end;
4731 
4732       if ((not (fdfSearchForward in Flags))
4733            and (ContextNode.PriorBrother<>nil))
4734       or ((fdfSearchForward in Flags)
4735           and (ContextNode.NextBrother<>nil)
4736           and (ContextNode.NextBrother.Desc<>ctnImplementation)) then
4737       begin
4738         // search next in prior/next brother
4739         if not (fdfSearchForward in Flags) then
4740           ContextNode:=ContextNode.PriorBrother
4741         else begin
4742           RaiseLastErrorIfInFrontOfCleanedPos(ContextNode.NextBrother.EndPos);
4743           ContextNode:=ContextNode.NextBrother;
4744         end;
4745         {$IFDEF ShowTriedIdentifiers}
4746         DebugLn('[TFindDeclarationTool.FindIdentifierInContext] Searching in Brother  ContextNode=',ContextNode.DescAsString);
4747         {$ENDIF}
4748         // it is not always allowed to search in every node on the same lvl:
4749 
4750         // -> test if class visibility valid
4751         if ContextNode.Desc in AllClassSections then
4752           break
4753         else if ContextNode.Desc=ctnWithVariable then begin
4754           { check if StartContextNode is covered by the ContextNode
4755              a WithVariable ranges from the start of its expression
4756              to the end of the with statement
4757              for example:
4758                will be skipped:
4759                  with ContextNode do ;
4760                  with B do StartContextNode;
4761 
4762                will be searched:
4763                  with ContextNode, StartContextNode do ;
4764           }
4765           {$IFDEF ShowExprEval}
4766           DebugLn('SearchNextNode WithVar StartContextNode.StartPos=',dbgs(StartContextNode.StartPos),
4767             ' ContextNode=',dbgs(ContextNode.StartPos),'-',dbgs(ContextNode.EndPos),
4768             ' WithStart=',StringToPascalConst(
4769               copy(copy(Src,ContextNode.StartPos,ContextNode.EndPos-ContextNode.StartPos),1,50)));
4770           {$ENDIF}
4771           if (StartContextNode.StartPos>=ContextNode.StartPos)
4772           and (StartContextNode.StartPos<ContextNode.EndPos) then begin
4773             {$IFDEF ShowExprEval}
4774             debugln(['SearchNextNode WithVar covers startcontext']);
4775             {$ENDIF}
4776             // for example: with ContextNode, StartContextNode do ;
4777             break;
4778           end else begin
4779             // this with statement does not cover the startcontext. For instance:
4780             //   with ContextNode do ;
4781             //   with B do StartContextNode;
4782             // -> skip it
4783           end;
4784         end else if ContextNode.Desc=ctnOnBlock then begin
4785           // the ctnOnIdentifier is only valid within the ctnOnStatement
4786           // => skip
4787         end else begin
4788           break;
4789         end;
4790       end else if (ContextNode.Parent<>nil)
4791       and ((fdfSearchInParentNodes in Flags)
4792         or (ContextNode.HasAsParent(StartContextNode))) then
4793       begin
4794         // search next in parent
4795         {$IFDEF ShowTriedParentContexts}
4796         DebugLn('[TFindDeclarationTool.FindIdentifierInContext] Searching in Parent ',
4797           ' old ContextNode=',ContextNode.DescAsString,
4798           ' new ContextNode=',ContextNode.Parent.DescAsString
4799           );
4800         {$ENDIF}
4801         ContextNode:=ContextNode.Parent;
4802 
4803         case ContextNode.Desc of
4804 
4805         ctnTypeSection, ctnVarSection, ctnConstSection, ctnResStrSection,
4806         ctnLabelSection, ctnPropertySection,
4807         ctnInterface, ctnImplementation, ctnProgram, ctnLibrary,
4808         ctnClassPublished,ctnClassPublic,ctnClassProtected,ctnClassPrivate,
4809         ctnClassClassVar,
4810         ctnRecordVariant,
4811         ctnProcedureHead, ctnParameterList,
4812         ctnClassInheritance,ctnHelperFor:
4813           // these codetreenodes build a parent-child-relationship, but
4814           // for pascal it is only a range, hence after searching in the
4815           // children of the last node, search must continue in the children
4816           // of the prior node
4817           ;
4818 
4819         ctnClass, ctnClassInterface, ctnDispinterface, ctnObject,
4820         ctnObjCClass, ctnObjCCategory, ctnObjCProtocol, ctnCPPClass,
4821         ctnRecordType, ctnRecordCase,
4822         ctnClassHelper, ctnRecordHelper, ctnTypeHelper,
4823         ctnEnumerationType:
4824           // do not search again in this node, go on ...
4825           ;
4826 
4827         ctnVarDefinition, ctnConstDefinition:
4828           if (ContextNode.Parent<>nil)
4829           and (ContextNode.Parent.Desc=ctnParameterList) then begin
4830             // pascal allows declarations like: 'var a: a;' in parameters
4831             // -> skip variable and search in next context node
4832             ;
4833           end else begin
4834             break;
4835           end;
4836 
4837         ctnProcedure:
4838           begin
4839             Result:=FindIdentifierInClassOfMethod(ContextNode,Params);
4840             if Result then begin
4841               FindIdentifierInContext:=true;
4842               {$IFDEF ShowCollect}
4843               if fdfCollect in Flags then
4844                 raise Exception.Create('fdfCollect must never return true');
4845               {$ENDIF}
4846               exit(AbortNoCacheResult);
4847             end;
4848           end;
4849 
4850         else
4851           break;
4852         end;
4853       end else begin
4854         ContextNode:=nil;
4855         break;
4856       end;
4857     until false;
4858     Result:=Proceed;
4859   end;
4860 
4861 begin
4862   Result:=false;
4863   InitNodesAndCacheAccess;
4864 
4865   {$IFDEF ShowTriedContexts}
4866   DebugLn('[TFindDeclarationTool.FindIdentifierInContext] Start Ident=',
4867   '"'+GetIdentifier(Params.Identifier)+'"',
4868   ' Context="'+ContextNode.DescAsString+'" "'+StringToPascalConst(copy(Src,ContextNode.StartPos,20)),'"',
4869   ' at '+CleanPosToStr(ContextNode.StartPos,true),
4870   ' Flags=['+dbgs(Flags)+']'
4871   );
4872   {$ELSE}
4873     {$IFDEF ShowCollect}
4874     if fdfCollect in Flags then begin
4875       DebugLn(['[TFindDeclarationTool.FindIdentifierInContext] COLLECT Start Ident=',
4876       '"',GetIdentifier(Params.Identifier),'"',
4877       ' Context="',ContextNode.DescAsString,'" "',copy(Src,ContextNode.StartPos,20),'"',
4878       ' at '+CleanPosToStr(ContextNode.StartPos,true),
4879       ' Flags=[',dbgs(Flags),']'
4880       ]);
4881     end;
4882     {$ENDIF}
4883   {$ENDIF}
4884 
4885   if (ContextNode.Desc=ctnInterface)
4886   and (fdfIgnoreUsedUnits in Flags) then begin
4887     {$IFDEF ShowTriedContexts}
4888     DebugLn(['TFindDeclarationTool.FindIdentifierInContext searching in interface of ',MainFilename]);
4889     {$ENDIF}
4890     Result:=FindIdentifierInInterface(Params.IdentifierTool,Params);
4891     CheckResult(Result,false);
4892     exit;
4893   end;
4894 
4895   if (ContextNode.Desc=ctnUseUnitNamespace) then
4896   begin
4897     //search in namespaces
4898     //debugln(['TFindDeclarationTool.FindIdentifierInContext NameSpace ',GetIdentifier(Params.Identifier),' ',ExtractNode(ContextNode,[])]);
4899     if SearchInNamespaces(ContextNode) then exit;
4900     Exit;
4901   end;
4902 
4903   // find class helper functions
4904   SearchInHelpersInTheEnd := False;
4905   if (fdfSearchInHelpers in Flags)
4906     and (ContextNode.Desc in [ctnClass,ctnRecordType,ctnTypeType,ctnObjCClass,ctnEnumerationType,ctnRangedArrayType,ctnOpenArrayType])
4907     and (ContextNode.Parent<>nil) and (ContextNode.Parent.Desc = ctnTypeDefinition)
4908   then begin
4909     if (fdfSearchInHelpersInTheEnd in Flags) then
4910       SearchInHelpersInTheEnd := True
4911     else begin
4912       if SearchInHelpers then Exit;
4913     end;
4914   end;
4915 
4916   //try
4917     // search in the Tree of this tool
4918     repeat
4919       {$IFDEF ShowTriedIdentifiers}
4920       DebugLn('[TFindDeclarationTool.FindIdentifierInContext] Loop Ident=',
4921       '"',GetIdentifier(Params.Identifier),'"',
4922       ' Context="',ContextNode.DescAsString,'" "',copy(Src,ContextNode.StartPos,20),'"',
4923       ' Flags=[',dbgs(Flags),']'
4924       );
4925       {$ELSE}
4926         {$IFDEF ShowCollect}
4927         if fdfCollect in Flags then begin
4928           DebugLn('[TFindDeclarationTool.FindIdentifierInContext] COLLECT Loop Ident=',
4929           '"',GetIdentifier(Params.Identifier),'"',
4930           ' Context="',ContextNode.DescAsString,'" "',copy(Src,ContextNode.StartPos,20),'"',
4931           ' Flags=[',dbgs(Flags),']'
4932           );
4933         end;
4934         {$ENDIF}
4935       {$ENDIF}
4936       // search identifier in current context
4937       LastContextNode:=ContextNode;
4938       if not (fdfIgnoreCurContextNode in Flags) then begin
4939         // search in cache
4940         if FindInNodeCache then begin
4941           if CheckResult(Params.NewNode<>nil,Params.NewNode<>nil) then
4942             exit;
4943         end;
4944         if FirstSearchedNode=nil then FirstSearchedNode:=ContextNode;
4945         LastSearchedNode:=ContextNode;
4946 
4947         case ContextNode.Desc of
4948 
4949         ctnTypeSection, ctnVarSection, ctnConstSection, ctnResStrSection,
4950         ctnLabelSection, ctnPropertySection,
4951         ctnInterface, ctnImplementation,
4952         ctnProgram, ctnLibrary,
4953         ctnClassPublic, ctnClassPrivate, ctnClassProtected, ctnClassPublished,
4954         ctnClassClassVar,
4955         ctnClass, ctnClassInterface, ctnDispinterface, ctnObject,
4956         ctnObjCClass, ctnObjCCategory, ctnObjCProtocol, ctnCPPClass,
4957         ctnRecordType, ctnRecordVariant,
4958         ctnClassHelper, ctnRecordHelper, ctnTypeHelper,
4959         ctnEnumerationType,
4960         ctnParameterList:
4961           // these nodes build a parent-child relationship. But in pascal
4962           // they just define a range and not a context.
4963           // -> search in all children
4964           MoveContextNodeToChildren;
4965 
4966         ctnTypeDefinition, ctnVarDefinition, ctnConstDefinition,
4967         ctnGlobalProperty:
4968           if SearchInTypeVarConstGlobPropDefinition then exit;
4969 
4970         ctnGenericType:
4971           if SearchInGenericType then exit;
4972         // ctnGenericParams: skip here, it was searched before searching the ancestors
4973 
4974         ctnIdentifier:
4975           if (ContextNode.Parent.Desc in [ctnConstDefinition,ctnVarDefinition])
4976           and (ContextNode=ContextNode.Parent.LastChild)
4977           and SearchInTypeOfVarConst then exit;
4978 
4979         ctnEnumIdentifier,ctnLabel:
4980           if SearchInEnumLabelDefinition then exit;
4981 
4982         ctnProcedure:
4983           begin
4984             IdentifierFoundResult:=
4985               FindIdentifierInProcContext(ContextNode,Params);
4986             if IdentifierFoundResult in [ifrAbortSearch,ifrSuccess] then begin
4987               if CheckResult(IdentifierFoundResult=ifrSuccess,true) then begin
4988                 {$IFDEF ShowProcSearch}
4989                 DebugLn(['TFindDeclarationTool.FindIdentifierInContext ctnProcedure FOUND, stopping']);
4990                 {$ENDIF}
4991                 exit;
4992               end;
4993               {$IFDEF ShowProcSearch}
4994               DebugLn(['TFindDeclarationTool.FindIdentifierInContext ctnProcedure FOUND, continue']);
4995               {$ENDIF}
4996             end;
4997           end;
4998 
4999         ctnProcedureHead:
5000           begin
5001             BuildSubTreeForProcHead(ContextNode);
5002             if ContextNode.FirstChild<>nil then
5003               ContextNode:=ContextNode.FirstChild; // the ctnParameterList
5004           end;
5005 
5006         ctnProperty:
5007           if SearchInProperty then exit;
5008 
5009         ctnUsesSection:
5010           begin
5011             if FindIdentifierInUsesSection(ContextNode,Params,True)
5012             and CheckResult(true,false) then
5013               exit;
5014           end;
5015 
5016         ctnWithVariable:
5017           begin
5018             if FindIdentifierInWithVarContext(ContextNode,Params)
5019             and CheckResult(true,false) then
5020               exit;
5021           end;
5022 
5023         ctnOnBlock:
5024           if SearchInOnBlockDefinition then exit;
5025 
5026         ctnPointerType,ctnClassOfType:
5027           begin
5028             // pointer and class-of can be forward definitions
5029             // -> search in both directions
5030             Params.ContextNode:=ContextNode.Parent;
5031             if CheckResult(FindForwardIdentifier(Params,IsForward),false) then
5032               exit;
5033           end;
5034 
5035         ctnRecordCase:
5036           begin
5037             // search in variable and variants
5038             MoveContextNodeToChildren;
5039           end;
5040 
5041         end;
5042       end else begin
5043         Exclude(Params.Flags,fdfIgnoreCurContextNode);
5044         Exclude(Flags,fdfIgnoreCurContextNode);
5045         {$IFDEF ShowTriedContexts}
5046         DebugLn('[TFindDeclarationTool.FindIdentifierInContext] IgnoreCurContext ');
5047         {$ENDIF}
5048       end;
5049       if LastContextNode=ContextNode then begin
5050         // no special context switch => search next node
5051         if not LeavingContextIsPermitted then break;
5052         if not SearchNextNode then exit;
5053       end;
5054     until ContextNode=nil;
5055 
5056     if SearchInHelpersInTheEnd then
5057     begin
5058       if SearchInHelpers then Exit;
5059     end;
5060 
5061     if LastSearchedNode=Tree.Root then begin
5062       if SearchDefault then exit;
5063     end;
5064 
5065   {except
5066     // unexpected exception
5067     on E: Exception do begin
5068       DebugLn('*** Unexpected Exception during find declaration: ',
5069         E.ClassName,': ',E.Message);
5070       DebugLn('  MainFilename=',MainFilename);
5071       raise;
5072     end;
5073   end;}
5074   // if we are here, the identifier was not found and there was no error
5075   if (FirstSearchedNode<>nil) and (Params.FoundProc=nil)
5076   and ([fdfCollect,fdfExtractOperand]*Flags=[]) then begin
5077     // add result to cache
5078     Params.NewNode:=nil;
5079     Params.NewCodeTool:=nil;
5080     AddResultToNodeCaches(FirstSearchedNode,LastSearchedNode,
5081                     fdfSearchForward in Flags,Params,SearchRangeFlags);
5082   end;
5083   CheckResult(false,false);
5084 end;
5085 
FindEnumInContextnull5086 function TFindDeclarationTool.FindEnumInContext(
5087   Params: TFindDeclarationParams): boolean;
5088 { search all subnodes for ctnEnumIdentifier
5089 
5090   Params:
5091     Identifier
5092     ContextNode  // = DeepestNode at Cursor
5093 
5094   Result:
5095     true, if enum found
5096  }
5097 var OldContextNode, CurContextNode: TCodeTreeNode;
5098   CollectResult: TIdentifierFoundResult;
5099   SearchEnumIdentifiers: Boolean;
5100 begin
5101   Result:=false;
5102   CurContextNode:=Params.ContextNode;
5103   if CurContextNode=nil then exit;
5104   if CurContextNode.Desc=ctnEnumerationType then
5105     SearchEnumIdentifiers := not (Scanner.GetDirectiveValueAt(sdScopedEnums, CurContextNode.StartPos) = '1')
5106   else
5107     SearchEnumIdentifiers := False;
5108   CurContextNode:=CurContextNode.FirstChild;
5109   while CurContextNode<>nil do begin
5110     if SearchEnumIdentifiers and (CurContextNode.Desc=ctnEnumIdentifier) then begin
5111       if (fdfCollect in Params.Flags) then begin
5112         //debugln('TFindDeclarationTool.FindEnumInContext ',GetIdentifier(@Src[CurContextNode.StartPos]));
5113         CollectResult:=DoOnIdentifierFound(Params,CurContextNode);
5114         if CollectResult=ifrAbortSearch then begin
5115           Result:=false;
5116           exit;
5117         end else if CollectResult=ifrSuccess then begin
5118           Result:=true;
5119           Params.SetResult(Self,CurContextNode);
5120           exit;
5121         end;
5122       end else if CompareSrcIdentifiers(CurContextNode.StartPos,Params.Identifier)
5123       then begin
5124         // identifier found
5125         Result:=true;
5126         Params.SetResult(Self,CurContextNode);
5127         exit;
5128       end;
5129     end;
5130     if CurContextNode.FirstChild<>nil then begin
5131       OldContextNode:=Params.ContextNode;
5132       Params.ContextNode:=CurContextNode;
5133       Result:=FindEnumInContext(Params);
5134       Params.ContextNode:=OldContextNode;
5135       if Result then exit;
5136     end;
5137     CurContextNode:=CurContextNode.NextBrother;
5138   end;
5139 end;
5140 
FindContextNodeAtCursornull5141 function TFindDeclarationTool.FindContextNodeAtCursor(
5142   Params: TFindDeclarationParams): TFindContext;
5143 { searches for the context node at a specific cursor pos
5144   Params.Context should contain the deepest node at cursor
5145   if there is no special context, then result is equal to Params.Context }
5146 var
5147   EndPos: integer;
5148   ExprType: TExpressionType;
5149   OldFlags: TFindDeclarationFlags;
5150 begin
5151   EndPos:=CurPos.StartPos;
5152   OldFlags:=Params.Flags;
5153   Params.Flags:=Params.Flags-[fdfFindVariable];
5154   ExprType:=FindExpressionTypeOfTerm(-1,EndPos,Params,false);
5155   Params.Flags:=OldFlags;
5156   if (ExprType.Desc=xtContext) then
5157     Result:=ExprType.Context
5158   else begin
5159     Result:=CleanFindContext;
5160     if fdfExceptionOnNotFound in Params.Flags then begin
5161       MoveCursorToCleanPos(EndPos);
5162       RaiseException(20170421200111,ctsNoContextNodeFoundAtCursor);
5163     end;
5164   end;
5165 end;
5166 
FindBaseTypeOfNodenull5167 function TFindDeclarationTool.FindBaseTypeOfNode(
5168   Params: TFindDeclarationParams; Node: TCodeTreeNode; AliasType: PFindContext;
5169   NodeStack: PCodeTreeNodeStack): TFindContext;
5170 var
5171   MyNodeStack: TCodeTreeNodeStack;
5172 
5173   procedure RaiseForwardClassNameLess;
5174   begin
5175     RaiseException(20170421200114,'[TFindDeclarationTool.FindBaseTypeOfNode] '
5176                   +'forward class node without name');
5177   end;
5178 
5179   procedure RaiseCircleDefs;
5180   begin
5181     Params.NewCodeTool.RaiseException(20170421200117,ctsCircleInDefinitions
5182       +' ('+ctsIdentifier+'='+GetIdentifier(Params.Identifier)+')');
5183   end;
5184 
5185   procedure RaiseInternalError;
5186   begin
5187     Params.IdentifierTool.RaiseException(20170421200121,
5188        '[TFindDeclarationTool.FindBaseTypeOfNode]'
5189       +' internal error: not IsPCharInSrc(Params.Identifier) '
5190       +' Params.IdentifierTool.='
5191               +TCodeBuffer(Params.IdentifierTool.Scanner.MainCode).Filename
5192       +' Ident="'+GetIdentifier(Params.Identifier)+'"');
5193   end;
5194 
5195   procedure RaiseBaseTypeOfNotFound;
5196   begin
5197     RaiseExceptionFmt(20170421200124,ctsBaseTypeOfNotFound,[GetIdentifier(Params.Identifier)]);
5198   end;
5199 
5200   procedure RaiseClassOfWithoutIdentifier;
5201   begin
5202     RaiseExceptionFmt(20170421200133,ctsBaseTypeOfNotFound+' ("class of")',
5203                       [GetIdentifier(Params.Identifier)]);
5204   end;
5205 
5206   procedure RaiseForwardNotResolved(ClassIdentNode: TCodeTreeNode);
5207   begin
5208     RaiseExceptionFmt(20170421200136,ctsForwardClassDefinitionNotResolved,
5209         [copy(Src,ClassIdentNode.StartPos,
5210             ClassIdentNode.EndPos-ClassIdentNode.StartPos)]);
5211   end;
5212 
5213   procedure RaiseClassOfNotResolved(ClassIdentNode: TCodeTreeNode);
5214   begin
5215     MoveCursorToNodeStart(ClassIdentNode);
5216     RaiseExceptionFmt(20170421200141,ctsClassOfDefinitionNotResolved,
5217         [copy(Src,ClassIdentNode.StartPos,
5218             ClassIdentNode.EndPos-ClassIdentNode.StartPos)]);
5219   end;
5220 
5221   procedure SearchIdentifier(StartNode: TCodeTreeNode; CleanPos: integer;
5222     out IsPredefined: boolean; var Context: TFindContext);
5223   var
5224     TypeFound: Boolean;
5225     TestContext: TFindContext;
5226     IdentStart: LongInt;
5227     SubParams: TFindDeclarationParams;
5228     ExprType: TExpressionType;
5229   begin
5230     IsPredefined:=false;
5231 
5232     SubParams:=TFindDeclarationParams.Create(Params);
5233     try
5234       SubParams.GenParams := Params.GenParams;
5235       IdentStart:=CleanPos;
5236       {$IFDEF ShowTriedBaseContexts}
5237       debugln(['TFindDeclarationTool.FindBaseTypeOfNode.SearchIdentifier Identifier=',GetIdentifier(@Src[IdentStart])]);
5238       {$ENDIF}
5239       SubParams.Flags:=[fdfSearchInParentNodes,fdfExceptionOnNotFound]
5240                       +(fdfGlobals*SubParams.Flags);
5241       SubParams.ContextNode:=StartNode.Parent;
5242       if (SubParams.ContextNode.Desc in (AllIdentifierDefinitions))
5243       then begin
5244         // pascal allows things like 'var a: a;' -> skip var definition
5245         Include(SubParams.Flags,fdfIgnoreCurContextNode);
5246       end;
5247       if SubParams.ContextNode.Desc=ctnParameterList then
5248         // skip search in parameter list
5249         SubParams.ContextNode:=SubParams.ContextNode.Parent;
5250       if SubParams.ContextNode.Desc=ctnProcedureHead then
5251         // skip search in proc parameters
5252         SubParams.ContextNode:=SubParams.ContextNode.Parent;
5253 
5254       MoveCursorToCleanPos(CleanPos);
5255       ReadNextAtom;
5256       ReadNextAtom;
5257       if (CurPos.Flag=cafPoint) or AtomIsChar('<') then begin
5258         // this is an expression, e.g. A.B or A<B>
5259         Include(SubParams.Flags,fdfFindVariable);
5260         ExprType:=FindExpressionTypeOfTerm(CleanPos,-1,SubParams,false);
5261         if ExprType.Desc=xtContext then begin
5262           if not (ExprType.Context.Node.Desc in [ctnTypeDefinition,ctnGenericType,ctnGenericParameter]) then
5263           begin
5264             // not a type
5265             {$IFDEF ShowTriedBaseContexts}
5266             debugln(['TFindDeclarationTool.FindBaseTypeOfNode.SearchIdentifier expression: type expected but found ',ExprTypeToString(ExprType)]);
5267             {$ENDIF}
5268             MoveCursorToCleanPos(IdentStart);
5269             ReadNextAtom;
5270             RaiseExceptionFmt(20170421200144,ctsStrExpectedButAtomFound,
5271                               [ctsTypeIdentifier,GetAtom]);
5272           end;
5273           Context:=ExprType.Context;
5274         end else begin
5275           IsPredefined:=true;
5276         end;
5277         exit;
5278       end;
5279 
5280       SubParams.SetIdentifier(Self,@Src[IdentStart],nil);
5281       TypeFound:=FindIdentifierInContext(SubParams);
5282       if TypeFound and (SubParams.NewNode.Desc in [ctnUnit,ctnLibrary,ctnPackage])
5283       then begin
5284         // identifier is a unit
5285         // => type expected
5286         MoveCursorToCleanPos(IdentStart);
5287         ReadNextAtom; // read AUnitName
5288         SaveRaiseCharExpectedButAtomFound(20170421200146,'.');
5289       end;
5290       if TypeFound and (SubParams.NewNode.Desc=ctnGenericParameter) then begin
5291         TypeFound:=SubParams.FindGenericParamType;
5292       end;
5293       if TypeFound then begin
5294         // only types allowed here
5295         TestContext.Tool:=SubParams.NewCodeTool;
5296         TestContext.Node:=SubParams.NewNode;
5297         if not (TestContext.Node.Desc in [ctnTypeDefinition,ctnGenericType,ctnGenericParameter]) then
5298         begin
5299           // not a type
5300           {$IFDEF ShowTriedBaseContexts}
5301           debugln(['TFindDeclarationTool.FindBaseTypeOfNode.SearchIdentifier expected type but found ',TestContext.Node.DescAsString]);
5302           {$ENDIF}
5303           MoveCursorToCleanPos(IdentStart);
5304           ReadNextAtom;
5305           RaiseExceptionFmt(20170421200149,ctsStrExpectedButAtomFound,
5306                             [ctsTypeIdentifier,GetAtom]);
5307         end;
5308         Context:=TestContext;
5309         {$IFDEF ShowTriedBaseContexts}
5310         debugln(['TFindDeclarationTool.FindBaseTypeOfNode.SearchIdentifier found ',GetIdentifier(@Src[IdentStart]),' Node=',Context.Node.DescAsString,' ',Context.Tool.CleanPosToStr(Context.Node.StartPos,true)]);
5311         {$ENDIF}
5312       end else begin
5313         // predefined identifier
5314         IsPredefined:=true;
5315       end;
5316 
5317     finally
5318       SubParams.Free;
5319     end;
5320   end;
5321 
5322   procedure CheckResult(var Context: TFindContext);
5323   var
5324     ResultNode: TCodeTreeNode;
5325     OldFlags: TFindDeclarationFlags;
5326     AliasContext: TFindContext;
5327     Cache: TBaseTypeCache;
5328   begin
5329     if (NodeStack<>nil) and (NodeStack<>@MyNodeStack) then exit; // will be handled by caller
5330 
5331     if (Context.Node<>nil) and (Context.Node.Desc in [ctnProcedure,ctnProcedureHead])
5332     and (fdfFunctionResult in Params.Flags) then begin
5333       // Note: do not resolve a constructor here
5334       //       because TMyClass.Create should return TMyClass
5335       //       and not TObject, where the Create is defined
5336       // a proc -> if this is a function then return the Context type
Contextnull5337       //debugln(['TFindDeclarationTool.FindBaseTypeOfNode checking function Context: ',Context.Tool.ExtractNode(Context.Node,[])]);
5338       Context.Tool.BuildSubTreeForProcHead(Context.Node,ResultNode);
5339       if (ResultNode<>nil) then begin
5340         // a function or an overloaded operator
5341         // search further for the base type of the function Context type
5342         OldFlags:=Params.Flags;
5343         Exclude(Params.Flags,fdfFunctionResult);
5344         //debugln(['TFindDeclarationTool.FindBaseTypeOfNode searching for function Context type: ',Context.Tool.ExtractNode(DummyNode,[])]);
5345         Context:=Context.Tool.FindBaseTypeOfNode(Params,ResultNode,AliasType);
5346         AliasType:=nil;  // aliasing has been done
5347         Params.Flags:=OldFlags;
5348         exit;
5349       end;
5350     end;
5351     if (Context.Node=nil) and (fdfExceptionOnNotFound in Params.Flags) then begin
5352       if (Context.Tool<>nil) and (Params.Identifier<>nil) then begin
5353 
5354         // ToDo ppu, dcu
5355 
5356         if (not Params.IdentifierTool.IsPCharInSrc(Params.Identifier)) then
5357           RaiseInternalError;
5358         Params.IdentifierTool.MoveCursorToCleanPos(Params.Identifier);
5359       end;
5360       RaiseBaseTypeOfNotFound;
5361     end;
5362     if AliasType<>nil then begin
5363       // follow the base type chain to the first type
5364       // for example: var d: TDateTime;  use TDateTime, instead of Double.
5365       AliasContext.Node:=Node;
5366       AliasContext.Tool:=Self;
5367       while AliasContext.Node<>nil do begin
5368         if AliasContext.Node.Desc in [ctnTypeDefinition,ctnGenericType] then begin
5369           {$IF defined(ShowExprEval) or defined(ShowTriedBaseContexts)}
5370           debugln(['TFindDeclarationTool.FindBaseTypeOfNode.CheckResult using alias ',AliasContext.Tool.ExtractDefinitionName(AliasContext.Node),' instead of base type ',Context.Node.DescAsString]);
5371           {$ENDIF}
5372           AliasType^:=AliasContext;
5373           exit;
5374         end;
5375         if AliasContext.Node.Cache is TBaseTypeCache then begin
5376           Cache:=TBaseTypeCache(AliasContext.Node.Cache);
5377           if AliasContext.Node=Cache.NextNode then break;
5378           AliasContext.Node:=Cache.NextNode;
5379           AliasContext.Tool:=TFindDeclarationTool(Cache.NextTool);
5380         end else
5381           break;
5382       end;
5383     end;
5384   end;
5385 
5386 var
5387   OldInput: TFindDeclarationInput;
5388   ClassIdentNode: TCodeTreeNode;
5389   TestContext: TFindContext;
5390   OldPos: integer;
5391   SpecializeNode: TCodeTreeNode;
5392   NameNode: TCodeTreeNode;
5393   IsPredefined: boolean;
5394   OldStartFlags: TFindDeclarationFlags;
5395 begin
5396   {$IFDEF CheckNodeTool}CheckNodeTool(Node);{$ENDIF}
5397   //debugln(['TFindDeclarationTool.FindBaseTypeOfNode Flags=[',dbgs(Params.Flags),'] CacheValid=',Node.Cache is TBaseTypeCache]);
5398   if (Node<>nil) and (Node.Cache is TBaseTypeCache) then begin
5399     // base type already cached
5400     Result:=CreateFindContext(TBaseTypeCache(Node.Cache));
5401     CheckResult(Result);
5402     exit;
5403   end;
5404 
5405   Result.Node:=Node;
5406   Result.Tool:=Self;
5407   OldStartFlags:=Params.Flags;
5408   Exclude(Params.Flags,fdfTopLvlResolving);
5409   if NodeStack=nil then begin
5410     NodeStack:=@MyNodeStack;
5411     InitializeNodeStack(NodeStack);
5412   end;
5413   try
5414     while (Result.Node<>nil) do begin
5415       if (Result.Node.Cache is TBaseTypeCache) then begin
5416         // base type already cached
5417         if NodeStack^.StackPtr>=0 then
5418           AddNodeToStack(NodeStack,Result.Tool,Result.Node);
5419         Result:=CreateFindContext(TBaseTypeCache(Result.Node.Cache));
5420         break;
5421       end;
5422       {$IFDEF ShowTriedBaseContexts}
5423       DebugLn('[TFindDeclarationTool.FindBaseTypeOfNode] LOOP Result=',Result.Node.DescAsString,' ',Result.Tool.CleanPosToStr(Result.Node.StartPos,true),' Flags=[',dbgs(Params.Flags),']');
5424       {$ENDIF}
5425       if NodeExistsInStack(NodeStack,Result.Node) then begin
5426         // cycle detected
5427         Result.Tool.MoveCursorToNodeStart(Result.Node);
5428         Result.Tool.RaiseException(20170421200151,ctsCircleInDefinitions);
5429       end;
5430       {$IFDEF CheckNodeTool}Result.Tool.CheckNodeTool(Result.Node);{$ENDIF}
5431 
5432       if Result.Tool<>Self then begin
5433         {$IFDEF ShowTriedBaseContexts}
5434         DebugLn(['[TFindDeclarationTool.FindBaseTypeOfNode] continuing in ',Result.Tool.MainFilename]);
5435         {$ENDIF}
5436         Result:=Result.Tool.FindBaseTypeOfNode(Params,Result.Node,AliasType,NodeStack);
5437         break;
5438       end;
5439 
5440       AddNodeToStack(NodeStack,Result.Tool,Result.Node);
5441 
5442       if (Result.Node.Desc in (AllSimpleIdentifierDefinitions+[ctnGenericType]))
5443       then begin
5444         // instead of variable/const/type definition, return the type
5445         TestContext.Node:=FindTypeNodeOfDefinition(Result.Node);
5446         if TestContext.Node=nil then
5447           // some constants and variants do not have a type
5448           break;
5449         Result.Node:=TestContext.Node;
5450       end else
5451       if (Result.Node.Desc in AllClasses)
5452       and ((Result.Node.SubDesc and ctnsForwardDeclaration)>0) then
5453       begin
5454         // this is a forward defined class
5455         // -> search the real class
5456         {$IFDEF ShowTriedBaseContexts}
5457         DebugLn('[TFindDeclarationTool.FindBaseTypeOfNode] Class is forward');
5458         {$ENDIF}
5459 
5460         // ToDo: check for cycles in ancestor chain
5461 
5462         ClassIdentNode:=Result.Node.Parent;
5463         if (ClassIdentNode=nil)
5464         or (not (ClassIdentNode.Desc in [ctnTypeDefinition,ctnGenericType]))
5465         then begin
5466           MoveCursorToCleanPos(Result.Node.StartPos);
5467           RaiseForwardClassNameLess;
5468         end;
5469         Params.Save(OldInput);
5470         Params.SetIdentifier(Self,@Src[ClassIdentNode.StartPos],
5471                              @CheckSrcIdentifier);
5472         Params.Flags:=[fdfSearchInParentNodes,fdfSearchForward,
5473                        fdfIgnoreUsedUnits,fdfExceptionOnNotFound,
5474                        fdfIgnoreCurContextNode]
5475                       +(fdfGlobals*Params.Flags);
5476         Params.ContextNode:=ClassIdentNode;
5477         FindIdentifierInContext(Params);
5478         if (not (Params.NewNode.Desc in [ctnTypeDefinition,ctnGenericType]))
5479         or (Params.NewCodeTool<>Self) then begin
5480           MoveCursorToCleanPos(Result.Node.StartPos);
5481           RaiseForwardNotResolved(ClassIdentNode);
5482         end;
5483         Result.Tool:=Params.NewCodeTool;
5484         Result.Node:=Params.NewNode;
5485         Params.Load(OldInput,true);
5486       end else
5487       if (Result.Node.Desc=ctnClassOfType) and (fdfFindChildren in Params.Flags)
5488       then begin
5489         // this is a 'class of' type
5490         // -> search the real class
5491         {$IFDEF ShowTriedBaseContexts}
5492         DebugLn('[TFindDeclarationTool.FindBaseTypeOfNode] "Class Of"');
5493         {$ENDIF}
5494 
5495         // ToDo: check for cycles in ancestor chain
5496 
5497         ClassIdentNode:=Result.Node.FirstChild;
5498         if (ClassIdentNode=nil) or (not (ClassIdentNode.Desc=ctnIdentifier))
5499         then begin
5500           MoveCursorToCleanPos(Result.Node.StartPos);
5501           RaiseClassOfWithoutIdentifier;
5502         end;
5503         Params.Save(OldInput);
5504         // first search backwards
5505         Params.SetIdentifier(Self,@Src[ClassIdentNode.StartPos],
5506                              @CheckSrcIdentifier);
5507         Params.Flags:=[fdfSearchInParentNodes,
5508                        fdfIgnoreCurContextNode]
5509                       +(fdfGlobals*Params.Flags)-[fdfExceptionOnNotFound];
5510         Params.ContextNode:=Result.Node.Parent;
5511         if not FindIdentifierInContext(Params) then begin
5512           // then search forwards
5513           Params.Load(OldInput,false);
5514           Params.SetIdentifier(Self,@Src[ClassIdentNode.StartPos],
5515                                @CheckSrcIdentifier);
5516           Params.Flags:=[fdfSearchInParentNodes,fdfExceptionOnNotFound,
5517                          fdfIgnoreCurContextNode,fdfSearchForward]
5518                         +(fdfGlobals*Params.Flags);
5519           Params.ContextNode:=Result.Node.Parent;
5520           FindIdentifierInContext(Params);
5521         end;
5522         if not (Params.NewNode.Desc in [ctnTypeDefinition,ctnGenericType]) then
5523         begin
5524           MoveCursorToCleanPos(Result.Node.StartPos);
5525           RaiseClassOfNotResolved(ClassIdentNode);
5526         end;
5527         Result.Tool:=Params.NewCodeTool;
5528         Result.Node:=Params.NewNode;
5529         Params.Load(OldInput,true);
5530       end else
5531       if (Result.Node.Desc=ctnOnIdentifier) and (Result.Node.PriorBrother=nil)
5532       then begin
5533         // this is the ON variable node, the type comes right behind
5534         Result.Node:=Result.Node.NextBrother;
5535       end else if Result.Node.Desc=ctnSrcName then begin
5536         break;
5537       end else if (Result.Node.Desc=ctnIdentifier)
5538       and (Result.Node.Parent.Desc=ctnSrcName) then begin
5539         if (Result.Node.NextBrother=nil) then
5540           Result.Node:=Result.Node.Parent;
5541         break;
5542       end else
5543       if (Result.Node.Desc in [ctnIdentifier,ctnOnIdentifier])
5544       then begin
5545         // this type is just an alias for another type
5546         // -> search the basic type
5547         if Result.Node.Parent=nil then
5548           break;
5549         SearchIdentifier(Result.Node,Result.Node.StartPos,IsPredefined,Result);
5550         if IsPredefined then break;
5551       end else
5552       if (Result.Node.Desc=ctnProperty)
5553       or (Result.Node.Desc=ctnGlobalProperty) then begin
5554         // this is a property -> search the type definition of the property
5555         if MoveCursorToPropType(Result.Node) then begin
5556           // property has a type
5557           SearchIdentifier(Result.Node,CurPos.StartPos,IsPredefined,Result);
5558           if IsPredefined then break;
5559         end else if (Result.Node.Desc=ctnProperty) then begin
5560           // property has no type
5561           // -> search ancestor property
5562           Params.Save(OldInput);
5563           if not MoveCursorToPropName(Result.Node) then break;
5564           OldPos:=CurPos.StartPos;
5565           Params.SetIdentifier(Self,@Src[CurPos.StartPos],nil);
5566           Params.Flags:=[fdfExceptionOnNotFound,fdfSearchInAncestors,fdfSearchInHelpers]
5567                        +(fdfGlobalsSameIdent*Params.Flags);
5568           FindIdentifierInAncestors(Result.Node.Parent.Parent,Params);
5569           TestContext.Tool:=Params.NewCodeTool;
5570           TestContext.Node:=Params.NewNode;
5571           Params.Load(OldInput,true);
5572           if Params.NewNode.Desc<>ctnProperty then begin
5573             // ancestor is not a property
5574             MoveCursorToCleanPos(OldPos);
5575             RaiseException(20170421200153,ctsAncestorIsNotProperty);
5576           end;
5577           Result:=TestContext;
5578         end else
5579           break;
5580       end else
5581       if Result.Node.Desc=ctnProcedure then begin
5582         Result.Node:=Result.Node.FirstChild;
5583         break;
5584       end else
5585       if Result.Node.Desc=ctnProcedureHead then begin
5586         break;
5587       end else
5588       if (Result.Node.Desc=ctnTypeType) then begin
5589         if fdfTypeType in Params.Flags then
5590           break; // the type node is wanted, not its real type
5591         // a TypeType is for example 'MyInt = type integer;'
5592         // the context is not the 'type' keyword, but the identifier after it.
5593         Result.Node:=Result.Node.FirstChild;
5594       end else
5595       if (Result.Node.Desc=ctnEnumIdentifier) then begin
5596         // an enum identifier
5597         if fdfEnumIdentifier in Params.Flags then
5598           break; // the enum is wanted, not its type
5599         // an enum identifier, the base type is the enumeration
5600         Result.Node:=Result.Node.Parent;
5601       end else
5602       if (Result.Node.Desc=ctnSpecialize) then begin
5603         // go to the type name of the specialisation
5604         SpecializeNode:=Result.Node;
5605         NameNode:=SpecializeNode.FirstChild;
5606         Result.Node:=NameNode;
5607         if Result.Node=nil then break;
5608         Params.SetGenericParamValues(Self, SpecializeNode);
5609         Params.UpdateGenericParamMapping(Self, SpecializeNode.FirstChild.NextBrother, Nil);
5610         SearchIdentifier(SpecializeNode,NameNode.StartPos,IsPredefined,Result);
5611         if (Result.Node=nil) or (Result.Node.Desc<>ctnGenericType) then begin
5612           // not a generic
5613           MoveCursorToNodeStart(NameNode);
5614           ReadNextAtom;
5615           RaiseExceptionFmt(20170421200156,ctsStrExpectedButAtomFound,
5616                             [ctsGenericIdentifier,GetAtom]);
5617         end;
5618       end else
5619         break;
5620     end;
5621 
5622     Params.Flags:=OldStartFlags;
5623   finally
5624     if NodeStack=@MyNodeStack then begin
5625       // cache the result in all nodes
5626       // do not cache the result of generic type
5627       if not Assigned(Params.GenParams.ParamValuesTool) then
5628         CreateBaseTypeCaches(NodeStack,Result);
5629       // free node stack
5630       FinalizeNodeStack(NodeStack);
5631     end;
5632   end;
5633 
5634   CheckResult(Result);
5635 
5636   {$IFDEF ShowFoundIdentifier}
5637   Debugln(['[TFindDeclarationTool.FindBaseTypeOfNode] END Node=',Node.DescAsString,' Result=',Result.Node.DescAsString]);
5638   {$ENDIF}
5639 end;
5640 
FindIdentifierInBasicTypeHelpersnull5641 function TFindDeclarationTool.FindIdentifierInBasicTypeHelpers(
5642   ExprType: TExpressionTypeDesc; Params: TFindDeclarationParams): Boolean;
5643 var
5644   OldFlags: TFindDeclarationFlags;
5645   FullExprType: TExpressionType;
5646   CHContext: TFindContext;
5647   Helpers: TFDHelpersList;
5648 begin
5649   Helpers:=Params.GetHelpers(fdhlkDelphiHelper);
5650   if Helpers=nil then exit(false);
5651   FullExprType := CleanExpressionType;
5652   FullExprType.Desc := ExprType;
5653   case FullExprType.Desc of
5654   xtConstString: FullExprType.Desc:=GetDefaultStringType;
5655   xtConstOrdInteger: FullExprType.Desc:=xtLongint;
5656   xtConstBoolean: FullExprType.Desc:=xtBoolean;
5657   xtConstReal: FullExprType.Desc:=xtDouble;
5658   end;
5659   //debugln(['TFindDeclarationTool.FindIdentifierInBasicTypeHelpers ',ExprTypeToString(FullExprType)]);
5660 
5661   // find class helper functions
5662   CHContext := Helpers.FindFromExprType(FullExprType);
5663 
5664   if Assigned(CHContext.Node) and Assigned(CHContext.Tool) then
5665   begin
5666     OldFlags := Params.Flags;
5667     try
5668       Exclude(Params.Flags, fdfExceptionOnNotFound);
5669       Exclude(Params.Flags, fdfIgnoreCurContextNode);
5670       Include(Params.Flags, fdfIgnoreUsedUnits);
5671       Params.ContextNode := CHContext.Node;
5672 
5673       Result := CHContext.Tool.FindIdentifierInContext(Params);
5674     finally
5675       Params.Flags := OldFlags;
5676     end;
5677   end else
5678     Result := False;
5679 end;
5680 
FindDeclarationAndOverloadnull5681 function TFindDeclarationTool.FindDeclarationAndOverload(
5682   const CursorPos: TCodeXYPosition; out ListOfPCodeXYPosition: TFPList;
5683   Flags: TFindDeclarationListFlags): boolean;
5684 var
5685   CurCursorPos: TCodeXYPosition;
5686   NewTool: TFindDeclarationTool;
5687   NewNode: TCodeTreeNode;
5688   NewPos: TCodeXYPosition;
5689   NewTopLine: integer;
5690   CurTool: TFindDeclarationTool;
5691   OldPositions: TFPList;
5692   NodeList: TFPList;
5693   CleanPos: integer;
5694   AtDefinition: Boolean;
5695 
5696   procedure AddPos;
5697   begin
5698     AddCodePosition(OldPositions,NewPos);
5699     if (NodeList.IndexOf(NewNode)>=0) then begin
5700       {$IFDEF VerboseFindDeclarationAndOverload}
5701       debugln(['AddPos skip, because Node already in NodList']);
5702       {$ENDIF}
5703       exit;
5704     end;
5705 
5706     if (fdlfOneOverloadPerUnit in Flags)
5707     and (NodeList.Count>0)
5708     and (TCodeTreeNode(NodeList[NodeList.Count-1]).GetRoot=NewTool.Tree.Root)
5709     then begin
5710       {$IFDEF VerboseFindDeclarationAndOverload}
5711       debugln(['AddPos skip, because in same unit']);
5712       {$ENDIF}
5713       exit;
5714     end;
5715     NodeList.Add(NewNode);
5716 
5717     if (fdlfWithoutEmptyProperties in Flags)
5718     and (NewNode.Desc=ctnProperty)
5719     and (NewTool.PropNodeIsTypeLess(NewNode)) then begin
5720       {$IFDEF VerboseFindDeclarationAndOverload}
5721       debugln(['AddPos skip, because property has no type']);
5722       {$ENDIF}
5723       exit;
5724     end;
5725     if (fdlfWithoutForwards in Flags) then begin
5726       if (NewNode.Desc in [ctnTypeDefinition,ctnGenericType])
5727       and NewTool.NodeIsForwardDeclaration(NewNode) then begin
5728         {$IFDEF VerboseFindDeclarationAndOverload}
5729         debugln(['AddPos skip, because type is forward']);
5730         {$ENDIF}
5731         exit;
5732       end;
5733       if (NewNode.Desc=ctnProcedure)
5734       and ((NewNode.SubDesc and ctnsForwardDeclaration)>0)
5735       and (not NewNode.HasParentOfType(ctnInterface)) then begin
5736         {$IFDEF VerboseFindDeclarationAndOverload}
5737         debugln(['AddPos skip, because proc is forward']);
5738         {$ENDIF}
5739         exit;
5740       end;
5741     end;
5742 
5743     AddCodePosition(ListOfPCodeXYPosition,NewPos);
5744   end;
5745 
5746   function StartPositionAtDefinition: boolean;
5747   begin
5748     if (NewNode.Desc in AllIdentifierDefinitions)
5749     and (PositionInDefinitionName(NewNode,CleanPos)) then
5750       Result:=true
5751     else if (NewNode.Desc in [ctnProcedure,ctnProcedureHead])
5752     and (PositionInProcName(NewNode,false,CleanPos)) then
5753       Result:=true
5754     else if (NewNode.Desc in [ctnProperty,ctnGlobalProperty])
5755     and (PositionInPropertyName(NewNode,CleanPos)) then
5756       Result:=true
5757     else if (NewNode.Desc in AllSourceTypes)
5758     and (PositionInSourceName(CleanPos)) then
5759       Result:=true
5760     else
5761       Result:=false;
5762   end;
5763 
5764   function StartPositionAtFunctionResult: boolean;
5765   var
5766     Node: TCodeTreeNode;
5767   begin
5768     Result:=false;
5769     if (NewNode.Desc in [ctnProcedureHead,ctnIdentifier])
5770     and PositionInFuncResultName(NewNode,CleanPos) then begin
5771       Node:=NewNode;
5772       if Node.Desc=ctnProcedureHead then begin
5773         Node:=Node.FirstChild;
5774         if Node=nil then exit;
5775         if Node.Desc=ctnParameterList then Node:=Node.NextBrother;
5776         if Node=nil then exit;
5777       end;
5778       if Node.Desc in [ctnVarDefinition,ctnIdentifier] then begin
5779         // return the function result type or the operator variable name
5780         NewNode:=Node;
5781         Result:=true;
5782       end;
5783     end;
5784   end;
5785 
5786 begin
5787   {$IFDEF VerboseFindDeclarationAndOverload}
5788   debugln(['TFindDeclarationTool.FindDeclarationAndOverload START']);
5789   {$ENDIF}
5790   Result:=true;
5791   ListOfPCodeXYPosition:=nil;
5792   NewTool:=nil;
5793   NewNode:=nil;
5794   OldPositions:=nil;
5795   NodeList:=nil;
5796 
5797   ActivateGlobalWriteLock;
5798   try
5799     BuildTreeAndGetCleanPos(trTillCursorSection,lsrEnd,CursorPos,CleanPos,[]);
5800 
5801     NodeList:=TFPList.Create;
5802     NewTool:=Self;
5803     NewNode:=BuildSubTreeAndFindDeepestNodeAtPos(CleanPos,true);
5804     NewPos:=CursorPos;
5805     AtDefinition:=StartPositionAtDefinition;
5806     if AtDefinition then begin
5807       AddPos;
5808       if fdlfIfStartIsDefinitionStop in Flags then begin
5809         {$IFDEF VerboseFindDeclarationAndOverload}
5810         debugln(['TFindDeclarationTool.FindDeclarationAndOverload AtDefiniton and fdlfIfStartIsDefinitionStop in Flags']);
5811         {$ENDIF}
5812         exit;
5813       end;
5814     end;
5815     if StartPositionAtFunctionResult then begin
5816       AddPos;
5817       // the function result has no overloads => stop search
5818       {$IFDEF VerboseFindDeclarationAndOverload}
resultnull5819       debugln(['TFindDeclarationTool.FindDeclarationAndOverload function result has no overloads']);
5820       {$ENDIF}
5821       exit;
5822     end;
5823     if NewNode.Desc in AllSourceTypes then begin
5824       // the unit name has no overloads => stop search
5825       {$IFDEF VerboseFindDeclarationAndOverload}
5826       debugln(['TFindDeclarationTool.FindDeclarationAndOverload unit name has no overload']);
5827       {$ENDIF}
5828       exit;
5829     end;
5830 
5831     CurCursorPos:=CursorPos;
5832     CurTool:=Self;
5833     try
5834       while CurTool.FindDeclaration(CurCursorPos,DefaultFindSmartFlags
5835         +[fsfSearchSourceName],
5836         NewTool,NewNode,NewPos,NewTopLine) do
5837       begin
5838         if IndexOfCodePosition(OldPositions,@NewPos)>=0 then break;
5839         AddPos;
5840         CurCursorPos:=NewPos;
5841         CurTool:=NewTool;
5842         {$IFDEF VerboseFindDeclarationAndOverload}
5843         debugln('TFindDeclarationTool.FindDeclarationAndOverload Self="',MainFilename,'" ');
5844         if CurCursorPos.Code<>nil then
5845           debugln('  CurCursorPos=',CurCursorPos.Code.Filename,' ',dbgs(CurCursorPos.X),',',dbgs(CurCursorPos.Y));
5846         if CurTool<>nil then
5847           debugln('  CurTool=',CurTool.MainFilename);
5848         {$ENDIF}
5849         if (CurTool=nil) then exit;
5850       end;
5851     except
5852       // ignore normal errors
5853       on E: ECodeToolError do ;
5854       on E: ELinkScannerError do ;
5855     end;
5856   finally
5857     FreeListOfPCodeXYPosition(OldPositions);
5858     NodeList.Free;
5859     DeactivateGlobalWriteLock;
5860   end;
5861 end;
5862 
FindIdentifierContextsAtStatementnull5863 function TFindDeclarationTool.FindIdentifierContextsAtStatement(CleanPos: integer;
5864   out IsSubIdentifier: boolean; out ListOfPFindContext: TFPList): boolean;
5865 var
5866   Params: TFindDeclarationParams;
5867   CursorNode: TCodeTreeNode;
5868   Node: TCodeTreeNode;
5869   Context: TFindContext;
5870   WithNode: TCodeTreeNode;
5871   ExprType: TExpressionType;
5872 begin
5873   Result:=false;
5874   IsSubIdentifier:=false;
5875   ListOfPFindContext:=nil;
5876   CursorNode:=FindDeepestNodeAtPos(CleanPos,true);
5877   if not (CursorNode.Desc in AllPascalStatements) then begin
5878     debugln(['TFindDeclarationTool.FindIdentifierContextsAtStatement CursorNode.Desc=',CursorNode.DescAsString]);
5879     exit;
5880   end;
5881   // check expression in front
5882   MoveCursorToCleanPos(CleanPos);
5883   ReadPriorAtom;
5884   if CurPos.Flag=cafPoint then begin
5885     // sub identifier
5886     // for example A.Identifier
5887     IsSubIdentifier:=true;
5888     // search the context of A and add it to the ListOfPFindContext
5889     Params:=TFindDeclarationParams.Create(Self, CursorNode);
5890     try
5891       Params.ContextNode:=CursorNode;
5892       Params.Flags:=[fdfSearchInParentNodes,fdfSearchInAncestors,fdfSearchInHelpers,
5893                      fdfTopLvlResolving,fdfFunctionResult];
5894       ExprType:=FindExpressionTypeOfTerm(-1,CleanPos,Params,false);
5895     finally
5896       Params.Free;
5897     end;
5898     if ExprType.Desc=xtContext then
5899       AddFindContext(ListOfPFindContext,ExprType.Context);
5900   end else begin
5901     // not a sub identifier
5902     BuildSubTree(CursorNode);
5903     CursorNode:=FindDeepestNodeAtPos(CursorNode,CleanPos,true);
5904     Node:=CursorNode;
5905     while Node<>nil do begin
5906       case Node.Desc of
5907       ctnWithStatement:
5908         begin
5909           // add all With contexts
5910           WithNode:=Node.Parent;
5911           while WithNode<>nil do begin
5912             if WithNode.Desc<>ctnWithVariable then break;
5913             Params:=TFindDeclarationParams.Create(Self, WithNode);
5914             try
5915               Params.ContextNode:=WithNode;
5916               Params.Flags:=[fdfExceptionOnNotFound,fdfSearchInAncestors,fdfSearchInHelpers,
5917                 fdfSearchInParentNodes,fdfFunctionResult,fdfIgnoreCurContextNode,
5918                 fdfFindChildren];
5919               ExprType:=FindExpressionResultType(Params,WithNode.StartPos,-1);
5920               if ExprType.Desc=xtContext then
5921                 AddFindContext(ListOfPFindContext,ExprType.Context);
5922             finally
5923               Params.Free;
5924             end;
5925             WithNode:=WithNode.PriorBrother;
5926           end;
5927         end;
5928       ctnProcedure:
5929         begin
5930           // add procedure context
5931           Context.Node:=Node;
5932           Context.Tool:=Self;
5933           AddFindContext(ListOfPFindContext,Context);
5934           if NodeIsMethodBody(Node) then begin
5935             // add class context
5936             Context.Node:=FindClassNodeForMethodBody(Node,true,false);
5937             if Context.Node<>nil then begin
5938               Context.Tool:=Self;
5939               AddFindContext(ListOfPFindContext,Context);
5940             end;
5941           end;
5942         end;
5943       ctnImplementation:
5944         begin
5945           Context.Node:=Node;
5946           Context.Tool:=Self;
5947           AddFindContext(ListOfPFindContext,Context);
5948         end;
5949       end;
5950       Node:=Node.Parent;
5951     end;
5952   end;
5953   Result:=true;
5954 end;
5955 
FindIdentifierInAncestorsnull5956 function TFindDeclarationTool.FindIdentifierInAncestors(
5957   ClassNode: TCodeTreeNode; Params: TFindDeclarationParams): boolean;
5958 var
5959   IdentFoundResult: TIdentifierFoundResult;
5960 begin
5961   Result := FindIdentifierInAncestors(ClassNode, Params, IdentFoundResult{%H-});
5962 end;
5963 
FindClassAndAncestorsnull5964 function TFindDeclarationTool.FindClassAndAncestors(ClassNode: TCodeTreeNode;
5965   var ListOfPFindContext: TFPList; ExceptionOnNotFound: boolean): boolean;
5966 var
5967   Params: TFindDeclarationParams;
5968 
5969   function Search: boolean;
5970   var
5971     CurTool: TFindDeclarationTool;
5972     FoundContext: TFindContext;
5973   begin
5974     CurTool:=Self;
5975     while CurTool.FindAncestorOfClass(ClassNode,Params,true) do begin
5976       if (Params.NewCodeTool=nil) then break;
5977       FoundContext.Tool:=Params.NewCodeTool;
5978       FoundContext.Node:=Params.NewNode;
5979       if IndexOfFindContext(ListOfPFindContext,@FoundContext)>=0 then break;
5980       AddFindContext(ListOfPFindContext,FoundContext);
5981       //debugln('TFindDeclarationTool.FindClassAndAncestors FoundContext=',DbgsFC(FoundContext));
5982       CurTool:=Params.NewCodeTool;
5983       ClassNode:=Params.NewNode;
5984       if (ClassNode=nil)
5985       or (not (ClassNode.Desc in AllClasses)) then
5986         break;
5987     end;
5988     Result:=true;
5989   end;
5990 
5991 begin
5992   {$IFDEF CheckNodeTool}CheckNodeTool(ClassNode);{$ENDIF}
5993   Result:=false;
5994   if (ClassNode=nil) or (not (ClassNode.Desc in AllClasses))
5995   or (ClassNode.Parent=nil)
5996   or (not (ClassNode.Parent.Desc in [ctnTypeDefinition,ctnGenericType])) then
5997     exit;
5998 
5999   AddFindContext(ListOfPFindContext,CreateFindContext(Self,ClassNode));
6000 
6001   Params:=TFindDeclarationParams.Create;
6002   ActivateGlobalWriteLock;
6003   try
6004     if ExceptionOnNotFound then
6005       Result:=Search
6006     else begin
6007       try
6008         Result:=Search;
6009       except
6010         // catch syntax errors
6011         on E: ECodeToolError do ;
6012         on E: ELinkScannerError do ;
6013       end;
6014     end;
6015   finally
6016     DeactivateGlobalWriteLock;
6017     Params.Free;
6018   end;
6019 end;
6020 
6021 procedure TFindDeclarationTool.FindHelpersInContext(
6022   Params: TFindDeclarationParams);
6023 var
6024   Node: TCodeTreeNode;
6025 begin
6026   Node:=Params.StartNode;
6027   Params.FNeedHelpers:=false;
6028   while Node<>nil do
6029   begin
6030     case Node.Desc of
6031       ctnClassHelper, ctnRecordHelper, ctnTypeHelper:
6032         if (Node.Parent.Desc = ctnTypeDefinition) then
6033           Params.GetHelpers(fdhlkDelphiHelper,true).AddFromHelperNode(Node, Self,
6034             False{ keep last found Helper }
6035             );
6036       ctnObjCCategory:
6037         if (Node.Parent.Desc = ctnTypeDefinition) then
6038           Params.GetHelpers(fdhlkObjCCategory,true).AddFromHelperNode(Node, Self, False);
6039       ctnUsesSection:
6040         FindHelpersInUsesSection(Node, Params);
6041     end;
6042     Node := Node.Prior;
6043   end;
6044 end;
6045 
6046 procedure TFindDeclarationTool.FindHelpersInInterface(
6047   AskingTool: TFindDeclarationTool; Params: TFindDeclarationParams);
6048 var
6049   HelperKind: TFDHelpersListKind;
6050   Cache: TFDHelpersList;
6051 begin
6052   // build tree for pascal source
6053   if not BuildInterfaceIdentifierCache(true) then exit;
6054   if (AskingTool<>Self) and (AskingTool<>nil) then
6055   begin
6056     AskingTool.AddToolDependency(Self);
6057     for HelperKind in TFDHelpersListKind do begin
6058       Cache:=FInterfaceHelperCache[HelperKind];
6059       if (Cache<>nil) and (Cache.Count>0) then
6060         Params.GetHelpers(HelperKind,true).AddFromList(FInterfaceHelperCache[HelperKind]);
6061     end;
6062   end;
6063 end;
6064 
6065 procedure TFindDeclarationTool.FindHelpersInUsesSection(
6066   UsesNode: TCodeTreeNode; Params: TFindDeclarationParams);
6067 var
6068   NewCodeTool: TFindDeclarationTool;
6069   Node: TCodeTreeNode;
6070   AnUnitName: string;
6071   InFilename: string;
6072 begin
6073   // search in units
6074   //debugln(['TFindDeclarationTool.FindHelpersInUsesSection START ',CleanPosToStr(UsesNode.StartPos,true),' Main=',MainFilename]);
6075   Node:=UsesNode.LastChild;
6076   while Node<>nil do begin
6077     AnUnitName:=ExtractUsedUnitName(Node,@InFilename);
6078     if AnUnitName<>'' then begin
6079       //debugln(['TFindDeclarationTool.FindHelpersInUsesSection ',CleanPosToStr(Node.StartPos),' AnUnitName="',AnUnitName,'" in "',InFilename,'"']);
6080       NewCodeTool:=FindCodeToolForUsedUnit(AnUnitName,InFilename,false);
6081       if NewCodeTool<>nil then begin
6082         // search the identifier in the interface of the used unit
6083         NewCodeTool.FindHelpersInInterface(Self,Params);
6084       end;
6085     end;
6086     Node:=Node.PriorBrother;
6087   end;
6088 end;
6089 
FindContextClassAndAncestorsAndExtendedClassOfHelpernull6090 function TFindDeclarationTool.FindContextClassAndAncestorsAndExtendedClassOfHelper
6091   (const CursorPos: TCodeXYPosition; var ListOfPFindContext: TFPList): boolean;
6092 // returns a list of nodes of AllClasses (ctnClass, ...)
6093 var
6094   CleanCursorPos: integer;
6095   ANode: TCodeTreeNode;
6096   ClassNode: TCodeTreeNode;
6097   ExtendedClassExpr: TExpressionType;
6098 begin
6099   Result:=false;
6100   ListOfPFindContext:=nil;
6101 
6102   ActivateGlobalWriteLock;
6103   try
6104     BuildTreeAndGetCleanPos(trTillCursor,lsrEnd,CursorPos,CleanCursorPos,
6105                 [btSetIgnoreErrorPos]);
6106 
6107     // find class node
6108     ANode:=FindDeepestNodeAtPos(CleanCursorPos,true);
6109     if (ANode.GetNodeOfType(ctnClassInheritance)<>nil) then
6110       exit;
6111     ClassNode:=FindClassNode(ANode);
6112     if (ClassNode=nil) or (ClassNode.Parent=nil)
6113     or (not (ClassNode.Parent.Desc in [ctnTypeDefinition,ctnGenericType])) then
6114       exit;
6115 
6116     //debugln('TFindDeclarationTool.FindContextClassAndAncestors A ClassName=',ExtractClassName(ClassNode,false));
6117     // add class and ancestors type definition to ListOfPCodeXYPosition
6118     if not FindClassAndAncestors(ClassNode,ListOfPFindContext,true)
6119     then exit;
6120 
6121     //find extended class node
6122     ExtendedClassExpr := FindExtendedExprOfHelper(ClassNode);
6123     if ((ExtendedClassExpr.Desc=xtContext) and (ExtendedClassExpr.Context.Tool<>nil) and
6124         (ExtendedClassExpr.Context.Node<>nil) and (ExtendedClassExpr.Context.Node.Desc=ctnClass)) then
6125     begin
6126       if not ExtendedClassExpr.Context.Tool.FindClassAndAncestors(ExtendedClassExpr.Context.Node,ListOfPFindContext,true)
6127       then exit;
6128     end;
6129 
6130     //debugln('TFindDeclarationTool.FindContextClassAndAncestors List: ',ListOfPFindContextToStr(ListOfPFindContext));
6131 
6132   finally
6133     DeactivateGlobalWriteLock;
6134   end;
6135   Result:=true;
6136 end;
6137 
FindDefaultAncestorOfClassnull6138 function TFindDeclarationTool.FindDefaultAncestorOfClass(
6139   ClassNode: TCodeTreeNode; Params: TFindDeclarationParams;
6140   FindClassContext: boolean): boolean;
6141 var
6142   OldInput: TFindDeclarationInput;
6143   AncestorNode, ClassIdentNode: TCodeTreeNode;
6144   AncestorContext: TFindContext;
6145   BaseClassName: PChar;
6146 
6147   procedure RaiseBaseClassNotFound;
6148   begin
6149     MoveCursorToNodeStart(ClassNode);
6150     if BaseClassName='TObject' then
6151       RaiseException(20170421200159,ctsDefaultClassAncestorTObjectNotFound)
6152     else if BaseClassName='IInterface' then
6153       RaiseException(20170421200202,ctsDefaultInterfaceAncestorIInterfaceNotFound)
6154     else if BaseClassName='IDispatch' then
6155       RaiseException(20170421200205,ctsDefaultDispinterfaceAncestorIDispatchNotFound)
6156     else if BaseClassName='JLObject' then
6157       RaiseException(20170421200207,ctsDefaultJavaClassAncestorJLObjectNotFound)
6158     else
6159       RaiseExceptionFmt(20170421200210,ctsDefaultAncestorNotFound, [BaseClassName]);
6160   end;
6161 
6162 begin
6163   //debugln(['TFindDeclarationTool.FindAncestorOfClass ',CleanPosToStr(ClassNode.StartPos,true)]);
6164   {$IFDEF CheckNodeTool}CheckNodeTool(ClassNode);{$ENDIF}
6165   if (ClassNode=nil) or (not (ClassNode.Desc in AllClasses))
6166   then
6167     RaiseException(20170421200213,'[TFindDeclarationTool.FindDefaultAncestorOfClass] '
6168       +' invalid classnode');
6169   Result:=false;
6170 
6171   // ToDo: ppu, dcu
6172 
6173   // no ancestor class specified
6174   ClassIdentNode:=ClassNode.Parent;
6175   // check class name
6176   if (ClassIdentNode<>nil)
6177   and (not (ClassIdentNode.Desc in [ctnTypeDefinition,ctnGenericType])) then
6178   begin
6179     debugln(['TFindDeclarationTool.FindDefaultAncestorOfClass not a type']);
6180     exit;
6181   end;
6182   BaseClassName:=nil;
6183   case ClassNode.Desc of
6184   ctnClass:
6185     if Scanner.Values.IsDefined('CPUJVM') then
6186       BaseClassName:='JLObject'
6187     else if (Scanner.PascalCompiler=pcPas2js)
6188     and (FindClassExternalNode(ClassNode)<>nil) then
6189       exit // external root class has no ancestor
6190     else
6191       BaseClassName:='TObject';
6192   ctnDispinterface:
6193     // default interface is IDispatch
6194     BaseClassName:='IDispatch';
6195   ctnClassInterface:
6196     begin
6197       if Scanner.Values.IsDefined('CPUJVM') then
6198         exit; // JVM has no default interface
6199       // Delphi has as default interface IInterface
6200       // FPC has as default interface IUnknown and an alias IInterface = IUnknown
6201       if CompareSrcIdentifiers(ClassIdentNode.StartPos,'IUnknown') then exit;
6202       BaseClassName:='IInterface';
6203     end
6204   else
6205     exit; // has no default ancestor (e.g. record)
6206   end;
6207   if CompareSrcIdentifiers(ClassIdentNode.StartPos,BaseClassName) then
6208     exit; // this is already the base class
6209 
6210   {$IFDEF ShowTriedContexts}
6211   DebugLn('[TFindDeclarationTool.FindAncestorOfClass] ',
6212   ' search default ancestor class '+BaseClassName);
6213   {$ENDIF}
6214 
6215   // search default ancestor
6216   Params.Save(OldInput);
6217   Params.Flags:=[fdfSearchInParentNodes,fdfIgnoreCurContextNode,
6218                  fdfExceptionOnNotFound]
6219                 +(fdfGlobals*Params.Flags)
6220                 -[fdfTopLvlResolving];
6221   Params.SetIdentifier(Self,BaseClassName,nil);
6222   Params.ContextNode:=ClassNode;
6223   if not FindIdentifierInContext(Params) then
6224     RaiseBaseClassNotFound;
6225 
6226   // check result
6227   if not (Params.NewNode.Desc in [ctnTypeDefinition,ctnGenericType]) then
6228     RaiseBaseClassNotFound;
6229 
6230   // search ancestor class context
6231   if FindClassContext then begin
6232     AncestorNode:=Params.NewNode;
6233     Params.Flags:=Params.Flags+[fdfFindChildren];
6234     AncestorContext:=Params.NewCodeTool.FindBaseTypeOfNode(Params,
6235                                                            AncestorNode);
6236     Params.SetResult(AncestorContext);
6237 
6238     // check result
6239     if Params.NewNode.Desc<>ClassNode.Desc then
6240       RaiseBaseClassNotFound;
6241   end;
6242   Result:=true;
6243   Params.Load(OldInput,true);
6244 end;
6245 
6246 {-------------------------------------------------------------------------------
6247   function TFindDeclarationTool.FindReferences(const CursorPos: TCodeXYPosition;
6248     SkipComments: boolean; var ListOfPCodeXYPosition: TFPList): boolean;
6249 
6250   Search for all identifiers in current unit, referring to the declaration
6251   at CursorPos.
6252 -------------------------------------------------------------------------------}
FindReferencesnull6253 function TFindDeclarationTool.FindReferences(const CursorPos: TCodeXYPosition;
6254   SkipComments: boolean; out ListOfPCodeXYPosition: TFPList): boolean;
6255 var
6256   DeclarationFound: boolean;
6257   Identifier: string;
6258   CleanDeclCursorPos: integer;
6259   DeclarationTool: TFindDeclarationTool;
6260   DeclarationNode: TCodeTreeNode;
6261   AliasDeclarationNode: TCodeTreeNode; // if exists: always in front of DeclarationNode
6262   Params: TFindDeclarationParams;
6263   PosTree: TAVLTree; // tree of PChar positions in Src
6264   ReferencePos: TCodeXYPosition;
6265   MinPos, MaxPos: Integer;
6266   CursorNode: TCodeTreeNode;
6267   UnitStartFound, Found: Boolean;
6268   StartPos: integer; // keep this here, it is modified at several places
6269 
6270   procedure AddReference(ACleanPos: integer);
6271   var
6272     p: PChar;
6273   begin
6274     if PosTree=nil then
6275       PosTree:=TAVLTree.Create;
6276     p:=@Src[ACleanPos];
6277     //debugln('TFindDeclarationTool.FindReferences.AddReference ',CleanPosToStr(ACleanPos),' ',dbgs(PosTree.Find(p)=nil),' Code=',dbgstr(copy(Src,ACleanPos-8,8)+'|'+dbgstr(copy(Src,ACleanPos,5))));
6278     if PosTree.Find(p)=nil then
6279       PosTree.Add(p);
6280   end;
6281 
6282   procedure AddNodeReference(Node: TCodeTreeNode);
6283   var
6284     p: LongInt;
6285   begin
6286     p:=Node.StartPos;
6287     if Node.Desc in [ctnProcedure,ctnProcedureHead] then begin
6288       MoveCursorToProcName(Node,true);
6289       p:=CurPos.StartPos;
6290     end else if Node.Desc in [ctnProperty,ctnGlobalProperty] then begin
6291       MoveCursorToPropName(Node);
6292       p:=CurPos.StartPos;
6293     end;
6294     AddReference(p);
6295   end;
6296 
6297   procedure UseProcHead(var Node: TCodeTreeNode);
6298   begin
6299     if Node=nil then exit;
6300     if (Node.Desc=ctnProcedure)
6301     and (Node.FirstChild<>nil)
6302     and (Node.FirstChild.Desc=ctnProcedureHead) then
6303       Node:=Node.FirstChild;
6304   end;
6305 
6306   procedure ReadIdentifier(IsComment: boolean);
6307   var
6308     IdentStartPos: Integer;
6309     IdentEndPos: integer;
6310   begin
6311     if (not IsComment) then
6312       UnitStartFound:=true;
6313     IdentStartPos:=StartPos;
6314     IdentEndPos:=IdentStartPos;
6315     while (IdentEndPos<=MaxPos) and (IsIdentChar[Src[IdentEndPos]]) do
6316       inc(IdentEndPos);
6317     StartPos:=IdentEndPos;
6318     //debugln(['ReadIdentifier ',CleanPosToStr(IdentStartPos,true),' ',copy(Src,IdentStartPos,IdentEndPos-IdentStartPos),' ',CompareIdentifiers(PChar(Pointer(Identifier)),@Src[IdentStartPos])]);
6319     if IdentEndPos-IdentStartPos<>length(Identifier) then exit;
6320     if CompareIdentifiers(PChar(Pointer(Identifier)),@Src[IdentStartPos])<>0 then exit;
6321     if IsComment and (SkipComments or (not UnitStartFound)) then exit;
6322     {debugln(['Identifier with same name found at: ',
6323       IdentStartPos,'=',CleanPosToStr(StartPos),' ',GetIdentifier(@Src[IdentStartPos]),
6324       ' CleanDeclCursorPos=',CleanDeclCursorPos,
6325       ' MaxPos=',MaxPos,
6326       ' IsComment=',IsComment,
6327       ' SkipComments=',SkipComments,
6328       ' UnitStartFound=',UnitStartFound
6329       ]);}
6330 
6331     CursorNode:=BuildSubTreeAndFindDeepestNodeAtPos(IdentStartPos,true);
6332     //debugln('  CursorNode=',CursorNode.DescAsString,' Forward=',dbgs(CursorNode.SubDesc and ctnsForwardDeclaration));
6333 
6334     if (DeclarationTool=Self)
6335     and ((IdentStartPos=CleanDeclCursorPos) or (CursorNode=AliasDeclarationNode))
6336     then begin
6337       // declaration itself found
6338       //debugln(['ReadIdentifier declaration itself found, adding ...']);
6339       AddReference(IdentStartPos)
6340     end
6341     else if CleanPosIsDeclarationIdentifier(IdentStartPos,CursorNode) then
6342       // this identifier is another declaration with the same name
6343     else begin
6344       // find declaration
6345       if Params=nil then
6346         Params:=TFindDeclarationParams.Create(Self, CursorNode)
6347       else
6348         Params.Clear;
6349       Params.Flags:=[fdfSearchInParentNodes,fdfSearchInAncestors,fdfSearchInHelpers,
6350                      fdfIgnoreCurContextNode];
6351       Params.ContextNode:=CursorNode;
6352       //debugln(copy(Src,Params.ContextNode.StartPos,200));
6353       Params.SetIdentifier(Self,@Src[IdentStartPos],@CheckSrcIdentifier);
6354 
6355       // search identifier in comment -> if not found, this is no bug
6356       // => silently ignore
6357       try
6358         Found:=FindDeclarationOfIdentAtParam(Params);
6359       except
6360         on E: ECodeToolError do begin
6361           if E.Sender<>Self then begin
6362             // there is an error in another unit, which prevents searching
6363             // stop further searching in this unit
6364             raise;
6365           end;
6366           // continue
6367         end;
6368         on E: Exception do
6369           raise;
6370       end;
6371 
6372       //debugln(' Found=',dbgs(Found));
6373       if Found and (Params.NewNode<>nil) then begin
6374         UseProcHead(Params.NewNode);
6375         //debugln('Context=',Params.NewNode.DescAsString,' ',dbgs(Params.NewNode.StartPos),' ',dbgs(DeclarationNode.StartPos));
6376         if (Params.NewNode=DeclarationNode)
6377         or (Params.NewNode=AliasDeclarationNode) then begin
6378           //debugln(['ReadIdentifier reference found, adding ...']);
6379           AddReference(IdentStartPos);
6380         end;
6381       end;
6382     end;
6383   end;
6384 
6385   procedure SearchIdentifiers;
6386   var
6387     CommentLvl: Integer;
6388     InStrConst: Boolean;
6389   begin
6390     StartPos:=MinPos;
6391     UnitStartFound:=false;
6392     while StartPos<=MaxPos do begin
6393       case Src[StartPos] of
6394 
6395       '{':
6396         begin
6397           inc(StartPos);
6398           if (StartPos<=MaxPos) and (Src[StartPos]=#3) then begin
6399             // codetools skip comment {#3 #3}
6400             inc(StartPos);
6401             while (StartPos<=MaxPos) do begin
6402               if (Src[StartPos]=#3) and (StartPos<MaxPos) and (Src[StartPos+1]='}')
6403               then begin
6404                 inc(StartPos,2);
6405                 break;
6406               end;
6407               inc(StartPos);
6408             end;
6409           end else begin
6410             // pascal comment {}
6411             CommentLvl:=1;
6412             InStrConst:=false;
6413             while StartPos<=MaxPos do begin
6414               case Src[StartPos] of
6415               '{': if Scanner.NestedComments then inc(CommentLvl);
6416               '}':
6417                 begin
6418                   dec(CommentLvl);
6419                   if CommentLvl=0 then break;
6420                 end;
6421               'a'..'z','A'..'Z','_':
6422                 if not InStrConst then begin
6423                   ReadIdentifier(true);
6424                   dec(StartPos);
6425                 end;
6426               '''':
6427                 InStrConst:=not InStrConst;
6428               #10,#13:
6429                 InStrConst:=false;
6430               end;
6431               inc(StartPos);
6432             end;
6433             inc(StartPos);
6434             //debugln(StartPos,' ',copy(Src,CommentStart,StartPos-CommentStart));
6435           end;
6436         end;
6437 
6438       '/':  // Delphi comment
6439         if (Src[StartPos+1]<>'/') then begin
6440           inc(StartPos);
6441         end else begin
6442           inc(StartPos,2);
6443           InStrConst:=false;
6444           while (StartPos<=MaxPos) do begin
6445             case Src[StartPos] of
6446             #10,#13:
6447               break;
6448             'a'..'z','A'..'Z','_':
6449               if not InStrConst then begin
6450                 ReadIdentifier(true);
6451                 dec(StartPos);
6452               end;
6453             '''':
6454               InStrConst:=not InStrConst;
6455             end;
6456             inc(StartPos);
6457           end;
6458           inc(StartPos);
6459           if (StartPos<=MaxPos) and (Src[StartPos] in [#10,#13])
6460           and (Src[StartPos-1]<>Src[StartPos]) then
6461             inc(StartPos);
6462         end;
6463 
6464       '(': // turbo pascal comment
6465         if (Src[StartPos+1]<>'*') then begin
6466           inc(StartPos);
6467         end else begin
6468           inc(StartPos,3);
6469           InStrConst:=false;
6470           while (StartPos<=MaxPos) do begin
6471             case Src[StartPos] of
6472             ')':
6473               if Src[StartPos-1]='*' then break;
6474             'a'..'z','A'..'Z','_':
6475               if not InStrConst then begin
6476                 ReadIdentifier(true);
6477                 dec(StartPos);
6478               end;
6479             '''':
6480               InStrConst:=not InStrConst;
6481             #10,#13:
6482               InStrConst:=false;
6483             end;
6484             inc(StartPos);
6485           end;
6486           inc(StartPos);
6487         end;
6488 
6489       'a'..'z','A'..'Z','_':
6490         ReadIdentifier(false);
6491 
6492       '''':
6493         begin
6494           // skip string constant
6495           inc(StartPos);
6496           while (StartPos<=MaxPos) do begin
6497             if (not (Src[StartPos] in ['''',#10,#13])) then
6498               inc(StartPos)
6499             else begin
6500               inc(StartPos);
6501               break;
6502             end;
6503           end;
6504         end;
6505 
6506       else
6507         inc(StartPos);
6508       end;
6509     end;
6510   end;
6511 
GetDeclarationToolnull6512   function GetDeclarationTool: boolean;
6513   begin
6514     Result:=false;
6515     DeclarationTool:=nil;
6516     if Assigned(FOnGetCodeToolForBuffer) then
6517       DeclarationTool:=FOnGetCodeToolForBuffer(Self,CursorPos.Code,true)
6518     else if CursorPos.Code=TObject(Scanner.MainCode) then
6519       DeclarationTool:=Self;
6520     if DeclarationTool=nil then begin
6521       debugln('WARNING: TFindDeclarationTool.FindReferences DeclarationTool=nil');
6522       exit;
6523     end;
6524     Result:=true;
6525   end;
6526 
FindDeclarationNodenull6527   function FindDeclarationNode: boolean;
6528   const
6529     ProcAttr = [phpInUpperCase,phpAddClassName,phpWithVarModifiers];
6530   var
6531     Node: TCodeTreeNode;
6532     CommentStart: integer;
6533     CommentEnd: integer;
6534     p: LongInt;
6535   begin
6536     if DeclarationFound then exit(true);
6537     Result:=false;
6538 
6539     // find the main declaration node and identifier
6540     DeclarationTool.BuildTreeAndGetCleanPos(CursorPos,CleanDeclCursorPos);
6541     DeclarationNode:=DeclarationTool.BuildSubTreeAndFindDeepestNodeAtPos(
6542                                            CleanDeclCursorPos,true);
6543     Identifier:=DeclarationTool.ExtractIdentifier(CleanDeclCursorPos);
6544     if Identifier='' then begin
6545       //debugln('FindDeclarationNode Identifier="',Identifier,'"');
6546       exit;
6547     end;
6548     UseProcHead(DeclarationNode);
6549     if DeclarationTool=Self then begin
6550       //debugln(['FindDeclarationNode adding DeclarationNode ...']);
6551       AddNodeReference(DeclarationNode);
6552     end;
6553 
6554     // find alias declaration node
6555     //debugln('FindDeclarationNode DeclarationNode=',DeclarationNode.DescAsString);
6556     AliasDeclarationNode:=nil;
6557     case DeclarationNode.Desc of
6558 
6559     ctnProcedure,ctnProcedureHead:
6560       begin
6561         Node:=DeclarationNode;
6562         if DeclarationNode.Desc=ctnProcedureHead then
6563           Node:=Node.Parent;
6564         AliasDeclarationNode:=DeclarationTool.FindCorrespondingProcNode(
6565                      Node,ProcAttr);
6566       end;
6567 
6568     ctnVarDefinition:
6569       if DeclarationNode.HasParentOfType(ctnProcedureHead) then begin
6570         AliasDeclarationNode:=FindCorrespondingProcParamNode(DeclarationNode,ProcAttr);
6571       end;
6572 
6573     ctnTypeDefinition:
6574       if NodeIsForwardType(DeclarationNode) then
6575         AliasDeclarationNode:=DeclarationTool.FindTypeOfForwardNode(DeclarationNode)
6576       else
6577         AliasDeclarationNode:=DeclarationTool.FindForwardTypeNode(DeclarationNode,true);
6578 
6579     end;
6580     if AliasDeclarationNode=DeclarationNode then
6581       AliasDeclarationNode:=nil;
6582 
6583     if AliasDeclarationNode<>nil then begin
6584       UseProcHead(AliasDeclarationNode);
6585       if DeclarationTool=Self then begin
6586         //debugln(['FindDeclarationNode adding alias node ...']);
6587         AddNodeReference(AliasDeclarationNode);
6588       end;
6589       if AliasDeclarationNode.StartPos>DeclarationNode.StartPos then begin
6590         Node:=AliasDeclarationNode;
6591         AliasDeclarationNode:=DeclarationNode;
6592         DeclarationNode:=Node;
6593       end;
6594       //debugln('FindDeclarationNode AliasDeclarationNode=',AliasDeclarationNode.DescAsString,' ',DeclarationTool.CleanPosToStr(AliasDeclarationNode.StartPos,DeclarationTool<>Self));
6595     end;
6596 
6597     // search comment in front of declaration
6598     //debugln(['FindDeclarationNode search comment in front: ',DeclarationTool=Self,' SkipComments=',SkipComments,' Identifier=',Identifier]);
6599     if (DeclarationTool=Self)
6600     and (not SkipComments)
6601     and FindCommentInFront(DeclarationNode.StartPos,Identifier,
6602       true,false,false,true,true,CommentStart,CommentEnd)
6603     then begin
6604       //debugln(['FindDeclarationNode Comment="',dbgstr(copy(Src,CommentStart,CommentEnd)),'"']);
6605       p:=CommentStart;
6606       if (Src[p]='{') then begin
6607         inc(p);
6608         while (p<=SrcLen) and IsSpaceChar[Src[p]] do inc(p);
6609         if (p<=SrcLen) and (CompareIdentifiers(@Src[p],PChar(Identifier))=0)
6610         then begin
6611           //debugln(['FindDeclarationNode comment in front']);
6612           AddReference(p);
6613         end;
6614       end;
6615     end;
6616 
6617     DeclarationFound:=true;
6618     Result:=true;
6619   end;
6620 
6621   procedure LimitScope(UseNode: TCodeTreeNode);
6622   var
6623     Node: TCodeTreeNode;
6624     StartNode: TCodeTreeNode;
6625   begin
6626     MinPos:=Tree.FindFirstPosition;
6627     MaxPos:=Tree.FindLastPosition;
6628     if MaxPos>SrcLen then MaxPos:=SrcLen;
6629 
6630     if DeclarationTool<>Self then begin
6631       MinPos:=UseNode.Parent.EndPos;
6632       exit;
6633     end;
6634 
6635     StartNode:=DeclarationNode;
6636     if (AliasDeclarationNode<>nil) then
6637       StartNode:=AliasDeclarationNode;
6638     Node:=StartNode;
6639     while Node<>nil do begin
6640       case Node.Desc of
6641       ctnImplementation:
6642         // only search in implementation
6643         if MinPos<Node.StartPos then MinPos:=Node.StartPos;
6644 
6645       ctnTypeDefinition:
6646         begin
6647           // Note: types can be used before declaration
6648         end;
6649 
6650       ctnVarDefinition,ctnConstDefinition,ctnEnumIdentifier,ctnLabel:
6651         begin
6652           // only search behind variable
6653           if MinPos<Node.StartPos then MinPos:=Node.StartPos;
6654         end;
6655 
6656       ctnProcedureHead:
6657         MinPos:=Node.StartPos;
6658 
6659       ctnProcedure:
6660         begin
6661           if (FindProcBody(Node)<>nil) and (StartNode<>Node.FirstChild) then
6662           begin
6663             // DeclarationNode is a local identifier
6664             // limit scope to procedure
6665             //debugln(['LimitScope ProcNode=',CleanPosToStr(Node.StartPos),'..',CleanPosToStr(Node.EndPos)]);
6666             if MinPos<Node.FirstChild.EndPos then
6667               MinPos:=Node.FirstChild.EndPos;
6668             if MaxPos>Node.EndPos then
6669               MaxPos:=Node.EndPos;
6670           end;
6671         end;
6672 
6673       ctnOnBlock:
6674         begin
6675           // a declaration in an on block is only accessible in the on block
6676           if MinPos<Node.StartPos then
6677             MinPos:=Node.StartPos;
6678           if MaxPos>Node.EndPos then
6679             MaxPos:=Node.EndPos;
6680         end;
6681 
6682       end;
6683       //debugln(['scope limited to node: ',Node.DescAsString,' ',CleanPosToStr(MinPos),'..',CleanPosToStr(MaxPos),': ',dbgstr(copy(Src,MinPos,20)),'..',dbgstr(copy(Src,MaxPos-20,20))]);
6684       Node:=Node.Parent;
6685     end;
6686     //debugln(['LimitScope ',CleanPosToStr(MinPos),'..',CleanPosToStr(MaxPos),': ',dbgstr(copy(Src,MinPos,20)),'..',dbgstr(copy(Src,MaxPos-20,20))]);
6687   end;
6688 
6689 var
6690   UseNode: TCodeTreeNode;
6691   AVLNode: TAVLTreeNode;
6692 begin
6693   Result:=false;
6694   //debugln('FindReferences ',MainFilename,' CursorPos=',CursorPos.Code.Filename,' x=',dbgs(CursorPos.X),' y=',dbgs(CursorPos.Y),' SkipComments=',dbgs(SkipComments));
6695 
6696   ListOfPCodeXYPosition:=nil;
6697   Params:=nil;
6698   PosTree:=nil;
6699   DeclarationFound:=false;
6700 
6701   ActivateGlobalWriteLock;
6702   try
6703     // get the tool of the declaration
6704     if not GetDeclarationTool then exit;
6705 
6706     // check if this unit uses the declaration unit
6707     UseNode:=nil;
6708     if Self<>DeclarationTool then begin
6709       BuildTree(lsrImplementationUsesSectionEnd);
6710       UseNode:=FindUnitFileInAllUsesSections(DeclarationTool.MainFilename);
6711       if UseNode=nil then
6712         exit(true); // the declaration unit is not used
6713     end;
6714 
6715     // find declaration nodes and identifier
6716     BuildTree(lsrEnd);
6717     if not FindDeclarationNode then exit;
6718 
6719     // search identifiers
6720     LimitScope(UseNode);
6721 
6722     //debugln('FindReferences MinPos=',CleanPosToStr(MinPos),' MaxPos=',CleanPosToStr(MaxPos));
6723     SearchIdentifiers;
6724 
6725     // create the reference list
6726     if PosTree<>nil then begin
6727       AVLNode:=PosTree.FindHighest;
6728       while AVLNode<>nil do begin
6729         StartPos:=PChar(AVLNode.Data)-PChar(Pointer(Src))+1;
6730         // Note: if an include file is included twice a code position could be duplicated
6731         if CleanPosToCaret(StartPos,ReferencePos) then
6732           AddCodePosition(ListOfPCodeXYPosition,ReferencePos);
6733         AVLNode:=PosTree.FindPrecessor(AVLNode);
6734       end;
6735     end;
6736 
6737   finally
6738     Params.Free;
6739     PosTree.Free;
6740     DeactivateGlobalWriteLock;
6741   end;
6742   Result:=true;
6743 end;
6744 
FindUnitReferencesnull6745 function TFindDeclarationTool.FindUnitReferences(UnitCode: TCodeBuffer;
6746   SkipComments: boolean; out ListOfPCodeXYPosition: TFPList): boolean;
6747 var
6748   AUnitName, UpperUnitName: String;
6749 
CheckUsesSectionnull6750   function CheckUsesSection(UsesNode: TCodeTreeNode; out Found: boolean): boolean;
6751   var
6752     ReferencePos: TCodeXYPosition;
6753   begin
6754     Result:=true;
6755     Found:=false;
6756     if UsesNode=nil then exit;
6757     //DebugLn(['CheckUsesSection ']);
6758     MoveCursorToNodeStart(UsesNode);
6759     if (UsesNode.Desc=ctnUsesSection) then begin
6760       ReadNextAtom;
6761       if not UpAtomIs('USES') then
6762         RaiseUsesExpected(20170421200509);
6763     end;
6764     repeat
6765       ReadNextAtom;  // read name
6766       if CurPos.StartPos>SrcLen then break;
6767       if AtomIsChar(';') then break;
6768       AtomIsIdentifierE;
6769       //DebugLn(['CheckUsesSection ',GetAtom,' ',AUnitName]);
6770       if UpAtomIs(UpperUnitName) then begin // compare case insensitive
6771         if CleanPosToCaret(CurPos.StartPos,ReferencePos) then begin
6772           //DebugLn(['CheckUsesSection found in uses section: ',Dbgs(ReferencePos)]);
6773           Found:=true;
6774           AddCodePosition(ListOfPCodeXYPosition,ReferencePos);
6775         end;
6776       end;
6777       ReadNextAtom;
6778       if UpAtomIs('IN') then begin
6779         ReadNextAtom;
6780         if not AtomIsStringConstant then RaiseStrConstExpected(20170421200522);
6781         ReadNextAtom;
6782       end;
6783       if AtomIsChar(';') then break;
6784       if not AtomIsChar(',') then
6785         RaiseExceptionFmt(20170421200217,ctsStrExpectedButAtomFound,[';',GetAtom])
6786     until (CurPos.StartPos>SrcLen);
6787   end;
6788 
CheckSourcenull6789   function CheckSource(StartPos: integer): boolean;
6790   var
6791     ReferencePos: TCodeXYPosition;
6792   begin
6793     MoveCursorToCleanPos(StartPos);
6794     repeat
6795       ReadNextAtom;
6796       if not SkipComments then
6797         ; // ToDo
6798       if UpAtomIs(UpperUnitName)
6799       and not LastAtomIs(0,'.') then begin
6800         if CleanPosToCaret(CurPos.StartPos,ReferencePos) then begin
6801           //DebugLn(['CheckSource found: ',Dbgs(ReferencePos)]);
6802           AddCodePosition(ListOfPCodeXYPosition,ReferencePos);
6803         end;
6804       end;
6805     until CurPos.StartPos>SrcLen;
6806     Result:=true;
6807   end;
6808 
6809 var
6810   InterfaceUsesNode: TCodeTreeNode;
6811   ImplementationUsesNode: TCodeTreeNode;
6812   Found: boolean;
6813   StartPos: Integer;
6814 begin
6815   Result:=false;
6816   //debugln('FindUnitReferences UnitCode=',UnitCode.Filename,' SkipComments=',dbgs(SkipComments),' ',MainFilename);
6817 
6818   AUnitName:=ExtractFileNameOnly(UnitCode.Filename);
6819   UpperUnitName:=UpperCaseStr(AUnitName);
6820   ListOfPCodeXYPosition:=nil;
6821   ActivateGlobalWriteLock;
6822   try
6823     BuildTree(lsrEnd);
6824 
6825     InterfaceUsesNode:=FindMainUsesNode;
6826     if not CheckUsesSection(InterfaceUsesNode,Found) then exit;
6827 
6828     StartPos:=-1;
6829     if Found then begin
6830       StartPos:=InterfaceUsesNode.EndPos;
6831     end else begin
6832       ImplementationUsesNode:=FindImplementationUsesNode;
6833       if not CheckUsesSection(ImplementationUsesNode,Found) then exit;
6834       if Found then
6835         StartPos:=ImplementationUsesNode.EndPos;
6836     end;
6837 
6838     // find unit reference in source
6839     if StartPos>0 then begin
6840       if not CheckSource(StartPos) then exit;
6841     end;
6842   finally
6843     DeactivateGlobalWriteLock;
6844   end;
6845   Result:=true;
6846 end;
6847 
6848 procedure TFindDeclarationTool.FindUsedUnitReferences(
6849   const CursorPos: TCodeXYPosition; SkipComments: boolean; out
6850   UsedUnitFilename: string; out ListOfPCodeXYPosition: TFPList);
6851 var
6852   CleanPos: integer;
6853   Node: TCodeTreeNode;
6854   UnitInFilename: string;
6855   AnUnitName: String;
6856   TargetCode: TCodeBuffer;
6857   TargetTool: TFindDeclarationTool;
6858 begin
6859   //debugln(['TFindDeclarationTool.FindUsedUnitReferences ',dbgs(CursorPos)]);
6860   UsedUnitFilename:='';
6861   ListOfPCodeXYPosition:=nil;
6862   BuildTreeAndGetCleanPos(CursorPos,CleanPos);
6863   Node:=FindDeepestNodeAtPos(CleanPos,true);
6864   if Node.Desc in [ctnUseUnitNamespace,ctnUseUnitClearName] then
6865     Node:=Node.Parent;
6866   if Node.Desc<>ctnUseUnit then
6867     RaiseException(20170421200221,'This function needs the cursor at a unit in a uses clause');
6868   // cursor is on an used unit -> try to locate it
6869   MoveCursorToCleanPos(Node.StartPos);
6870   ReadNextAtom;
6871   AnUnitName:=ExtractUsedUnitNameAtCursor(@UnitInFilename);
6872   //debugln(['TFindDeclarationTool.FindUsedUnitReferences Used Unit=',AnUnitName,' in "',UnitInFilename,'"']);
6873   TargetCode:=FindUnitSource(AnUnitName,UnitInFilename,true,Node.StartPos);
6874   UsedUnitFilename:=TargetCode.Filename;
6875   //debugln(['TFindDeclarationTool.FindUsedUnitReferences TargetCode=',TargetCode.Filename]);
6876   TargetTool:=FOnGetCodeToolForBuffer(Self,TargetCode,false);
6877   FindUsedUnitReferences(TargetTool,SkipComments,ListOfPCodeXYPosition);
6878 end;
6879 
6880 procedure TFindDeclarationTool.FindUsedUnitReferences(
6881   TargetTool: TFindDeclarationTool; SkipComments: boolean; out
6882   ListOfPCodeXYPosition: TFPList);
6883 var
6884   refs: TFindUsedUnitReferences;
6885 begin
6886   ListOfPCodeXYPosition:=TFPList.Create;
6887   if TargetTool=nil then
6888     RaiseException(20170421200226,'TargetTool=nil');
6889   TargetTool.BuildInterfaceIdentifierCache(true);
6890   refs:=TFindUsedUnitReferences.Create(Self, FindLastNode);
6891   try
6892     refs.TargetTool:=TargetTool;
6893     refs.TargetUnitName:=TargetTool.GetSourceName(false);
6894     refs.ListOfPCodeXYPosition:=ListOfPCodeXYPosition;
6895     ForEachIdentifier(SkipComments,@OnFindUsedUnitIdentifier,refs);
6896   finally
6897     refs.Free;
6898   end;
6899 end;
6900 
6901 {-------------------------------------------------------------------------------
6902   function TFindDeclarationTool.CleanPosIsDeclarationIdentifier(CleanPos: integer;
6903     Node: TCodeTreeNode): boolean;
6904 
6905   Node should be the deepest node at CleanPos, and all sub trees built.
6906   See BuildSubTree
6907 -------------------------------------------------------------------------------}
CleanPosIsDeclarationIdentifiernull6908 function TFindDeclarationTool.CleanPosIsDeclarationIdentifier(CleanPos: integer;
6909   Node: TCodeTreeNode): boolean;
6910 
InNodeIdentifiernull6911   function InNodeIdentifier(NodeIdentStartPos: Integer): boolean;
6912   var
6913     IdentStartPos, IdentEndPos: integer;
6914   begin
6915     GetIdentStartEndAtPosition(Src,CleanPos,IdentStartPos,IdentEndPos);
6916     Result:=(IdentEndPos>IdentStartPos) and (IdentStartPos=NodeIdentStartPos);
6917   end;
6918 
6919 begin
6920   {$IFDEF CheckNodeTool}CheckNodeTool(Node);{$ENDIF}
6921   Result:=false;
6922   if Node=nil then exit;
6923   case Node.Desc of
6924 
6925   ctnTypeDefinition,ctnVarDefinition,ctnConstDefinition,ctnEnumIdentifier,ctnLabel:
6926     begin
6927       if NodeIsForwardDeclaration(Node) then exit;
6928       Result:=InNodeIdentifier(Node.StartPos);
6929     end;
6930 
6931   ctnGenericType:
6932     begin
6933       if (Node.FirstChild=nil) or NodeIsForwardDeclaration(Node) then exit;
6934       Result:=InNodeIdentifier(Node.FirstChild.StartPos);
6935     end;
6936 
6937   ctnProcedure:
6938     begin
6939       if (Node.FirstChild<>nil)
6940       and ((Node.FirstChild.SubDesc and ctnsForwardDeclaration)>0) then
6941         RaiseException(20170421200230,'TFindDeclarationTool.CleanPosIsDeclarationIdentifier Node not expanded');
6942       MoveCursorToProcName(Node,true);
6943       Result:=InNodeIdentifier(CurPos.StartPos);
6944     end;
6945 
6946   ctnProcedureHead:
6947     begin
6948       MoveCursorToProcName(Node,true);
6949       Result:=InNodeIdentifier(CurPos.StartPos);
6950     end;
6951 
6952   ctnProperty, ctnGlobalProperty:
6953     begin
6954       if not MoveCursorToPropName(Node) then exit;
6955       Result:=InNodeIdentifier(CurPos.StartPos);
6956     end;
6957 
6958   ctnUnit:
6959     Result:=PositionInSourceName(CleanPos);
6960   end;
6961 end;
6962 
JumpToNodenull6963 function TFindDeclarationTool.JumpToNode(ANode: TCodeTreeNode; out
6964   NewPos: TCodeXYPosition; out NewTopLine, BlockTopLine,
6965   BlockBottomLine: integer; IsCodeBlock: boolean): boolean;
6966 var
6967   JumpPos: LongInt;
6968   Caret: TCodeXYPosition;
6969 begin
6970   {$IFDEF CheckNodeTool}CheckNodeTool(ANode);{$ENDIF}
6971   Result:=false;
6972   if (ANode=nil) or (ANode.StartPos<1) then exit;
6973   JumpPos:=ANode.StartPos;
6974   if ANode.Desc in [ctnProperty,ctnGlobalProperty] then begin
6975     MoveCursorToPropName(ANode);
6976     JumpPos:=CurPos.StartPos;
6977   end;
6978   Result:=JumpToCleanPos(JumpPos,JumpPos,ANode.EndPos,
6979                          NewPos,NewTopLine,BlockTopLine,BlockBottomLine,IsCodeBlock);
6980   if CleanPosToCaret(ANode.StartPos, Caret) then
6981     BlockTopLine := Caret.Y
6982   else
6983     BlockTopLine := -1;
6984   if CleanPosToCaret(ANode.EndPos, Caret) then
6985     BlockBottomLine := Caret.Y
6986   else
6987     BlockBottomLine := -1;
6988 end;
6989 
JumpToNodenull6990 function TFindDeclarationTool.JumpToNode(ANode: TCodeTreeNode; out
6991   NewPos: TCodeXYPosition; out NewTopLine: integer; IsCodeBlock: boolean
6992   ): boolean;
6993 var
6994   BlockTopLine, BlockBottomLine: integer;
6995 begin
6996   Result := JumpToNode(ANode, NewPos, NewTopLine, BlockTopLine, BlockBottomLine, IsCodeBlock);
6997 end;
6998 
JumpToCleanPosnull6999 function TFindDeclarationTool.JumpToCleanPos(NewCleanPos, NewTopLineCleanPos,
7000   NewBottomLineCleanPos: integer; out NewPos: TCodeXYPosition; out NewTopLine,
7001   BlockTopLine, BlockBottomLine: integer; IsCodeBlock: boolean): boolean;
7002 var
7003   NewTopLinePos: TCodeXYPosition;
7004   NewBottomLinePos: TCodeXYPosition;
7005   JumpPos: Integer;
7006 begin
7007   Result:=false;
7008   // convert clean position to line, column and code
7009   if not CleanPosToCaret(NewCleanPos,NewPos) then exit;
7010   NewTopLine:=NewPos.Y;
7011   if AdjustTopLineDueToComment then begin
7012     // if there is a comment in front of the top position, it probably belongs
7013     // to the destination code
7014     // -> adjust the topline position, so that the comment is visible
7015     NewTopLineCleanPos:=FindLineEndOrCodeInFrontOfPosition(NewTopLineCleanPos,
7016                                                            false);
7017     if (NewTopLineCleanPos>=1) and (Src[NewTopLineCleanPos] in [#13,#10])
7018     then begin
7019       inc(NewTopLineCleanPos);
7020       if (Src[NewTopLineCleanPos] in [#10,#13])
7021       and (Src[NewTopLineCleanPos]<>Src[NewTopLineCleanPos-1]) then
7022         inc(NewTopLineCleanPos);
7023     end;
7024   end;
7025   // convert clean top line position to line, column and code
7026   if not CleanPosToCaret(NewTopLineCleanPos,NewTopLinePos) then exit;
7027   BlockTopLine := NewTopLinePos.Y;
7028   // convert clean bottom line position to line, column and code
7029   NewBottomLinePos:=NewPos;
7030   if (NewBottomLineCleanPos>NewCleanPos)
7031   and (not CleanPosToCaret(NewBottomLineCleanPos,NewBottomLinePos)) then exit;
7032   BlockBottomLine := NewBottomLinePos.Y;
7033 
7034   if NewTopLinePos.Code=NewPos.Code then begin
7035     // center the destination position in the source editor
7036     if IsCodeBlock and (JumpCodeBlockPos>0) then
7037       JumpPos := JumpCodeBlockPos
7038     else
7039     if not IsCodeBlock and (JumpSingleLinePos>0) then
7040       JumpPos := JumpSingleLinePos
7041     else
7042       JumpPos := 0;
7043     if JumpPos>0 then
7044       NewTopLine:=NewTopLinePos.Y-((VisibleEditorLines-(NewBottomLinePos.Y-NewTopLinePos.Y))*JumpPos div 100)
7045     else
7046       NewTopLine:=High(NewTopLine);
7047     if NewTopLine>NewTopLinePos.Y then
7048       NewTopLine:=NewTopLinePos.Y;
7049 
7050     // NewTopLine not above first line of code
7051     if NewTopLine<1 then NewTopLine:=1;
7052     // make NewTopLine visible
7053     if NewTopLine<=NewPos.Y-VisibleEditorLines then begin
7054       // NewTopLine is not visible
7055       // center or align to bottom
7056       if (NewBottomLineCleanPos>NewCleanPos)
7057       and (NewBottomLinePos.Y<NewPos.Y+(VisibleEditorLines div 2))
7058       then begin
7059         // align to bottom
7060         NewTopLine:=NewBottomLinePos.Y-VisibleEditorLines+1;
7061       end else begin
7062         // center
7063         NewTopLine:=NewPos.Y-(VisibleEditorLines*JumpSingleLinePos div 100);
7064       end;
7065       if NewTopLine<1 then NewTopLine:=1;
7066     end;
7067   end else
7068     NewTopLine:=1;
7069   Result:=true;
7070 end;
7071 
JumpToCleanPosnull7072 function TFindDeclarationTool.JumpToCleanPos(NewCleanPos, NewTopLineCleanPos,
7073   NewBottomLineCleanPos: integer; out NewPos: TCodeXYPosition; out
7074   NewTopLine: integer; IsCodeBlock: boolean): boolean;
7075 var
7076   BlockTopLine, BlockBottomLine: integer;
7077 begin
7078   Result := JumpToCleanPos(NewCleanPos, NewTopLineCleanPos, NewBottomLineCleanPos,
7079     NewPos, NewTopLine, BlockTopLine, BlockBottomLine, IsCodeBlock);
7080 end;
7081 
NodeIsForwardDeclarationnull7082 function TFindDeclarationTool.NodeIsForwardDeclaration(Node: TCodeTreeNode
7083   ): boolean;
7084 var
7085   TypeNode: TCodeTreeNode;
7086 begin
7087   {$IFDEF CheckNodeTool}CheckNodeTool(Node);{$ENDIF}
7088   Result:=false;
7089   if (Node=nil) or (not (Node.Desc in [ctnTypeDefinition,ctnGenericType])) then
7090     exit;
7091   TypeNode:=FindTypeNodeOfDefinition(Node);
7092   if TypeNode=nil then exit;
7093   if TypeNode.Desc in AllClasses then begin
7094     if (TypeNode.SubDesc and ctnsForwardDeclaration)>0 then begin
7095       Result:=true;
7096       exit;
7097     end;
7098   end;
7099 end;
7100 
GetExpandedOperandnull7101 function TFindDeclarationTool.GetExpandedOperand(const CursorPos: TCodeXYPosition;
7102   out Operand: string; ResolveProperty: Boolean): Boolean;
7103 var
7104   CursorNode: TCodeTreeNode;
7105   CleanCursorPos: integer;
7106   Params: TFindDeclarationParams;
7107   Identifier: PChar;
7108   LineRange: TLineRange;
7109 begin
7110   Result := False;
7111   Operand := '';
7112   if (CursorPos.Y<1) or (CursorPos.Y>CursorPos.Code.LineCount)
7113   or (CursorPos.X<1) then Exit;
7114   CursorPos.Code.GetLineRange(CursorPos.Y-1,LineRange);
7115   if LineRange.EndPos-LineRange.StartPos+1<CursorPos.X then Exit;
7116 
7117   ActivateGlobalWriteLock;
7118   try
7119     // build code tree
7120     BuildTreeAndGetCleanPos(trTillCursor,lsrEnd,CursorPos,CleanCursorPos,
7121                   [btSetIgnoreErrorPos,btCursorPosOutAllowed]);
7122     // find CodeTreeNode at cursor
7123     if (Tree.Root<>nil) and (Tree.Root.StartPos<=CleanCursorPos) then
7124       CursorNode := BuildSubTreeAndFindDeepestNodeAtPos(CleanCursorPos, True)
7125     else
7126       CursorNode := nil;
7127 
7128     if CursorNode = nil then begin
7129       // raise exception
7130       CursorNode := FindDeepestNodeAtPos(CleanCursorPos, True);
7131     end;
7132     if CursorNode.Desc = ctnBeginBlock then begin
7133       BuildSubTreeForBeginBlock(CursorNode);
7134       CursorNode := FindDeepestNodeAtPos(CursorNode, CleanCursorPos, True);
7135     end;
7136     // set cursor on identifier
7137     MoveCursorToCleanPos(CleanCursorPos);
7138     GetIdentStartEndAtPosition(Src,CleanCursorPos,
7139                                CurPos.StartPos,CurPos.EndPos);
7140     if CurPos.StartPos >= CurPos.EndPos then Exit;
7141     Identifier := @Src[CurPos.StartPos];
7142     // find declaration of identifier
7143     Params := TFindDeclarationParams.Create;
7144     try
7145       Params.ContextNode := CursorNode;
7146       Params.SetIdentifier(Self, Identifier, nil);
7147       Params.Flags := [fdfSearchInParentNodes, fdfTopLvlResolving,
7148                        fdfSearchInAncestors, fdfSkipClassForward,
7149                        fdfExtractOperand];
7150       if ResolveProperty then
7151         Include(Params.Flags, fdfPropertyResolving);
7152       if FindDeclarationOfIdentAtParam(Params) then
7153       begin
7154         Operand := Params.ExtractedOperand;
7155         Result := Operand <> '';
7156       end;
7157     finally
7158       Params.Free;
7159     end;
7160   finally
7161     ClearIgnoreErrorAfter;
7162     DeactivateGlobalWriteLock;
7163   end;
7164 end;
7165 
TFindDeclarationTool.FindIdentifierInProcContextnull7166 function TFindDeclarationTool.FindIdentifierInProcContext(
7167   ProcContextNode: TCodeTreeNode;
7168   Params: TFindDeclarationParams): TIdentifierFoundResult;
7169 { this function is internally used by FindIdentifierInContext
7170 }
7171 var
7172   NameAtom: TAtomPosition;
7173 begin
7174   {$IFDEF CheckNodeTool}CheckNodeTool(ProcContextNode);{$ENDIF}
7175   Result:=ifrProceedSearch;
7176   // if proc is a method body, search in class
7177   // -> find class name
7178   if ProcContextNode.FirstChild=nil then
7179     exit(ifrProceedSearch);
7180   MoveCursorToNodeStart(ProcContextNode.FirstChild);
7181   ReadNextAtom; // read name
7182   if not AtomIsIdentifier then exit; // ignore operator procs
7183   NameAtom:=CurPos;
7184   ReadNextAtom;
7185   if AtomIsChar('.') then begin
7186     // proc is a method body (not a declaration).
7187     // -> proceed the search normally ...
7188   end else begin
7189     // proc is a proc declaration
7190     if ((fdfCollect in Params.Flags)
7191     or CompareSrcIdentifiers(NameAtom.StartPos,Params.Identifier)) then begin
7192       // proc identifier found
7193       // the parameters will be checked by the caller
7194       {$IFDEF ShowTriedContexts}
7195       DebugLn('[TFindDeclarationTool.FindIdentifierInProcContext]  Proc-Identifier found="',GetIdentifier(@Src[NameAtom.StartPos]),'"');
7196       {$ENDIF}
7197       Params.SetResult(Self,ProcContextNode,NameAtom.StartPos);
7198       Result:=ifrSuccess;
7199     end else begin
7200       // proceed the search normally ...
7201     end;
7202   end;
7203 end;
7204 
FindIdentifierInClassOfMethodnull7205 function TFindDeclarationTool.FindIdentifierInClassOfMethod(
7206   ProcContextNode: TCodeTreeNode; Params: TFindDeclarationParams): boolean;
7207 { this function is internally used by FindIdentifierInContext
7208 }
7209 var
7210   ClassNameAtom: TAtomPosition;
7211   OldFlags: TFindDeclarationFlags;
7212   IdentFoundResult: TIdentifierFoundResult;
7213   CurClassNode: TCodeTreeNode;
7214   ForExprType: TExpressionType;
7215 begin
7216   {$IFDEF CheckNodeTool}CheckNodeTool(ProcContextNode);{$ENDIF}
7217   Result:=false;
7218   // if proc is a method, search in class
7219   // -> find class name
7220   MoveCursorToNodeStart(ProcContextNode);
7221   ReadNextAtom; // read keyword
7222   if UpAtomIs('CLASS') then
7223     ReadNextAtom;
7224   ReadNextAtom; // read classname
7225   ClassNameAtom:=CurPos;
7226   ReadNextAtom;
7227   if AtomIsChar('.') then begin
7228     // proc is a method
7229     if CompareSrcIdentifiers(ClassNameAtom.StartPos,Params.Identifier) then
7230     begin
7231       // the class itself is searched
7232       // -> proceed the search normally ...
7233     end else begin
7234       // search the identifier in the class first
7235       // search the class in the same unit
7236       CurClassNode:=FindClassOfMethod(ProcContextNode,true,true);
7237       repeat
7238         // search identifier in class
7239         OldFlags := Params.Flags;
7240         Params.Flags:=[fdfSearchInAncestors]
7241                       +(fdfGlobalsSameIdent*Params.Flags)
7242                       -[fdfExceptionOnNotFound];
7243         Params.ContextNode:=CurClassNode;
7244         {$IFDEF ShowTriedContexts}
7245         DebugLn('[TFindDeclarationTool.FindIdentifierInClassOfMethod]  searching identifier in class of method Identifier=',GetIdentifier(Params.Identifier));
7246         {$ENDIF}
7247         if (fdfSearchInHelpers in Params.Flags)
7248           and (CurClassNode.Desc in [ctnClassHelper,ctnRecordHelper])
7249           and (Params.GetHelpers(fdhlkDelphiHelper)<>nil)
7250         then begin
7251           // override current helper for the type and search in that type
7252           ForExprType := Params.GetHelpers(fdhlkDelphiHelper).AddFromHelperNode(CurClassNode, Self, True).ForExprType;
7253           if (ForExprType.Desc = xtContext) and (ForExprType.Context.Node<>nil)
7254           then begin
7255             Params.ContextNode:=ForExprType.Context.Node;
7256             Result:=ForExprType.Context.Tool.FindIdentifierInContext(Params);
7257           end;
7258         end else
7259           Result:=FindIdentifierInContext(Params);
7260         Params.Flags := OldFlags;
7261         if Result and Params.IsFoundProcFinal then exit;
7262         // in a nested class, continue search in enclosing class
7263         repeat
7264           CurClassNode:=CurClassNode.Parent;
7265         until (CurClassNode=nil) or (CurClassNode.Desc in AllClassObjects);
7266       until CurClassNode=nil;
7267     end;
7268   end else begin
7269     // proc is not a method
7270     if (fdfCollect in Params.Flags)
7271     or CompareSrcIdentifiers(ClassNameAtom.StartPos,Params.Identifier) then
7272     begin
7273       // proc identifier found
7274       {$IFDEF ShowTriedContexts}
7275       DebugLn('[TFindDeclarationTool.FindIdentifierInClassOfMethod]  Proc Identifier found="',GetIdentifier(Params.Identifier),'"');
7276       {$ENDIF}
7277       Params.SetResult(Self,ProcContextNode,ClassNameAtom.StartPos);
7278       IdentFoundResult:=Params.NewCodeTool.DoOnIdentifierFound(Params,
7279                                                                Params.NewNode);
7280       Result:=IdentFoundResult=ifrSuccess;
7281       exit;
7282     end else begin
7283       // proceed the search normally ...
7284     end;
7285   end;
7286 end;
7287 
TFindDeclarationTool.FindIdentifierInContextnull7288 function TFindDeclarationTool.FindIdentifierInContext(
7289   Params: TFindDeclarationParams): boolean;
7290 var
7291   IdentFoundResult: TIdentifierFoundResult;
7292 begin
7293   Result := FindIdentifierInContext(Params, IdentFoundResult{%H-});
7294 end;
7295 
FindClassOfMethodnull7296 function TFindDeclarationTool.FindClassOfMethod(ProcNode: TCodeTreeNode;
7297   FindClassContext, ExceptionOnNotFound: boolean): TCodeTreeNode;
7298 var
7299   ClassNameAtom: TAtomPosition;
7300   Node: TCodeTreeNode;
7301   TypeNode: TCodeTreeNode;
7302   NextNameAtom: TAtomPosition;
7303   CurClassName: PChar;
7304   CurClassNode: TCodeTreeNode;
7305 
7306   procedure RaiseClassNotFound;
7307   begin
7308     MoveCursorToAtomPos(ClassNameAtom);
7309     RaiseExceptionFmt(20170421200233,'Class %s not found',[GetAtom]);
7310   end;
7311 
7312   procedure RaiseNotAClass;
7313   begin
7314     MoveCursorToAtomPos(ClassNameAtom);
7315     RaiseExceptionFmt(20170421200237,'Class expected, but %s found',[GetAtom]);
7316   end;
7317 
7318 begin
7319   {$IFDEF CheckNodeTool}CheckNodeTool(ProcNode);{$ENDIF}
7320   {$IFDEF ShowTriedContexts}
7321   DebugLn('[TFindDeclarationTool.FindClassOfMethod] A ');
7322   {$ENDIF}
7323   Result:=nil;
7324   if ProcNode.Desc=ctnProcedureHead then
7325     ProcNode:=ProcNode.Parent;
7326   if (ProcNode.Parent<>nil) and (ProcNode.Parent.Desc in AllClassSections) then begin
7327     CurClassNode:=ProcNode.Parent.Parent;
7328     if FindClassContext then begin
7329       // return the class node
7330       exit(CurClassNode);
7331     end else begin
7332       // return the type identifier node
7333       exit(CurClassNode.Parent);
7334     end;
7335   end;
7336 
7337   MoveCursorToNodeStart(ProcNode);
7338   ReadNextAtom; // read keyword
7339   if UpAtomIs('CLASS') then ReadNextAtom;
7340   ReadNextAtom; // read classname
7341   ClassNameAtom:=CurPos;
7342   if CurPos.Flag<>cafWord then begin
7343     if not ExceptionOnNotFound then exit;
7344     RaiseNotAClass;
7345   end;
7346   CurClassName:=@Src[ClassNameAtom.StartPos];
7347   ReadNextAtom;
7348   if CurPos.Flag<>cafPoint then begin
7349     // not a method
7350     if not ExceptionOnNotFound then exit;
7351     RaiseNotAClass;
7352   end;
7353   ReadNextAtom;
7354   NextNameAtom:=CurPos;
7355 
7356   //debugln(['TFindDeclarationTool.FindClassOfMethod ClassName="',GetAtom(ClassNameAtom),'"']);
7357 
7358   // proc is a method
7359   // -> search the class
7360   Node:=ProcNode;
7361   repeat
7362     if Node.Desc=ctnTypeSection then begin
7363       TypeNode:=Node.LastChild;
7364       while TypeNode<>nil do begin
7365         {$IFDEF ShowTriedIdentifiers}
7366         debugln(['TFindDeclarationTool.FindClassOfMethod ',TypeNode.DescAsString,' ',dbgstr(ExtractNode(TypeNode,[]),1,40)]);
7367         {$ENDIF}
7368         if ((TypeNode.Desc=ctnTypeDefinition)
7369         and (CompareIdentifierPtrs(CurClassName,@Src[TypeNode.StartPos])=0))
7370         or ((TypeNode.Desc=ctnGenericType)
7371         and (TypeNode.FirstChild<>nil)
7372         and (CompareIdentifierPtrs(CurClassName,@Src[TypeNode.FirstChild.StartPos])=0))
7373         then begin
7374           repeat
7375             // type with same name found
7376             //debugln(['TFindDeclarationTool.FindClassOfMethod type found ',ExtractDefinitionName(TypeNode)]);
7377             CurClassNode:=FindTypeNodeOfDefinition(TypeNode);
7378             if (CurClassNode=nil) then begin
7379               if not ExceptionOnNotFound then exit;
7380               RaiseClassNotFound;
7381             end;
7382             if (not (CurClassNode.Desc in AllClassObjects))
7383             or ((ctnsForwardDeclaration and Node.SubDesc)<>0)
7384             then begin
7385               if not ExceptionOnNotFound then exit;
7386               RaiseNotAClass;
7387             end;
7388             //debugln(['TFindDeclarationTool.FindClassOfMethod class found, NextNameAtom=',GetAtom(NextNameAtom)]);
7389             // class found
7390             if NextNameAtom.Flag=cafWord then begin
7391               MoveCursorToAtomPos(NextNameAtom);
7392               ReadNextAtom;
7393               if CurPos.Flag<>cafPoint then begin
7394                 if FindClassContext then begin
7395                   // return the class node
7396                   exit(CurClassNode);
7397                 end else begin
7398                   // return the type identifier node
7399                   exit(TypeNode);
7400                 end;
7401               end;
7402               ReadNextAtom;
7403               ClassNameAtom:=NextNameAtom;
7404               NextNameAtom:=CurPos;
7405               CurClassName:=@Src[ClassNameAtom.StartPos];
7406             end else begin
7407               // operator or missing sub identifier
7408               if FindClassContext then begin
7409                 // return the class node
7410                 exit(CurClassNode);
7411               end else begin
7412                 // return the type identifier node
7413                 exit(TypeNode);
7414               end;
7415             end;
7416             // search sub class
7417             //debugln(['TFindDeclarationTool.FindClassOfMethod searching sub class "',GetIdentifier(CurClassName),'"']);
7418             Node:=FindClassMember(CurClassNode,CurClassName);
7419             if Node=nil then begin
7420               if not ExceptionOnNotFound then exit;
7421               RaiseClassNotFound;
7422             end;
7423             if not (Node.Desc in [ctnTypeDefinition,ctnGenericType]) then begin
7424               if not ExceptionOnNotFound then exit;
7425               RaiseNotAClass;
7426             end;
7427             TypeNode:=Node;
7428           until false;
7429         end;
7430         TypeNode:=TypeNode.PriorBrother;
7431       end;
7432     end;
7433     // next
7434     if Node.PriorBrother<>nil then
7435       Node:=Node.PriorBrother
7436     else begin
7437       Node:=Node.Parent;
7438       if (Node=nil) or (Node.Desc<>ctnImplementation) then break;
7439       Node:=Node.PriorBrother;
7440       if (Node=nil) or (Node.Desc<>ctnInterface) then break;
7441       Node:=Node.LastChild;
7442       if Node=nil then break;
7443     end;
7444   until false;
7445   if ExceptionOnNotFound then
7446     RaiseClassNotFound;
7447 end;
7448 
TFindDeclarationTool.FindClassMembernull7449 function TFindDeclarationTool.FindClassMember(aClassNode: TCodeTreeNode;
7450   Identifier: PChar): TCodeTreeNode;
7451 var
7452   Node: TCodeTreeNode;
7453   CurIdentifier: PChar;
7454 begin
7455   Result:=nil;
7456   if GetIdentLen(Identifier)=0 then exit;
7457   if aClassNode=nil then exit;
7458   Node:=aClassNode.LastChild;
7459   while Node<>nil do begin
7460     if (Node.Desc in AllClassSections)
7461     and (Node.FirstChild<>nil) then begin
7462       Node:=Node.LastChild;
7463       continue;
7464     end
7465     else if Node.Desc in AllSimpleIdentifierDefinitions then begin
7466       if CompareIdentifierPtrs(@Src[Node.StartPos],Identifier)=0 then
7467         exit(Node);
7468     end else if Node.Desc=ctnProperty then begin
7469       CurIdentifier:=GetPropertyNameIdentifier(Node);
7470       if CompareIdentifierPtrs(CurIdentifier,Identifier)=0 then
7471         exit(Node);
7472     end else if Node.Desc=ctnProcedure then begin
7473       CurIdentifier:=GetProcNameIdentifier(Node);
7474       if CompareIdentifierPtrs(CurIdentifier,Identifier)=0 then
7475         exit(Node);
7476     end;
7477     // next
7478     if Node.PriorBrother<>nil then
7479       Node:=Node.PriorBrother
7480     else begin
7481       repeat
7482         Node:=Node.Parent;
7483         if Node=aClassNode then exit;
7484       until Node.PriorBrother<>nil;
7485       Node:=Node.PriorBrother;
7486     end;
7487   end;
7488 end;
7489 
TFindDeclarationTool.FindClassMembernull7490 function TFindDeclarationTool.FindClassMember(aClassNode: TCodeTreeNode;
7491   const Identifier: String; SearchInAncestors: boolean): TFindContext;
7492 var
7493   Params: TFindDeclarationParams;
7494 begin
7495   Result.Tool:=Self;
7496   Result.Node:=FindClassMember(aClassNode,PChar(Identifier));
7497   if Result.Node<>nil then exit;
7498   if not SearchInAncestors then begin
7499     Result:=CleanFindContext;
7500     exit;
7501   end;
7502   Params:=TFindDeclarationParams.Create;
7503   try
7504     while Result.Tool.FindAncestorOfClass(aClassNode,Params,True) do begin
7505       Result.Tool:=Params.NewCodeTool;
7506       aClassNode:=Params.NewNode;
7507       Result.Node:=Result.Tool.FindClassMember(aClassNode,PChar(Identifier));
7508       if Result.Node<>nil then exit;
7509     end;
7510     Result:=CleanFindContext;
7511   finally
7512     Params.Free;
7513   end;
7514 end;
7515 
TFindDeclarationTool.FindAncestorOfClassnull7516 function TFindDeclarationTool.FindAncestorOfClass(ClassNode: TCodeTreeNode;
7517   Params: TFindDeclarationParams; FindClassContext: boolean): boolean;
7518 var
7519   InheritanceNode: TCodeTreeNode;
7520 begin
7521   {$IFDEF CheckNodeTool}CheckNodeTool(ClassNode);{$ENDIF}
7522   if (ClassNode=nil) or (not (ClassNode.Desc in AllClasses)) then
7523     RaiseException(20170421200240,'[TFindDeclarationTool.FindAncestorOfClass]  invalid classnode');
7524   Result:=false;
7525 
7526   // ToDo: ppu, dcu
7527 
7528   InheritanceNode:=FindInheritanceNode(ClassNode);
7529   if (InheritanceNode<>nil)
7530   and (InheritanceNode.FirstChild<>nil) then begin
7531     Result:=FindAncestorOfClassInheritance(InheritanceNode.FirstChild,
7532                                            Params,FindClassContext);
7533   end else begin
7534     Result:=FindDefaultAncestorOfClass(ClassNode,Params,FindClassContext);
7535   end;
7536 end;
7537 
TFindDeclarationTool.FindAncestorOfClassInheritancenull7538 function TFindDeclarationTool.FindAncestorOfClassInheritance(
7539   IdentifierNode: TCodeTreeNode; ResultParams: TFindDeclarationParams;
7540   FindClassContext: boolean): boolean;
7541 var
7542   InheritanceNode: TCodeTreeNode;
7543   ClassNode: TCodeTreeNode;
7544   SpecializeNode , GenericParamsNode: TCodeTreeNode;
7545   AncestorContext: TFindContext;
7546   AncestorStartPos: LongInt;
7547   ExprType: TExpressionType;
7548   Params: TFindDeclarationParams;
7549 
7550   procedure RaiseExpected(const Expected: string);
7551   begin
7552     MoveCursorToCleanPos(AncestorStartPos);
7553     ReadNextAtom;
7554     RaiseExceptionFmt(20170421200243,ctsStrExpectedButAtomFound,[Expected,ExtractNode(IdentifierNode,[])]);
7555   end;
7556 
7557 begin
7558   {$IFDEF CheckNodeTool}CheckNodeTool(IdentifierNode);{$ENDIF}
7559   if (IdentifierNode=nil)
7560   or (not (IdentifierNode.Desc in [ctnIdentifier,ctnSpecialize]))
7561   or (IdentifierNode.Parent=nil)
7562   or (IdentifierNode.Parent.Desc<>ctnClassInheritance)
7563   then
7564     RaiseException(20170421200245,'[TFindDeclarationTool.FindAncestorOfClass] '
7565       +' not an inheritance node');
7566   Result:=false;
7567 
7568   InheritanceNode:=IdentifierNode.Parent;
7569   ClassNode:=InheritanceNode.Parent;
7570 
7571   if IdentifierNode.Desc=ctnSpecialize then begin
7572     if (IdentifierNode.FirstChild=nil) then begin
7573       MoveCursorToCleanPos(IdentifierNode.StartPos);
7574       ReadNextAtom;
7575       if UpAtomIs('SPECIALIZE') then
7576         ReadNextAtom;
7577       RaiseStringExpectedButAtomFound(20170421200248,'class type');
7578     end;
7579     MoveCursorToCleanPos(IdentifierNode.FirstChild.StartPos);
7580   end else
7581     MoveCursorToCleanPos(IdentifierNode.StartPos);
7582   ReadNextAtom;
7583   AtomIsIdentifierE;
7584   AncestorStartPos:=CurPos.StartPos;
7585   ReadNextAtom;
7586 
7587   Params:=TFindDeclarationParams.Create(ResultParams);
7588   try
7589     Params.Flags:=fdfDefaultForExpressions;
7590     Params.ContextNode:=IdentifierNode;
7591     if CurPos.Flag=cafPoint then begin
7592       // complex identifier
7593       {$IFDEF ShowTriedContexts}
7594       DebugLn(['[TFindDeclarationTool.FindAncestorOfClass] ',
7595       ' search complex ancestor class = "',ExtractNode(IdentifierNode,[]),'" for class "',ExtractClassName(ClassNode,false),'"']);
7596       {$ENDIF}
7597       if not FindClassContext then
7598         Params.Flags:=Params.Flags+[fdfFindVariable];
7599       ExprType:=FindExpressionTypeOfTerm(IdentifierNode.StartPos,IdentifierNode.EndPos,Params,false);
7600       if ExprType.Desc<>xtContext then
7601         RaiseExpected('type');
7602       AncestorContext:=ExprType.Context
7603     end else begin
7604       // simple identifier
7605       {$IFDEF ShowTriedContexts}
7606       DebugLn('[TFindDeclarationTool.FindAncestorOfClass] ',
7607       ' search ancestor class="',GetIdentifier(@Src[AncestorStartPos]),'" for class "',ExtractClassName(ClassNode,false),'"');
7608       {$ENDIF}
7609       Params.SetIdentifier(Self,@Src[AncestorStartPos],nil);
7610       if not FindIdentifierInContext(Params) then
7611         exit;
7612       AncestorContext.Tool:=Params.NewCodeTool;
7613       AncestorContext.Node:=Params.NewNode;
7614     end;
7615   finally
7616     Params.Free;
7617   end;
7618 
7619   if FindClassContext then begin
7620     // search ancestor class context
7621     if (AncestorContext.Node.Desc in [ctnTypeDefinition,ctnGenericType]) then
7622     begin
7623       Params:=TFindDeclarationParams.Create;
7624       if IdentifierNode.Desc=ctnSpecialize then begin
7625          SpecializeNode:=IdentifierNode;
7626          Params.SetGenericParamValues(Self, SpecializeNode);
7627          if (ClassNode <> nil) then begin
7628            GenericParamsNode := nil;
7629            if (ClassNode.Parent <> nil)
7630            and (ClassNode.Parent.Desc = ctnGenericType) then
7631              GenericParamsNode:=ClassNode.Parent.FirstChild.NextBrother;
7632            ResultParams.UpdateGenericParamMapping(Self, SpecializeNode.FirstChild.NextBrother, GenericParamsNode);
7633          end;
7634       end;
7635       try
7636         Params.Flags:=fdfDefaultForExpressions+[fdfFindChildren];
7637         AncestorContext:=AncestorContext.Tool.FindBaseTypeOfNode(Params,AncestorContext.Node);
7638         ResultParams.GenParams:=Params.GenParams;
7639       finally
7640         Params.Free;
7641       end;
7642     end;
7643     // check result
7644     if not (AncestorContext.Node.Desc in AllClasses) then
7645       RaiseExpected('class');
7646     if AncestorContext.Node=ClassNode then begin
7647       MoveCursorToCleanPos(AncestorStartPos);
7648       ReadNextAtom;
7649       RaiseException(20170421200252,'cycle detected');
7650     end;
7651   end else begin
7652     // check if class identifier
7653     if (not (AncestorContext.Node.Desc in [ctnTypeDefinition,ctnGenericType])) then
7654       RaiseExpected('type');
7655   end;
7656 
7657   ResultParams.SetResult(AncestorContext);
7658   Result:=true;
7659 end;
7660 
FindAncestorsOfClassnull7661 function TFindDeclarationTool.FindAncestorsOfClass(ClassNode: TCodeTreeNode;
7662   var ListOfPFindContext: TFPList;
7663   Params: TFindDeclarationParams; FindClassContext: boolean;
7664   ExceptionOnNotFound: boolean): boolean;
7665 var
7666   Node: TCodeTreeNode;
7667   Context: TFindContext;
7668   InheritanceNode: TCodeTreeNode;
7669 begin
7670   Result:=false;
7671   InheritanceNode:=FindInheritanceNode(ClassNode);
7672   if (InheritanceNode=nil) then
7673     exit(true);
7674   Node:=InheritanceNode.FirstChild;
7675   if Node=nil then begin
7676     try
7677       if not FindAncestorOfClass(ClassNode,Params,FindClassContext) then begin
7678         exit(true); // this is TObject or IInterface, IUnknown
7679       end else begin
7680         Context:=CreateFindContext(Params);
7681       end;
7682       AddFindContext(ListOfPFindContext,Context);
7683       Result:=Context.Node<>nil;
7684     except
7685       if ExceptionOnNotFound then raise;
7686     end;
7687   end else begin
7688     while Node<>nil do begin
7689       try
7690         if FindAncestorOfClassInheritance(Node,Params,FindClassContext) then
7691         begin
7692           Context:=CreateFindContext(Params);
7693           AddFindContext(ListOfPFindContext,Context);
7694         end;
7695       except
7696         if ExceptionOnNotFound then raise;
7697       end;
7698       Node:=Node.NextBrother;
7699     end;
7700   end;
7701   Result:=true;
7702 end;
7703 
FindForwardIdentifiernull7704 function TFindDeclarationTool.FindForwardIdentifier(
7705   Params: TFindDeclarationParams; out IsForward: boolean): boolean;
7706 { first search the identifier in the normal way via FindIdentifierInContext
7707   then search the other direction }
7708 var
7709   OldInput: TFindDeclarationInput;
7710 begin
7711   Params.Save(OldInput);
7712   Exclude(Params.Flags,fdfExceptionOnNotFound);
7713   Result:=FindIdentifierInContext(Params);
7714   if not Result then begin
7715     Params.Load(OldInput,false);
7716     Params.Flags:=Params.Flags+[fdfSearchForward,fdfIgnoreCurContextNode];
7717     Result:=FindIdentifierInContext(Params);
7718     IsForward:=true;
7719   end else begin
7720     IsForward:=false;
7721   end;
7722   Params.Load(OldInput,true);
7723 end;
7724 
FindNonForwardClassnull7725 function TFindDeclarationTool.FindNonForwardClass(ForwardNode: TCodeTreeNode
7726   ): TCodeTreeNode;
7727 var
7728   Node: TCodeTreeNode;
7729   Identifier: PChar;
7730 begin
7731   Result:=nil;
7732   Node:=ForwardNode;
7733   if Node.Desc=ctnGenericType then begin
7734     Node:=Node.FirstChild;
7735     if Node=nil then exit;
7736   end else if Node.Desc<>ctnTypeDefinition then
7737     exit;
7738   Node:=Node.FirstChild;
7739   if Node=nil then
7740     Exit;
7741   Identifier:=@Src[Node.StartPos];
7742   if (Node=nil)
7743   or (not (Node.Desc in AllClasses))
7744   or ((ctnsForwardDeclaration and Node.SubDesc)=0) then
7745     exit;
7746   Node:=ForwardNode;
7747   repeat
7748     //DebugLn(['TFindDeclarationTool.FindNonForwardClass Node=',dbgstr(copy(Src,Node.StartPos,20))]);
7749     if Node.NextBrother<>nil then
7750       Node:=Node.NextBrother
7751     else if (Node.Parent=nil)
7752     or (not (Node.Parent.Desc in AllDefinitionSections)) then
7753       break
7754     else begin
7755       Node:=Node.Parent.NextBrother;
7756       while (Node<>nil)
7757       and ((Node.FirstChild=nil) or (not (Node.Desc in AllDefinitionSections)))
7758       do
7759         Node:=Node.NextBrother;
7760       if Node=nil then break;
7761       Node:=Node.FirstChild;
7762     end;
7763     if CompareSrcIdentifiers(Node.StartPos,Identifier) then begin
7764       Result:=Node;
7765       exit;
7766     end;
7767   until false;
7768 end;
7769 
FindNonForwardClassnull7770 function TFindDeclarationTool.FindNonForwardClass(Params: TFindDeclarationParams
7771   ): boolean;
7772 var
7773   Node: TCodeTreeNode;
7774 begin
7775   Node:=FindNonForwardClass(Params.NewNode);
7776   if Node<>nil then begin
7777     Params.SetResult(Self,Node,Node.StartPos);
7778     Result:=true;
7779   end else begin
7780     Result:=false;
7781   end;
7782 end;
7783 
FindIdentifierInWithVarContextnull7784 function TFindDeclarationTool.FindIdentifierInWithVarContext(
7785   WithVarNode: TCodeTreeNode; Params: TFindDeclarationParams): boolean;
7786 { this function is internally used by FindIdentifierInContext }
7787 var
7788   WithVarExpr: TExpressionType;
7789   OldInput: TFindDeclarationInput;
7790   OldExtractedOperand, NewExtractedOperand: string;
7791 begin
7792   {$IFDEF ShowExprEval}
7793   DebugLn('[TFindDeclarationTool.FindIdentifierInWithVarContext] Ident=',
7794   '"',GetIdentifier(Params.Identifier),'"',
7795   ' WithStart=',StringToPascalConst(copy(Src,WithVarNode.StartPos,15))
7796   );
7797   {$ENDIF}
7798   {$IFDEF CheckNodeTool}CheckNodeTool(WithVarNode);{$ENDIF}
7799   Result:=false;
7800   // find the base type of the with variable
7801   // move cursor to end of with-variable
7802   Params.Save(OldInput);
7803   Params.ContextNode:=WithVarNode;
7804   Params.Flags:=Params.Flags*fdfGlobals
7805                 +[fdfExceptionOnNotFound,fdfFunctionResult,fdfFindChildren];
7806   OldExtractedOperand:=Params.ExtractedOperand;
7807   WithVarExpr:=FindExpressionTypeOfTerm(WithVarNode.StartPos,-1,Params,true);
7808   if fdfExtractOperand in Params.Flags then
7809     NewExtractedOperand:=Params.ExtractedOperand+'.'
7810   else
7811     NewExtractedOperand:='';
7812   if (WithVarExpr.Desc<>xtContext)
7813   or (WithVarExpr.Context.Node=nil)
7814   or (WithVarExpr.Context.Node=OldInput.ContextNode)
7815   or (not (WithVarExpr.Context.Node.Desc in (AllClasses+[ctnEnumerationType])))
7816   then begin
7817     MoveCursorToCleanPos(WithVarNode.StartPos);
7818     RaiseException(20170421200254,ctsExprTypeMustBeClassOrRecord);
7819   end;
7820   // search identifier in 'with' context
7821   // Note: do not search in parent nodes (e.g. with ListBox1 do Items)
7822   Params.Load(OldInput,false);
7823   Params.Flags:=Params.Flags-[fdfExceptionOnNotFound,fdfSearchInParentNodes];
7824   Params.ContextNode:=WithVarExpr.Context.Node;
7825   Result:=WithVarExpr.Context.Tool.FindIdentifierInContext(Params);
7826   Params.Load(OldInput,true);
7827   if fdfExtractOperand in Params.Flags then
7828     if Result then
7829       Params.FExtractedOperand:=NewExtractedOperand
7830     else
7831       Params.FExtractedOperand:=OldExtractedOperand;
7832 end;
7833 
TFindDeclarationTool.FindIdentifierInAncestorsnull7834 function TFindDeclarationTool.FindIdentifierInAncestors(
7835   ClassNode: TCodeTreeNode; Params: TFindDeclarationParams;
7836   var IdentFoundResult: TIdentifierFoundResult): boolean;
7837 { this function is internally used by FindIdentifierInContext
7838   and FindBaseTypeOfNode
7839 }
7840 
Searchnull7841   function Search(AncestorTool: TFindDeclarationTool;
7842     AncestorClassNode: TCodeTreeNode): boolean;
7843   var
7844     OldFlags: TFindDeclarationFlags;
7845   begin
7846     OldFlags := Params.Flags;
7847     Params.ContextNode:=AncestorClassNode;
7848     Params.Flags:=Params.Flags
7849       -[fdfIgnoreCurContextNode,fdfSearchInParentNodes]
7850       +[fdfSearchInAncestors];
7851     Result:=AncestorTool.FindIdentifierInContext(Params,IdentFoundResult);
7852     Params.Flags := OldFlags;
7853   end;
7854 
7855 var
7856   InheritanceNode: TCodeTreeNode;
7857   Node: TCodeTreeNode;
7858   SearchDefaultAncestor: Boolean;
7859 begin
7860   Result:=false;
7861   {$IFDEF CheckNodeTool}CheckNodeTool(ClassNode);{$ENDIF}
7862 
7863   if not (fdfSearchInAncestors in Params.Flags) then exit;
7864 
7865   SearchDefaultAncestor:=true;
7866   InheritanceNode:=FindInheritanceNode(ClassNode);
7867   if (InheritanceNode<>nil) then begin
7868     Node:=InheritanceNode.FirstChild;
7869     while Node<>nil do begin
7870       if not FindAncestorOfClassInheritance(Node,Params,true) then exit;
7871       SearchDefaultAncestor:=false;
7872       if Search(Params.NewCodeTool,Params.NewNode) then exit(true);
7873       Node:=Node.NextBrother;
7874     end;
7875   end;
7876   //debugln(['TFindDeclarationTool.FindIdentifierInAncestors SearchDefaultAncestor=',SearchDefaultAncestor,' ',CleanPosToStr(ClassNode.StartPos,true)]);
7877   if SearchDefaultAncestor then begin
7878     if not FindDefaultAncestorOfClass(ClassNode,Params,true) then exit;
7879     //debugln(['TFindDeclarationTool.FindIdentifierInAncestors search in default ancestor ',FindContextToString(CreateFindContext(Params.NewCodeTool,Params.NewNode))]);
7880     Result:=Search(Params.NewCodeTool,Params.NewNode);
7881   end;
7882 end;
7883 
7884 {$IFDEF DebugPrefix}
7885 procedure TFindDeclarationTool.DecPrefix;
7886 begin
7887   DebugPrefix:=copy(DebugPrefix,1,length(DebugPrefix)-2);
7888 end;
7889 
7890 procedure TFindDeclarationTool.IncPrefix;
7891 begin
7892   DebugPrefix:=DebugPrefix+'  ';
7893 end;
7894 {$ENDIF}
7895 
FindExpressionResultTypenull7896 function TFindDeclarationTool.FindExpressionResultType(
7897   Params: TFindDeclarationParams; StartPos, EndPos: integer;
7898   AliasType: PFindContext): TExpressionType;
7899 {
7900 - operators
7901     - mixing ansistring and shortstring gives ansistring
7902     - Pointer +,- Pointer gives Pointer
7903     - Sets:
7904         [enum1] gives  set of enumeration type
7905         set *,-,+ set   gives set of same type
7906         set <>,=,<,> set  gives boolean
7907     - precedence rules table:
7908         1. brackets
7909         2. not @ sign
7910         3. * / div mod and shl shr as
7911         4. + - or xor
7912         5. < <> > <= >= in is
7913     - nil is compatible to pointers and classes
7914 
7915 
7916 - operator overloading?
7917 - internal types. e.g. string[], ansistring[], shortstring[], pchar[] to char
7918 - the type of a subrange is the type of the first constant/enum/number/char
7919 - predefined types:
7920     ordinal:
7921       int64, cardinal, QWord, boolean, bytebool, wordbool, qwordbool, longbool, char
7922 
7923     real:
7924       real, single, double, extended, cextended, comp, currency
7925 
7926 - predefined functions:
7927     function pred(ordinal type): ordinal constant of same type;
7928     function succ(ordinal type): ordinal constant of same type;
7929     function ord(ordinal type): ordinal type;
7930     val?
7931     function low(array): type of leftmost index type in the array;
7932     function high(array): type of leftmost index type in the array;
7933     procedure dec(ordinal var);
7934     procedure dec(ordinal var; ordinal type);
7935     procedure dec(pointer var);
7936     procedure dec(pointer var; ordinal type);
7937     procedure inc(ordinal var);
7938     procedure inc(ordinal var; ordinal type);
7939     procedure inc(pointer var);
7940     procedure inc(pointer var; ordinal type);
7941     procedure write(...);
7942     procedure writeln(...);
7943     function SizeOf(type): ordinal constant;
7944     typeinfo?
7945     uniquestring?
7946     procedure include(set type,enum identifier);
7947     procedure exclude(set type,enum identifier);
7948     function objcselector(string): sel;
7949 }
7950 type
7951   TOperandAndOperator = record
7952     Operand: TOperand;
7953     theOperator: TAtomPosition;
7954     OperatorLvl: integer;
7955   end;
7956   POperandAndOperator = ^TOperandAndOperator;
7957   TExprStack = array[0..4] of TOperandAndOperator;
7958 var
7959   CurExprType: TExpressionType;
7960   CurAliasType: PFindContext;
7961   AliasTypeStorage: TFindContext;
7962   ExprStack: TExprStack;
7963   StackPtr: integer;
7964 
7965   procedure ExecuteStack(Complete: boolean);
7966   { Executes the operand+operator stack
7967     Examples:
7968       Position Operand Operator
7969          0      AWord     *
7970          1      AByte     +
7971       Because * has higher predence than + the stack is executed:
7972       AWord*AByte gives an integer. New stack
7973       Position Operand Operator
7974          0      Integer   +
7975   }
7976   var
7977     NewOperand: TOperand;
7978     LastPos: TAtomPosition;
7979   begin
7980     if StackPtr<=0 then begin
7981       // only one element -> nothing to do
7982       exit;
7983     end;
7984     LastPos:=CurPos;
7985     {$IFDEF ShowExprEval}
7986     DebugLn('[TFindDeclarationTool.FindExpressionResultType.ExecuteStack] ',
7987       ' StackPtr=',dbgs(StackPtr),
7988       ' Lvl=',dbgs(ExprStack[StackPtr].OperatorLvl),
7989       ' Complete=',dbgs(Complete));
7990     {$ENDIF}
7991     while (StackPtr>0)
7992     and (Complete
7993      or (ExprStack[StackPtr-1].OperatorLvl<=ExprStack[StackPtr].OperatorLvl)) do
7994     begin
7995       // next operand has a higher or equal precedence
7996       // (lower is computed before higher)
7997       // -> calculate last two operands
7998       NewOperand:=CalculateBinaryOperator(ExprStack[StackPtr-1].Operand,
7999         ExprStack[StackPtr].Operand,ExprStack[StackPtr-1].theOperator,
8000         Params);
8001       // put result on stack
8002       ExprStack[StackPtr-1]:=ExprStack[StackPtr];
8003 
8004       dec(StackPtr);
8005       ExprStack[StackPtr].Operand:=NewOperand;
8006     end;
8007     MoveCursorToAtomPos(LastPos);
8008   end;
8009 
8010   procedure RaiseBinaryOperatorNotFound;
8011   begin
8012     RaiseExceptionFmt(20170421200256,ctsStrExpectedButAtomFound,[ctsBinaryOperator,GetAtom]);
8013   end;
8014 
8015   procedure RaiseInternalError;
8016   begin
8017     RaiseException(20170421200300,'[TFindDeclarationTool.FindExpressionResultType]'
8018       +' internal error: unknown precedence lvl for operator '+GetAtom);
8019   end;
8020 
8021   procedure RaiseInternalErrorStack;
8022   begin
8023     RaiseException(20170421200303,'[TFindDeclarationTool.FindExpressionResultType]'
8024       +' internal error: stackptr too big ');
8025   end;
8026 
8027 var
8028   OldFlags: TFindDeclarationFlags;
8029   StackEntry: POperandAndOperator;
8030   IsEnd, IsBinOpError: Boolean;
8031 begin
8032   {$IFDEF ShowExprEval}
8033   DebugLn(['[TFindDeclarationTool.FindExpressionResultType] Start',
8034   ' Pos=',StartPos,'-',EndPos,
8035   '="',dbgstr(Src,StartPos,EndPos-StartPos),'" Context=',Params.ContextNode.DescAsString,' Alias=',AliasType<>nil]);
8036   {$ENDIF}
8037   Result:=CleanExpressionType;
8038   if (AliasType<>nil) and (AliasType^.Node=nil) then begin
8039     AliasTypeStorage:=CleanFindContext;
8040     CurAliasType:=@AliasTypeStorage;
8041   end else
8042     CurAliasType:=nil;
8043   OldFlags:=Params.Flags;
8044   Exclude(Params.Flags,fdfFindVariable);
8045   // read the expression from left to right and calculate the type
8046   StackPtr:=-1;
8047   MoveCursorToCleanPos(StartPos);
8048   repeat
8049     // read operand
8050     CurExprType:=ReadOperandTypeAtCursor(Params,EndPos,CurAliasType);
8051     {$IFDEF ShowExprEval}
8052     DebugLn(['[TFindDeclarationTool.FindExpressionResultType] Operand: ',
8053       ExprTypeToString(CurExprType),' Alias=',FindContextToString(CurAliasType)]);
8054     {$ENDIF}
8055     // put operand on stack
8056     inc(StackPtr);
8057     if StackPtr>High(ExprStack) then
8058       RaiseInternalErrorStack;
8059     StackEntry:=@ExprStack[StackPtr];
8060     StackEntry^.Operand.Expr:=CurExprType;
8061     if CurAliasType<>nil then
8062       StackEntry^.Operand.AliasType:=CurAliasType^
8063     else
8064       StackEntry^.Operand.AliasType:=CleanFindContext;
8065     StackEntry^.theOperator.StartPos:=-1;
8066     StackEntry^.OperatorLvl:=5;
8067     // read operator
8068     ReadNextAtom;
8069     {$IFDEF ShowExprEval}
8070     DebugLn('[TFindDeclarationTool.FindExpressionResultType] Operator: ',
8071       GetAtom,' CurPos.EndPos=',dbgs(CurPos.EndPos),' EndPos=',dbgs(EndPos));
8072     {$ENDIF}
8073     IsEnd := (CurPos.EndPos>EndPos) or (CurExprType.Desc=xtNone);
8074     if not IsEnd then
8075       IsBinOpError := not WordIsBinaryOperator.DoItCaseInsensitive(Src,CurPos.StartPos,
8076         CurPos.EndPos-CurPos.StartPos)
8077     else
8078       IsBinOpError := False;
8079     // check if expression is completely parsed
8080     if IsEnd or (IsBinOpError and (fdfIgnoreOperatorError in Params.Flags)) then
8081     begin
8082       // -> execute complete stack
8083       ExecuteStack(true);
8084       Result:=ExprStack[StackPtr].Operand.Expr;
8085       if CurAliasType<>nil then
8086         AliasType^:=ExprStack[StackPtr].Operand.AliasType;
8087       Params.Flags:=OldFlags;
8088       exit;
8089     end;
8090     if IsBinOpError then
8091       RaiseBinaryOperatorNotFound;
8092     // put operator on stack
8093     ExprStack[StackPtr].theOperator:=CurPos;
8094     // find operator precendence level
8095     if WordIsLvl1Operator.DoItCaseInsensitive(Src,CurPos.StartPos,
8096             CurPos.EndPos-CurPos.StartPos)
8097     then
8098       ExprStack[StackPtr].OperatorLvl:=1
8099     else if WordIsLvl2Operator.DoItCaseInsensitive(Src,CurPos.StartPos,
8100             CurPos.EndPos-CurPos.StartPos)
8101     then
8102       ExprStack[StackPtr].OperatorLvl:=2
8103     else if WordIsLvl3Operator.DoItCaseInsensitive(Src,CurPos.StartPos,
8104             CurPos.EndPos-CurPos.StartPos)
8105     then
8106       ExprStack[StackPtr].OperatorLvl:=3
8107     else if WordIsLvl4Operator.DoItCaseInsensitive(Src,CurPos.StartPos,
8108             CurPos.EndPos-CurPos.StartPos)
8109     then
8110       ExprStack[StackPtr].OperatorLvl:=4
8111     else
8112       RaiseInternalError;
8113     // execute stack if possible
8114     ExecuteStack(false);
8115     // move cursor to next atom (= next operand start)
8116     ReadNextAtom;
8117   until false;
8118 end;
8119 
TFindDeclarationTool.FindIdentifierInUsesSectionnull8120 function TFindDeclarationTool.FindIdentifierInUsesSection(
8121   UsesNode: TCodeTreeNode; Params: TFindDeclarationParams;
8122   FindMissingFPCUnits: Boolean): boolean;
8123 { this function is internally used by FindIdentifierInContext
8124 
8125    search backwards through the uses section
8126    compare first all unit names, then load the units and search there
8127 }
8128 var
8129   NewCodeTool: TFindDeclarationTool;
8130   OldFlags: TFindDeclarationFlags;
8131   Node: TCodeTreeNode;
8132   CollectResult: TIdentifierFoundResult;
8133   MissingUnit: TCodeTreeNode;
8134 
8135   procedure RaiseUnitNotFound;
8136   var
8137     AnUnitName: String;
8138     InFilename: String;
8139   begin
8140     AnUnitName:=ExtractUsedUnitName(MissingUnit,@InFilename);
8141     RaiseExceptionInstance(
8142       ECodeToolUnitNotFound.Create(Self,20170421200312,
8143         Format(ctsUnitNotFound,[AnUnitName]),InFilename));
8144   end;
8145 
8146 var
8147   AnUnitName: string;
8148   InFilename: string;
8149 begin
8150   {$IFDEF CheckNodeTool}CheckNodeTool(UsesNode);{$ENDIF}
8151   {$IFDEF ShowTriedParentContexts}
8152   DebugLn(['TFindDeclarationTool.FindIdentifierInUsesSection ',MainFilename,' fdfIgnoreUsedUnits=',fdfIgnoreUsedUnits in Params.Flags]);
8153   {$ENDIF}
8154   Result:=false;
8155   // first search the identifier in the uses section (not in the interfaces of the units)
8156   if (Params.IdentifierTool=Self) then begin
8157     Node:=UsesNode.LastChild;
8158     while Node<>nil do begin
8159       if (fdfCollect in Params.Flags) then begin
8160         CollectResult:=DoOnIdentifierFound(Params,Node.FirstChild);
8161         if CollectResult=ifrAbortSearch then begin
8162           Result:=false;
8163           exit;
8164         end else if CollectResult=ifrSuccess then begin
8165           Result:=true;
8166           Params.SetResult(Self,Node.FirstChild);
8167           exit;
8168         end;
8169       end else if CompareSrcIdentifiers(Node.StartPos,Params.Identifier) then begin
8170         // the searched identifier was a uses AUnitName, point to the identifier in
8171         // the uses section
8172         // if the unit name has a namespace defined point to the namespace
8173         Params.SetResult(Self,Node.FirstChild);
8174         Result:=true;
8175         exit;
8176       end;
8177       Node:=Node.PriorBrother;
8178     end;
8179   end;
8180 
8181   if not (fdfIgnoreUsedUnits in Params.Flags) then begin
8182     MissingUnit:=nil;
8183     // search in units
8184     Node:=UsesNode.LastChild;
8185     while Node<>nil do begin
8186       AnUnitName:=ExtractUsedUnitName(Node,@InFilename);
8187       if AnUnitName<>'' then begin
8188         NewCodeTool:=FindCodeToolForUsedUnit(AnUnitName,InFilename,false);
8189         if NewCodeTool<>nil then begin
8190           // search the identifier in the interface of the used unit
8191           OldFlags:=Params.Flags;
8192           Params.Flags:=[fdfIgnoreUsedUnits]+(fdfGlobalsSameIdent*Params.Flags)
8193                        -[fdfExceptionOnNotFound];
8194           Result:=NewCodeTool.FindIdentifierInInterface(Self,Params);
8195           Params.Flags:=OldFlags;
8196           if Result and Params.IsFoundProcFinal then exit;
8197         end else if MissingUnit=nil then begin
8198           MissingUnit:=Node;
8199         end;
8200         {$IFDEF ShowTriedParentContexts}
8201         DebugLn(['TFindDeclarationTool.FindIdentifierInUsesSection ',AnUnitName,' Result=',Result]);
8202         {$ENDIF}
8203       end;
8204       Node:=Node.PriorBrother;
8205     end;
8206 
8207     if (not Result) and (MissingUnit<>nil) then begin
8208       // identifier not found and there is a missing unit
8209       if FindMissingFPCUnits and Assigned(FOnRescanFPCDirectoryCache) then
8210       begin
8211         AnUnitName := LowerCase(AnUnitName);
8212         if FFindMissingFPCUnits=nil then
8213           FFindMissingFPCUnits := TFindIdentifierInUsesSection_FindMissingFPCUnit.Create;
8214         if not FFindMissingFPCUnits.IsInResults(AnUnitName) // don't rescan twice
8215         and FFindMissingFPCUnits.Find(AnUnitName, DirectoryCache) then
8216         begin
8217           FOnRescanFPCDirectoryCache(Self);
8218           Result := FindIdentifierInUsesSection(UsesNode, Params, False);
8219         end else
8220           RaiseUnitNotFound;
8221       end else
8222         RaiseUnitNotFound;
8223     end;
8224   end;
8225 end;
8226 
FindCodeToolForUsedUnitnull8227 function TFindDeclarationTool.FindCodeToolForUsedUnit(const AnUnitName,
8228   AnUnitInFilename: string; ExceptionOnNotFound: boolean): TFindDeclarationTool;
8229 var
8230   NewCode: TCodeBuffer;
8231 begin
8232   Result:=nil;
8233   NewCode:=FindUnitSource(AnUnitName,AnUnitInFilename,ExceptionOnNotFound);
8234   if (NewCode=nil) then begin
8235     // no source found
8236     if ExceptionOnNotFound then
8237       RaiseException(20170421200315,'unit '+AnUnitName+' not found');
8238   end else begin
8239     // source found -> get codetool for it
8240     {$IF defined(ShowTriedFiles) or defined(ShowTriedUnits)}
8241     DebugLn('[TFindDeclarationTool.FindCodeToolForUsedUnit] ',
8242     ' This source is=',TCodeBuffer(Scanner.MainCode).Filename,
8243     ' NewCode=',NewCode.Filename);
8244     {$ENDIF}
8245     if Assigned(FOnGetCodeToolForBuffer) then
8246       Result:=FOnGetCodeToolForBuffer(Self,NewCode,false)
8247     else if NewCode=TCodeBuffer(Scanner.MainCode) then
8248       Result:=Self;
8249   end;
8250 end;
8251 
FindIdentifierInInterfacenull8252 function TFindDeclarationTool.FindIdentifierInInterface(
8253   AskingTool: TFindDeclarationTool; Params: TFindDeclarationParams): boolean;
8254 
8255   function CheckEntry(Entry: PInterfaceIdentCacheEntry): TIdentifierFoundResult;
8256   begin
8257     while Entry<>nil do begin
8258       Params.SetResult(Self,Entry^.Node,Entry^.CleanPos);
8259       Result:=DoOnIdentifierFound(Params,Params.NewNode);
8260       if Result in [ifrSuccess,ifrAbortSearch] then
8261         exit;
8262       // proceed
8263       Entry:=Entry^.Overloaded;
8264     end;
8265     Result:=ifrProceedSearch;
8266   end;
8267 
8268 var
8269   CacheEntry: PInterfaceIdentCacheEntry;
8270   AVLNode: TAVLTreeNode;
8271 begin
8272   Result:=false;
8273   // build code tree
8274   {$IFDEF ShowTriedContexts}
8275   DebugLn({$IFDEF DebugPrefix}DebugPrefix,{$ENDIF}
8276   'TFindDeclarationTool.FindIdentifierInInterface',
8277   ' Ident="',GetIdentifier(Params.Identifier),'"',
8278   ' IgnoreUsedUnits=',dbgs(fdfIgnoreUsedUnits in Params.Flags),
8279   ' Self=',TCodeBuffer(Scanner.MainCode).Filename
8280   );
8281   {$ENDIF}
8282 
8283   // ToDo: build codetree for ppu, dcu files
8284 
8285   // build tree for pascal source
8286   if not BuildInterfaceIdentifierCache(true) then exit(false);
8287   if (AskingTool<>Self) and (AskingTool<>nil) then
8288     AskingTool.AddToolDependency(Self);
8289   // search identifier in cache
8290   if fdfCollect in Params.Flags then begin
8291     AVLNode:=FInterfaceIdentifierCache.Items.FindLowest;
8292     while AVLNode<>nil do begin
8293       CacheEntry:=PInterfaceIdentCacheEntry(AVLNode.Data);
8294       //DebugLn(['TFindDeclarationTool.FindIdentifierInInterface ',CacheEntry^.Identifier]);
8295       case CheckEntry(CacheEntry) of
8296       ifrSuccess: exit(true);
8297       ifrAbortSearch: exit(false);
8298       end;
8299       AVLNode:=FInterfaceIdentifierCache.Items.FindSuccessor(AVLNode);
8300     end;
8301   end else begin
8302     CacheEntry:=FInterfaceIdentifierCache.FindIdentifier(Params.Identifier);
8303     if CacheEntry=nil then
8304       exit(false);
8305     case CheckEntry(CacheEntry) of
8306     ifrSuccess: exit(true);
8307     ifrAbortSearch: exit(false);
8308     end;
8309   end;
8310 
8311   // proceed search
8312   Result:=false;
8313 end;
8314 
BuildInterfaceIdentifierCachenull8315 function TFindDeclarationTool.BuildInterfaceIdentifierCache(
8316   ExceptionOnNotUnit: boolean): boolean;
8317 
8318   procedure ScanForEnums(ParentNode: TCodeTreeNode);
8319   var
8320     Node: TCodeTreeNode;
8321   begin
8322     Node:=ParentNode.FirstChild;
8323     if (Node=nil) or (Scanner.GetDirectiveValueAt(sdScopedEnums, Node.StartPos) = '1') then
8324       Exit;
8325     while Node<>nil do begin
8326       if Node.Desc=ctnEnumIdentifier then
8327         FInterfaceIdentifierCache.Add(@Src[Node.StartPos],Node,Node.StartPos);
8328       if Node.FirstChild<>nil then
8329         Node:=Node.FirstChild
8330       else begin
8331         while Node.NextBrother=nil do begin
8332           Node:=Node.Parent;
8333           if Node=ParentNode then exit;
8334         end;
8335         Node:=Node.NextBrother;
8336       end;
8337     end;
8338   end;
8339 
8340   procedure ScanChildren(ParentNode: TCodeTreeNode); forward;
8341 
8342   procedure ScanNode(Node: TCodeTreeNode);
8343   var
8344     FirstChild: TCodeTreeNode;
8345   begin
8346     case Node.Desc of
8347     ctnTypeSection,ctnConstSection,ctnVarSection,ctnResStrSection,ctnPropertySection:
8348       ScanChildren(Node);
8349     ctnVarDefinition,ctnConstDefinition,ctnTypeDefinition,ctnGlobalProperty:
8350       begin
8351         FInterfaceIdentifierCache.Add(@Src[Node.StartPos],Node,Node.StartPos);
8352         ScanForEnums(Node);
8353         FirstChild:=Node.FirstChild;
8354         if (Node.Desc = ctnTypeDefinition) and (FirstChild<>nil) then begin
8355           case FirstChild.Desc of
8356           ctnClassHelper, ctnRecordHelper, ctnTypeHelper:
8357             FInterfaceHelperCache[fdhlkDelphiHelper].AddFromHelperNode(FirstChild, Self,
8358               True{ use last found helper}
8359               );
8360           ctnObjCCategory:
8361             FInterfaceHelperCache[fdhlkObjCCategory].AddFromHelperNode(FirstChild, Self, false);
8362           end;
8363         end;
8364       end;
8365     ctnGenericType:
8366       if Node.FirstChild<>nil then begin
8367         FInterfaceIdentifierCache.Add(@Src[Node.FirstChild.StartPos],Node,Node.StartPos);
8368         ScanForEnums(Node);
8369       end;
8370     ctnProperty:
8371       begin
8372         MoveCursorToPropName(Node);
8373         FInterfaceIdentifierCache.Add(@Src[CurPos.StartPos],Node,Node.StartPos);
8374       end;
8375     ctnProcedure:
8376       if (Node.FirstChild<>nil) and (not NodeIsOperator(Node)) then
8377         FInterfaceIdentifierCache.Add(@Src[Node.FirstChild.StartPos],Node,
8378                                       Node.FirstChild.StartPos);
8379     end;
8380   end;
8381 
8382   procedure ScanChildren(ParentNode: TCodeTreeNode);
8383   var
8384     Node: TCodeTreeNode;
8385   begin
8386     Node:=ParentNode.FirstChild;
8387     while Node<>nil do begin
8388       ScanNode(Node);
8389       Node:=Node.NextBrother;
8390     end;
8391   end;
8392 
8393 var
8394   InterfaceNode: TCodeTreeNode;
8395   Node: TCodeTreeNode;
8396   HelperKind: TFDHelpersListKind;
8397 begin
8398   // build tree for pascal source
8399   //debugln(['TFindDeclarationTool.BuildInterfaceIdentifierCache BEFORE ',MainFilename]);
8400   BuildTree(lsrImplementationStart);
8401   //debugln(['TFindDeclarationTool.BuildInterfaceIdentifierCache AFTER ',MainFilename]);
8402   if Tree.Root=nil then exit(false);
8403 
8404   // search interface section
8405   InterfaceNode:=FindInterfaceNode;
8406   if InterfaceNode=nil then begin
8407     // check source type
8408     if ExceptionOnNotUnit then begin
8409       MoveCursorToNodeStart(Tree.Root);
8410       ReadNextAtom; // read keyword for source type, e.g. 'unit'
8411       if not UpAtomIs('UNIT') then
8412         RaiseException(20170421200317,ctsSourceIsNotUnit);
8413       RaiseException(20170421200319,ctsInterfaceSectionNotFound);
8414     end;
8415   end;
8416 
8417   // create tree
8418   if (FInterfaceIdentifierCache<>nil) and FInterfaceIdentifierCache.Complete then
8419     exit(true);
8420 
8421   if FInterfaceIdentifierCache=nil then
8422     FInterfaceIdentifierCache:=TInterfaceIdentifierCache.Create(Self)
8423   else
8424     FInterfaceIdentifierCache.Clear;
8425   FInterfaceIdentifierCache.Complete:=true;
8426   for HelperKind in TFDHelpersListKind do
8427     if FInterfaceHelperCache[HelperKind]=nil then
8428       FInterfaceHelperCache[HelperKind]:=TFDHelpersList.Create(HelperKind)
8429     else
8430       FInterfaceHelperCache[HelperKind].Clear;
8431 
8432   // add unit node
8433   MoveCursorToNodeStart(Tree.Root);
8434   ReadNextAtom; // keyword unit
8435   ReadNextAtom;
8436   FInterfaceIdentifierCache.Add(@Src[CurPos.StartPos],Tree.Root,CurPos.StartPos);
8437 
8438   // create nodes
8439   if InterfaceNode<>nil then
8440     // scan interface
8441     ScanChildren(InterfaceNode)
8442   else begin
8443     // scan program
8444     Node:=Tree.Root;
8445     while Node<>nil do begin
8446       ScanNode(Node);
8447       Node:=Node.NextBrother;
8448     end;
8449   end;
8450 
8451   //DebugLn(['TFindDeclarationTool.BuildInterfaceIdentifierCache ',MainFilename,' ',FInterfaceIdentifierCache.Items.Count,' ',GlobalIdentifierTree.Count]);
8452   Result:=true;
8453 end;
8454 
CompareNodeIdentifiernull8455 function TFindDeclarationTool.CompareNodeIdentifier(Node: TCodeTreeNode;
8456   Params: TFindDeclarationParams): boolean;
8457 begin
8458   {$IFDEF CheckNodeTool}CheckNodeTool(Node);{$ENDIF}
8459   Result:=false;
8460   if Node=nil then exit;
8461   if Node.Desc in AllSourceTypes then begin
8462     MoveCursorToNodeStart(Node);
8463     ReadNextAtom;
8464     if (Node.Desc=ctnProgram) and not UpAtomIs('PROGRAM') then exit;
8465     ReadNextAtom;
8466     Result:=CompareSrcIdentifiers(CurPos.StartPos,Params.Identifier);
8467   end else if (Node.Desc in AllSimpleIdentifierDefinitions)
8468   or (Node.Desc in [ctnIdentifier,ctnGenericName]) then begin
8469     Result:=CompareSrcIdentifiers(Node.StartPos,Params.Identifier);
8470   end else if Node.Desc=ctnGenericType then begin
8471     if Node.FirstChild<>nil then
8472       Result:=CompareSrcIdentifiers(Node.FirstChild.StartPos,Params.Identifier);
8473   end;
8474 end;
8475 
GetInterfaceNodenull8476 function TFindDeclarationTool.GetInterfaceNode: TCodeTreeNode;
8477 begin
8478   Result:=Tree.Root;
8479   if Result=nil then begin
8480     CurPos.StartPos:=-1;
8481     RaiseException(20170421200323,'[TFindDeclarationTool.GetInterfaceNode] no code tree found');
8482   end;
8483   if not (Tree.Root.Desc in AllUsableSourceTypes) then begin
8484     CurPos.StartPos:=-1;
8485     RaiseException(20170421200325,ctsUsedUnitIsNotAPascalUnit);
8486   end;
8487   Result:=FindInterfaceNode;
8488   if Result=nil then begin
8489     CurPos.StartPos:=-1;
8490     RaiseException(20170421200327,ctsInterfaceSectionNotFound);
8491   end;
8492 end;
8493 
FindIdentifierInUsedUnitnull8494 function TFindDeclarationTool.FindIdentifierInUsedUnit(
8495   const AnUnitName: string; Params: TFindDeclarationParams; ErrorPos: integer
8496   ): boolean;
8497 { Note: this function is internally used by FindIdentifierInHiddenUsedUnits
8498   for hidden used units, like the system unit or the objpas unit
8499 }
8500 var
8501   NewCode: TCodeBuffer;
8502   NewCodeTool: TFindDeclarationTool;
8503   OldFlags: TFindDeclarationFlags;
8504 begin
8505   Result:=false;
8506   // open the unit and search the identifier in the interface
8507   NewCode:=FindUnitSource(AnUnitName,'',true,ErrorPos);
8508   if NewCode=TCodeBuffer(Scanner.MainCode) then begin
8509     // Searching again in hidden unit
8510     DebugLn('WARNING: Searching again in hidden unit: "',NewCode.Filename,'" identifier=',GetIdentifier(Params.Identifier));
8511     NewCodeTool:=Self;
8512     MoveCursorToCleanPos(ErrorPos);
8513     RaiseExceptionFmt(20170421200330,ctsIllegalCircleInUsedUnits,[AnUnitName]);
8514   end else begin
8515     // source found -> get codetool for it
8516     {$IF defined(ShowTriedContexts) or defined(ShowTriedUnits)}
8517     DebugLn('[TFindDeclarationTool.FindIdentifierInUsedUnit] ',
8518     ' This source is=',TCodeBuffer(Scanner.MainCode).Filename,
8519     ' NewCode=',NewCode.Filename,' IgnoreUsedUnits=',dbgs(fdfIgnoreUsedUnits in Params.Flags));
8520     {$ENDIF}
8521     NewCodeTool:=nil;
8522     if not Assigned(FOnGetCodeToolForBuffer) then begin
8523       MoveCursorToCleanPos(ErrorPos);
8524       RaiseExceptionFmt(20170421200333,
8525         'Unable to create codetool for "%s", need OnGetCodeToolForBuffer',
8526           [NewCode.Filename]);
8527     end;
8528     NewCodeTool:=FOnGetCodeToolForBuffer(Self,NewCode,false);
8529     if NewCodeTool=nil then begin
8530       MoveCursorToCleanPos(ErrorPos);
8531       RaiseExceptionFmt(20170421200346,'Unable to create codetool for "%s"',[NewCode.Filename]);
8532     end;
8533     // search the identifier in the interface of the used unit
8534     OldFlags:=Params.Flags;
8535     Params.Flags:=[fdfIgnoreUsedUnits]+(fdfGlobalsSameIdent*Params.Flags)
8536                  -[fdfExceptionOnNotFound];
8537     Result:=NewCodeTool.FindIdentifierInInterface(Self,Params);
8538     Params.Flags:=OldFlags;
8539   end;
8540 end;
8541 
FindIdentifierInTypeOfConstantnull8542 function TFindDeclarationTool.FindIdentifierInTypeOfConstant(
8543   VarConstNode: TCodeTreeNode; Params: TFindDeclarationParams): boolean;
8544 { const a: atype = context;
8545   for example:  const p: TPoint = (x:0; y:0);
8546 }
8547 var
8548   TypeNode: TCodeTreeNode;
8549   ExprType: TExpressionType;
8550   TypeParams: TFindDeclarationParams;
8551   OldInput: TFindDeclarationInput;
8552 begin
8553   Result:=false;
8554   //debugln(['TFindDeclarationTool.FindIdentifierInTypeOfConstant ',VarConstNode.DescAsString]);
8555   TypeNode:=VarConstNode.FirstChild;
8556   if TypeNode=nil then exit;
8557   if TypeNode.Desc=ctnIdentifier then begin
8558     // resolve type
8559     //debugln(['TFindDeclarationTool.FindIdentifierInTypeOfConstant ']);
8560     TypeParams:=TFindDeclarationParams.Create(Params);
8561     try
8562       TypeParams.ContextNode:=TypeNode;
8563       TypeParams.SetIdentifier(Self,nil,nil);
8564       TypeParams.Flags:=fdfDefaultForExpressions;
8565       ExprType:=FindExpressionTypeOfTerm(TypeNode.StartPos,-1,TypeParams,false);
8566       //debugln(['TFindDeclarationTool.FindIdentifierInTypeOfConstant ExprType=',ExprTypeToString(ExprType)]);
8567     finally
8568       TypeParams.Free;
8569     end;
8570     if ExprType.Desc=xtContext then begin
8571       if ExprType.Context.Node.Parent=nil then exit;
8572       if not (ExprType.Context.Node.Parent.Desc in [ctnTypeDefinition,ctnGenericType])
8573       then
8574         exit;
8575       // search identifier in type
8576       Params.Save(OldInput);
8577       Params.ContextNode:=ExprType.Context.Node;
8578       Params.Flags:=Params.Flags-[fdfIgnoreCurContextNode,fdfSearchInParentNodes];
8579       Result:=ExprType.Context.Tool.FindIdentifierInContext(Params);
8580       Params.Load(OldInput,true);
8581     end;
8582   end;
8583 end;
8584 
8585 procedure TFindDeclarationTool.RaiseUsesExpected(id: int64);
8586 begin
8587   RaiseExceptionFmt(id,ctsStrExpectedButAtomFound,['"uses"',GetAtom]);
8588 end;
8589 
8590 procedure TFindDeclarationTool.RaiseStrConstExpected(id: int64);
8591 begin
8592   RaiseExceptionFmt(id,ctsStrExpectedButAtomFound,[ctsStringConstant,GetAtom]);
8593 end;
8594 
8595 procedure TFindDeclarationTool.BeginParsing(Range: TLinkScannerRange);
8596 begin
8597   // scan code and init parser
8598   inherited BeginParsing(Range);
8599 
8600   // now the scanner knows, which compiler mode is needed
8601   // -> setup compiler dependent tables
8602   case Scanner.PascalCompiler of
8603   pcDelphi: WordIsPredefinedIdentifier:=WordIsPredefinedDelphiIdentifier;
8604   pcPas2js: WordIsPredefinedIdentifier:=WordIsPredefinedPas2jsIdentifier;
8605   else
8606     WordIsPredefinedIdentifier:=WordIsPredefinedFPCIdentifier;
8607   end;
8608 end;
8609 
FindIdentifierInHiddenUsedUnitsnull8610 function TFindDeclarationTool.FindIdentifierInHiddenUsedUnits(
8611   Params: TFindDeclarationParams): boolean;
8612 var
8613   HiddenUnits: String;
8614   p: Integer;
8615   AnUnitName: String;
8616 begin
8617   Result:=false;
8618   {$IFDEF ShowTriedContexts}
8619   DebugLn('[TFindDeclarationTool.FindIdentifierInHiddenUsedUnits] ',
8620   '"',GetIdentifier(Params.Identifier),'" IgnoreUsedUnits=',dbgs(fdfIgnoreUsedUnits in Params.Flags));
8621   {$ENDIF}
8622   if (Tree.Root<>nil) and (not (fdfIgnoreUsedUnits in Params.Flags)) then begin
8623     HiddenUnits:=Scanner.GetHiddenUsedUnits;
8624     {$IFDEF ShowTriedContexts}
8625     debugln(['TFindDeclarationTool.FindIdentifierInHiddenUsedUnits Identifier=',GetIdentifier(Params.Identifier),' ',Scanner.MainFilename,' SourceName=',Scanner.SourceName,' HiddenUnits=',HiddenUnits]);
8626     {$ENDIF}
8627     p:=length(HiddenUnits);
8628     while p>=1 do begin
8629       while (p>1) and (HiddenUnits[p-1]<>',') do dec(p);
8630       AnUnitName:=GetDottedIdentifier(@HiddenUnits[p]);
8631       if AnUnitName<>'' then begin
8632         // try hidden used unit
8633         Result:=FindIdentifierInUsedUnit(AnUnitName,Params,0);
8634         if Result and Params.IsFoundProcFinal then exit;
8635       end;
8636       dec(p);
8637     end;
8638   end;
8639 end;
8640 
FindEndOfTermnull8641 function TFindDeclarationTool.FindEndOfTerm(
8642   StartPos: integer; ExceptionIfNoVariableStart, WithAsOperator: boolean
8643   ): integer;
8644 { ExceptionIfNoVariableStart: if false allow starting in the middle of a term
8645 
8646   a variable can have the form:
8647     A
8648     A.B()^.C()[]^^.D
8649     (A).B
8650     inherited A
8651     A as B
8652 }
8653   procedure RaiseIdentNotFound;
8654   begin
8655     RaiseExceptionFmt(20170421200525,ctsIdentExpectedButAtomFound,[GetAtom]);
8656   end;
8657 
8658 var
8659   FirstIdentifier: boolean;
8660 
8661   procedure StartVar;
8662   begin
8663     ReadNextAtom;
8664     if UpAtomIs('INHERITED') then
8665       ReadNextAtom;
8666     if UpAtomIs('ARRAY') then
8667     begin
8668       ReadNextAtom;
8669       if UpAtomIs('OF') then
8670         ReadNextAtom;
8671     end;
8672     FirstIdentifier:=true;
8673     if not (CurPos.Flag in AllCommonAtomWords) then exit;
8674     AtomIsIdentifierE;
8675     FirstIdentifier:=false;
8676     ReadNextAtom;
8677   end;
8678 
8679 begin
8680   MoveCursorToCleanPos(StartPos);
8681   StartVar;
8682   repeat
8683     case CurPos.Flag of
8684     cafRoundBracketOpen:
8685       begin
8686         ReadTilBracketClose(true);
8687         FirstIdentifier:=false;
8688       end;
8689 
8690     cafPoint:
8691       begin
8692         if FirstIdentifier and ExceptionIfNoVariableStart then
8693           RaiseIdentNotFound;
8694         ReadNextAtom;
8695         AtomIsIdentifierE;
8696       end;
8697 
8698     cafEdgedBracketOpen:
8699       begin
8700         if FirstIdentifier and ExceptionIfNoVariableStart then
8701           RaiseIdentNotFound;
8702         ReadTilBracketClose(true);
8703       end;
8704 
8705     else
8706       if AtomIsChar('^') then begin
8707         if FirstIdentifier and ExceptionIfNoVariableStart then
8708           RaiseIdentNotFound;
8709       end else if UpAtomIs('AS') then begin
8710         if not WithAsOperator then
8711           break;
8712         StartVar;
8713         UndoReadNextAtom;
8714       end else
8715         break;
8716     end;
8717     ReadNextAtom;
8718   until false;
8719   if LastAtoms.HasPrior then
8720     UndoReadNextAtom
8721   else
8722     MoveCursorToCleanPos(StartPos);
8723   Result:=CurPos.EndPos;
8724 end;
8725 
FindStartOfTermnull8726 function TFindDeclarationTool.FindStartOfTerm(EndPos: integer; InType: boolean
8727   ): integer;
8728 { a variable can be combinations of
8729   1. A.B
8730   2. A().B
8731   3. inherited A
8732   4. A[].
8733   5. A[].B
8734   6. A^.
8735   7. (A).
8736   8. (A as B)
8737   9. (@A)
8738   10. A()[]
8739   11. nothing (e.g. cursor behind semicolon, keyword or closing bracket)
8740   12. 'A'.B  (constant.B, type helpers)
8741 }
8742   procedure RaiseIdentNotFound;
8743   begin
8744     RaiseExceptionFmt(20170421200528,ctsIdentExpectedButAtomFound,[GetAtom]);
8745   end;
8746 
8747 var CurAtom, NextAtom: TAtomPosition;
8748   NextAtomType, CurAtomType: TVariableAtomType;
8749   StartPos: LongInt;
8750   CurIsValue, NextIsValue: Boolean;
8751 begin
8752   StartPos:=FindStartOfAtom(Src,EndPos);
8753   MoveCursorToCleanPos(StartPos);
8754   NextAtom:=CurPos;
8755   if not IsSpaceChar[Src[StartPos]] then
8756     ReadNextAtom;
8757   NextAtomType:=GetCurrentAtomType;
8758   NextIsValue:=NextAtomType in [vatIdentifier,vatPreDefIdentifier,vatNumber,vatStringConstant];
8759   repeat
8760     ReadPriorAtom;
8761     CurAtom:=CurPos;
8762     CurAtomType:=GetCurrentAtomType;
8763     if CurAtomType=vatNone then begin
8764       Result:=NextAtom.StartPos;
8765       exit;
8766     end;
8767     //DebugLn(['TFindDeclarationTool.FindStartOfTerm ',GetAtom,' Cur=',VariableAtomTypeNames[CurAtomType],' Next=',VariableAtomTypeNames[NextAtomType]]);
8768     if CurAtomType in [vatRoundBracketClose,vatEdgedBracketClose] then begin
8769       if NextAtomType in [vatRoundBracketOpen,vatRoundBracketClose,
8770                      vatEdgedBracketOpen,vatEdgedBracketClose,vatPoint,vatUp,
8771                      vatAS,vatNone,vatSpace]
8772       then begin
8773         ReadBackTilBracketOpen(true);
8774         CurAtom.StartPos:=CurPos.StartPos;
8775       end else begin
8776         Result:=NextAtom.StartPos;
8777         exit;
8778       end;
8779     end;
8780     // check if CurAtom belongs to variable
8781     if CurAtomType=vatINHERITED then begin
8782       Result:=CurAtom.StartPos;
8783       exit;
8784     end;
8785     if (CurAtomType in [vatAS,vatKeyword]) then begin
8786       Result:=NextAtom.StartPos;
8787       exit;
8788     end;
8789     if (CurAtomType=vatUp) and InType then begin
8790       Result:=NextAtom.StartPos;
8791       exit;
8792     end;
8793     CurIsValue:=CurAtomType in [vatIdentifier,vatPreDefIdentifier,vatNumber,vatStringConstant];
8794 
8795     if (not (CurAtomType in [vatIdentifier,vatPreDefIdentifier,vatNumber,vatStringConstant,
8796       vatPoint,vatUp,vatEdgedBracketClose,vatRoundBracketClose]))
8797     or (CurIsValue and NextIsValue)
8798     then begin
8799       // boundary found between current and next
8800       if NextAtom.StartPos>=EndPos then begin
8801         // no token belongs to a variable (e.g. ; ;)
8802         Result:=EndPos;
8803       end else begin
8804         // the next atom is the start of the variable
8805         if (not (NextAtomType in [vatSpace,vatIdentifier,vatPreDefIdentifier,
8806           vatRoundBracketClose,vatEdgedBracketClose,vatAddrOp])) then
8807         begin
8808           MoveCursorToCleanPos(NextAtom.StartPos);
8809           ReadNextAtom;
8810           RaiseIdentNotFound;
8811         end;
8812         Result:=NextAtom.StartPos;
8813       end;
8814       exit;
8815     end;
8816     NextAtom:=CurAtom;
8817     NextAtomType:=CurAtomType;
8818     NextIsValue:=CurIsValue;
8819   until false;
8820 end;
8821 
NodeTermInTypenull8822 function TFindDeclarationTool.NodeTermInType(Node: TCodeTreeNode): boolean;
8823 begin
8824   if Node=nil then exit(false);
8825   Result:=not (Node.Desc in AllPascalStatements);
8826 end;
8827 
FindExpressionTypeOfTermnull8828 function TFindDeclarationTool.FindExpressionTypeOfTerm(StartPos,
8829   EndPos: integer; Params: TFindDeclarationParams; WithAsOperator: boolean;
8830   AliasType: PFindContext): TExpressionType;
8831 { examples
8832   1. A.B
8833   2. A().B
8834   3. inherited A
8835   4. A[]
8836   5. A[].B
8837   6. A^.
8838   7. (A).
8839   8. (A as B)
8840   9. (@A)
8841   10. A as B
8842 }
8843 type
8844   TIsIdentEndOfVar = (iieovYes, iieovNo, iieovUnknown);
8845 var
8846   CurAtomType: TVariableAtomType;
8847   NextAtomType: TVariableAtomType; // next, if CurAtomType is brackets then after the brackets
8848   PrevAtomType: TVariableAtomType; // previous, start of brackets
8849   CurAtom, NextAtom: TAtomPosition;
8850   CurAtomBracketEndPos: integer;
8851   StartNode: TCodeTreeNode;
8852   OldInput: TFindDeclarationInput;
8853   StartFlags: TFindDeclarationFlags;
8854   IsIdentEndOfVar: TIsIdentEndOfVar;
8855   FlagCanBeForwardDefined, FlagCanBeForwardDefinedValid: boolean;
8856   ExprType: TExpressionType;
8857   FirstParamStartPos: Integer;
8858   FirstParamProcContext: TFindContext;
8859 
8860   procedure RaiseIdentExpected;
8861   begin
8862     RaiseExceptionFmt(20170421200530,ctsStrExpectedButAtomFound,[ctsIdentifier,GetAtom]);
8863   end;
8864 
8865   procedure RaiseIdentNotFound;
8866   begin
8867     RaiseExceptionFmt(20170421200532,ctsIdentifierNotFound,[GetAtom]);
8868   end;
8869 
8870   procedure RaiseIllegalQualifierFound;
8871   begin
8872     RaiseExceptionFmt(20170421200535,ctsIllegalQualifier,[GetAtom]);
8873   end;
8874 
8875   procedure RaisePointNotFound;
8876   begin
8877     RaiseExceptionFmt(20170421200537,ctsStrExpectedButAtomFound,['.',GetAtom]);
8878   end;
8879 
8880   procedure RaiseClassDeclarationNotFound(Tool: TFindDeclarationTool);
8881   begin
8882     Tool.RaiseExceptionFmt(20170421200539,ctsClassSNotFound, [Tool.GetAtom]);
8883   end;
8884 
8885   function InitAtomQueue: boolean;
8886 
8887     procedure RaiseInternalError;
8888     begin
8889       RaiseException(20170421200543,'internal codetool error: FindExpressionTypeOfVariable '
8890         +' StartPos='+IntToStr(StartPos)+' EndPos='+IntToStr(EndPos));
8891     end;
8892 
8893   begin
8894     Result:=false;
8895     if StartPos<1 then
8896       StartPos:=FindStartOfTerm(EndPos,NodeTermInType(Params.ContextNode))
8897     else if EndPos<1 then
8898       EndPos:=FindEndOfTerm(StartPos,true,WithAsOperator);
8899     //DebugLn(['InitAtomQueue StartPos=',StartPos,'=',dbgstr(copy(Src,StartPos,10)),' EndPos=',dbgstr(copy(Src,EndPos,10))]);
8900     if (StartPos<1) then
8901       RaiseInternalError;
8902     if StartPos>SrcLen then exit;
8903     if StartPos=EndPos then begin
8904       // e.g. cursor behind semicolon, keyword or closing bracket
8905       exit;
8906     end;
8907     {$IFDEF ShowExprEval}
8908     DebugLn(['  FindExpressionTypeOfTerm InitAtomQueue StartPos=',StartPos,' EndPos=',EndPos,' Expr="',copy(Src,StartPos,EndPos-StartPos),'"']);
8909     {$ENDIF}
8910     PrevAtomType:=vatNone;
8911     MoveCursorToCleanPos(StartPos);
8912     ReadNextAtom;
8913     if CurPos.StartPos>SrcLen then exit;
8914     CurAtom:=CurPos;
8915     CurAtomType:=GetCurrentAtomType;
8916     if CurAtomType in [vatRoundBracketOpen,vatEdgedBracketOpen] then
8917       ReadTilBracketClose(true);
8918     CurAtomBracketEndPos:=CurPos.EndPos;
8919     ReadNextAtom;
8920     NextAtom:=CurPos;
8921     if NextAtom.EndPos<=EndPos then
8922       NextAtomType:=GetCurrentAtomType
8923     else
8924       NextAtomType:=vatSpace;
8925     MoveCursorToCleanPos(CurAtom.StartPos);
8926     IsIdentEndOfVar:=iieovUnknown;
8927     FlagCanBeForwardDefinedValid:=false;
8928     Result:=true;
8929   end;
8930 
8931   procedure ReadNextExpressionAtom;
8932   begin
8933     PrevAtomType:=CurAtomType;
8934     CurAtom:=NextAtom;
8935     CurAtomType:=NextAtomType;
8936     MoveCursorToCleanPos(NextAtom.StartPos);
8937     ReadNextAtom;
8938     if CurAtomType in [vatRoundBracketOpen,vatEdgedBracketOpen] then
8939       ReadTilBracketClose(true);
8940     CurAtomBracketEndPos:=CurPos.EndPos;
8941     ReadNextAtom;
8942     NextAtom:=CurPos;
8943     if NextAtom.EndPos<=EndPos then
8944       NextAtomType:=GetCurrentAtomType
8945     else
8946       NextAtomType:=vatSpace;
8947     MoveCursorToCleanPos(CurAtom.StartPos);
8948     IsIdentEndOfVar:=iieovUnknown;
8949   end;
8950 
8951   function IsIdentifierEndOfVariable: boolean;
8952   var BehindFuncAtomType: TVariableAtomType;
8953   begin
8954     if IsIdentEndOfVar=iieovUnknown then begin
8955       if CurAtom.StartPos>=EndPos then begin
8956         IsIdentEndOfVar:=iieovYes;
8957       end else if CurAtom.Flag=cafWord then begin
8958         ReadNextAtom;
8959         if AtomIsChar('(') then begin
8960           ReadTilBracketClose(true);
8961           ReadNextAtom;
8962         end;
8963         if CurPos.StartPos<EndPos then begin
8964           BehindFuncAtomType:=GetCurrentAtomType;
8965           if (BehindFuncAtomType in [vatPoint,vatUP,
8966             vatEdgedBracketOpen,vatRoundBracketOpen])
8967           then
8968             IsIdentEndOfVar:=iieovNo
8969           else
8970             IsIdentEndOfVar:=iieovYes;
8971         end else begin
8972           IsIdentEndOfVar:=iieovYes;
8973         end;
8974       end else begin
8975         IsIdentEndOfVar:=iieovNo
8976       end;
8977     end;
8978     Result:=(IsIdentEndOfVar=iieovYes);
8979   end;
8980 
8981   function CanBeForwardDefined: boolean;
8982   var
8983     Node: TCodeTreeNode;
8984   begin
8985     if not FlagCanBeForwardDefinedValid then begin
8986       FlagCanBeForwardDefinedValid:=true;
8987       FlagCanBeForwardDefined:=false;
8988       Node:=StartNode;
8989       while Node<>nil do begin
8990         if Node.Desc in [ctnTypeDefinition,ctnGenericType] then begin
8991           FlagCanBeForwardDefined:=true;
8992           break;
8993         end else if not (Node.Desc in AllPascalTypes) then
8994           break;
8995         Node:=Node.Parent;
8996       end;
8997     end;
8998     Result:=FlagCanBeForwardDefined;
8999   end;
9000 
9001   procedure ResolveTypeLessProperty;
9002   begin
9003     if ExprType.Desc<>xtContext then exit;
9004     with ExprType.Context do begin
9005       if not (Node.Desc in [ctnProperty,ctnGlobalProperty]) then exit;
9006       if Tool.PropNodeIsTypeLess(Node)
9007       and Tool.MoveCursorToPropName(Node) then begin
9008         // typeless property => search in ancestors: it can be property with parameters
9009         Params.Save(OldInput);
9010         Params.SetIdentifier(Tool,@Tool.Src[Tool.CurPos.StartPos],nil);
9011         Params.Flags:=[fdfSearchInAncestors,fdfSearchInHelpers];
9012         if Tool.FindIdentifierInAncestors(Node.Parent.Parent,Params) then begin
9013           Tool:=Params.NewCodeTool;
9014           Node:=Params.NewNode;
9015         end;
9016         Params.Load(OldInput,true);
9017       end;
9018     end;
9019   end;
9020 
9021   procedure ResolveStringFunctionParam;
9022   var
9023     FirstParamAlias: TFindContext;
9024     FirstParamExprType: TExpressionType;
9025   begin
9026     MoveCursorToCleanPos(FirstParamStartPos);
9027     ReadNextAtom;
9028     if (CurPos.Flag=cafRoundBracketOpen) then
9029     begin
9030       ReadNextAtom;
9031       FirstParamStartPos := CurPos.StartPos;
9032 
9033       if CurPos.Flag<>cafRoundBracketClose then
9034       begin
9035         // read first expressions
9036         // read til comma or bracket close
9037         repeat
9038           while not(AtomIsChar(',') or AtomIsChar('[') or AtomIsChar('(') or AtomIsChar(')')) do
9039             ReadNextAtom;
9040           if CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen] then begin
9041             ReadTilBracketClose(true);
9042             ReadNextAtom;
9043           end;
9044           if (CurPos.StartPos>SrcLen)
9045           or (CurPos.Flag in [cafRoundBracketClose,cafEdgedBracketClose,cafComma])
9046           then
9047             break;
9048         until false;
9049 
9050         // find expression type
9051         Params.Flags:=Params.Flags-[fdfExceptionOnNotFound];
9052         FillChar(FirstParamAlias{%H-}, SizeOf(FirstParamAlias), 0);
9053         //DebugLn('TFindDeclarationTool.CreateParamExprListFromStatement CurIgnoreErrorAfterPos=',dbgs(CurIgnoreErrorAfterPos),' ExprStartPos=',dbgs(ExprStartPos));
9054         FirstParamExprType:=FindExpressionResultType(Params,FirstParamStartPos,CurPos.StartPos,@FirstParamAlias);
9055         if (FirstParamExprType.Desc in [xtAnsiString, xtString, xtShortString]) then
9056         begin
9057           ExprType := FirstParamExprType;
9058           if AliasType<>nil then
9059             AliasType^ := FirstParamAlias;
9060         end;
9061       end;
9062     end;
9063   end;
9064 
9065   procedure ResolveBaseTypeOfIdentifier;
9066   { normally not the identifier is searched, but its type
9067     but there is one exception:
9068       if the identifier is a function and it is the end of the variable then
9069       the decision is based on the fdfFunctionResult flag.
9070   }
9071   var
9072     ProcNode, FuncResultNode, FirstParamNode: TCodeTreeNode;
9073     AtEnd: Boolean;
9074     CurAliasType: PFindContext;
9075     Context: TFindContext;
9076     FirstParamProcExpr: TExpressionType;
9077     NewParams: TFindDeclarationParams;
9078   begin
9079     //DebugLn(['ResolveBaseTypeOfIdentifier ',ExprType.Context.Node<>nil]);
9080     if ExprType.Desc=xtContext then
9081       Context:=ExprType.Context
9082     else
9083       Context:=CreateFindContext(Self,StartNode);
9084     if (Context.Node=nil) then exit;
9085 
9086     AtEnd:=IsIdentifierEndOfVariable;
9087     // check if at the end of the variable
9088     if AtEnd and (fdfFindVariable in StartFlags) then begin
9089       // the variable is wanted, not its type
9090       exit;
9091     end;
9092     if (not AtEnd)
9093     and (Context.Node.Desc in [ctnProperty,ctnGlobalProperty])
9094     then begin
9095       ResolveTypeLessProperty;
9096     end;
9097 
9098     CurAliasType:=nil;
9099     if AtEnd then CurAliasType:=AliasType;
9100 
9101     // find base type
9102     Params.Flags:=Params.Flags+[fdfEnumIdentifier]-[fdfFunctionResult,fdfFindChildren];
9103     {$IFDEF ShowExprEval}
9104     DebugLn(['  FindExpressionTypeOfTerm ResolveBaseTypeOfIdentifier BEFORE ExprType=',ExprTypeToString(ExprType),' Alias=',CurAliasType<>nil]);
9105     {$ENDIF}
9106     ExprType:=Context.Tool.ConvertNodeToExpressionType(
9107                                Context.Node,Params,CurAliasType);
9108     {$IFDEF ShowExprEval}
9109     DebugLn(['  FindExpressionTypeOfTerm ResolveBaseTypeOfIdentifier AFTER ExprType=',ExprTypeToString(ExprType),' Alias=',FindContextToString(CurAliasType)]);
9110     {$ENDIF}
9111     if (ExprType.Desc=xtContext)
9112     and (ExprType.Context.Node.Desc in [ctnProcedure,ctnProcedureHead]) then
9113     begin
9114       // check if this is a function
9115       ProcNode:=ExprType.Context.Node;
9116       if ProcNode.Desc=ctnProcedureHead then
9117         ProcNode:=ProcNode.Parent;
9118       ExprType.Context.Tool.BuildSubTreeForProcHead(ProcNode.FirstChild,
9119                                                     FuncResultNode);
9120       {$IFDEF ShowExprEval}
9121       DebugLn(['  FindExpressionTypeOfTerm ResolveBaseTypeOfIdentifier IsFunction=',FuncResultNode<>nil,' IsIdentifierEndOfVariable=',IsIdentifierEndOfVariable,' fdfFunctionResult in StartFlags=',fdfFunctionResult in StartFlags]);
9122       {$ENDIF}
9123       if (FuncResultNode<>nil) then begin
9124         // it is function
9125         // -> use the result type instead of the function
9126         if AtEnd then begin
9127           // this function identifier is the end of the variable
9128           if not (fdfFunctionResult in StartFlags) then
9129             exit;
9130         end;
9131         Include(Params.Flags,fdfFunctionResult);
9132         ExprType:=ExprType.Context.Tool.ConvertNodeToExpressionType(
9133                                             ProcNode,Params,CurAliasType);
9134 
9135         if  (ExprType.Desc in [xtAnsiString, xtString, xtShortString])
9136         and (FirstParamStartPos>0)
9137         and (FirstParamProcContext.Node<>nil) then
9138         begin
9139           FirstParamNode := FirstParamProcContext.Node;
9140           while (FirstParamNode<>nil) and (FirstParamNode.Desc in [ctnProcedure, ctnProcedureHead, ctnParameterList]) do
9141             FirstParamNode := FirstParamNode.FirstChild;
9142           if (FirstParamNode<>nil) and (FirstParamNode.Desc=ctnVarDefinition) then
9143           begin
9144             while FirstParamNode.NextBrother<>nil do
9145               FirstParamNode := FirstParamNode.NextBrother;
9146             FirstParamNode := FirstParamNode.FirstChild;
9147           end;
9148           if (FirstParamNode<>nil) and (FirstParamNode.Desc=ctnIdentifier) then
9149           begin
9150             NewParams := TFindDeclarationParams.Create(FirstParamProcContext.Tool, FirstParamProcContext.Node);
9151             try
9152               FirstParamProcExpr := FirstParamProcContext.Tool.FindExpressionResultType(NewParams, FirstParamNode.StartPos, FirstParamNode.EndPos);
9153             finally
9154               NewParams.Free;
9155             end;
9156             if FirstParamProcExpr.Desc in [xtAnsiString, xtString, xtShortString] then
9157               ResolveStringFunctionParam;
9158           end;
9159         end;
9160       end;
9161     end;
9162   end;
9163 
9164   function ResolveUseUnit(StartUseUnitNode: TCodeTreeNode): TCodeTreeNode;
9165   // IsStart=true, NextAtomType=vatPoint,
9166   // StartUseUnitNameNode.Desc=ctnUseUnit
9167   // -> Find the longest namespaced used unit (ctnUseUnitNamespace,ctnUseUnitClearName)
9168   //    or the source name (ctnIdentifier), that fits the start of the
9169   //    current identifier a.b.c...
9170   //
9171 
9172     function GetPrevUseUnit(UseUnitNode: TCodeTreeNode): TCodeTreeNode;
9173     begin
9174       if UseUnitNode.PriorBrother<>nil then
9175         Result:=UseUnitNode.PriorBrother
9176       else begin
9177         if UseUnitNode.Parent.Parent.Desc=ctnImplementation then begin
9178           Result:=FindMainUsesNode;
9179           if Result<>nil then
9180             Result:=Result.FirstChild;
9181         end else
9182           Result:=nil;
9183       end;
9184     end;
9185 
9186   var
9187     UseUnitNode, Node, BestNode: TCodeTreeNode;
9188     HasNamespace: Boolean;
9189     Count, Level, BestLevel: Integer;
9190     p: PChar;
9191     DottedIdentifier: String;
9192   begin
9193     Result:=StartUseUnitNode.FirstChild;
9194     //debugln(['ResolveUsenit START ',NextAtomType,' ',StartUseUnitNode.DescAsString,' "',GetIdentifier(@Src[CurAtom.StartPos]),'"']);
9195     // find all candidates
9196     Count:=0;
9197     HasNamespace:=false;
9198     UseUnitNode:=StartUseUnitNode;
9199     repeat
9200       if (UseUnitNode.FirstChild<>nil)
9201       and CompareSrcIdentifiers(CurAtom.StartPos,UseUnitNode.StartPos) then begin
9202         // found candidate
9203         inc(Count);
9204         //debugln(['ResolveUsenit candidate found']);
9205         if UseUnitNode.FirstChild.Desc=ctnUseUnitNamespace then begin
9206           HasNamespace:=true;
9207         end;
9208       end;
9209       UseUnitNode:=GetPrevUseUnit(UseUnitNode);
9210     until UseUnitNode=nil;
9211     //debugln(['ResolveUsenit CandidateCount=',Count,' HasNamespace=',HasNamespace]);
9212     if not HasNamespace then exit;
9213 
9214     // multiple uses start with this identifier -> collect candidates
9215     //debugln(['ResolveUsenit collect candidates ...']);
9216 
9217     // read a.b.c...
9218     DottedIdentifier:=GetIdentifier(@Src[CurAtom.StartPos]);
9219     MoveCursorToCleanPos(NextAtom.EndPos);
9220     Level:=1;
9221     repeat
9222       ReadNextAtom;
9223       if not AtomIsIdentifier then break;
9224       inc(Level);
9225       DottedIdentifier:=DottedIdentifier+'.'+GetAtom;
9226       ReadNextAtom;
9227     until CurPos.Flag<>cafPoint;
9228     //debugln(['ResolveUsenit DottedIdentifier="',DottedIdentifier,'"']);
9229 
9230     // find longest dotted unit name in uses and source name
9231     UseUnitNode:=StartUseUnitNode;
9232     BestNode:=nil;
9233     BestLevel:=0;
9234     repeat
9235       Node:=UseUnitNode.FirstChild; // ctnUseUnitNamespace or ctnUseUnitClearName
9236       UseUnitNode:=GetPrevUseUnit(UseUnitNode);
9237       if (Node<>nil)
9238       and CompareSrcIdentifiers(CurAtom.StartPos,Node.StartPos) then begin
9239         // found candidate
9240         //debugln(['ResolveUseUnit Candidate=',ExtractNode(Node,[])]);
9241         Level:=1;
9242         p:=PChar(DottedIdentifier);
9243         repeat
9244           inc(p,GetIdentLen(p));
9245           if p^='.' then inc(p);
9246           //debugln(['ResolveUseUnit p=',p,' NextBrother=',Node.NextBrother<>nil]);
9247           if Node.NextBrother=nil then begin
9248             // fits
9249             if Level>BestLevel then begin
9250               BestNode:=Node.Parent;
9251               BestLevel:=Level;
9252             end;
9253             break;
9254           end else if p^=#0 then begin
9255             // unitname too long
9256             break;
9257           end else begin
9258             Node:=Node.NextBrother;
9259             //debugln(['ResolveUseUnit p=',p,' node=',GetIdentifier(@Src[Node.StartPos])]);
9260             if not CompareSrcIdentifiers(Node.StartPos,p) then
9261               break;
9262             inc(Level);
9263           end;
9264         until false;
9265       end;
9266     until UseUnitNode=nil;
9267     //debugln(['ResolveUseUnit collected candidates Best=',ExtractNode(BestNode,[])]);
9268 
9269     //debugln(['ResolveUseUnit Src=',Tree.Root.DescAsString,' Name=',GetSourceName(false),' DottedIdentifier="',DottedIdentifier,'"']);
9270     // check source name
9271     if (Tree.Root.Desc in AllSourceTypes)
9272     and (Tree.Root.FirstChild<>nil)
9273     and (Tree.Root.FirstChild.Desc=ctnSrcName)
9274     and CompareSrcIdentifiers(Tree.Root.FirstChild.StartPos,PChar(DottedIdentifier))
9275     then begin
9276       // found candidate
9277       Level:=1;
9278       Node:=Tree.Root.FirstChild.FirstChild;
9279       //debugln(['ResolveUseUnit Candidate SrcName']);
9280       p:=PChar(DottedIdentifier);
9281       repeat
9282         //debugln('ResolveUseUnit SrcName p=',p,' Node=',ExtractNode(Node,[]));
9283         if (Node.FirstChild=nil) or (Node.NextBrother.Desc<>ctnIdentifier) then begin
9284           // fits
9285           //debugln(['ResolveUseUnit FITS Level=',Level,' Best=',BestLevel]);
9286           if Level>BestLevel then begin
9287             // source name fits best
9288             Result:=Tree.Root.FirstChild.FirstChild;
9289             // move cursor forward
9290             while (Result.NextBrother<>nil)
9291             and (NextAtom.EndPos<EndPos) do begin
9292               if (Result.NextBrother=nil) then
9293                 exit(Tree.Root);
9294               ReadNextExpressionAtom; // read point
9295               ReadNextExpressionAtom; // read namespace/unitname
9296               //debugln(['ResolveUseUnit Next ',GetAtom(CurAtom)]);
9297               Result:=Result.NextBrother;
9298             end;
9299             //debugln(['ResolveUseUnit SrcName fits better']);
9300             exit;
9301           end;
9302           break;
9303         end else if p^=#0 then begin
9304           // source name too long
9305           break;
9306         end else begin
9307           Node:=Node.NextBrother;
9308           inc(p,GetIdentLen(p));
9309           if p^='.' then inc(p);
9310           //debugln('ResolveUseUnit SrcName NEXT p=',p,' Node=',ExtractNode(Node,[]));
9311           if not CompareSrcIdentifiers(Node.StartPos,p) then
9312             break;
9313           inc(Level);
9314         end;
9315       until false;
9316     end;
9317 
9318     Result:=BestNode;
9319     if Result=nil then exit;
9320 
9321     // Result is now a ctnUseUnit
9322     Result:=Result.FirstChild;
9323     // move cursor forward
9324     while (Result.NextBrother<>nil) and (NextAtom.EndPos<EndPos) do begin
9325       ReadNextExpressionAtom; // read point
9326       ReadNextExpressionAtom; // read namespace/unitname
9327       //debugln(['ResolveUseUnit Next ',GetAtom(CurAtom)]);
9328       Result:=Result.NextBrother;
9329     end;
9330   end;
9331 
9332   function ResolveAttribute(const Context: TFindContext): boolean;
9333   var
9334     Identifier: String;
9335     l: Integer;
9336   begin
9337     Result:=false;
9338     if CurAtom.Flag<>cafWord then exit;
9339     Identifier:=GetAtom;
9340     l:=length(Identifier)-length('attribute');
9341     if (l>0) and (CompareIdentifiers(@Identifier[l+1],'attribute')=0) then
9342       exit;
9343     // auto append 'attribute' to typename
9344     Identifier+='Attribute';
9345     Params.SetIdentifier(Self,PChar(Identifier),@CheckSrcIdentifier);
9346     if Context.Tool.FindIdentifierInContext(Params) then begin
9347       ExprType.Desc:=xtContext;
9348       ExprType.Context:=CreateFindContext(Params);
9349       Params.Load(OldInput,true);
9350       exit(true);
9351     end;
9352     Params.Load(OldInput,false);
9353     Result:=false;
9354   end;
9355 
9356   procedure ResolveIdentifier;
9357   var
9358     ProcNode: TCodeTreeNode;
9359     IdentFound: boolean;
9360     OldFlags: TFindDeclarationFlags;
9361     ResultNode: TCodeTreeNode;
9362     IsStart: Boolean;
9363     Context: TFindContext;
9364     IsEnd: Boolean;
9365     SearchForwardToo: Boolean;
9366   begin
9367     // for example  'AnObject[3]'
9368 
9369     {$IFDEF ShowExprEval}
9370     debugln(['ResolveIdentifier "',GetAtom(CurAtom),'"']);
9371     {$ENDIF}
9372 
9373     // check special identifiers 'Result' and 'Self'
9374     IdentFound:=false;
9375     IsStart:=ExprType.Desc=xtNone;
9376     IsEnd:=IsIdentifierEndOfVariable;
9377     if IsStart then begin
9378       // start context
9379       if (StartNode.Desc in AllPascalStatements) then begin
9380         if CompareSrcIdentifiers(CurAtom.StartPos,'SELF') then begin
9381           // SELF in a method is the object itself
9382           // -> check if in a method or nested proc of a method
9383           if fdfExtractOperand in Params.Flags then
9384             Params.AddOperandPart('Self');
9385           ProcNode:=StartNode;
9386           while (ProcNode<>nil) do begin
9387             if (ProcNode.Desc=ctnProcedure) and NodeIsMethodBody(ProcNode) then
9388             begin
9389               ResultNode:=FindClassOfMethod(ProcNode,True,
9390                 fdfExceptionOnNotFound in Params.Flags);
9391               if (ResultNode<>nil) and
9392                  (ResultNode.Desc in [ctnClassHelper,ctnRecordHelper,ctnTypeHelper])
9393               then//Self is helper -> return extended type
9394               begin
9395                 ExprType := FindExtendedExprOfHelper(ResultNode);
9396                 ResultNode := ExprType.Context.Node;
9397               end else
9398               begin//Self is class/record
9399                 if (ResultNode<>nil) and (ResultNode.Parent<>nil) then
9400                 begin
9401                   ExprType.Desc:=xtContext;
9402                   ExprType.Context.Tool:=Self;
9403                 end else
9404                   ExprType := CleanExpressionType;
9405               end;
9406               if IsEnd and (ResultNode<>nil) then
9407                 ResultNode := ResultNode.Parent;
9408               ExprType.Context.Node:=ResultNode;
9409               IdentFound:=ExprType.Desc<>xtNone;
9410               break;
9411             end;
9412             ProcNode:=ProcNode.Parent;
9413           end;
9414         end else if CompareSrcIdentifiers(CurAtom.StartPos,'RESULT')
9415         and (cmsResult in Scanner.CompilerModeSwitches) then begin
9416           // RESULT has a special meaning in a function
9417           // -> check if in a function
9418           if fdfExtractOperand in Params.Flags then
9419             Params.AddOperandPart('Result');
9420           ProcNode:=StartNode;
9421           while (ProcNode<>nil) do begin
9422             if (ProcNode.Desc=ctnProcedure)
9423             and (NodeIsFunction(ProcNode) or NodeIsOperator(ProcNode)) then
9424               break;
9425             ProcNode:=ProcNode.Parent;
9426           end;
9427           if (ProcNode<>nil) then begin
9428             if IsEnd and (fdfFindVariable in StartFlags) then begin
9429               BuildSubTreeForProcHead(ProcNode);
9430               ResultNode:=ProcNode.FirstChild.FirstChild;
9431               while (ResultNode<>nil) do begin
9432                 if ResultNode.Desc in [ctnVarDefinition,ctnIdentifier] then begin
9433                   // procedure: none
9434                   // operator: ctnVarDefinition,ctnIdentifier
9435                   // function: ctnIdentifier
9436                   ExprType.Desc:=xtContext;
9437                   ExprType.Context.Node:=ResultNode;
9438                   ExprType.Context.Tool:=Self;
9439                   exit;
9440                 end;
9441                 ResultNode:=ResultNode.NextBrother;
9442               end;
9443             end else begin
9444               OldFlags:=Params.Flags;
9445               Params.Flags:=Params.Flags+[fdfFunctionResult,fdfFindChildren];
9446               ExprType.Context:=FindBaseTypeOfNode(Params,ProcNode);
9447               ExprType.Desc:=xtContext;
9448               Params.Flags:=OldFlags;
9449               exit;
9450             end;
9451           end;
9452         end;
9453       end;
9454     end;
9455     // find identifier
9456     if not IdentFound then begin
9457       if not (ExprType.Desc in [xtContext,xtNone]) then
9458       begin
9459         // find special sub identifier
9460         if (ExprType.Desc in xtAllTypeHelperTypes) then
9461         begin
9462           // found predefined basic type (e.g. string) without a context!
9463           // -> search in type helpers
9464           Params.Save(OldInput);
9465           // build new param flags for sub identifiers
9466           Params.Flags:=[fdfSearchInAncestors,fdfExceptionOnNotFound,fdfSearchInHelpers]
9467                         +(fdfGlobals*Params.Flags);
9468           Params.SetIdentifier(Self,@Src[CurAtom.StartPos],nil);
9469           {$IFDEF ShowExprEval}
9470           debugln(['ResolveIdentifier searching "',GetAtom(CurAtom),'" in helper of predefined type "',ExprTypeToString(ExprType),'"']);
9471           {$ENDIF}
9472           if FindIdentifierInBasicTypeHelpers(ExprType.Desc, Params) then
9473           begin
9474             ExprType.Desc:=xtContext;
9475             ExprType.SubDesc:=xtNone;
9476             ExprType.Context.Tool := Params.NewCodeTool;
9477             ExprType.Context.Node := Params.NewNode;
9478             {$IFDEF ShowExprEval}
9479             debugln(['ResolveIdentifier "',GetAtom(CurAtom),'" Found In Helper: "',ExprTypeToString(ExprType),'"']);
9480             {$ENDIF}
9481           end else begin
9482             {$IFDEF ShowExprEval}
9483             debugln(['ResolveIdentifier "',GetAtom(CurAtom),'" NOT Found In Helper']);
9484             {$ENDIF}
9485           end;
9486           Params.Load(OldInput,true);
9487         end;
9488 
9489         if ExprType.Desc in xtAllPredefinedTypes then begin
9490           ExprType:=FindExpressionTypeOfPredefinedIdentifier(CurAtom.StartPos,
9491                                                              Params);
9492           {$IFDEF CheckNodeTool}
9493           if ExprType.Desc=xtContext then
9494             ExprType.Context.Tool.CheckNodeTool(ExprType.Context.Node);
9495           {$ENDIF}
9496           {$IFDEF ShowExprEval}
9497           debugln(['ResolveIdentifier Predefined  "',GetAtom(CurAtom),'" : ',ExprType.Desc in xtAllTypeHelperTypes]);
9498           {$ENDIF}
9499         end;
9500       end else
9501       begin
9502         // find identifier
9503         if ExprType.Desc=xtContext then
9504           Context:=ExprType.Context
9505         else
9506           Context:=CreateFindContext(Self,StartNode);
9507         Params.Save(OldInput);
9508         // build new param flags for sub identifiers
9509         Params.Flags:=[fdfSearchInAncestors,fdfExceptionOnNotFound,fdfSearchInHelpers]
9510                       +(fdfGlobals*Params.Flags);
9511         Params.ContextNode:=Context.Node;
9512         SearchForwardToo:=false;
9513         if Context.Node=StartNode then begin
9514           // there is no special context -> search in parent contexts too
9515           Params.Flags:=Params.Flags+[fdfSearchInParentNodes,fdfIgnoreCurContextNode];
9516           // check if searching forward too
9517           if CanBeForwardDefined then begin
9518             SearchForwardToo:=true;
9519             Params.Flags:=Params.Flags-[fdfExceptionOnNotFound];
9520           end;
9521         end else begin
9522           // only search in special context
9523           Params.Flags:=Params.Flags+[fdfIgnoreUsedUnits];
9524           if Assigned(Context.Node) and (Context.Node.Desc=ctnImplementation) then
9525             Params.Flags:=Params.Flags+[fdfSearchInParentNodes];
9526           if Context.Node.Desc=ctnObjCClass then
9527             Exclude(Params.Flags,fdfExceptionOnNotFound); // ObjCClass has predefined identifiers like 'alloc'
9528         end;
9529 
9530         // check identifier for overloaded procs
9531         if (IsEnd and (fdfIgnoreOverloadedProcs in StartFlags))
9532         then
9533           Include(Params.Flags,fdfIgnoreOverloadedProcs);
9534 
9535         //debugln(['ResolveIdentifier ',IsEnd,' ',GetAtom(CurAtom),' ',Context.Node.DescAsString,' ',Context.Node.Parent.DescAsString,' ']);
9536         if IsEnd and (Context.Node.Desc=ctnIdentifier)
9537         and (Context.Node.Parent.Desc=ctnAttribParam)
9538         and ResolveAttribute(Context) then begin
9539           exit;
9540         end;
9541 
9542         Params.SetIdentifier(Self,@Src[CurAtom.StartPos],@CheckSrcIdentifier);
9543 
9544         // search ...
9545         {$IFDEF ShowExprEval}
9546         Debugln(['  FindExpressionTypeOfTerm ResolveIdentifier "',GetIdentifier(Params.Identifier),'" backward ',BoolToStr(IsStart,'Main','Sub'),'Ident="',GetIdentifier(Params.Identifier),'" ContextNode="',Params.ContextNode.DescAsString,'" "',dbgstr(Context.Tool.Src,Params.ContextNode.StartPos,15),'" ',dbgs(Params.Flags)]);
9547         {$ENDIF}
9548         ExprType.Desc:=xtNone;
9549         // first search backwards
9550         if Context.Tool.FindIdentifierInContext(Params) then begin
9551           ExprType.Desc:=xtContext;
9552         end else if SearchForwardToo then begin
9553           // then search forwards
9554           Params.Load(OldInput,false);
9555           Params.SetIdentifier(Self,@Src[CurAtom.StartPos],@CheckSrcIdentifier);
9556           Params.Flags:=[fdfSearchInParentNodes,fdfExceptionOnNotFound,
9557                          fdfIgnoreCurContextNode,fdfSearchForward]
9558                         +(fdfGlobals*Params.Flags);
9559           Params.ContextNode:=Context.Node;
9560           {$IFDEF ShowExprEval}
9561           DebugLn(['  FindExpressionTypeOfTerm ResolveIdentifier "',GetAtom(CurAtom),'" forward SubIdent="',GetIdentifier(Params.Identifier),'" ContextNode="',Params.ContextNode.DescAsString,'" "',dbgstr(Context.Tool.Src,Params.ContextNode.StartPos,15),'" ',dbgs(Params.Flags)]);
9562           {$ENDIF}
9563           if FindIdentifierInContext(Params) then begin
9564             ExprType.Desc:=xtContext;
9565           end;
9566         end;
9567         if ExprType.Desc=xtContext then begin
9568           // identifier found
9569           if Params.NewCodeTool.NodeIsConstructor(Params.NewNode) then begin
9570             // identifier is a constructor
9571             if (Context.Node.Desc in AllClassObjects) then begin
9572               if (not IsEnd) or (not (fdfFindVariable in StartFlags)) then begin
9573                 // examples:
9574                 //   TMyClass.Create.
9575                 //   :=TMyClass.Create;
9576                 // use this class (the constructor can be defined in the ancestor)
9577                 ExprType.Context:=Context;
9578                 Params.Load(OldInput,true);
9579                 exit;
9580               end;
9581             end;
9582           end;
9583           if IsStart and (NextAtomType=vatPoint)
9584           and (Params.NewCodeTool=Self)
9585           and (Params.NewNode.Desc in [ctnUseUnitClearName,ctnUseUnitNamespace])
9586           then begin
9587             // first identifier is a used unit -> find longest fitting unitname
9588             //debugln(['ResolveIdentifier UseUnit FindLongest... ',Params.NewNode.DescAsString,' ',ExtractNode(Params.NewNode,[])]);
9589             Params.NewNode:=ResolveUseUnit(Params.NewNode.Parent);
9590             //debugln(['ResolveIdentifier UseUnit FoundLongest: ',Params.NewNode.DescAsString,' ',ExtractNode(Params.NewNode,[])]);
9591           end;
9592           ExprType.Context:=CreateFindContext(Params);
9593           Params.Load(OldInput,true);
9594         end else begin
9595           // predefined identifier
9596           if (Context.Node.Desc=ctnObjCClass)
9597             and CompareSrcIdentifiers('alloc',@Src[CurAtom.StartPos])
9598           then begin
9599             // 'alloc' returns the class itself
9600             ExprType.Context:=Context;
9601             //debugln(['ResolveIdentifier ',ExprTypeToString(ExprType)]);
9602             Params.Load(OldInput,true);
9603             exit;
9604           end;
9605 
9606           Params.Load(OldInput,true);
9607           if IsEnd then
9608             ExprType:=FindExpressionTypeOfPredefinedIdentifier(CurAtom.StartPos,
9609                                                                Params,AliasType)
9610           else
9611             ExprType:=FindExpressionTypeOfPredefinedIdentifier(CurAtom.StartPos,
9612                                                                Params);
9613           {$IFDEF CheckNodeTool}
9614           if ExprType.Desc=xtContext then
9615             ExprType.Context.Tool.CheckNodeTool(ExprType.Context.Node);
9616           {$ENDIF}
9617         end;
9618       end;
9619       {$IFDEF ShowExprEval}
9620       DebugLn(['  FindExpressionTypeOfTerm ResolveIdentifier END Ident="',dbgstr(Src,StartPos,CurAtom.EndPos-StartPos),'" Expr=',ExprTypeToString(ExprType)]);
9621       {$ENDIF}
9622     end;
9623   end;
9624 
9625   procedure ResolveConstant;
9626   var
9627     IsStart: Boolean;
9628   begin
9629     IsStart:=ExprType.Desc=xtNone;
9630     if not IsStart then
9631       RaiseExceptionFmt(20170421200546,ctsOperatorExpectedButAtomFound,[GetAtom]);
9632     if AtomIsStringConstant then begin
9633       // string or char constant
9634       if AtomIsCharConstant then
9635         ExprType.Desc:=xtChar
9636       else
9637         ExprType.Desc:=xtConstString;
9638       MoveCursorToCleanPos(CurPos.StartPos);
9639     end
9640     else if AtomIsNumber then begin
9641       // ordinal or real constant
9642       if AtomIsRealNumber then
9643         ExprType.Desc:=xtConstReal
9644       else
9645         ExprType.Desc:=xtConstOrdInteger;
9646       MoveCursorToCleanPos(CurPos.EndPos);
9647     end else
9648       RaiseExceptionFmt(20170421200548,ctsOperatorExpectedButAtomFound,[GetAtom]);
9649   end;
9650 
9651   procedure ResolveUseUnit;
9652   var
9653     AnUnitName: string;
9654     InFilename: string;
9655     aTool: TFindDeclarationTool;
9656     NewCodeTool: TFindDeclarationTool;
9657     NewNode: TCodeTreeNode;
9658   begin
9659     aTool:=ExprType.Context.Tool;
9660     {$IFDEF ShowExprEval}
9661     debugln(['  FindExpressionTypeOfTerm ResolveUseUnit used unit -> interface node ',dbgstr(ExprType.Context.Tool.ExtractNode(ExprType.Context.Node,[]))]);
9662     {$ENDIF}
9663     AnUnitName:=aTool.ExtractUsedUnitName(ExprType.Context.Node.Parent,@InFilename);
9664     NewCodeTool:=aTool.FindCodeToolForUsedUnit(AnUnitName,InFilename,true);
9665     NewCodeTool.BuildInterfaceIdentifierCache(true);
9666     NewNode:=NewCodeTool.FindInterfaceNode;
9667     ExprType.Context.Tool:=NewCodeTool;
9668     ExprType.Context.Node:=NewNode;
9669   end;
9670 
9671   procedure ResolveChildren;
9672   var
9673     NewNode: TCodeTreeNode;
9674   begin
9675     if (ExprType.Context.Node=nil) then exit;
9676     {$IFDEF ShowExprEval}
9677     debugln(['  FindExpressionTypeOfTerm ResolveChildren']);
9678     {$ENDIF}
9679     ResolveBaseTypeOfIdentifier;
9680     {$IFDEF ShowExprEval}
9681     debugln(['  FindExpressionTypeOfTerm ResolveChildren ExprType=',ExprTypeToString(ExprType)]);
9682     //debugln(['ResolveChildren xtContext=',(ExprType.Desc=xtContext),
9683     //  ' ctnPointerType=',(ExprType.Context.Node.Desc=ctnPointerType),
9684     //  ' Node=',(ExprType.Context.Node<>StartNode),
9685     //  ' cmsAutoderef=',(cmsAutoderef in Scanner.CompilerModeSwitches),
9686     //  ' ',CompilerModeNames[Scanner.CompilerMode]
9687     //  ]);
9688     {$ENDIF}
9689     NewNode:=ExprType.Context.Node;
9690     if (NewNode=nil) then exit;
9691     if (NewNode.Desc in AllUsableSourceTypes)
9692     or (NewNode.Desc=ctnSrcName)
9693     or ((NewNode.Desc=ctnIdentifier) and (NewNode.Parent.Desc=ctnSrcName)
9694       and (NewNode.NextBrother=nil))
9695     then begin
9696       if ExprType.Context.Tool=Self then begin
9697         // unit name of this unit => implementation
9698         // Note: allowed for programs too
9699         NewNode:=Tree.Root;
9700         if NewNode.Desc=ctnUnit then begin
9701           NewNode:=FindImplementationNode;
9702           if NewNode=nil then
9703             NewNode:=FindInterfaceNode;
9704         end;
9705         {$IFDEF ShowExprEval}
9706         debugln(['  FindExpressionTypeOfTerm ResolveChildren this unit -> ',NewNode.DescAsString]);
9707         {$ENDIF}
9708         ExprType.Context.Node:=NewNode;
9709       end else begin
9710         // unit name of another unit => interface
9711         {$IFDEF ShowExprEval}
9712         debugln(['  FindExpressionTypeOfTerm ResolveChildren unit -> interface node']);
9713         {$ENDIF}
9714         ExprType.Context.Node:=ExprType.Context.Tool.GetInterfaceNode;
9715       end;
9716     end
9717     else if (ExprType.Context.Node.Desc=ctnUseUnitClearName) then begin
9718       // uses unit name => interface of used unit
9719       ResolveUseUnit;
9720     end
9721     else if (ExprType.Context.Node.Desc=ctnClassOfType) then begin
9722       // 'class of' => jump to the class
9723       ExprType.Context:=ExprType.Context.Tool.FindBaseTypeOfNode(Params,ExprType.Context.Node.FirstChild);
9724     end
9725     else if (ExprType.Desc=xtContext)
9726     and (ExprType.Context.Node.Desc=ctnPointerType)
9727     and (ExprType.Context.Node<>StartNode)
9728     and (cmsAutoderef in Scanner.CompilerModeSwitches) then begin
9729       // Delphi knows . as shortcut for ^.
9730       // -> check for pointer type
9731       // left side of expression has defined a special context
9732       // => this '.' is a dereference
9733       ExprType.Context:=ExprType.Context.Tool.FindBaseTypeOfNode(Params,ExprType.Context.Node.FirstChild);
9734     end;
9735   end;
9736 
9737   procedure ResolvePoint;
9738   begin
9739     // for example 'A.B'
9740     if fdfExtractOperand in Params.Flags then
9741       Params.AddOperandPart('.');
9742     if (not (NextAtomType in [vatSpace,vatIdentifier,vatPreDefIdentifier])) then
9743     begin
9744       MoveCursorToCleanPos(NextAtom.StartPos);
9745       ReadNextAtom;
9746       RaiseIdentExpected;
9747     end;
9748     ResolveChildren;
9749     if ExprType.Desc in xtAllTypeHelperTypes then begin
9750       // Lazarus supports record helpers for basic types (string) as well (with TYPEHELPERS modeswitch!).
9751     end else if (ExprType.Context.Node=nil) then begin
9752       MoveCursorToCleanPos(CurAtom.StartPos);
9753       ReadNextAtom;
9754       RaiseIllegalQualifierFound;
9755     end else if ExprType.Context.Node.Desc in AllPointContexts then begin
9756       // ok, allowed
9757     end else begin
9758       // not allowed
9759       //debugln(['ResolvePoint ',ExprTypeToString(ExprType)]);
9760       MoveCursorToCleanPos(CurAtom.StartPos);
9761       ReadNextAtom;
9762       RaiseIllegalQualifierFound;
9763     end;
9764   end;
9765 
9766   procedure ResolveAs;
9767   begin
9768     // for example 'A as B'
9769     if (not (NextAtomType in [vatSpace,vatIdentifier,vatPreDefIdentifier])) then
9770     begin
9771       MoveCursorToCleanPos(NextAtom.StartPos);
9772       ReadNextAtom;
9773       RaiseIdentExpected;
9774     end;
9775     // 'as' is a type cast, so the left side is irrelevant
9776     // -> context is default context
9777     ExprType.Desc:=xtContext;
9778     ExprType.Context.Tool:=Self;
9779     ExprType.Context.Node:=StartNode;
9780   end;
9781 
9782   procedure ResolveUp;
9783   begin
9784     // for example:
9785     //   1. 'PInt = ^integer'  pointer type
9786     //   2. a^  dereferencing
9787     {$IFDEF ShowExprEval}
9788     debugln(['  FindExpressionTypeOfTerm ResolveUp']);
9789     {$ENDIF}
9790     if fdfExtractOperand in Params.Flags then
9791       Params.AddOperandPart('^');
9792     if (not (NextAtomType in [vatSpace,vatPoint,vatUp,vatAS,vatEdgedBracketOpen]))
9793     or ((ExprType.Context.Node=nil) and (ExprType.Desc<>xtPointer))
9794     then begin
9795       MoveCursorToCleanPos(NextAtom.StartPos);
9796       ReadNextAtom;
9797       RaiseIllegalQualifierFound;
9798     end;
9799     ResolveBaseTypeOfIdentifier;
9800     if (ExprType.Desc=xtPointer) then begin
9801       // the compiler type 'Pointer'
9802       exit;
9803     end;
9804     if (ExprType.Context.Node<>StartNode) then begin
9805       // left side of expression has defined a special context
9806       // => this '^' is a dereference
9807       if (not
9808           (NextAtomType in [vatSpace,vatPoint,vatAS,vatUP,vatEdgedBracketOpen]))
9809       then begin
9810         MoveCursorToCleanPos(NextAtom.StartPos);
9811         ReadNextAtom;
9812         RaisePointNotFound;
9813       end;
9814       if (ExprType.Context.Node=nil)
9815       or (ExprType.Context.Node.Desc<>ctnPointerType) then begin
9816         MoveCursorToCleanPos(CurAtom.StartPos);
9817         RaiseExceptionFmt(20170421200550,ctsIllegalQualifier,['^']);
9818       end;
9819       ExprType.Desc:=xtContext;
9820       ExprType.Context.Node:=ExprType.Context.Node.FirstChild;
9821     end else if NodeHasParentOfType(ExprType.Context.Node,ctnPointerType) then
9822     begin
9823       // this is a pointer type definition
9824       // -> the default context is ok
9825     end;
9826   end;
9827 
9828   procedure ResolveEdgedBracketOpen;
9829   { for example:  a[]
9830       this could be:
9831         1. ranged array      e.g. array[1..2] of
9832         2. dynamic array     e.g. array of integer
9833         3. variant array     e.g. array of const
9834         4. indexed pointer   e.g. PInteger[1]
9835         5. default property  e.g. Items[Index: integer]
9836         6. indexed property  e.g. Items[Index: integer]
9837         7. string character  e.g. string[3]
9838   }
9839 
9840     procedure RaiseTypeIdentNotFound;
9841     begin
9842       ExprType.Context.Tool.RaiseExceptionFmt(20170421200553,ctsStrExpectedButAtomFound,
9843                              [ctsTypeIdentifier,ExprType.Context.Tool.GetAtom]);
9844     end;
9845 
9846     procedure RaiseIdentInCurContextNotFound;
9847     begin
9848       ExprType.Context.Tool.RaiseExceptionFmt(20170421200557,ctsStrExpectedButAtomFound,
9849                                               [ctsIdentifier,GetAtom]);
9850     end;
9851   begin
9852     {$IFDEF ShowExprEval}
9853     debugln(['  FindExpressionTypeOfTerm ResolveEdgedBracketOpen ',ExprTypeToString(ExprType)]);
9854     {$ENDIF}
9855     if fdfExtractOperand in Params.Flags then begin
9856       // simple copying, todo: expand argument
9857       Params.AddOperandPart(ExtractBrackets(CurPos.StartPos,[]));
9858     end;
9859     if (not (NextAtomType in [vatSpace,vatPoint,vatAs,vatUp,vatRoundBracketClose,
9860       vatRoundBracketOpen,vatEdgedBracketClose,vatEdgedBracketOpen]))
9861     then begin
9862       MoveCursorToCleanPos(NextAtom.StartPos);
9863       ReadNextAtom;
9864       RaiseIllegalQualifierFound;
9865     end;
9866 
9867     if (ExprType.Desc=xtContext)
9868     and (ExprType.Context.Node.Desc=ctnProperty) then begin
9869       // [] behind a property
9870       // -> Check if this property has parameters
9871       ResolveTypeLessProperty;
9872       if (ExprType.Desc=xtContext)
9873       and (ExprType.Context.Node.Desc=ctnProperty)
9874       and ExprType.Context.Tool.PropertyNodeHasParamList(ExprType.Context.Node)
9875       then begin
9876         // use the property type
9877         ResolveChildren;
9878         exit;
9879       end;
9880     end;
9881 
9882     ResolveBaseTypeOfIdentifier;
9883 
9884     if ExprType.Desc in xtAllStringTypes then begin
9885       ExprType.Desc:=xtChar;
9886       ExprType.Context.Node:=nil;
9887       exit;
9888     end;
9889     if ExprType.Desc in xtAllWideStringTypes then begin
9890       ExprType.Desc:=xtWideChar;
9891       ExprType.Context.Node:=nil;
9892       exit;
9893     end;
9894     if ExprType.Context.Node=nil then begin
9895       MoveCursorToCleanPos(NextAtom.StartPos);
9896       ReadNextAtom;
9897       RaiseIllegalQualifierFound;
9898     end;
9899 
9900     if ExprType.Context.Node.Desc in [ctnRangedArrayType,ctnOpenArrayType] then
9901     begin
9902       MoveCursorToCleanPos(CurAtom.StartPos);
9903       ReadNextAtom; // "["
9904       ReadNextAtom;
9905       repeat
9906         case CurPos.Flag of
9907         cafRoundBracketClose: SaveRaiseBracketCloseExpectedButAtomFound(20170425090717);
9908         cafRoundBracketOpen,
9909         cafEdgedBracketOpen: ReadTilBracketClose(true);
9910         cafComma:
9911           with ExprType, Context do begin
9912             Context:=Tool.FindBaseTypeOfNode(Params,Node.LastChild);
9913             if not (Node.Desc in [ctnRangedArrayType,ctnOpenArrayType]) then
9914               RaiseIllegalQualifierFound;
9915           end;
9916         end;
9917         ReadNextAtom;
9918       until CurPos.Flag=cafEdgedBracketClose;
9919     end;
9920 
9921     {$IFDEF ShowExprEval}
9922     DebugLn(['  FindExpressionTypeOfTerm ResolveEdgedBracketOpen ExprType=',ExprTypeToString(ExprType)]);
9923     {$ENDIF}
9924     case ExprType.Context.Node.Desc of
9925 
9926     ctnOpenArrayType,ctnRangedArrayType:
9927       begin
9928         // the array type is the last child node
9929         //debugln('ResolveEdgedBracketOpen Open/RangedArray LastChild=',ExprType.Context.Node.LastChild.DescAsString);
9930         if ExprType.Context.Node.LastChild.Desc=ctnOfConstType then begin
9931           // 'array of const'; the array type is 'TVarRec'
9932 
9933           // => search 'TVarRec'
9934           Params.Save(OldInput);
9935           Params.Flags:=[fdfSearchInParentNodes,fdfIgnoreCurContextNode,
9936                          fdfExceptionOnNotFound,fdfFindChildren];
9937           // special identifier for TVarRec
9938           Params.SetIdentifier(Self,'tvarrec',nil);
9939           Params.ContextNode:=ExprType.Context.Node;
9940           ExprType.Context.Tool.FindIdentifierInContext(Params);
9941           ExprType.Context:=CreateFindContext(Params);
9942           Params.Load(OldInput,true);
9943         end else begin
9944           ExprType.Context.Node:=ExprType.Context.Node.LastChild;
9945         end;
9946       end;
9947 
9948     ctnPointerType:
9949       // the pointer type is the only child node
9950       ExprType.Context.Node:=ExprType.Context.Node.FirstChild;
9951 
9952     ctnClass, ctnClassInterface, ctnDispinterface, ctnObject, ctnRecordType,
9953     ctnClassHelper, ctnRecordHelper, ctnTypeHelper,
9954     ctnObjCClass, ctnObjCCategory, ctnObjCProtocol, ctnCPPClass:
9955       begin
9956         // search default property of the class / interface
9957         Params.Save(OldInput);
9958         Params.Flags:=[fdfSearchInAncestors,fdfExceptionOnNotFound,fdfSearchInHelpers]
9959                       +fdfGlobals*Params.Flags;
9960         // special identifier '[' for default property
9961         Params.SetIdentifier(Self,@Src[CurAtom.StartPos],nil);
9962         Params.ContextNode:=ExprType.Context.Node;
9963         ExprType.Context.Tool.FindIdentifierInContext(Params);
9964         ExprType.Context:=CreateFindContext(Params);
9965         Params.Load(OldInput,true);
9966       end;
9967 
9968     ctnProperty, ctnGlobalProperty:
9969       begin
9970         if not ExprType.Context.Tool.PropertyNodeHasParamList(ExprType.Context.Node) then
9971           RaiseIdentInCurContextNotFound;
9972       end;
9973 
9974     ctnIdentifier:
9975       begin
9976         MoveCursorToNodeStart(ExprType.Context.Node);
9977         ReadNextAtom;
9978         if UpAtomIs('STRING') or UpAtomIs('ANSISTRING')
9979         or UpAtomIs('SHORTSTRING') then begin
9980           ExprType.Desc:=xtChar;
9981           ExprType.Context.Node:=nil;
9982           exit;
9983         end else if UpAtomIs('WIDESTRING') or UpAtomIs('UNICODESTRING') then begin
9984           ExprType.Desc:=xtWideChar;
9985           ExprType.Context.Node:=nil;
9986           exit;
9987         end else begin
9988           MoveCursorToCleanPos(CurAtom.StartPos);
9989           ReadNextAtom;
9990           RaiseIllegalQualifierFound;
9991         end;
9992       end;
9993 
9994     else
9995       MoveCursorToCleanPos(CurAtom.StartPos);
9996       ReadNextAtom;
9997       RaiseIllegalQualifierFound;
9998     end;
9999   end;
10000 
10001   procedure ResolveRoundBracketOpen;
10002   begin
10003     { for example:
10004         (a+b)   expression bracket: the type is the result type of the
10005                                     expression.
10006         a()     typecast or function
10007     }
10008     if not (NextAtomType in [vatSpace,vatPoint,vatAs,vatUp,vatRoundBracketClose,
10009       vatRoundBracketOpen,vatEdgedBracketClose,vatEdgedBracketOpen]) then
10010     begin
10011       MoveCursorToCleanPos(NextAtom.StartPos);
10012       ReadNextAtom;
10013       RaiseIllegalQualifierFound;
10014     end;
10015     if PrevAtomType<>vatNone then begin
10016       // typecast or function
10017       {$IFDEF ShowExprEval}
10018       debugln(['  FindExpressionTypeOfTerm ResolveRoundBracketOpen skip typecast/paramlist="',dbgstr(Src,CurAtom.StartPos,CurAtomBracketEndPos-CurAtom.StartPos),'"']);
10019       {$ENDIF}
10020       if fdfExtractOperand in Params.Flags then begin
10021         if (ExprType.Context.Node<>nil)
10022         and (ExprType.Context.Node.Desc=ctnTypeDefinition) then begin
10023           // typecast
10024           with ExprType.Context do
10025             Params.AddOperandPart(GetIdentifier(@Tool.Src[Node.StartPos]));
10026           Params.AddOperandPart('(');
10027           // assumption: one term in brakets
10028           FindExpressionTypeOfTerm(CurAtom.StartPos+1,CurAtomBracketEndPos-1,
10029             Params,false);
10030           Params.AddOperandPart(')');
10031         end;
10032       end;
10033       if fdfOverrideStringTypesWithFirstParamType in Params.Flags then begin
10034         if (ExprType.Context.Node<>nil)
10035         and (ExprType.Context.Node.Desc in [ctnProcedure, ctnProcedureHead])
10036         and (FirstParamStartPos<0) then begin
10037           FirstParamStartPos := CurAtom.StartPos;
10038           FirstParamProcContext := ExprType.Context;
10039         end;
10040       end;
10041     end else begin
10042       // expression
10043       {$IFDEF ShowExprEval}
10044       debugln(['  FindExpressionTypeOfTerm ResolveRoundBracketOpen subexpr="',dbgstr(Src,CurAtom.StartPos,CurAtomBracketEndPos-CurAtom.StartPos),'"']);
10045       {$ENDIF}
10046       ExprType:=FindExpressionResultType(Params,CurAtom.StartPos+1,
10047                                          CurAtomBracketEndPos-1, AliasType);
10048     end;
10049   end;
10050 
10051   procedure ResolveINHERITED;
10052   // for example: inherited A; inherited;
10053   // inherited skips the class and begins to search in the ancestor class
10054   var
10055     ProcNode: TCodeTreeNode;
10056     ClassNodeOfMethod: TCodeTreeNode;
10057     HasIdentifier: Boolean;
10058     Context: TFindContext;
10059   var
10060     DefProcNode: TCodeTreeNode;
10061     HelperForExpr: TExpressionType;
10062     SearchInHelpersInTheEnd: Boolean;
10063   begin
10064     if ExprType.Desc=xtNone then
10065       Context:=CreateFindContext(Self,StartNode)
10066     else
10067       Context:=ExprType.Context;
10068 
10069     if (Context.Node<>StartNode) or (Context.Node=nil) then begin
10070       MoveCursorToCleanPos(CurAtom.StartPos);
10071       RaiseIllegalQualifierFound;
10072     end;
10073     ProcNode:=GetMethodOfBody(Context.Node);
10074     if ProcNode=nil then begin
10075       MoveCursorToCleanPos(CurAtom.StartPos);
10076       RaiseException(20170421200601,ctsInheritedKeywordOnlyAllowedInMethods);
10077     end;
10078     HasIdentifier:=NextAtom.EndPos<=EndPos;
10079     if HasIdentifier then begin
10080       if (not (NextAtomType in [vatIdentifier,vatPreDefIdentifier])) then
10081       begin
10082         MoveCursorToCleanPos(NextAtom.StartPos);
10083         ReadNextAtom;
10084         RaiseIdentExpected;
10085       end;
10086 
10087       ReadNextExpressionAtom;
10088     end;
10089     {$IFDEF ShowExprEval}
10090     DebugLn('  FindExpressionTypeOfTerm ResolveINHERITED CurAtomType=',
10091       VariableAtomTypeNames[CurAtomType],
10092       ' CurAtom="',copy(Src,CurAtom.StartPos,CurAtom.EndPos-CurAtom.StartPos),'"');
10093     {$ENDIF}
10094 
10095     // find class of method
10096     ClassNodeOfMethod:=FindClassOfMethod(ProcNode,true,true);
10097 
10098     // find class ancestor
10099     OldInput.Flags:=Params.Flags;
10100     Params.Flags:=[fdfSearchInParentNodes,fdfExceptionOnNotFound]
10101                   +fdfGlobals*Params.Flags;
10102     FindAncestorOfClass(ClassNodeOfMethod,Params,true);
10103     Params.Flags:=OldInput.Flags;
10104 
10105     ExprType.Desc:=xtContext;
10106     ExprType.Context:=CreateFindContext(Params);
10107 
10108     SearchInHelpersInTheEnd := False;
10109     if ClassNodeOfMethod.Desc in [ctnClassHelper,ctnRecordHelper] then
10110     begin
10111       // helpers have different order in "inherited" call.
10112       // -> first search in extended class and then in helper (applies only to inherited call)
10113       if (ExprType.Context.Node<>nil) then//inherited helper found -> use it!
10114         Params.GetHelpers(fdhlkDelphiHelper,true)
10115           .AddFromHelperNode(ExprType.Context.Node, ExprType.Context.Tool, True)
10116       else//inherited helper not found -> delete current
10117         Params.GetHelpers(fdhlkDelphiHelper,true)
10118           .DeleteHelperNode(ClassNodeOfMethod, Self);
10119 
10120       HelperForExpr := FindExtendedExprOfHelper(ClassNodeOfMethod);
10121       if HelperForExpr.Desc = xtContext then
10122       begin
10123         ExprType.Context := HelperForExpr.Context;
10124         SearchInHelpersInTheEnd := True;
10125       end;
10126     end;
10127 
10128     if (not HasIdentifier) then begin
10129       // the keyword 'inherited' is the last atom
10130       if StartFlags*[fdfFindChildren,fdfFindVariable]=[fdfFindVariable] then begin
10131         // for example: inherited; search the method, not the context
10132         DefProcNode:=FindCorrespondingProcNode(ProcNode);
10133         if DefProcNode=nil then begin
10134           MoveCursorToProcName(ProcNode,true);
10135           RaiseExceptionFmt(20170421200604,ctsMethodSignatureSNotFoundInClass, [GetAtom]);
10136         end;
10137         MoveCursorToProcName(DefProcNode,true);
10138       end else begin
10139         // for example: inherited |
10140         // return the ancestor class context
10141         exit;
10142       end;
10143     end else
10144       MoveCursorToCleanPos(CurAtom.StartPos);
10145 
10146     // search identifier only in class ancestor
10147     if SearchInHelpersInTheEnd then
10148       Params.Flags := Params.Flags + [fdfSearchInHelpersInTheEnd];
10149     Params.Save(OldInput);
10150     Params.SetIdentifier(Self,@Src[CurPos.StartPos],@CheckSrcIdentifier);
10151     Params.ContextNode:=ExprType.Context.Node;
10152     Params.Flags:=Params.Flags-[fdfSearchInParentNodes]
10153                               +[fdfExceptionOnNotFound,fdfSearchInAncestors];
10154     ExprType.Context.Tool.FindIdentifierInContext(Params);
10155     ExprType.Context:=CreateFindContext(Params);
10156     Params.Load(OldInput,true);
10157     Params.Flags := Params.Flags - [fdfSearchInHelpersInTheEnd];
10158   end;
10159 
10160 begin
10161   Result:=CleanExpressionType;
10162   FirstParamStartPos := -1;
10163   FirstParamProcContext := CleanFindContext;
10164   StartFlags:=Params.Flags;
10165   StartNode:=Params.ContextNode;
10166   {$IFDEF ShowExprEval}
10167   DebugLn(['[TFindDeclarationTool.FindExpressionTypeOfTerm] START',
10168     ' Flags=[',dbgs(Params.Flags),']',
10169     ' StartContext=',StartNode.DescAsString,'=',dbgstr(Src,StartNode.StartPos,15),
10170     ' Alias=',AliasType<>nil]
10171   );
10172   {$ENDIF}
10173   {$IFDEF CheckNodeTool}
10174   CheckNodeTool(StartNode);
10175   {$ENDIF}
10176 
10177   if not InitAtomQueue then exit;
10178   ExprType:=CleanExpressionType;
10179   repeat
10180     {$IFDEF ShowExprEval}
10181     DebugLn(['  FindExpressionTypeOfTerm ATOM',
10182       ' CurAtomType=',VariableAtomTypeNames[CurAtomType],
10183       ' CurAtom="',GetAtom(CurAtom),'"',
10184       ' ExprType=',ExprTypeToString(ExprType)]);
10185     {$ENDIF}
10186     case CurAtomType of
10187     vatIdentifier, vatPreDefIdentifier: ResolveIdentifier;
10188     vatStringConstant,vatNumber: ResolveConstant;
10189     vatPoint:             ResolvePoint;
10190     vatAS:                ResolveAs;
10191     vatUP:                ResolveUp;
10192     vatEdgedBracketOpen:  ResolveEdgedBracketOpen;
10193     vatRoundBracketOpen:  ResolveRoundBracketOpen;
10194     vatINHERITED:         ResolveINHERITED;
10195     end;
10196     ReadNextExpressionAtom;
10197   until CurAtom.EndPos>EndPos;
10198 
10199   if fdfFunctionResult in StartFlags then
10200     ResolveChildren;
10201 
10202   Result:=ExprType;
10203   if (Result.Desc=xtContext) and (not (fdfFindVariable in StartFlags))
10204   and (not (Result.Context.Node.Desc = ctnSpecialize)) then
10205     Result:=Result.Context.Tool.ConvertNodeToExpressionType(
10206                  Result.Context.Node,Params);
10207   {$IFDEF ShowExprEval}
10208   DebugLn('  FindExpressionTypeOfTerm Result=',ExprTypeToString(Result));
10209   {$ENDIF}
10210 end;
10211 
FindEndOfExpressionnull10212 function TFindDeclarationTool.FindEndOfExpression(StartPos: integer): integer;
10213 var
10214   First: Integer;
10215 begin
10216   MoveCursorToCleanPos(StartPos);
10217   Result:=CurPos.StartPos;
10218   First:=0;
10219   repeat
10220     ReadNextAtom;
10221     if First=0 then begin
10222       First:=CurPos.StartPos;
10223       if UpAtomIs('INHERITED') then begin
10224         Result:=CurPos.EndPos;
10225         ReadNextAtom;
10226       end;
10227     end;
10228     // read till statement end
10229     if (CurPos.StartPos>SrcLen)
10230     or (CurPos.Flag in [cafSemicolon,cafComma,cafEnd,
10231                         cafRoundBracketClose,cafEdgedBracketClose])
10232     or (AtomIsKeyWord
10233       and not IsKeyWordInConstAllowed.DoItCaseInsensitive(Src,
10234                                  CurPos.StartPos,CurPos.EndPos-CurPos.StartPos))
10235     then begin
10236       break;
10237     end
10238     else if CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen] then begin
10239       ReadTilBracketClose(true);
10240     end;
10241     Result:=CurPos.EndPos;
10242   until false;
10243 end;
10244 
ConvertNodeToExpressionTypenull10245 function TFindDeclarationTool.ConvertNodeToExpressionType(Node: TCodeTreeNode;
10246   Params: TFindDeclarationParams; AliasType: PFindContext): TExpressionType;
10247 
10248   procedure ConvertIdentifierAtCursor(Tool: TFindDeclarationTool);
10249   begin
10250     if WordIsPredefinedIdentifier.DoItCaseInsensitive(Tool.Src,Tool.CurPos.StartPos,
10251       Tool.CurPos.EndPos-Tool.CurPos.StartPos) then
10252     begin
10253       // predefined identifiers
10254       ConvertNodeToExpressionType:=Tool.FindExpressionTypeOfPredefinedIdentifier(
10255                                                     Tool.CurPos.StartPos,Params);
10256     end;
10257   end;
10258 
10259 var
10260   BaseContext: TFindContext;
10261   OldInput: TFindDeclarationInput;
10262   Tool: TFindDeclarationTool;
10263   CurAliasType: PFindContext;
10264 begin
10265   {$IFDEF CheckNodeTool}CheckNodeTool(Node);{$ENDIF}
10266   {$IFDEF ShowExprEval}
10267   DebugLn(['[TFindDeclarationTool.ConvertNodeToExpressionType] A',
10268   ' Node=',Node.DescAsString,' "',dbgstr(copy(ExtractNode(Node,[]),1,30)),'" Flags=[',dbgs(Params.Flags),'] Alias=',AliasType<>nil]);
10269   {$ENDIF}
10270   BaseContext:=FindBaseTypeOfNode(Params,Node,AliasType);
10271   Node:=BaseContext.Node;
10272   Tool:=BaseContext.Tool;
10273   Result:=CleanExpressionType;
10274   Result.Desc:=xtContext;
10275   Result.Context:=BaseContext;
10276   {$IFDEF ShowExprEval}
10277   DebugLn('[TFindDeclarationTool.ConvertNodeToExpressionType] B',
10278   ' Expr=',ExprTypeToString(Result),' Alias=',FindContextToString(AliasType));
10279   {$ENDIF}
10280   if (AliasType<>nil) and (AliasType^.Node=nil) then
10281     CurAliasType:=AliasType
10282   else
10283     CurAliasType:=nil;
10284   case Node.Desc of
10285   ctnRangeType:
10286     begin
10287       // range type -> convert to special expression type
10288       // for example: type c = 1..3;
10289 
10290       // ToDo: ppu, dcu files
10291 
10292       Tool.MoveCursorToNodeStart(Node);
10293 
10294       // ToDo: check for cycles
10295 
10296       Params.Save(OldInput);
10297       Params.ContextNode:=Node;
10298       Result:=Tool.ReadOperandTypeAtCursor(Params,-1,CurAliasType);
10299       Params.Load(OldInput,true);
10300       Result.Context:=CreateFindContext(Tool,Node);
10301     end;
10302 
10303   ctnConstDefinition:
10304     begin
10305       // const -> convert to special expression type
10306       // for example: const a: integer = 3;
10307 
10308       // ToDo: ppu, dcu files
10309 
10310       Tool.MoveCursorToNodeStart(Node);
10311 
10312       Tool.ReadNextAtom;
10313       if not Tool.AtomIsIdentifier then exit;
10314       Tool.ReadNextAtom;
10315       if not (CurPos.Flag in [cafEqual,cafColon]) then exit;
10316       Tool.ReadNextAtom;
10317 
10318       // ToDo: check for cycles
10319 
10320       Params.Save(OldInput);
10321       Params.ContextNode:=Node;
10322       Result:=Tool.ReadOperandTypeAtCursor(Params,-1,CurAliasType);
10323       Params.Load(OldInput,true);
10324       Result.Context:=CreateFindContext(Tool,Node);
10325     end;
10326 
10327   ctnIdentifier:
10328     begin
10329 
10330       // ToDo: ppu, dcu files
10331 
10332       Tool.MoveCursorToNodeStart(Node);
10333       Tool.ReadNextAtom;
10334       ConvertIdentifierAtCursor(Tool);
10335     end;
10336 
10337   ctnProperty,ctnGlobalProperty:
10338     begin
10339 
10340       // ToDo: ppu, dcu files
10341 
10342       if Tool.MoveCursorToPropType(Node) then
10343         ConvertIdentifierAtCursor(Tool);
10344     end;
10345 
10346   ctnConstant:
10347     begin
10348       // for example: const a = 3;
10349 
10350       // ToDo: ppu, dcu files
10351 
10352       Tool.MoveCursorToNodeStart(Node);
10353       Params.Save(OldInput);
10354       Params.ContextNode:=Node;
10355       Result:=Tool.ReadOperandTypeAtCursor(Params,-1,CurAliasType);
10356       Params.Load(OldInput,true);
10357       Result.Context:=CreateFindContext(Tool,Node);
10358     end;
10359   end;
10360 
10361   {$IFDEF ShowExprEval}
10362   DebugLn('[TFindDeclarationTool.ConvertNodeToExpressionType] END',
10363   ' Expr=',ExprTypeToString(Result),' Alias=',FindContextToString(AliasType));
10364   {$ENDIF}
10365 end;
10366 
ReadOperandTypeAtCursornull10367 function TFindDeclarationTool.ReadOperandTypeAtCursor(
10368   Params: TFindDeclarationParams; MaxEndPos: integer; AliasType: PFindContext
10369   ): TExpressionType;
10370 { internally used by FindExpressionResultType
10371   after reading, the cursor will be on the next atom
10372 }
10373 var EndPos, SubStartPos: integer;
10374 
10375   procedure ReadEdgedBracketOperand;
10376 
10377     procedure RaiseConstExpected;
10378     begin
10379       RaiseExceptionFmt(20170421200607,ctsStrExpectedButAtomFound,[ctsConstant,GetAtom]);
10380     end;
10381 
10382   begin
10383     // 'set' constant
10384     SubStartPos:=CurPos.StartPos;
10385     ReadNextAtom;
10386     if not AtomIsChar(']') then begin
10387       Result:=ReadOperandTypeAtCursor(Params);
10388       {$IFDEF ShowExprEval}
10389       DebugLn('[TFindDeclarationTool.ReadOperandTypeAtCursor] Set of ',
10390       ExpressionTypeDescNames[Result.Desc]);
10391       if Result.Desc=xtContext then
10392         DebugLn('  Result.Context.Node=',Result.Context.Node.DescAsString);
10393       {$ENDIF}
10394     end else begin
10395       // empty set '[]'
10396       Result.Desc:=xtNone;
10397     end;
10398     Result.SubDesc:=Result.Desc;
10399     Result.Desc:=xtConstSet;
10400     MoveCursorToCleanPos(SubStartPos);
10401     ReadNextAtom;
10402     ReadTilBracketClose(true);
10403     MoveCursorToCleanPos(CurPos.EndPos);
10404   end;
10405 
10406   procedure RaiseIdentExpected;
10407   begin
10408     RaiseExceptionFmt(20170421200609,ctsStrExpectedButAtomFound,[ctsIdentifier,GetAtom]);
10409   end;
10410 
10411 var
10412   OldFlags: TFindDeclarationFlags;
10413 begin
10414   Result:=CleanExpressionType;
10415   if AliasType<>nil then
10416     AliasType^:=CleanFindContext;
10417 
10418   if CurPos.StartPos=CurPos.EndPos then ReadNextAtom;
10419   // read unary operators which have no effect on the type: +, -, not
10420   while AtomIsChar('+') or AtomIsChar('-') or UpAtomIs('NOT') do
10421     ReadNextAtom;
10422   {$IFDEF ShowExprEval}
10423   DebugLn('[TFindDeclarationTool.ReadOperandTypeAtCursor] A Atom=',GetAtom);
10424   debugln(['TFindDeclarationTool.ReadOperandTypeAtCursor StartContext=',Params.ContextNode.DescAsString,'="',dbgstr(Src,Params.ContextNode.StartPos,15),'"']);
10425   {$ENDIF}
10426   if (AtomIsIdentifier)
10427   or (CurPos.Flag=cafRoundBracketOpen)
10428   or UpAtomIs('INHERITED')
10429   or UpAtomIs('ARRAY')
10430   then begin
10431     // read variable
10432     SubStartPos:=CurPos.StartPos;
10433     EndPos:=FindEndOfTerm(SubStartPos,false,true);
10434     if EndPos>MaxEndPos then
10435       EndPos:=MaxEndPos;
10436     OldFlags:=Params.Flags;
10437     Params.Flags:=(Params.Flags*fdfGlobals)+[fdfFunctionResult];
10438     Result:=FindExpressionTypeOfTerm(SubStartPos,EndPos,Params,true,AliasType);
10439     Params.Flags:=OldFlags;
10440     MoveCursorToCleanPos(EndPos);
10441   end
10442   else if UpAtomIs('NIL') then begin
10443     Result.Desc:=xtNil;
10444     ReadNextAtom;
10445   end
10446   else if AtomIsChar('[') then begin
10447     ReadEdgedBracketOperand;
10448   end
10449   else if AtomIsStringConstant then begin
10450     // string or char constant
10451     if AtomIsCharConstant then
10452       Result.Desc:=xtChar
10453     else
10454       Result.Desc:=xtConstString;
10455     MoveCursorToCleanPos(CurPos.StartPos);
10456     ReadAsStringConstant;
10457   end
10458   else if AtomIsNumber then begin
10459     // ordinal or real constant
10460     if AtomIsRealNumber then
10461       Result.Desc:=xtConstReal
10462     else
10463       Result.Desc:=xtConstOrdInteger;
10464     MoveCursorToCleanPos(CurPos.EndPos);
10465   end
10466   else if AtomIsChar('@') then begin
10467     // a simple pointer or a PChar or an event
10468     ReadNextAtom;
10469     if CurPos.Flag=cafWord then begin
10470       SubStartPos:=CurPos.StartPos;
10471       EndPos:=FindEndOfTerm(SubStartPos,false,true);
10472       if EndPos>MaxEndPos then
10473         EndPos:=MaxEndPos;
10474       OldFlags:=Params.Flags;
10475       Params.Flags:=(Params.Flags*fdfGlobals)-[fdfFunctionResult];
10476       Result:=FindExpressionTypeOfTerm(SubStartPos,EndPos,Params,true,AliasType);
10477       Params.Flags:=OldFlags;
10478       MoveCursorToCleanPos(EndPos);
10479     end else begin
10480       MoveCursorToCleanPos(CurPos.StartPos);
10481       Result:=ReadOperandTypeAtCursor(Params);
10482     end;
10483     if (Result.Desc=xtContext)
10484     or ((Result.Context.Node<>nil) and (Result.Context.Node.Desc=ctnProcedure))
10485     then begin
10486       Result.SubDesc:=Result.Desc;
10487       Result.Desc:=xtPointer;
10488     end else if (Result.Desc=xtChar) then begin
10489       Result.SubDesc:=xtNone;
10490       Result.Desc:=xtPChar
10491     end else begin
10492       Result.SubDesc:=xtNone;
10493       Result.Context:=CleanFindContext;
10494       Result.Desc:=xtPointer;
10495     end;
10496   end
10497   else
10498     RaiseIdentExpected;
10499 
10500   {$IFDEF ShowExprEval}
10501   DbgOut('[TFindDeclarationTool.ReadOperandTypeAtCursor] END ',
10502   ExpressionTypeDescNames[Result.Desc]);
10503   if Result.Context.Node<>nil then
10504     DbgOut(' Context.Node=',Result.Context.Node.DescAsString)
10505   else
10506     DbgOut(' Context.Node=nil');
10507   if AliasType<>nil then
10508     DbgOut(' Alias=',FindContextToString(AliasType));
10509   DebugLn('');
10510   {$ENDIF}
10511 end;
10512 
FindExpressionTypeOfPredefinedIdentifiernull10513 function TFindDeclarationTool.FindExpressionTypeOfPredefinedIdentifier(
10514   StartPos: integer; Params: TFindDeclarationParams; AliasType: PFindContext
10515   ): TExpressionType;
10516 var
10517   IdentPos: PChar;
10518   ParamList: TExprTypeList;
10519   ParamNode: TCodeTreeNode;
10520   SubParams: TFindDeclarationParams;
10521   NewTool: TFindDeclarationTool;
10522 begin
10523   Result:=CleanExpressionType;
10524   IdentPos:=@Src[StartPos];
10525   Result.Desc:=PredefinedIdentToExprTypeDesc(IdentPos,Scanner.PascalCompiler);
10526 
10527   {$IFDEF ShowExprEval}
10528   debugln('TFindDeclarationTool.FindExpressionTypeOfPredefinedIdentifier "',GetIdentifier(IdentPos),'" ',
10529     ExpressionTypeDescNames[Result.Desc]);
10530   if Result.desc=xtNone then begin
10531     //CTDumpStack;
10532     //IsWordBuiltInFunc.WriteDebugListing;
10533   end;
10534   {$ENDIF}
10535   ParamList:=nil;
10536   try
10537     case Result.Desc of
10538     xtCompilerFunc:
10539       begin
10540         if not (Params.ContextNode.Desc in (AllPascalStatements+[ctnConstant])) then begin
10541           {$IFDEF ShowExprEval}
10542           debugln(['TFindDeclarationTool.FindExpressionTypeOfPredefinedIdentifier Skipping non expr parent ContextNode=',Params.ContextNode.DescAsString]);
10543           {$ENDIF}
10544           exit;
10545         end;
10546         MoveCursorToCleanPos(StartPos);
10547         ReadNextAtom;
10548         ReadNextAtom;
10549         if not AtomIsChar('(') then
10550           exit;
10551         ParamList:=CreateParamExprListFromStatement(CurPos.StartPos,Params,true);
10552         if (CompareIdentifiers(IdentPos,'PRED')=0)
10553         or (CompareIdentifiers(IdentPos,'SUCC')=0)
10554         or (CompareIdentifiers(IdentPos,'DEFAULT')=0)
10555         then begin
10556           // the DEFAULT, PRED and SUCC of a expression has the same type as the expression
10557           if ParamList.Count<>1 then exit;
10558           Result:=ParamList.Items[0];
10559           if AliasType<>nil then
10560             AliasType^:=ParamList.AliasTypes[0];
10561           //debugln(['TFindDeclarationTool.FindExpressionTypeOfPredefinedIdentifier ',ExprTypeToString(Result)]);
10562         end
10563         else if (CompareIdentifiers(IdentPos,'LOW')=0)
10564              or (CompareIdentifiers(IdentPos,'HIGH')=0) then
10565         begin
10566           {$IFDEF ShowExprEval}
10567           debugln('TFindDeclarationTool.FindExpressionTypeOfPredefinedIdentifier Ident=',GetIdentifier(IdentPos));
10568           {$ENDIF}
10569           { examples:
10570              Low(ordinal type)  is the ordinal type
10571              Low(array)         has type of the array items
10572              Low(set)           has type of the enums
10573           }
10574           if ParamList.Count<>1 then exit;
10575           Result:=ParamList.Items[0];
10576           if Result.Desc<>xtContext then exit;
10577           ParamNode:=Result.Context.Node;
10578           case ParamNode.Desc of
10579 
10580           ctnEnumerationType:
10581             // Low(enum)   has the type of the enum
10582             if (ParamNode.Parent<>nil)
10583             and (ParamNode.Parent.Desc=ctnTypeDefinition) then
10584               Result.Context.Node:=ParamNode.Parent;
10585 
10586           ctnOpenArrayType:
10587             // array without explicit range -> open array
10588             // Low(Open array) is ordinal integer
10589             begin
10590               Result.Desc:=xtConstOrdInteger;
10591               Result.Context:=CleanFindContext;
10592             end;
10593 
10594           ctnRangedArrayType:
10595             begin
10596               // array with explicit range
10597               // Low(array[SubRange])  has the type of the subrange
10598               Result.Context.Tool.MoveCursorToNodeStart(ParamNode.FirstChild);
10599               SubParams:=TFindDeclarationParams.Create(Params);
10600               try
10601                 SubParams.Flags:=fdfDefaultForExpressions;
10602                 SubParams.ContextNode:=ParamNode;
10603                 Result:=Result.Context.Tool.ReadOperandTypeAtCursor(SubParams);
10604               finally
10605                 SubParams.Free;
10606               end;
10607             end;
10608 
10609           else
10610             DebugLn('NOTE: unimplemented Low(type) type=',ParamNode.DescAsString);
10611           end;
10612         end
10613         else if (CompareIdentifiers(IdentPos,'LENGTH')=0) then
10614         begin
10615           if ParamList.Count<>1 then exit;
10616           Result.Desc:=xtConstOrdInteger;
10617         end
10618         else if (CompareIdentifiers(IdentPos,'COPY')=0) then
10619         begin
10620           if (ParamList.Count<1) or (ParamList.Count>3) or (Scanner.Values.IsDefined('VER1_0')) then
10621             exit;
10622           Result:=ParamList.Items[0]; // Copy sets the result based on the first
10623             // parameter (can be any kind of string or array)
10624         end
10625         else if (CompareIdentifiers(IdentPos,'GET_FRAME')=0) then
10626         begin
10627           if ParamList.Count<>1 then exit;
10628           Result.Desc:=xtPointer;
10629         end
10630         else if (CompareIdentifiers(IdentPos,'OBJCSELECTOR')=0) then
10631         begin
10632           // return type is System.SEL
10633           NewTool:=FindCodeToolForUsedUnit('system','',true);
10634           if NewTool=nil then exit;
10635           SubParams:=TFindDeclarationParams.Create(Params);
10636           try
10637             SubParams.Identifier:='SEL'#0;
10638             if (not NewTool.FindIdentifierInInterface(Self,SubParams))
10639             or (SubParams.NewNode=nil) then exit;
10640             Result.Desc:=xtContext;
10641             Result.Context.Node:=SubParams.NewNode;
10642             Result.Context.Tool:=SubParams.NewCodeTool;
10643           finally
10644             SubParams.Free;
10645           end;
10646         end;
10647       end;
10648 
10649     xtString:
10650       Result.Desc:=GetDefaultStringType;
10651     end;
10652   finally
10653     ParamList.Free;
10654   end;
10655 end;
10656 
FindExpressionTypeOfConstSetnull10657 function TFindDeclarationTool.FindExpressionTypeOfConstSet(Node: TCodeTreeNode
10658   ): TExpressionType;
10659 var
10660   AliasType: TFindContext;
10661   Params: TFindDeclarationParams;
10662 begin
10663   Result:=CleanExpressionType;
10664   if Node=nil then
10665     RaiseException(20170421212058,'TFindDeclarationTool.FindExpressionTypeOfConstSet Node=nil');
10666   {$IFDEF CheckNodeTool}
10667   CheckNodeTool(Node);
10668   {$ENDIF}
10669   MoveCursorToNodeStart(Node);
10670   ReadNextAtom;
10671   if CurPos.Flag<>cafEdgedBracketOpen then
10672     RaiseStringExpectedButAtomFound(20170421212227,'[');
10673   ReadNextAtom;
10674   Params:=TFindDeclarationParams.Create(Self,Node);
10675   try
10676     Params.Flags:=fdfDefaultForExpressions+[fdfFunctionResult];
10677     AliasType:=CleanFindContext;
10678     Result:=FindExpressionTypeOfTerm(CurPos.StartPos,-1,Params,false,@AliasType);
10679     //debugln(['TFindDeclarationTool.FindExpressionTypeOfConstSet ',ExprTypeToString(Result)]);
10680   finally
10681     Params.Free;
10682   end;
10683 end;
10684 
GetDefaultStringTypenull10685 function TFindDeclarationTool.GetDefaultStringType: TExpressionTypeDesc;
10686 begin
10687   if cmsDefault_unicodestring in Scanner.CompilerModeSwitches then
10688     Result:=xtUnicodeString
10689   else if (Scanner.PascalCompiler=pcDelphi)
10690   or ((Scanner.CompilerMode=cmDELPHI)
10691   or (Scanner.Values['LONGSTRINGS']='1')) then
10692     Result:=xtAnsiString
10693   else
10694     Result:=xtString;
10695 end;
10696 
CalculateBinaryOperatornull10697 function TFindDeclarationTool.CalculateBinaryOperator(LeftOperand,
10698   RightOperand: TOperand; BinaryOperator: TAtomPosition;
10699   Params: TFindDeclarationParams): TOperand;
10700 begin
10701   Result.Expr:=CleanExpressionType;
10702   Result.AliasType:=CleanFindContext;
10703   {$IFDEF ShowExprEval}
10704   DebugLn('[TFindDeclarationTool.CalculateBinaryOperator] A',
10705   ' LeftOperand=',ExprTypeToString(LeftOperand.Expr),
10706   ' Operator=',GetAtom(BinaryOperator),
10707   ' RightOperand=',ExprTypeToString(RightOperand.Expr)
10708   );
10709   {$ENDIF}
10710   // convert Left and RightOperand contexts to expressiontype
10711   if LeftOperand.Expr.Desc=xtContext then begin
10712     LeftOperand.Expr:=LeftOperand.Expr.Context.Tool.ConvertNodeToExpressionType(
10713                       LeftOperand.Expr.Context.Node,Params);
10714   end;
10715   if RightOperand.Expr.Desc=xtContext then begin
10716     RightOperand.Expr:=RightOperand.Expr.Context.Tool.ConvertNodeToExpressionType(
10717                       RightOperand.Expr.Context.Node,Params);
10718   end;
10719 
10720 
10721   // ToDo: search for an overloaded operator
10722 
10723   if WordIsBooleanOperator.DoItCaseInsensitive(Src,BinaryOperator.StartPos,
10724     BinaryOperator.EndPos-BinaryOperator.StartPos)
10725   then begin
10726     // Boolean operators
10727     // < > <= >= <> in is
10728     Result.Expr.Desc:=xtBoolean;
10729   end
10730   else if (BinaryOperator.EndPos-BinaryOperator.StartPos=1)
10731   and (Src[BinaryOperator.StartPos]='/') then begin
10732     // real division /
10733     Result:=RealTypesOrderList.Compare(LeftOperand, RightOperand, Self, BinaryOperator.EndPos);
10734     if not(Result.Expr.Desc in xtAllRealTypes) then
10735     begin
10736       Result.Expr.Desc:=xtConstReal;
10737       Result.AliasType:=CleanFindContext;
10738     end;
10739   end
10740   else if WordIsOrdNumberOperator.DoItCaseInsensitive(Src,BinaryOperator.StartPos,
10741     BinaryOperator.EndPos-BinaryOperator.StartPos)
10742   then begin
10743     // ordinal number operator
10744     // or xor and mod div shl shr
10745     if LeftOperand.Expr.Desc in xtAllBooleanTypes then
10746       Result:=BooleanTypesOrderList.Compare(LeftOperand, RightOperand, Self, BinaryOperator.EndPos)
10747     else
10748       Result:=IntegerTypesOrderList.Compare(LeftOperand, RightOperand, Self, BinaryOperator.EndPos);
10749   end
10750   else if WordIsNumberOperator.DoItCaseInsensitive(Src,BinaryOperator.StartPos,
10751     BinaryOperator.EndPos-BinaryOperator.StartPos)
10752   then begin
10753     // number operator (or string concatenating or set cut)
10754     // + - *
10755 
10756     if (Src[BinaryOperator.StartPos]='+')
10757     and (LeftOperand.Expr.Desc in xtAllStringCompatibleTypes)
10758     then begin
10759       // string/char '+'
10760       if (RightOperand.Expr.Desc in xtAllStringCompatibleTypes)
10761       then
10762       begin
10763         Result:=StringTypesOrderList.Compare(LeftOperand, RightOperand, Self, BinaryOperator.EndPos);
10764         if not(Result.Expr.Desc in xtAllStringTypes) then
10765         begin
10766           Result.Expr.Desc:=xtConstString;
10767           Result.AliasType:=CleanFindContext;
10768         end;
10769       end else begin
10770         MoveCursorToCleanPos(BinaryOperator.EndPos);
10771         ReadNextAtom;
10772         RaiseExceptionFmt(20170421200612,ctsIncompatibleTypesGotExpected,
10773                           ['char',ExpressionTypeDescNames[RightOperand.Expr.Desc]]);
10774       end;
10775     end else if (Src[BinaryOperator.StartPos] in ['+','-','*'])
10776     and (LeftOperand.Expr.Desc=xtContext)
10777     and (LeftOperand.Expr.Context.Node<>nil)
10778     and (LeftOperand.Expr.Context.Node.Desc=ctnSetType)
10779     then begin
10780       Result:=LeftOperand;
10781     end else begin
10782       if (LeftOperand.Expr.Desc in xtAllRealTypes)
10783       or (RightOperand.Expr.Desc in xtAllRealTypes) then
10784         Result:=RealTypesOrderList.Compare(LeftOperand, RightOperand, Self, BinaryOperator.EndPos)
10785       else if (LeftOperand.Expr.Desc=xtPointer)
10786       or (RightOperand.Expr.Desc=xtPointer)
10787       or ((LeftOperand.Expr.Desc=xtContext)
10788         and (LeftOperand.Expr.Context.Node.Desc=ctnPointerType))
10789       or ((RightOperand.Expr.Desc=xtContext)
10790         and (RightOperand.Expr.Context.Node.Desc=ctnPointerType))
10791       then
10792         Result.Expr.Desc:=xtPointer
10793       else
10794         Result:=IntegerTypesOrderList.Compare(LeftOperand, RightOperand, Self, BinaryOperator.EndPos);
10795     end;
10796   end else begin
10797     // ???
10798     {$IFDEF ShowExprEval}
10799     debugln(['TFindDeclarationTool.CalculateBinaryOperator unknown operator: ',GetAtom(BinaryOperator)]);
10800     {$ENDIF}
10801     Result:=RightOperand;
10802   end;
10803 end;
10804 
IsParamExprListCompatibleToNodeListnull10805 function TFindDeclarationTool.IsParamExprListCompatibleToNodeList(
10806   FirstTargetParameterNode: TCodeTreeNode;
10807   SourceExprParamList: TExprTypeList;  IgnoreMissingParameters: boolean;
10808   Params: TFindDeclarationParams;
10809   CompatibilityList: TTypeCompatibilityList): TTypeCompatibility;
10810 // tests if SourceExprParamList fits into the TargetFirstParameterNode
10811 var
10812   ParamNode: TCodeTreeNode;
10813   i, MinParamCnt, MaxParamCnt: integer;
10814   ParamCompatibility: TTypeCompatibility;
10815   CompatibilityListCount: LongInt;
10816 begin
10817   {$IFDEF CheckNodeTool}CheckNodeTool(FirstTargetParameterNode);{$ENDIF}
10818   // quick check: parameter count
10819   ParamNode:=FirstTargetParameterNode;
10820   MinParamCnt:=0;
10821   while (ParamNode<>nil)
10822   and ((ParamNode.SubDesc and ctnsHasDefaultValue)=0) do begin
10823     ParamNode:=ParamNode.NextBrother;
10824     inc(MinParamCnt);
10825   end;
10826   MaxParamCnt:=MinParamCnt;
10827   while (ParamNode<>nil) do begin
10828     ParamNode:=ParamNode.NextBrother;
10829     inc(MaxParamCnt);
10830   end;
10831 
10832   {$IF defined(ShowExprEval) or defined(ShowProcSearch)}
10833   DebugLn('[TFindDeclarationTool.IsParamExprListCompatibleToNodeList] ',
10834   ' ExprParamList.Count=',dbgs(SourceExprParamList.Count),
10835   ' MinParamCnt=',dbgs(MinParamCnt),' MaxParamCnt=',dbgs(MaxParamCnt)
10836   );
10837     try
10838   {$ENDIF}
10839   Result:=tcExact;
10840 
10841   if (SourceExprParamlist.Count>MaxParamCnt)
10842   or ((not IgnoreMissingParameters) and (SourceExprParamList.Count<MinParamCnt))
10843   then begin
10844     Result:=tcIncompatible;
10845     exit;
10846   end;
10847 
10848   // check each parameter for compatibility
10849   ParamNode:=FirstTargetParameterNode;
10850   i:=0;
10851   CompatibilityListCount:=SourceExprParamList.Count;
10852   while (ParamNode<>nil) and (i<CompatibilityListCount) do begin
10853     ParamCompatibility:=IsCompatible(ParamNode,SourceExprParamList.Items[i],
10854                                      Params);
10855     {$IF defined(ShowExprEval) or defined(ShowProcSearch)}
10856     DebugLn(['[TFindDeclarationTool.IsParamExprListCompatibleToNodeList] SourceParam=',ExprTypeToString(SourceExprParamList.Items[i]),' TargetParam=',ExtractNode(ParamNode,[]),' ',TypeCompatibilityNames[ParamCompatibility]]);
10857     {$ENDIF}
10858     if CompatibilityList<>nil then
10859       CompatibilityList[i]:=ParamCompatibility;
10860     if (ParamCompatibility=tcIncompatible)
10861     or ((ParamCompatibility=tcCompatible)
10862         and MoveCursorToParameterSpecifier(ParamNode)
10863         and (UpAtomIs('VAR') or UpAtomIs('CONSTREF')
10864              or (UpAtomIs('OUT') and (cmsOut in Scanner.CompilerModeSwitches))))
10865     then begin
10866       Result:=tcIncompatible;
10867       exit;
10868     end;
10869     if ParamCompatibility=tcCompatible then
10870       Result:=tcCompatible;
10871     ParamNode:=ParamNode.NextBrother;
10872     inc(i);
10873   end;
10874   if (i<SourceExprParamList.Count) then begin
10875     // there are more expressions, then the param list has variables
10876     Result:=tcIncompatible;
10877   end else if (ParamNode<>nil) then begin
10878     // there are not enough expressions for the param list
10879     // -> check if missing variables have default variables
10880     if (ParamNode.SubDesc and ctnsHasDefaultValue)>0 then begin
10881       // the rest params have default values
10882       if CompatibilityList<>nil then begin
10883         while (ParamNode<>nil) and (i<CompatibilityListCount) do begin
10884           CompatibilityList[i]:=tcExact;
10885           ParamNode:=ParamNode.NextBrother;
10886           inc(i);
10887         end;
10888       end;
10889     end else if not IgnoreMissingParameters then begin
10890       // not enough expression for param list
10891       // -> incompatible
10892       Result:=tcIncompatible;
10893     end;
10894   end;
10895   {$IF defined(ShowExprEval) or defined(ShowProcSearch)}
10896     finally
10897       DebugLn('[TFindDeclarationTool.IsParamExprListCompatibleToNodeList] END ',
10898       ' Result=',TypeCompatibilityNames[Result],' ! ONLY VALID if no error !'
10899       );
10900     end;
10901   {$ENDIF}
10902 end;
10903 
IsParamNodeListCompatibleToExprListnull10904 function TFindDeclarationTool.IsParamNodeListCompatibleToExprList(
10905   TargetExprParamList: TExprTypeList; FirstSourceParameterNode: TCodeTreeNode;
10906   Params: TFindDeclarationParams;
10907   CompatibilityList: TTypeCompatibilityList): TTypeCompatibility;
10908 // tests if FirstSourceParameterNode fits (i.e. can be assigned) into
10909 // the TargetExprParamList
10910 var
10911   ParamNode: TCodeTreeNode;
10912   i, MinParamCnt, MaxParamCnt: integer;
10913   ParamCompatibility: TTypeCompatibility;
10914   SourceExprType: TExpressionType;
10915 begin
10916   {$IFDEF CheckNodeTool}CheckNodeTool(FirstSourceParameterNode);{$ENDIF}
10917 
10918   // quick check: parameter count
10919   MinParamCnt:=0;
10920   ParamNode:=FirstSourceParameterNode;
10921   while (ParamNode<>nil) do begin
10922     ParamNode:=ParamNode.NextBrother;
10923     inc(MinParamCnt);
10924   end;
10925   MaxParamCnt:=MinParamCnt;
10926 
10927   {$IFDEF ShowExprEval}
10928   DebugLn('[TFindDeclarationTool.IsParamNodeListCompatibleToExprList] ',
10929   ' ExprParamList.Count=',dbgs(TargetExprParamList.Count),' ',
10930   ' MinParamCnt=',dbgs(MinParamCnt),' MaxParamCnt=',dbgs(MaxParamCnt)
10931   );
10932     try
10933   {$ENDIF}
10934   Result:=tcExact;
10935 
10936   if (TargetExprParamList.Count<>MaxParamCnt) then begin
10937     Result:=tcIncompatible;
10938     exit;
10939   end;
10940 
10941   // check each parameter for compatibility
10942 
10943   {$IFDEF ShowExprEval}
10944   DebugLn('[TFindDeclarationTool.IsParamNodeListCompatibleToExprList] ',
10945     ' ExprParamList=[',TargetExprParamList.AsString,']');
10946   {$ENDIF}
10947   ParamNode:=FirstSourceParameterNode;
10948   i:=0;
10949   while (ParamNode<>nil) and (i<TargetExprParamList.Count) do begin
10950     SourceExprType:=ConvertNodeToExpressionType(ParamNode,Params);
10951     ParamCompatibility:=IsCompatible(TargetExprParamList.Items[i],
10952                                      SourceExprType,Params);
10953     {$IFDEF ShowExprEval}
10954     DebugLn(['[TFindDeclarationTool.IsParamNodeListCompatibleToExprList] B ',i,' Source=[',ExprTypeToString(SourceExprType),'] Target=[',ExprTypeToString(TargetExprParamList.Items[i]),'] Result=',TypeCompatibilityNames[ParamCompatibility]]);
10955     {$ENDIF}
10956     if CompatibilityList<>nil then
10957       CompatibilityList[i]:=ParamCompatibility;
10958     if ParamCompatibility=tcIncompatible then begin
10959       Result:=tcIncompatible;
10960       exit;
10961     end else if ParamCompatibility=tcCompatible then begin
10962       Result:=tcCompatible;
10963     end;
10964     ParamNode:=ParamNode.NextBrother;
10965     inc(i);
10966   end;
10967   if (ParamNode<>nil) or (i<TargetExprParamList.Count) then
10968     RaiseException(20170421200618,'Internal Error: one param list has changed');
10969 
10970   {$IFDEF ShowExprEval}
10971     finally
10972       DebugLn('[TFindDeclarationTool.IsParamNodeListCompatibleToExprList] END ',
10973       ' Result=',TypeCompatibilityNames[Result],' ! ONLY VALID if no error !'
10974       );
10975     end;
10976   {$ENDIF}
10977 end;
10978 
IsParamNodeListCompatibleToParamNodeListnull10979 function TFindDeclarationTool.IsParamNodeListCompatibleToParamNodeList(
10980   FirstTargetParameterNode, FirstSourceParameterNode: TCodeTreeNode;
10981   Params: TFindDeclarationParams;
10982   CompatibilityList: TTypeCompatibilityList): TTypeCompatibility;
10983 var
10984   CurParamNode1, CurParamNode2: TCodeTreeNode;
10985   ParamCompatibility: TTypeCompatibility;
10986   SourceExprType, TargetExprType: TExpressionType;
10987   OldFlags: TFindDeclarationFlags;
10988   i: integer;
10989 begin
10990   {$IFDEF CheckNodeTool}CheckNodeTool(FirstTargetParameterNode);{$ENDIF}
10991   // quick check: parameter count
10992   CurParamNode1:=FirstTargetParameterNode;
10993   CurParamNode2:=FirstSourceParameterNode;
10994   while (CurParamNode1<>nil) and (CurParamNode2<>nil) do begin
10995     CurParamNode1:=CurParamNode1.NextBrother;
10996     CurParamNode2:=CurParamNode2.NextBrother;
10997   end;
10998   if (CurParamNode1<>nil) or (CurParamNode2<>nil) then begin
10999     Result:=tcIncompatible;
11000     exit;
11001   end;
11002 
11003   // check each parameter
11004   OldFlags:=Params.Flags;
11005   Params.Flags:=Params.Flags-[fdfFindVariable]+[fdfIgnoreOverloadedProcs];
11006   CurParamNode1:=FirstTargetParameterNode;
11007   CurParamNode2:=FirstSourceParameterNode;
11008   Result:=tcExact;
11009   i:=0;
11010   while (CurParamNode1<>nil) and (CurParamNode2<>nil) do begin
11011     TargetExprType:=ConvertNodeToExpressionType(CurParamNode1,Params);
11012     SourceExprType:=ConvertNodeToExpressionType(CurParamNode2,Params);
11013     ParamCompatibility:=IsBaseCompatible(TargetExprType,SourceExprType,Params);
11014     if CompatibilityList<>nil then
11015       CompatibilityList[i]:=ParamCompatibility;
11016     if ParamCompatibility=tcIncompatible then begin
11017       Result:=tcIncompatible;
11018       exit;
11019     end else if ParamCompatibility=tcCompatible then begin
11020       Result:=tcCompatible;
11021     end;
11022     CurParamNode1:=CurParamNode1.NextBrother;
11023     CurParamNode2:=CurParamNode2.NextBrother;
11024     inc(i);
11025   end;
11026   Params.Flags:=OldFlags;
11027 end;
11028 
GetParameterNodenull11029 function TFindDeclarationTool.GetParameterNode(Node: TCodeTreeNode
11030   ): TCodeTreeNode;
11031 begin
11032   {$IFDEF CheckNodeTool}CheckNodeTool(Node);{$ENDIF}
11033   Result:=Node;
11034   if Result=nil then exit;
11035   if Result.Desc=ctnReferenceTo then begin
11036     Result:=Result.FirstChild;
11037     if Result=nil then exit;
11038   end;
11039   if (Result.Desc in [ctnProperty,ctnGlobalProperty]) then
11040     Result:=Result.FirstChild
11041   else if Result.Desc in [ctnProcedure,ctnProcedureHead,ctnProcedureType] then begin
11042     BuildSubTreeForProcHead(Result);
11043     if Result.Desc in [ctnProcedure,ctnProcedureType] then
11044       Result:=Result.FirstChild;
11045     if Result.Desc=ctnProcedureHead then
11046       Result:=Result.FirstChild;
11047   end;
11048 end;
11049 
GetFirstParameterNodenull11050 function TFindDeclarationTool.GetFirstParameterNode(Node: TCodeTreeNode
11051   ): TCodeTreeNode;
11052 begin
11053   Result:=GetParameterNode(Node);
11054   if Result<>nil then Result:=Result.FirstChild;
11055 end;
11056 
CheckSrcIdentifiernull11057 function TFindDeclarationTool.CheckSrcIdentifier(
11058   Params: TFindDeclarationParams;
11059   const FoundContext: TFindContext): TIdentifierFoundResult;
11060 // this is a TOnIdentifierFound function
11061 //   if identifier found is a proc then it searches for the best overloaded proc
11062 
11063   function CallHasEmptyParamsAndFoundProcFits: boolean;
11064   var
11065     FirstParameterNode: TCodeTreeNode;
11066     TargetTool: TFindDeclarationTool;
11067   begin
11068     Result:=false;
11069     FirstParameterNode:=FoundContext.Tool.GetFirstParameterNode(
11070                                               FoundContext.Node);
11071     if (FirstParameterNode<>nil)
11072     and ((FirstParameterNode.SubDesc and ctnsHasDefaultValue)=0) then begin
11073       // found proc needs at least one parameter
11074       exit;
11075     end;
11076     // FoundContext is a proc with no or only default params
11077     TargetTool:=Params.IdentifierTool;
11078     TargetTool.MoveCursorToCleanPos(Params.Identifier);
11079     TargetTool.ReadNextAtom; // read identifier
11080     TargetTool.ReadNextAtom; // read bracket
11081     if TargetTool.CurPos.Flag<>cafRoundBracketOpen then exit;
11082     TargetTool.ReadNextAtom; // read bracket close
11083     if TargetTool.CurPos.Flag<>cafRoundBracketClose then exit;
11084     Result:=true;
11085   end;
11086 
11087 var
11088   FirstParameterNode, StartContextNode: TCodeTreeNode;
11089   ParamCompatibility: TTypeCompatibility;
11090   OldInput: TFindDeclarationInput;
11091   CurCompatibilityList: TTypeCompatibilityList;
11092   CompListSize: integer;
11093   NewExprInputList: TExprTypeList;
11094 begin
11095   // the search has found an identifier with the right name
11096   {$IFDEF ShowFoundIdentifier}
11097   DebugLn('[TFindDeclarationTool.CheckSrcIdentifier]',
11098   ' Ident=',GetIdentifier(Params.Identifier),
11099   ' FoundContext=',FoundContext.Node.DescAsString,
11100   ' Flags=[',dbgs(Params.Flags),']'
11101   );
11102   {$ENDIF}
11103   if FoundContext.Node.Desc=ctnProcedure then begin
11104     // the found node is a proc
11105 
11106     // 1. the current identifier cache is blind for parameter lists
11107     // => proc identifiers can not be identified by the name alone
11108     // -> do not cache
11109     // 2. Even if there is only one proc. With different search flags,
11110     //    different routes will be searched and then there can be another proc.
11111     //    The only solution is to store the param expression list and all flags
11112     //    in the cache. This is a ToDo
11113     Include(Params.Flags,fdfDoNotCache);
11114     Include(Params.NewFlags,fodDoNotCache);
11115 
11116     if (fdfIgnoreOverloadedProcs in Params.Flags) then begin
11117       // do not check for overloaded procs -> ident found
11118       Result:=ifrSuccess;
11119       exit;
11120     end;
11121 
11122     // Procs can be overloaded, that means there can be several procs with the
11123     // same name, but with different param lists.
11124     // The search must go on, and the most compatible proc is returned.
11125 
11126     if not Params.IdentifierTool.IsPCharInSrc(Params.Identifier) then begin
11127       // Params.Identifier is not in the source of the start tool
11128       // => impossible to check param list, because the context is unknown
11129       // -> identifier found
11130       {$IFDEF ShowProcSearch}
11131       DebugLn('[TFindDeclarationTool.CheckSrcIdentifier]',
11132       ' Ident=',GetIdentifier(Params.Identifier),
11133       ' NO SOURCE to check params'
11134       );
11135       {$ENDIF}
11136       Result:=ifrSuccess;
11137       exit;
11138     end;
11139 
11140     if FoundContext.Tool.NodeIsClassConstructorOrDestructor(FoundContext.Node) then
11141     begin
11142       Result:=ifrProceedSearch;
11143       Exit;
11144     end;
11145 
11146     if (not (fdfCollect in Params.Flags))
11147     and CallHasEmptyParamsAndFoundProcFits then begin
11148       // call has brackets without params (e.g. writeln() )
11149       // and found proc fits exactly
11150       // => stop search
11151       {$IF defined(ShowFoundIdentifier) or defined(ShowProcSearch)}
11152       debugln(['TFindDeclarationTool.CheckSrcIdentifier call is () and found proc fits exactly',
11153         ' Ident=',GetIdentifier(Params.Identifier),
11154         ' ',FoundContext.Tool.CleanPosToStr(FoundContext.Node.StartPos)
11155         ]);
11156       {$ENDIF}
11157       Params.SetResult(FoundContext);
11158       Result:=ifrSuccess;
11159       exit;
11160     end;
11161 
11162     Result:=ifrProceedSearch;
11163     if (Params.FoundProc=nil) then begin
11164       // this is the first proc found
11165       // -> save it and proceed the search to find all overloadeded procs
11166       {$IF defined(ShowFoundIdentifier) or defined(ShowProcSearch)}
11167       DebugLn('[TFindDeclarationTool.CheckSrcIdentifier]',
11168       ' Ident=',GetIdentifier(Params.Identifier),
11169       ' ',FoundContext.Tool.CleanPosToStr(FoundContext.Node.StartPos),
11170       ' FIRST PROC searching for overloads ...'
11171       );
11172       {$ENDIF}
11173       Params.SetFoundProc(FoundContext);
11174       exit;
11175     end;
11176 
11177     // -> check which one is more compatible
11178     // create the input expression list
11179     // (the expressions in the brackets are parsed and converted to types)
11180     if Params.FoundProc^.ExprInputList=nil then begin
11181       {$IF defined(ShowFoundIdentifier) or defined(ShowProcSearch)}
11182       DebugLn('[TFindDeclarationTool.CheckSrcIdentifier]',
11183       ' Ident=',GetIdentifier(Params.Identifier),
11184       ' Creating Input Expression List ...'
11185       );
11186       {$ENDIF}
11187       if Params.IdentifierTool.IsPCharInSrc(Params.Identifier) then begin
11188         Params.IdentifierTool.MoveCursorToCleanPos(Params.Identifier);
11189         StartContextNode:=Params.IdentifierTool.FindDeepestNodeAtPos(
11190           Params.IdentifierTool.CurPos.StartPos,true);
11191         if (StartContextNode<>nil) then begin
11192           if (StartContextNode.Desc in AllPascalStatements) then begin
11193             {$IFDEF ShowProcSearch}
11194             DebugLn('[TFindDeclarationTool.CheckSrcIdentifier]',
11195             ' Ident=',GetIdentifier(Params.Identifier),
11196             ' Creating Input Expression List for statement ...'
11197             );
11198             {$ENDIF}
11199             Params.Save(OldInput);
11200             Params.IdentifierTool.MoveCursorToCleanPos(Params.Identifier);
11201             Params.Flags:=fdfDefaultForExpressions+Params.Flags*fdfGlobals;
11202             Params.ContextNode:=StartContextNode;
11203             Params.OnIdentifierFound:=@Params.IdentifierTool.CheckSrcIdentifier;
11204             Params.IdentifierTool.ReadNextAtom;
11205             NewExprInputList:=
11206               Params.IdentifierTool.CreateParamExprListFromStatement(
11207                                     Params.IdentifierTool.CurPos.EndPos,Params);
11208             {$IFDEF ShowProcSearch}
11209             debugln(['TFindDeclarationTool.CheckSrcIdentifier Params: ',NewExprInputList.AsString]);
11210             {$ENDIF}
11211             Params.Load(OldInput,true);
11212             FreeAndNil(Params.FoundProc^.ExprInputList);
11213             Params.FoundProc^.ExprInputList:=NewExprInputList;
11214           end
11215           else if (StartContextNode.Desc in [ctnProcedureHead,ctnProcedure])
11216           then begin
11217             {$IFDEF ShowProcSearch}
11218             DebugLn('[TFindDeclarationTool.CheckSrcIdentifier]',
11219             ' Ident=',GetIdentifier(Params.Identifier),
11220             ' Creating Input Expression List for proc node ...'
11221             );
11222             {$ENDIF}
11223             NewExprInputList:=
11224               Params.IdentifierTool.CreateParamExprListFromProcNode(
11225                                                        StartContextNode,Params);
11226             {$IFDEF ShowProcSearch}
11227             debugln(['TFindDeclarationTool.CheckSrcIdentifier Params: ',NewExprInputList.AsString]);
11228             {$ENDIF}
11229             FreeAndNil(Params.FoundProc^.ExprInputList);
11230             Params.FoundProc^.ExprInputList:=NewExprInputList;
11231           end;
11232         end;
11233       end;
11234       if Params.FoundProc^.ExprInputList=nil then begin
11235         // create expression list without params
11236         Params.FoundProc^.ExprInputList:=TExprTypeList.Create;
11237       end;
11238     end;
11239 
11240     // create compatibility lists for params
11241     // (each parameter is checked for compatibility)
11242     CompListSize:=SizeOf(TTypeCompatibility)
11243                   *Params.FoundProc^.ExprInputList.Count;
11244     if (CompListSize>0)
11245     and (Params.FoundProc^.ParamCompatibilityList=nil) then begin
11246       GetMem(Params.FoundProc^.ParamCompatibilityList,CompListSize);
11247       //DebugLn(['TFindDeclarationTool.CheckSrcIdentifier FoundProc=',dbgs(Params.FoundProc),' New ParamCompatibilityList=',dbgs(Params.FoundProc^.ParamCompatibilityList),' CompListSize=',CompListSize]);
11248     end else begin
11249       //DebugLn(['TFindDeclarationTool.CheckSrcIdentifier FoundProc=',dbgs(Params.FoundProc),' Old ParamCompatibilityList=',dbgs(Params.FoundProc^.ParamCompatibilityList),' CompListSize=',CompListSize]);
11250     end;
11251 
11252     // check the first found proc for compatibility
11253     // (compare the expression list with the proc param list)
11254     if not Params.FoundProc^.CacheValid then begin
11255       {$IF defined(ShowFoundIdentifier) or defined(ShowProcSearch)}
11256       DebugLn('[TFindDeclarationTool.CheckSrcIdentifier]',
11257       ' Ident=',GetIdentifier(Params.Identifier),
11258       ' Check the first found proc for compatibility ...'
11259       );
11260       {$ENDIF}
11261       FirstParameterNode:=Params.FoundProc^.Context.Tool.GetFirstParameterNode(
11262                                                 Params.FoundProc^.Context.Node);
11263       ParamCompatibility:=
11264         Params.FoundProc^.Context.Tool.IsParamExprListCompatibleToNodeList(
11265           FirstParameterNode,
11266           Params.FoundProc^.ExprInputList,
11267           fdfIgnoreMissingParams in Params.Flags,
11268           Params,Params.FoundProc^.ParamCompatibilityList);
11269       Params.FoundProc^.ProcCompatibility:=ParamCompatibility;
11270       Params.FoundProc^.CacheValid:=true;
11271       if ParamCompatibility=tcExact then begin
11272         Params.SetResult(Params.FoundProc^.Context.Tool,
11273                          Params.FoundProc^.Context.Node.FirstChild);
11274       end;
11275     end;
11276 
11277     if Params.FoundProc^.ProcCompatibility=tcExact then begin
11278       {$IF defined(ShowFoundIdentifier) or defined(ShowProcSearch)}
11279       DebugLn('[TFindDeclarationTool.CheckSrcIdentifier]',
11280       ' Ident=',GetIdentifier(Params.Identifier),
11281       ' First Proc ParamCompatibility=',TypeCompatibilityNames[Params.FoundProc^.ProcCompatibility]
11282       );
11283       {$ENDIF}
11284       // the first proc fits exactly -> stop the search
11285       Result:=ifrSuccess;
11286       exit;
11287     end;
11288 
11289     // check the current proc for compatibility
11290     // (compare the expression list with the proc param list)
11291     {$IF defined(ShowFoundIdentifier) or defined(ShowProcSearch)}
11292     DebugLn('[TFindDeclarationTool.CheckSrcIdentifier]',
11293     ' Ident=',GetIdentifier(Params.Identifier),
11294     ' Check the current found proc for compatibility ...'
11295     );
11296     {$ENDIF}
11297     if CompListSize>0 then begin
11298       GetMem(CurCompatibilityList,CompListSize);
11299       //DebugLn(['TFindDeclarationTool.CheckSrcIdentifier create temp CurCompatibilityList=',dbgs(CurCompatibilityList),' CompListSize=',CompListSize]);
11300     end else begin
11301       CurCompatibilityList:=nil;
11302     end;
11303     try
11304       FirstParameterNode:=
11305         FoundContext.Tool.GetFirstParameterNode(FoundContext.Node);
11306       ParamCompatibility:=
11307         FoundContext.Tool.IsParamExprListCompatibleToNodeList(
11308           FirstParameterNode,
11309           Params.FoundProc^.ExprInputList,
11310           fdfIgnoreMissingParams in Params.Flags,
11311           Params,CurCompatibilityList);
11312       {$IF defined(ShowFoundIdentifier) or defined(ShowProcSearch)}
11313       DebugLn('[TFindDeclarationTool.CheckSrcIdentifier]',
11314       ' Ident=',GetIdentifier(Params.Identifier),
11315       ' Current Proc ParamCompatibility=',TypeCompatibilityNames[ParamCompatibility]
11316       );
11317       {$ENDIF}
11318       if ParamCompatibility=tcExact then begin
11319         // the current proc fits exactly -> stop the search
11320         Params.ChangeFoundProc(FoundContext,ParamCompatibility,
11321           CurCompatibilityList);
11322         CurCompatibilityList:=nil; // set to nil, so that it will not be freed
11323         Params.SetResult(FoundContext.Tool,FoundContext.Node.FirstChild);
11324         Result:=ifrSuccess;
11325       end else if ParamCompatibility=tcCompatible then begin
11326         // the proc fits not exactly, but is compatible
11327         if (Params.FoundProc^.ProcCompatibility=tcInCompatible)
11328         or CompatibilityList1IsBetter(CurCompatibilityList,
11329           Params.FoundProc^.ParamCompatibilityList,
11330           Params.FoundProc^.ExprInputList.Count) then
11331         begin
11332           // the new proc fits better
11333           Params.ChangeFoundProc(FoundContext,ParamCompatibility,CurCompatibilityList);
11334           CurCompatibilityList:=nil; // set to nil, so that it will not be freed
11335         end;
11336       end;
11337     finally
11338       // end overloaded proc search
11339       if CurCompatibilityList<>nil then begin
11340         //DebugLn(['TFindDeclarationTool.CheckSrcIdentifier free CurCompatibilityList=',dbgs(CurCompatibilityList)]);
11341         FreeMem(CurCompatibilityList);
11342       end;
11343     end;
11344   end else
11345   if (FoundContext.Node.Desc=ctnVarDefinition) then begin
11346     if not (fdfIgnoreClassVisibility in Params.Flags)
11347     and (FoundContext.Tool<>Params.IdentifierTool)
11348     and (GetClassVisibility(FoundContext.Node)=ctnClassPrivate) then
11349       Result:=ifrProceedSearch
11350     else
11351       Result:=ifrSuccess;
11352   end else begin
11353     Result:=ifrSuccess;
11354   end;
11355 end;
11356 
DoOnIdentifierFoundnull11357 function TFindDeclarationTool.DoOnIdentifierFound(
11358   Params: TFindDeclarationParams;
11359   FoundNode: TCodeTreeNode): TIdentifierFoundResult;
11360 // this internal function is called, whenever an identifier is found
11361 var IsTopLvlIdent: boolean;
11362 begin
11363   {$IFDEF CheckNodeTool}CheckNodeTool(FoundNode);{$ENDIF}
11364   IsTopLvlIdent:=(fdfTopLvlResolving in Params.Flags);
11365   if Assigned(Params.OnIdentifierFound) then
11366     Result:=Params.OnIdentifierFound(Params,CreateFindContext(Self,FoundNode))
11367   else
11368     Result:=ifrSuccess;
11369   if (Result=ifrSuccess) and IsTopLvlIdent
11370   and Assigned(Params.OnTopLvlIdentifierFound) then
11371     Params.OnTopLvlIdentifierFound(Params,CreateFindContext(Self,FoundNode));
11372 end;
11373 
IsCompatiblenull11374 function TFindDeclarationTool.IsCompatible(TargetNode: TCodeTreeNode;
11375   const ExpressionType: TExpressionType;
11376   Params: TFindDeclarationParams): TTypeCompatibility;
11377 var TargetContext: TFindContext;
11378   OldInput: TFindDeclarationInput;
11379   NodeExprType: TExpressionType;
11380 begin
11381   {$IFDEF CheckNodeTool}CheckNodeTool(TargetNode);{$ENDIF}
11382   {$IFDEF ShowExprEval}
11383   DebugLn('[TFindDeclarationTool.IsCompatible] A Node=',TargetNode.DescAsString,
11384   ' ExpressionType=',ExpressionTypeDescNames[ExpressionType.Desc]);
11385   {$ENDIF}
11386   Result:=tcIncompatible;
11387   // find base type of node
11388   OldInput.Flags:=Params.Flags;
11389   Include(Params.Flags,fdfExceptionOnNotFound);
11390   TargetContext:=FindBaseTypeOfNode(Params,TargetNode);
11391   Params.Flags:=OldInput.Flags;
11392 
11393   // compare node base type and ExpressionType
11394   if (ExpressionType.Context.Node<>nil)
11395   and (ExpressionType.Context.Node=TargetContext.Node) then begin
11396     // same base type
11397     Result:=tcExact;
11398   end
11399   else if (TargetContext.Node.Desc=ctnGenericParameter)
11400   or ((ExpressionType.Desc=xtContext)
11401       and (ExpressionType.Context.Node.Desc=ctnGenericParameter))
11402   then begin
11403     // generic type is always preferred
11404     Result:=tcExact;
11405   end
11406   else if (TargetContext.Node.Desc=ctnSetType) then begin
11407     {$IFDEF ShowExprEval}
11408     DebugLn('[TFindDeclarationTool.IsCompatible] TargetContext.Node.Desc=ctnSetType',
11409     ' "',copy(TargetContext.Tool.Src,TargetContext.Node.Parent.StartPos,20),'"');
11410     {$ENDIF}
11411     if (ExpressionType.Desc=xtConstSet) then begin
11412       // both are sets, compare type of sets
11413       if (ExpressionType.SubDesc<>xtNone) then begin
11414 
11415         // ToDo: check if enums of expression fits into enums of target
11416 
11417         // ToDo: ppu, dcu
11418 
11419         Result:=tcCompatible;
11420       end else
11421         // the empty set is compatible to all kinds of sets
11422         Result:=tcExact;
11423     end else begin
11424 
11425     end;
11426   end else begin
11427     NodeExprType:=CleanExpressionType;
11428     NodeExprType.Desc:=xtContext;
11429     NodeExprType.Context:=CreateFindContext(Self,TargetNode);
11430     Result:=IsCompatible(NodeExprType,ExpressionType,Params);
11431   end;
11432   {$IFDEF ShowExprEval}
11433   DebugLn('[TFindDeclarationTool.IsCompatible] END',
11434   ' BaseNode=',TargetContext.Node.DescAsString,
11435   ' ExpressionType=',ExpressionTypeDescNames[ExpressionType.Desc],
11436   ' Result=',TypeCompatibilityNames[Result]
11437   );
11438   {$ENDIF}
11439 end;
11440 
IsCompatiblenull11441 function TFindDeclarationTool.IsCompatible(TargetType,
11442   ExpressionType: TExpressionType; Params: TFindDeclarationParams
11443   ): TTypeCompatibility;
11444 begin
11445   if TargetType.Desc=xtContext then begin
11446     if TargetType.Context.Node.Desc=ctnGenericParameter then
11447       exit(tcExact);
11448     TargetType:=TargetType.Context.Tool.ConvertNodeToExpressionType(
11449                     TargetType.Context.Node,Params);
11450   end;
11451   if ExpressionType.Desc=xtContext then begin
11452     if ExpressionType.Context.Node.Desc=ctnGenericParameter then
11453       exit(tcExact);
11454     ExpressionType:=ExpressionType.Context.Tool.ConvertNodeToExpressionType(
11455                     ExpressionType.Context.Node,Params);
11456   end;
11457   Result:=IsBaseCompatible(TargetType,ExpressionType,Params);
11458 end;
11459 
GetCurrentAtomTypenull11460 function TFindDeclarationTool.GetCurrentAtomType: TVariableAtomType;
11461 var
11462   Node: TCodeTreeNode;
11463   c: Char;
11464 begin
11465   //debugln(['TFindDeclarationTool.GetCurrentAtomType ',CurPos.StartPos,' ',CurPos.EndPos,' ',SrcLen,' ',GetAtom]);
11466   if (CurPos.StartPos=CurPos.EndPos) then
11467     exit(vatSpace)
11468   else if (CurPos.StartPos<1) or (CurPos.StartPos>SrcLen) then
11469     exit(vatNone);
11470   c:=Src[CurPos.StartPos];
11471   if IsIdentStartChar[c] then begin
11472     if WordIsPredefinedIdentifier.DoItCaseInsensitive(Src,CurPos.StartPos,
11473       CurPos.EndPos-CurPos.StartPos) then
11474       exit(vatPreDefIdentifier)
11475     else if UpAtomIs('INHERITED') then
11476       exit(vatINHERITED)
11477     else if UpAtomIs('AS') then
11478       exit(vatAS)
11479     else if WordIsKeyWord.DoItCaseInsensitive(Src,CurPos.StartPos,
11480              CurPos.EndPos-CurPos.StartPos) then
11481       exit(vatKeyWord)
11482     else if UpAtomIs('PROPERTY') then begin
11483       Node:=FindDeepestNodeAtPos(CurPos.StartPos,false);
11484       if (Node<>nil) and (Node.Desc in [ctnProperty,ctnPropertySection]) then
11485         exit(vatKeyword)
11486       else
11487         exit(vatIdentifier);
11488     end else
11489       exit(vatIdentifier);
11490   end else if (CurPos.StartPos=CurPos.EndPos-1) then begin
11491     case c of
11492     '.': exit(vatPoint);
11493     '^': exit(vatUp);
11494     '(': exit(vatRoundBracketOpen);
11495     ')': exit(vatRoundBracketClose);
11496     '[': exit(vatEdgedBracketOpen);
11497     ']': exit(vatEdgedBracketClose);
11498     '@': exit(vatAddrOp);
11499     else exit(vatNone);
11500     end;
11501   end
11502   else begin
11503     case c of
11504     '''','#': exit(vatStringConstant);
11505     '&':
11506       begin
11507         if (CurPos.StartPos+1=CurPos.EndPos) then exit(vatNone);
11508         c:=Src[CurPos.StartPos+1];
11509         if IsIdentStartChar[c] then begin
11510           // &keyword
11511           exit(vatIdentifier);
11512         end else if IsNumberChar[c] then
11513           exit(vatNumber) // octal
11514         else exit(vatNone);
11515       end;
11516     else exit(vatNone);
11517     end;
11518   end;
11519 end;
11520 
CreateParamExprListFromStatementnull11521 function TFindDeclarationTool.CreateParamExprListFromStatement(
11522   StartPos: integer; Params: TFindDeclarationParams; GetAlias: boolean
11523   ): TExprTypeList;
11524 var ExprType: TExpressionType;
11525   BracketClose: char;
11526   ExprStartPos, ExprEndPos: integer;
11527   CurIgnoreErrorAfterPos: Integer;
11528   OldFlags: TFindDeclarationFlags;
11529   ok: Boolean;
11530   AliasType: TFindContext;
11531 
11532   procedure RaiseBracketNotFound;
11533   begin
11534     RaiseExceptionFmt(20170421200621,ctsStrExpectedButAtomFound,[BracketClose,GetAtom]);
11535   end;
11536 
11537 begin
11538   {$IFDEF ShowExprEval}
11539   DebugLn('[TFindDeclarationTool.CreateParamExprListFromStatement] ',
11540   '"',copy(Src,StartPos,40),'" Context=',Params.ContextNode.DescAsString);
11541   {$ENDIF}
11542   Result:=TExprTypeList.Create;
11543   ok:=false;
11544   try
11545     MoveCursorToCleanPos(StartPos);
11546     ReadNextAtom; // reads first atom after proc name
11547     if AtomIsChar('(') then
11548       BracketClose:=')'
11549     else if AtomIsChar('[') then
11550       BracketClose:=']'
11551     else
11552       BracketClose:=#0;
11553     if IgnoreErrorAfterValid then
11554       CurIgnoreErrorAfterPos:=IgnoreErrorAfterCleanedPos
11555     else
11556       CurIgnoreErrorAfterPos:=-1;
11557     OldFlags:=Params.Flags;
11558     if BracketClose<>#0 then begin
11559       // read parameter list
11560       ReadNextAtom;
11561       if not AtomIsChar(BracketClose) then begin
11562         // read all expressions
11563         while true do begin
11564           ExprStartPos:=CurPos.StartPos;
11565           // read til comma or bracket close
11566           repeat
11567             if CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen] then begin
11568               ReadTilBracketClose(true);
11569             end;
11570             ReadNextAtom;
11571             if (CurPos.StartPos>SrcLen)
11572             or (CurPos.Flag in [cafRoundBracketClose,cafEdgedBracketClose,cafComma])
11573             then
11574               break;
11575           until false;
11576           ExprEndPos:=CurPos.StartPos;
11577           // find expression type
11578           if (CurIgnoreErrorAfterPos>=ExprStartPos) then
11579             Params.Flags:=Params.Flags-[fdfExceptionOnNotFound];
11580           //DebugLn('TFindDeclarationTool.CreateParamExprListFromStatement CurIgnoreErrorAfterPos=',dbgs(CurIgnoreErrorAfterPos),' ExprStartPos=',dbgs(ExprStartPos));
11581           if GetAlias then begin
11582             AliasType:=CleanFindContext;
11583             ExprType:=FindExpressionResultType(Params,ExprStartPos,ExprEndPos,@AliasType);
11584             Result.Add(ExprType,AliasType);
11585           end else begin
11586             ExprType:=FindExpressionResultType(Params,ExprStartPos,ExprEndPos);
11587             Result.Add(ExprType);
11588           end;
11589           MoveCursorToCleanPos(ExprEndPos);
11590           ReadNextAtom;
11591           if AtomIsChar(BracketClose) then break;
11592           if not AtomIsChar(',') then
11593             RaiseBracketNotFound;
11594           ReadNextAtom;
11595         end;
11596       end;
11597     end;
11598     Params.Flags:=OldFlags;
11599     {$IFDEF ShowExprEval}
11600     DebugLn('[TFindDeclarationTool.CreateParamExprListFromStatement] END ',
11601     'ParamCount=',dbgs(Result.Count),' "',copy(Src,StartPos,40),'"');
11602     DebugLn('  ExprList=[',Result.AsString,']');
11603     {$ENDIF}
11604     Ok:=true;
11605   finally
11606     if not Ok then Result.Free;
11607   end;
11608 end;
11609 
CreateParamExprListFromProcNodenull11610 function TFindDeclarationTool.CreateParamExprListFromProcNode(
11611   ProcNode: TCodeTreeNode; Params: TFindDeclarationParams): TExprTypeList;
11612 var
11613   ExprType: TExpressionType;
11614   ParamNode: TCodeTreeNode;
11615 begin
11616   {$IFDEF CheckNodeTool}CheckNodeTool(ProcNode);{$ENDIF}
11617   {$IFDEF ShowExprEval}
11618   DebugLn('[TFindDeclarationTool.CreateParamExprListFromProcNode] ',
11619   '"',copy(Src,ProcNode.StartPos,40),'" Context=',ProcNode.DescAsString);
11620   {$ENDIF}
11621   Result:=TExprTypeList.Create;
11622   ParamNode:=GetFirstParameterNode(ProcNode);
11623   while ParamNode<>nil do begin
11624     // find expression type
11625     ExprType:=ConvertNodeToExpressionType(ParamNode,Params);
11626     // add expression type to list
11627     Result.Add(ExprType);
11628     ParamNode:=ParamNode.NextBrother;
11629   end;
11630   {$IFDEF ShowExprEval}
11631   DebugLn('[TFindDeclarationTool.CreateParamExprListFromProcNode] END ',
11632   'ParamCount=',dbgs(Result.Count),' "',copy(Src,ProcNode.StartPos,40),'"');
11633   DebugLn('  ExprList=[',Result.AsString,']');
11634   {$ENDIF}
11635 end;
11636 
CompatibilityList1IsBetternull11637 function TFindDeclarationTool.CompatibilityList1IsBetter( List1,
11638   List2: TTypeCompatibilityList; ListCount: integer): boolean;
11639 // List1 and List2 should only contain tcCompatible and tcExact values
11640 var i: integer;
11641 begin
11642   // search first difference, start at end
11643   i:=ListCount-1;
11644   while (i>=0) and (List1[i]=List2[i]) do dec(i);
11645   // List1 is better, if first difference is better for List1
11646   Result:=(i>=0) and (List1[i]=tcExact);
11647   {$IFDEF ShowFoundIdentifier}
11648   DebugLn('[TFindDeclarationTool.CompatibilityList1IsBetter] END i=',dbgs(i));
11649   {$ENDIF}
11650 end;
11651 
ContextIsDescendOfnull11652 function TFindDeclarationTool.ContextIsDescendOf(const DescendContext,
11653   AncestorContext: TFindContext; Params: TFindDeclarationParams): boolean;
11654 
11655   procedure RaiseInternalError;
11656   begin
11657     RaiseException(20170421200624,'[TFindDeclarationTool.ContextIsDescendOf] '
11658       +' internal error: DescendContext.Desc<>ctnClass');
11659   end;
11660 
11661 var CurContext: TFindContext;
11662   OldInput: TFindDeclarationInput;
11663 begin
11664   if not (DescendContext.Node.Desc in AllClasses) then
11665     RaiseInternalError;
11666   {$IFDEF ShowExprEval}
11667   DebugLn('[TFindDeclarationTool.ContextIsDescendOf] ',
11668   ' DescendContext="',copy(DescendContext.Tool.Src,DescendContext.Node.Parent.StartPos,15),'"');
11669   {$ENDIF}
11670   CurContext:=DescendContext;
11671   Params.Save(OldInput);
11672   repeat
11673     Result:=CurContext.Tool.FindAncestorOfClass(CurContext.Node,Params,true);
11674     if Result then begin
11675       CurContext:=CreateFindContext(Params);
11676       {$IFDEF ShowExprEval}
11677       DebugLn('[TFindDeclarationTool.ContextIsDescendOf] B ',
11678       ' CurContext="',copy(CurContext.Tool.Src,CurContext.Node.Parent.StartPos,15),'"');
11679       {$ENDIF}
11680       Result:=FindContextAreEqual(CurContext,AncestorContext);
11681       if Result then exit;
11682     end else
11683       break;
11684   until false;
11685   Result:=false;
11686 end;
11687 
IsBaseCompatiblenull11688 function TFindDeclarationTool.IsBaseCompatible(const TargetType,
11689   ExpressionType: TExpressionType; Params: TFindDeclarationParams
11690   ): TTypeCompatibility;
11691 // test if ExpressionType can be assigned to TargetType
11692 // both expression types must be base types
11693 var TargetNode, ExprNode: TCodeTreeNode;
11694 begin
11695   {$IFDEF ShowExprEval}
11696   DebugLn('[TFindDeclarationTool.IsBaseCompatible] START ',
11697   ' TargetType=',ExprTypeToString(TargetType),
11698   ' ExpressionType=',ExprTypeToString(ExpressionType));
11699   {$ENDIF}
11700   Result:=tcIncompatible;
11701   if (TargetType.Desc=xtContext)
11702   and (TargetType.Context.Node.Desc=ctnGenericParameter) then
11703     exit(tcExact);
11704   if (ExpressionType.Desc=xtContext)
11705   and (ExpressionType.Context.Node.Desc=ctnGenericParameter) then
11706     exit(tcExact);
11707   if (TargetType.Desc=ExpressionType.Desc) then begin
11708     case TargetType.Desc of
11709 
11710     xtNone: ;
11711 
11712     xtContext:
11713       begin
11714         TargetNode:=TargetType.Context.Node;
11715         ExprNode:=ExpressionType.Context.Node;
11716         {$IFDEF ShowExprEval}
11717         DebugLn('[TFindDeclarationTool.IsBaseCompatible] C ',
11718         ' TargetContext="',copy(TargetType.Context.Tool.Src,TargetType.Context.Node.StartPos,20),'"',
11719         ' ExpressionContext="',copy(ExpressionType.Context.Tool.Src,ExpressionType.Context.Node.StartPos,20),'"'
11720         );
11721         {$ENDIF}
11722         if TargetNode=ExprNode then
11723           Result:=tcExact
11724         else
11725         if ExprNode.Desc=TargetNode.Desc then begin
11726           // same context type
11727           case ExprNode.Desc of
11728 
11729           ctnClass, ctnClassInterface, ctnDispinterface, ctnObject, ctnRecordType,
11730           ctnClassHelper, ctnRecordHelper, ctnTypeHelper,
11731           ctnObjCClass, ctnObjCCategory, ctnObjCProtocol, ctnCPPClass:
11732             // check, if ExpressionType.Context descends from TargetContext
11733             if ContextIsDescendOf(ExpressionType.Context,
11734                                   TargetType.Context,Params)
11735             then
11736               Result:=tcExact;
11737 
11738           ctnRangedArrayType,ctnOpenArrayType:
11739             // ToDo: check range and type of arrayfields
11740             begin
11741               Result:=tcCompatible;
11742             end;
11743 
11744           end;
11745         end else begin
11746           // different context type
11747 
11748         end;
11749       end;
11750     else
11751       Result:=tcExact;
11752     end;
11753 
11754   end else if ((TargetType.Desc=xtPointer)
11755       and (ExpressionType.Desc=xtContext)
11756       and (ExpressionType.Context.Node.Desc in AllClasses))
11757   then begin
11758     // assigning a class to a pointer
11759     Result:=tcExact;
11760 
11761   end else begin
11762     // check, if ExpressionType can be auto converted into TargetType
11763     if ((TargetType.Desc in xtAllRealTypes)
11764       and (ExpressionType.Desc in xtAllRealConvertibles))
11765     or ((TargetType.Desc in xtAllStringTypes)
11766       and (ExpressionType.Desc in xtAllStringConvertibles))
11767     or ((TargetType.Desc in xtAllWideStringTypes)
11768       and (ExpressionType.Desc in xtAllWideStringCompatibleTypes))
11769     or ((TargetType.Desc in xtAllIntegerTypes)
11770       and (ExpressionType.Desc in xtAllIntegerConvertibles))
11771     or ((TargetType.Desc in xtAllBooleanTypes)
11772       and (ExpressionType.Desc in xtAllBooleanConvertibles))
11773     or ((TargetType.Desc in xtAllPointerTypes)
11774       and (ExpressionType.Desc in xtAllPointerConvertibles))
11775     or (TargetType.Desc=xtJSValue)
11776     then
11777       Result:=tcCompatible
11778     else if (TargetType.Desc=xtContext) then begin
11779       TargetNode:=TargetType.Context.Node;
11780       if ((TargetNode.Desc in (AllClasses+[ctnProcedure]))
11781         and (ExpressionType.Desc=xtNil))
11782       or ((TargetNode.Desc in [ctnOpenArrayType,ctnRangedArrayType])
11783         and (TargetNode.LastChild<>nil)
11784         and (TargetNode.LastChild.Desc=ctnOfConstType)
11785         and (ExpressionType.Desc=xtConstSet))
11786       then
11787         Result:=tcCompatible
11788     end
11789     else if (ExpressionType.Desc=xtContext) then begin
11790       ExprNode:=ExpressionType.Context.Node;
11791       if (TargetType.Desc=xtFile) and (ExprNode.Desc=ctnFileType)
11792       then
11793         Result:=tcCompatible
11794     end;
11795   end;
11796   {$IFDEF ShowExprEval}
11797   DebugLn('[TFindDeclarationTool.IsBaseCompatible] END ',
11798   ' TargetType=',ExpressionTypeDescNames[TargetType.Desc],
11799   ' ExpressionType=',ExpressionTypeDescNames[ExpressionType.Desc],
11800   ' Result=',TypeCompatibilityNames[Result]
11801   );
11802   {$ENDIF}
11803 end;
11804 
CheckParameterSyntaxnull11805 function TFindDeclarationTool.CheckParameterSyntax(StartPos,
11806   CleanCursorPos: integer; out ParameterAtom, ProcNameAtom: TAtomPosition; out
11807   ParameterIndex: integer): boolean;
11808 // check for Identifier(expr,expr,...,expr,VarName
11809 //        or Identifier[expr,expr,...,expr,VarName
11810 // ParameterIndex is 0 based
11811 {off $DEFINE VerboseCPS}
11812 
11813   procedure RaiseBracketNotOpened;
11814   begin
11815     if CurPos.Flag=cafRoundBracketClose then
11816       RaiseExceptionFmt(20170421200628,ctsBracketNotFound,['('])
11817     else
11818       RaiseExceptionFmt(20170421200630,ctsBracketNotFound,['[']);
11819   end;
11820 
11821   function CheckIdentifierAndParameterList: boolean; forward;
11822 
11823   function CheckBrackets: boolean;
11824   { check simple brackets (no identifier in front of brackets)
11825   }
11826   var
11827     BracketAtom: TAtomPosition;
11828   begin
11829     BracketAtom:=CurPos;
11830     {$IFDEF VerboseCPS}DebugLn('CheckBrackets "',GetAtom,'" BracketAtom=',dbgs(BracketAtom));{$ENDIF}
11831     repeat
11832       ReadNextAtom;
11833       if CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen] then begin
11834         if (LastAtoms.GetPriorAtom.Flag=cafWord) then begin
11835           {$IFDEF VerboseCPS}DebugLn('CheckBrackets check word+bracket open');{$ENDIF}
11836           UndoReadNextAtom;
11837           if CheckIdentifierAndParameterList() then exit(true);
11838         end else begin
11839           {$IFDEF VerboseCPS}DebugLn('CheckBrackets check bracket open');{$ENDIF}
11840           if CheckBrackets() then exit(true);
11841         end;
11842       end else if CurPos.Flag in [cafRoundBracketClose,cafEdgedBracketClose]
11843       then begin
11844         if (BracketAtom.Flag=cafRoundBracketOpen)
11845            =(CurPos.Flag=cafRoundBracketClose)
11846         then begin
11847           // closing bracket found, but the variable was not in them
11848           {$IFDEF VerboseCPS}DebugLn('CheckBrackets bracket closed');{$ENDIF}
11849           exit(false);
11850         end else begin
11851           // invalid closing bracket found
11852           RaiseBracketNotOpened;
11853         end;
11854       end;
11855     until (CurPos.EndPos>CleanCursorPos);
11856     Result:=false;
11857   end;
11858 
11859   function CheckIdentifierAndParameterList: boolean;
11860   { when called: CursorPos is at an identifier followed by a ( or [
11861   }
11862   var
11863     BracketAtom: TAtomPosition;
11864     CurProcNameAtom: TAtomPosition;
11865     CurParameterIndex: Integer;
11866     ParameterStart: integer;
11867   begin
11868     Result:=false;
11869     if CurPos.Flag<>cafWord then exit;
11870     CurProcNameAtom:=CurPos;
11871     CurParameterIndex:=0;
11872     {$IFDEF VerboseCPS}DebugLn('CheckIdentifierAndParameterList START "',GetAtom,'" ',dbgs(CurProcNameAtom));{$ENDIF}
11873     ReadNextAtom;
11874     if not (CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen]) then exit;
11875     BracketAtom:=CurPos;
11876     ParameterStart:=CurPos.EndPos;
11877     {$IFDEF VerboseCPS}DebugLn('CheckIdentifierAndParameterList Bracket="',GetAtom,'"');{$ENDIF}
11878     repeat
11879       ReadNextAtom;
11880       {$IFDEF VerboseCPS}DebugLn('CheckIdentifierAndParameterList Atom="',GetAtom,'"');{$ENDIF}
11881       if (CurPos.EndPos>CleanCursorPos)
11882       or ((CurPos.EndPos=CleanCursorPos)
11883         and ((CurPos.Flag=cafWord) or AtomIsChar('@')))
11884       then begin
11885         // parameter found => search parameter expression bounds e.g. ', parameter ,'
11886         // important: this function should work, even if the code
11887         //            behind CleanCursorPos has syntax errors
11888         {$IFDEF VerboseCPS}DebugLn('CheckIdentifierAndParameterList Parameter found, search range ...');{$ENDIF}
11889         ProcNameAtom:=CurProcNameAtom;
11890         ParameterIndex:=CurParameterIndex;
11891         ParameterAtom.StartPos:=ParameterStart;
11892         ParameterAtom.EndPos:=ParameterStart;
11893         MoveCursorToCleanPos(ParameterStart);
11894         repeat
11895           ReadNextAtom;
11896           {$IFDEF VerboseCPS}DebugLn('CheckIdentifierAndParameterList parameter atom "',GetAtom,'"');{$ENDIF}
11897           if (CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen]) then
11898           begin
11899             // atom belongs to the parameter expression
11900             if ParameterAtom.StartPos=ParameterAtom.EndPos then
11901               ParameterAtom.StartPos:=CurPos.StartPos;
11902             ReadTilBracketClose(false);
11903             ParameterAtom.EndPos:=CurPos.EndPos;
11904           end
11905           else
11906           if (CurPos.StartPos>SrcLen)
11907           or (CurPos.Flag in [cafComma,cafSemicolon,cafEnd,
11908               cafRoundBracketClose,cafEdgedBracketClose])
11909           or ((CurPos.Flag=cafWord)
11910               and (LastAtoms.GetPriorAtom.Flag=cafWord)
11911               and (not LastUpAtomIs(0,'INHERITED'))) then
11912           begin
11913             // end of parameter expression found
11914             {$IFDEF VerboseCPS}DebugLn('CheckIdentifierAndParameterList end of parameter found "',GetAtom,'" Parameter="',dbgstr(Src,ParameterAtom.StartPos,ParameterAtom.EndPos-ParameterAtom.StartPos),'"');{$ENDIF}
11915             exit(true);
11916           end else begin
11917             // atom belongs to the parameter expression
11918             if ParameterAtom.StartPos=ParameterAtom.EndPos then
11919               ParameterAtom.StartPos:=CurPos.StartPos;
11920             ParameterAtom.EndPos:=CurPos.EndPos;
11921           end;
11922         until false;
11923       end;
11924       if (CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen]) then begin
11925         if (LastAtoms.GetPriorAtom.Flag=cafWord) then begin
11926           {$IFDEF VerboseCPS}DebugLn('CheckIdentifierAndParameterList check word+bracket open');{$ENDIF}
11927           UndoReadNextAtom;
11928           if CheckIdentifierAndParameterList() then exit(true);
11929         end else begin
11930           {$IFDEF VerboseCPS}DebugLn('CheckIdentifierAndParameterList check bracket open');{$ENDIF}
11931           if CheckBrackets then exit(true);
11932         end;
11933       end
11934       else if CurPos.Flag in [cafRoundBracketClose,cafEdgedBracketClose] then
11935       begin
11936         {$IFDEF VerboseCPS}DebugLn('CheckIdentifierAndParameterList check bracket close');{$ENDIF}
11937         if (BracketAtom.Flag=cafRoundBracketOpen)
11938         =(CurPos.Flag=cafRoundBracketClose)
11939         then begin
11940           // parameter list ended in front of Variable => continue search
11941           {$IFDEF VerboseCPS}DebugLn('CheckIdentifierAndParameterList parameter list ended in front of cursor');{$ENDIF}
11942           if CurPos.Flag=cafEdgedBracketClose then begin
11943             ReadNextAtom;
11944             if CurPos.Flag=cafEdgedBracketOpen then begin
11945               // [][] is equal to [,]
11946               ParameterStart:=CurPos.EndPos;
11947               inc(CurParameterIndex);
11948               continue;
11949             end else
11950               UndoReadNextAtom;
11951           end;
11952           exit;
11953         end else begin
11954           // invalid closing bracket found
11955           RaiseBracketNotOpened;
11956         end;
11957       end;
11958       // finally after checking the expression: count commas
11959       if CurPos.Flag=cafComma then begin
11960         ParameterStart:=CurPos.EndPos;
11961         inc(CurParameterIndex);
11962       end;
11963       {$IFDEF VerboseCPS}DebugLn('CheckIdentifierAndParameterList After parsing atom. atom="',GetAtom,'"');{$ENDIF}
11964     until (CurPos.EndPos>CleanCursorPos);
11965   end;
11966 
11967 var
11968   CommentStart: integer;
11969   CommentEnd: integer;
11970   CleanPosInFront: Integer;
11971 begin
11972   Result:=false;
11973   ParameterAtom:=CleanAtomPosition;
11974   ProcNameAtom:=CleanAtomPosition;
11975   ParameterIndex:=0;
11976   //DebugLn('TFindDeclarationTool.CheckParameterSyntax START');
11977 
11978   if StartPos<1 then exit;
11979   // read code in front to find ProcName and check the syntax
11980   MoveCursorToCleanPos(StartPos);
11981   repeat
11982     ReadNextAtom;
11983     {$IFDEF VerboseCPS}
11984     DebugLn('TFindDeclarationTool.CheckParameterSyntax ',GetAtom,' at ',CleanPosToStr(CurPos.StartPos),' ',dbgs(CurPos.EndPos),'<',dbgs(CleanCursorPos));
11985     {$ENDIF}
11986     if CurPos.EndPos>CleanCursorPos then begin
11987       if not LastAtoms.HasPrior then exit;
11988       CleanPosInFront:=LastAtoms.GetPriorAtom.EndPos;
11989       //debugln(['TFindDeclarationTool.CheckParameterSyntax Cur="',GetAtom,'" Last="',GetAtom(LastAtoms.GetValueAt(0)),'"']);
11990       if not CleanPosIsInComment(CleanCursorPos,CleanPosInFront,
11991         CommentStart,CommentEnd,false) then exit;
11992       // cursor in a comment
11993       // => parse within the comment
11994       MoveCursorToCleanPos(CommentStart);
11995     end else if (CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen])
11996     and (LastAtoms.GetPriorAtom.Flag=cafWord) then begin
11997       UndoReadNextAtom;
11998       if CheckIdentifierAndParameterList then exit(true);
11999       if CurPos.EndPos>CleanCursorPos then exit;
12000     end;
12001   until false;
12002 end;
12003 
12004 procedure TFindDeclarationTool.OnFindUsedUnitIdentifier(
12005   Sender: TPascalParserTool; IdentifierCleanPos: integer; Range: TEPRIRange;
12006   Node: TCodeTreeNode; Data: Pointer; var Abort: boolean);
12007 var
12008   Identifier: PChar;
12009   CacheEntry: PInterfaceIdentCacheEntry;
12010   refs: TFindUsedUnitReferences;
12011   Found: Boolean;
12012   ReferencePos: TCodeXYPosition;
12013 begin
12014   if Range=epriInDirective then exit;
12015   if not (Node.Desc in (AllPascalTypes+AllPascalStatements)) then exit;
12016   Identifier:=@Src[IdentifierCleanPos];
12017   refs:=TFindUsedUnitReferences(Data);
12018   CacheEntry:=refs.TargetTool.FInterfaceIdentifierCache.FindIdentifier(Identifier);
12019   //debugln(['TFindUsedUnitReferences.OnIdentifier Identifier=',GetIdentifier(Identifier),' Found=',CacheEntry<>nil]);
12020   if (CacheEntry=nil)
12021   and (CompareIdentifiers(Identifier,PChar(refs.TargetUnitName))<>0) then
12022     exit;
12023   Sender.MoveCursorToCleanPos(IdentifierCleanPos);
12024   Sender.ReadPriorAtom;
12025   if (Sender.CurPos.Flag=cafPoint) or (Sender.UpAtomIs('inherited')) then exit;
12026   //debugln(['TFindUsedUnitReferences.OnIdentifier Identifier=',GetIdentifier(Identifier),' at begin of term']);
12027   // find declaration
12028   refs.Params.Clear;
12029   refs.Params.Flags:=[fdfSearchInParentNodes,fdfSearchInAncestors,
12030                  fdfIgnoreCurContextNode];
12031   refs.Params.ContextNode:=Node;
12032   //debugln(copy(Src,Params.ContextNode.StartPos,200));
12033   refs.Params.SetIdentifier(Self,Identifier,@CheckSrcIdentifier);
12034 
12035   if Range=epriInCode then begin
12036     // search identifier in code
12037     Found:=FindDeclarationOfIdentAtParam(refs.Params);
12038   end else begin
12039     // search identifier in comment -> if not found, this is no problem
12040     // => silently ignore
12041     try
12042       Found:=FindDeclarationOfIdentAtParam(refs.Params);
12043     except
12044       on E: ECodeToolError do begin
12045         // continue
12046       end;
12047       on E: Exception do
12048         raise;
12049     end;
12050   end;
12051   //debugln(['TFindUsedUnitReferences.OnIdentifier Identifier=',GetIdentifier(Identifier),' found=',Found]);
12052 
12053   if not Found then exit;
12054 
12055   if CleanPosToCaret(IdentifierCleanPos,ReferencePos) then
12056     AddCodePosition(refs.ListOfPCodeXYPosition,ReferencePos);
12057 end;
12058 
FindNthParameterNodenull12059 function TFindDeclarationTool.FindNthParameterNode(Node: TCodeTreeNode;
12060   ParameterIndex: integer): TCodeTreeNode;
12061 var
12062   ProcNode, FunctionNode: TCodeTreeNode;
12063   ProcHeadNode: TCodeTreeNode;
12064   ParameterNode: TCodeTreeNode;
12065   i: Integer;
12066 begin
12067   {$IFDEF CheckNodeTool}CheckNodeTool(Node);{$ENDIF}
12068   Result:=nil;
12069   if Node=nil then exit;
12070   if Node.Desc=ctnReferenceTo then begin
12071     Node:=Node.FirstChild;
12072     if Node=nil then exit;
12073   end;
12074   if Node.Desc in [ctnProcedure,ctnProcedureType] then begin
12075     ProcNode:=Node;
12076     //DebugLn('  FindNthParameterNode ProcNode="',copy(Params.NewCodeTool.Src,ProcNode.StartPos,ProcNode.EndPos-ProcNode.StartPos),'"');
12077     FunctionNode:=nil;
12078     BuildSubTreeForProcHead(ProcNode,FunctionNode);
12079     // find procedure head
12080     ProcHeadNode:=ProcNode.FirstChild;
12081     if (ProcHeadNode=nil) or (ProcHeadNode.Desc<>ctnProcedureHead) then begin
12082       DebugLn('  FindNthParameterNode Procedure has no parameter list');
12083       exit;
12084     end;
12085     // find parameter list
12086     ParameterNode:=ProcHeadNode.FirstChild;
12087     if (ParameterNode=nil) or (ParameterNode.Desc<>ctnParameterList)
12088     then begin
12089       DebugLn('  FindNthParameterNode Procedure has no parameter list');
12090       exit;
12091     end;
12092     // find parameter
12093     ParameterNode:=ParameterNode.FirstChild;
12094     i:=0;
12095     while (i<ParameterIndex) and (ParameterNode<>nil) do begin
12096       //DebugLn('  FindNthParameterNode ',ParameterNode.DescAsString);
12097       ParameterNode:=ParameterNode.NextBrother;
12098       inc(i);
12099     end;
12100     Result:=ParameterNode;
12101   end;
12102 end;
12103 
12104 constructor TFindDeclarationTool.Create;
12105 begin
12106   inherited Create;
12107   FSourcesChangeStep:=CTInvalidChangeStamp64;
12108   FFilesChangeStep:=CTInvalidChangeStamp64;
12109   FInitValuesChangeStep:=CTInvalidChangeStamp;
12110 end;
12111 
12112 procedure TFindDeclarationTool.DoDeleteNodes(StartNode: TCodeTreeNode);
12113 var
12114   HelperKind: TFDHelpersListKind;
12115 begin
12116   ClearNodeCaches;
12117   if FInterfaceIdentifierCache<>nil then begin
12118     FInterfaceIdentifierCache.Clear;
12119     FInterfaceIdentifierCache.Complete:=false;
12120   end;
12121   for HelperKind in TFDHelpersListKind do
12122     if FInterfaceHelperCache[HelperKind]<>nil then
12123       FInterfaceHelperCache[HelperKind].Clear;
12124   inherited DoDeleteNodes(StartNode);
12125 end;
12126 
CheckDependsOnNodeCachesnull12127 function TFindDeclarationTool.CheckDependsOnNodeCaches(
12128   CheckedTools: TAVLTree = nil): boolean;
12129 var
12130   ANode: TAVLTreeNode;
12131   ATool: TFindDeclarationTool;
12132   FreeCheckedTools: Boolean;
12133   SourcesChangeStep, FilesChangeStep: int64;
12134   InitValuesChangeStep: integer;
12135 begin
12136   Result:=false;
12137   //debugln(['TFindDeclarationTool.CheckDependsOnNodeCaches ',MainFilename,' FDependsOnCodeTools=',FDependsOnCodeTools]);
12138   if (FDependsOnCodeTools=nil) or FCheckingNodeCacheDependencies then exit;
12139   if Scanner=nil then exit;
12140 
12141   if Assigned(Scanner.OnGetGlobalChangeSteps) then begin
12142     // check if any sources or values have changed
12143     Scanner.OnGetGlobalChangeSteps(SourcesChangeStep,FilesChangeStep,
12144                                    InitValuesChangeStep);
12145     if (SourcesChangeStep=FSourcesChangeStep)
12146     and (FilesChangeStep=FFilesChangeStep)
12147     and (InitValuesChangeStep=FInitValuesChangeStep) then
12148       // all sources and values are the same
12149       exit;
12150     FSourcesChangeStep:=SourcesChangeStep;
12151     FFilesChangeStep:=FilesChangeStep;
12152     FInitValuesChangeStep:=InitValuesChangeStep;
12153   end;
12154 
12155   if (CheckedTools<>nil) and (CheckedTools.Find(Self)<>nil) then exit;
12156 
12157   {$IFDEF ShowCacheDependencies}
12158   DebugLn(['[TFindDeclarationTool.CheckDependsOnNodeCaches] START DependsOn=',FDependsOnCodeTools.Count,' ',MainFilename]);
12159   {$ENDIF}
12160   FCheckingNodeCacheDependencies:=true;
12161   FreeCheckedTools:=false;
12162   if CheckedTools=nil then begin
12163     FreeCheckedTools:=true;
12164     CheckedTools:=TAVLTree.Create;
12165   end;
12166   try
12167     CheckedTools.Add(Self);
12168     ANode:=FDependsOnCodeTools.FindLowest;
12169     while ANode<>nil do begin
12170       ATool:=TFindDeclarationTool(ANode.Data);
12171       Result:=ATool.UpdateNeeded(lsrImplementationStart)
12172               or ATool.CheckDependsOnNodeCaches(CheckedTools);
12173       if Result then exit;
12174       ANode:=FDependsOnCodeTools.FindSuccessor(ANode);
12175     end;
12176     Result:=false;
12177   finally
12178     {$IFDEF ShowCacheDependencies}
12179     DebugLn('[TFindDeclarationTool.CheckDependsOnNodeCaches] Result=',DbgS(Result),' ',MainFilename);
12180     {$ENDIF}
12181     FCheckingNodeCacheDependencies:=false;
12182     if FreeCheckedTools then FreeAndNil(CheckedTools);
12183     if Result then ClearNodeCaches;
12184   end;
12185 end;
12186 
12187 destructor TFindDeclarationTool.Destroy;
12188 var
12189   HelperKind: TFDHelpersListKind;
12190 begin
12191   FreeAndNil(FInterfaceIdentifierCache);
12192   for HelperKind in TFDHelpersListKind do
12193     FreeAndNil(FInterfaceHelperCache[HelperKind]);
12194   FreeAndNil(FDependsOnCodeTools);
12195   FreeAndNil(FDependentCodeTools);
12196   if FDirectoryCache<>nil then begin
12197     FDirectoryCache.Release;
12198     FDirectoryCache:=nil;
12199   end;
12200   FFindMissingFPCUnits.Free;
12201   inherited Destroy;
12202 end;
12203 
12204 procedure TFindDeclarationTool.ClearNodeCaches;
12205 var
12206   NodeCache: TCodeTreeNodeCache;
12207   BaseTypeCache: TBaseTypeCache;
12208 begin
12209   // check if there is something in cache to delete
12210   if (FFirstNodeCache=nil) and (FFirstBaseTypeCache=nil)
12211   and (FRootNodeCache=nil)
12212   and ((FDependentCodeTools=nil) or (FDependentCodeTools.Count=0))
12213   and ((FDependsOnCodeTools=nil) or (FDependsOnCodeTools.Count=0)) then
12214     exit;
12215   {$IFDEF ShowCacheDependencies}
12216   DebugLn('[TFindDeclarationTool.ClearNodeCaches] Force=',
12217           DbgS(Force),' ',MainFilename);
12218   {$ENDIF}
12219 
12220   // clear node caches
12221   while FFirstNodeCache<>nil do begin
12222     NodeCache:=FFirstNodeCache;
12223     FFirstNodeCache:=NodeCache.Next;
12224     NodeCacheMemManager.DisposeNodeCache(NodeCache);
12225   end;
12226   while FFirstBaseTypeCache<>nil do begin
12227     BaseTypeCache:=FFirstBaseTypeCache;
12228     FFirstBaseTypeCache:=BaseTypeCache.NextCache;
12229     BaseTypeCacheMemManager.DisposeBaseTypeCache(BaseTypeCache);
12230   end;
12231   if FRootNodeCache<>nil then begin
12232     NodeCacheMemManager.DisposeNodeCache(FRootNodeCache);
12233     FRootNodeCache:=nil;
12234   end;
12235 
12236   // clear dependent codetools
12237   ClearDependentNodeCaches;
12238   ClearDependsOnToolRelationships;
12239 end;
12240 
12241 procedure TFindDeclarationTool.ClearDependentNodeCaches;
12242 var
12243   ANode: TAVLTreeNode;
12244   DependentTool: TFindDeclarationTool;
12245 begin
12246   if (FDependentCodeTools=nil) or (FDependentCodeTools.Count=0)
12247   or FClearingDependentNodeCaches then exit;
12248   FClearingDependentNodeCaches:=true;
12249   {$IFDEF ShowCacheDependencies}
12250   DebugLn('[TFindDeclarationTool.ClearDependentNodeCaches] ',MainFilename);
12251   {$ENDIF}
12252   try
12253     ANode:=FDependentCodeTools.FindLowest;
12254     while ANode<>nil do begin
12255       DependentTool:=TFindDeclarationTool(ANode.Data);
12256       DependentTool.ClearNodeCaches;
12257       ANode:=FDependentCodeTools.FindSuccessor(ANode);
12258     end;
12259     FDependentCodeTools.Clear;
12260   finally
12261     FClearingDependentNodeCaches:=false;
12262   end;
12263 end;
12264 
12265 procedure TFindDeclarationTool.ClearDependsOnToolRelationships;
12266 var
12267   ANode: TAVLTreeNode;
12268   DependOnTool: TFindDeclarationTool;
12269 begin
12270   if (FDependsOnCodeTools=nil) or (FDependsOnCodeTools.Count=0) then exit;
12271   {$IFDEF ShowCacheDependencies}
12272   DebugLn('[TFindDeclarationTool.ClearDependsOnToolRelationships] ',MainFilename);
12273   {$ENDIF}
12274   ANode:=FDependsOnCodeTools.FindLowest;
12275   while ANode<>nil do begin
12276     DependOnTool:=TFindDeclarationTool(ANode.Data);
12277     if not DependOnTool.FClearingDependentNodeCaches then
12278       DependOnTool.FDependentCodeTools.Remove(Self);
12279     ANode:=FDependsOnCodeTools.FindSuccessor(ANode);
12280   end;
12281   FDependsOnCodeTools.Clear;
12282 end;
12283 
12284 procedure TFindDeclarationTool.AddToolDependency(
12285   DependOnTool: TFindDeclarationTool);
12286 // build a relationship: this tool depends on DependOnTool
12287 {$IFDEF DebugAddToolDependency}
12288 var
12289   AVLNode: TAVLTreeNode;
12290   Tool: TFindDeclarationTool;
12291 {$ENDIF}
12292 begin
12293   {$IFDEF ShowCacheDependencies}
12294   DebugLn('[TFindDeclarationTool.AddToolDependency] "',MainFilename,'" depends on "',DependOnTool.MainFilename,'"');
12295   {$ENDIF}
12296   if DependOnTool.FDependentCodeTools=nil then
12297     DependOnTool.FDependentCodeTools:=TAVLTree.Create;
12298   if DependOnTool.FDependentCodeTools.Find(Self)=nil then
12299     DependOnTool.FDependentCodeTools.Add(Self);
12300 
12301   if FDependsOnCodeTools=nil then
12302     FDependsOnCodeTools:=TAVLTree.Create;
12303 
12304   if FDependsOnCodeTools.Find(DependOnTool)=nil then begin
12305     {$IFDEF DebugAddToolDependency}
12306     AVLNode:=FDependsOnCodeTools.FindLowest;
12307     while AVLNode<>nil do begin
12308       Tool:=TFindDeclarationTool(AVLNode.Data);
12309       if CompareFilenames(ExtractFilename(Tool.MainFilename),ExtractFilename(DependOnTool.MainFilename))=0 then begin
12310         DebugLn(['TFindDeclarationTool.AddToolDependency inconsistency: ',Tool.MainFilename,' ',DependOnTool.MainFilename]);
12311       end;
12312       AVLNode:=FDependsOnCodeTools.FindSuccessor(AVLNode);
12313     end;
12314     {$ENDIF}
12315 
12316     FDependsOnCodeTools.Add(DependOnTool);
12317   end;
12318 end;
12319 
12320 procedure TFindDeclarationTool.ConsistencyCheck;
12321 var ANodeCache: TCodeTreeNodeCache;
12322 begin
12323   inherited ConsistencyCheck;
12324   if FInterfaceIdentifierCache<>nil then
12325     FInterfaceIdentifierCache.ConsistencyCheck;
12326   ANodeCache:=FFirstNodeCache;
12327   while ANodeCache<>nil do begin
12328     ANodeCache.ConsistencyCheck;
12329     ANodeCache:=ANodeCache.Next;
12330   end;
12331   if FDependentCodeTools<>nil then
12332     FDependentCodeTools.ConsistencyCheck;
12333   if FDependsOnCodeTools<>nil then
12334     FDependsOnCodeTools.ConsistencyCheck;
12335 end;
12336 
12337 procedure TFindDeclarationTool.CalcMemSize(Stats: TCTMemStats);
12338 var
12339   NodeCache: TCodeTreeNodeCache;
12340   TypeCache: TBaseTypeCache;
12341   m: PtrUInt;
12342   HelperKind: TFDHelpersListKind;
12343 begin
12344   inherited CalcMemSize(Stats);
12345   if FInterfaceIdentifierCache<>nil then
12346     Stats.Add('TFindDeclarationTool.FInterfaceIdentifierCache',
12347       FInterfaceIdentifierCache.CalcMemSize);
12348   for HelperKind in TFDHelpersListKind do
12349     if FInterfaceHelperCache[HelperKind]<>nil then
12350       Stats.Add('TFindDeclarationTool.FInterfaceHelperCache[]',
12351         FInterfaceHelperCache[HelperKind].CalcMemSize);
12352   if FFirstNodeCache<>nil then begin
12353     m:=0;
12354     NodeCache:=FFirstNodeCache;
12355     while NodeCache<>nil do begin
12356       inc(m,NodeCache.CalcMemSize);
12357       NodeCache:=NodeCache.Next;
12358     end;
12359     Stats.Add('TFindDeclarationTool.NodeCache',m);
12360   end;
12361   if FFirstBaseTypeCache<>nil then begin
12362     m:=0;
12363     TypeCache:=FFirstBaseTypeCache;
12364     while TypeCache<>nil do begin
12365       inc(m,TypeCache.CalcMemSize);
12366       TypeCache:=TypeCache.NextCache;
12367     end;
12368     Stats.Add('TFindDeclarationTool.TypeCache',m);
12369   end;
12370   if FDependentCodeTools<>nil then
12371     Stats.Add('TFindDeclarationTool.FDependentCodeTools',
12372       FDependentCodeTools.Count*SizeOf(TAVLTreeNode));
12373   if FDependsOnCodeTools<>nil then
12374     Stats.Add('TFindDeclarationTool.FDependsOnCodeTools',
12375       FDependsOnCodeTools.Count*SizeOf(TAVLTreeNode));
12376 end;
12377 
12378 procedure TFindDeclarationTool.ValidateToolDependencies;
12379 begin
12380   //debugln(['TFindDeclarationTool.ValidateToolDependencies ',MainFilename]);
12381   inherited ValidateToolDependencies;
12382   CheckDependsOnNodeCaches;
12383 end;
12384 
GetNodeCachenull12385 function TFindDeclarationTool.GetNodeCache(Node: TCodeTreeNode;
12386   CreateIfNotExists: boolean): TCodeTreeNodeCache;
12387 begin
12388   {$IFDEF CheckNodeTool}CheckNodeTool(Node);{$ENDIF}
12389   while (Node<>nil) and (not (Node.Desc in AllNodeCacheDescs)) do
12390     Node:=Node.Parent;
12391   if Node<>nil then begin
12392     if (Node.Cache=nil) and CreateIfNotExists then
12393       CreateNewNodeCache(Node);
12394     if (Node.Cache is TCodeTreeNodeCache) then
12395       Result:=TCodeTreeNodeCache(Node.Cache)
12396     else
12397       Result:=nil;
12398   end else begin
12399     if (FRootNodeCache=nil) and CreateIfNotExists then
12400       FRootNodeCache:=CreateNewNodeCache(nil);
12401     Result:=FRootNodeCache;
12402   end;
12403 end;
12404 
12405 procedure TFindDeclarationTool.AddResultToNodeCaches(
12406   StartNode, EndNode: TCodeTreeNode; SearchedForward: boolean;
12407   Params: TFindDeclarationParams; SearchRangeFlags: TNodeCacheEntryFlags);
12408 var Node: TCodeTreeNode;
12409   CurNodeCache, LastNodeCache: TCodeTreeNodeCache;
12410   CleanStartPos, CleanEndPos: integer;
12411   NewNode: TCodeTreeNode;
12412   NewTool: TPascalParserTool;
12413   NewCleanPos: integer;
12414   {$IFDEF ShowNodeCache}
12415   BeVerbose: boolean;
12416   NodeOwner: TObject;
12417 
12418   function WriteSrcPos(t: TPascalParserTool; p: integer): string;
12419   begin
12420     Result:=StringToPascalConst(copy(t.Src,p-10,10)+'|'+copy(t.Src,p,15)+'"');
12421   end;
12422 
12423   function NodeOwnerAsString(ANodeOwner: TObject): string;
12424   begin
12425     if ANodeOwner=nil then
12426       Result:='nil'
12427     else if ANodeOwner is TPascalParserTool then
12428       Result:=ExtractFileName(TPascalParserTool(ANodeOwner).MainFilename)
12429     else
12430       Result:='?'+ANodeOwner.ClassName+'?';
12431   end;
12432   {$ENDIF}
12433 begin
12434   {$IFDEF CheckNodeTool}CheckNodeTool(StartNode);{$ENDIF}
12435   if StartNode=nil then exit;
12436   if EndNode=nil then EndNode:=StartNode;
12437 
12438   if Params.NewNode<>nil then begin
12439     // identifier found
12440     NewNode:=Params.NewNode;
12441     NewTool:=Params.NewCodeTool;
12442     NewCleanPos:=Params.NewCleanPos;
12443   end else begin
12444     // identifier not found
12445     NewNode:=nil;
12446     NewTool:=nil;
12447     NewCleanPos:=-1;
12448   end;
12449   // calculate search range
12450   if EndNode<>nil then begin
12451     if SearchedForward then begin
12452       CleanStartPos:=StartNode.StartPos;
12453       CleanEndPos:=EndNode.EndPos;
12454     end else begin
12455       CleanStartPos:=EndNode.StartPos;
12456       CleanEndPos:=StartNode.EndPos;
12457     end;
12458   end else begin
12459     // searched till start or end of source
12460     if not SearchedForward then begin
12461       CleanStartPos:=1;
12462       CleanEndPos:=StartNode.StartPos;
12463     end else begin
12464       CleanStartPos:=StartNode.StartPos;
12465       CleanEndPos:=SrcLen+1;
12466     end;
12467   end;
12468 
12469   {$IFDEF ShowNodeCache}
12470   beVerbose:=true; //CompareSrcIdentifiers(Params.Identifier,'InitDecompressor');
12471   if beVerbose then begin
12472     DebugLn('(((((((((((((((((((((((((((==================');
12473 
12474     DbgOut('TFindDeclarationTool.AddResultToNodeCaches ',
12475     ' Ident=',GetIdentifier(Params.Identifier));
12476     DbgOut(' SearchedForward=',DbgS(SearchedForward));
12477     DbgOut(' Flags=[');
12478     if ncefSearchedInParents in SearchRangeFlags then DbgOut('Parents');
12479     if ncefSearchedInAncestors in SearchRangeFlags then DbgOut(',Ancestors');
12480     DebugLn(']');
12481 
12482     DbgOut('     StartNode=',StartNode.DescAsString,
12483       '('+DbgS(StartNode.StartPos),'-',DbgS(StartNode.EndPos)+')=',
12484       WriteSrcPos(Self,StartNode.StartPos));
12485     NodeOwner:=FindOwnerOfCodeTreeNode(StartNode);
12486     if NodeOwner<>Self then DbgOut(' StartNodeOwner=',NodeOwnerAsString(NodeOwner));
12487     DebugLn('');
12488 
12489     if EndNode<>nil then
12490       DbgOut(' EndNode=',EndNode.DescAsString,
12491         '('+DbgS(EndNode.StartPos),'-',DbgS(EndNode.EndPos)+')=',
12492         WriteSrcPos(Self,EndNode.StartPos))
12493     else
12494       DbgOut(' EndNode=nil');
12495     NodeOwner:=FindOwnerOfCodeTreeNode(EndNode);
12496     if NodeOwner<>Self then DbgOut(' EndNodeOwner=',NodeOwnerAsString(NodeOwner));
12497     DebugLn('');
12498 
12499     DebugLn('     Self=',ExtractFileName(MainFilename));
12500 
12501     if NewNode<>nil then begin
12502       DebugLn('       NewNode=',NewNode.DescAsString,
12503               '(',DbgS(NewNode.StartPos),'-',DbgS(NewNode.EndPos),')=',
12504               WriteSrcPos(NewTool,NewNode.StartPos),
12505                  ' NewTool=',ExtractFileName(NewTool.MainFilename));
12506     end else begin
12507       DebugLn('       NOT FOUND');
12508       //RaiseCatchableException('');
12509     end;
12510 
12511     DebugLn('  CleanStartPos=',DbgS(CleanStartPos),' ',WriteSrcPos(Self,CleanStartPos));
12512     DebugLn('  CleanEndPos=',DbgS(CleanEndPos),' ',WriteSrcPos(Self,CleanEndPos));
12513   end;
12514   {$ENDIF}
12515   LastNodeCache:=nil;
12516   // start with parent of deepest node and end parent of highest
12517   Node:=StartNode;
12518   repeat
12519     if (Node.Desc in AllNodeCacheDescs) then begin
12520       if (Node.Cache=nil) then
12521         CreateNewNodeCache(Node);
12522       if (Node.Cache is TCodeTreeNodeCache) then begin
12523         CurNodeCache:=TCodeTreeNodeCache(Node.Cache);
12524         if LastNodeCache<>CurNodeCache then begin
12525           {$IFDEF ShowNodeCache}
12526           if BeVerbose then begin
12527             CurNodeCache.WriteDebugReport('  BEFORE NODECACHE REPORT: ');
12528           end;
12529           {$ENDIF}
12530           CurNodeCache.Add(Params.Identifier,
12531                            Self,CleanStartPos,CleanEndPos,
12532                            NewNode,NewTool,NewCleanPos,SearchRangeFlags);
12533           {$IFDEF ShowNodeCache}
12534           if BeVerbose then begin
12535             CurNodeCache.WriteDebugReport('  AFTER NODECACHE REPORT: ');
12536           end;
12537           {$ENDIF}
12538           LastNodeCache:=CurNodeCache;
12539         end;
12540       end;
12541     end;
12542     Node:=Node.Parent;
12543   until (Node=nil) or (EndNode=Node) or EndNode.HasAsParent(Node);
12544   {$IFDEF ShowNodeCache}
12545   if BeVerbose then begin
12546     DebugLn('=========================))))))))))))))))))))))))))))))))');
12547   end;
12548   {$ENDIF}
12549 end;
12550 
CreateNewNodeCachenull12551 function TFindDeclarationTool.CreateNewNodeCache(
12552   Node: TCodeTreeNode): TCodeTreeNodeCache;
12553 begin
12554   {$IFDEF CheckNodeTool}CheckNodeTool(Node);{$ENDIF}
12555   Result:=NodeCacheMemManager.NewNodeCache(Node);
12556   Result.Next:=FFirstNodeCache;
12557   FFirstNodeCache:=Result;
12558 end;
12559 
CreateNewBaseTypeCachenull12560 function TFindDeclarationTool.CreateNewBaseTypeCache(
12561   Tool: TFindDeclarationTool; Node: TCodeTreeNode): TBaseTypeCache;
12562 begin
12563   {$IFDEF CheckNodeTool}Tool.CheckNodeTool(Node);{$ENDIF}
12564   Result:=BaseTypeCacheMemManager.NewBaseTypeCache(Node);
12565   Result.NextCache:=Tool.FFirstBaseTypeCache;
12566   Tool.FFirstBaseTypeCache:=Result;
12567 end;
12568 
12569 procedure TFindDeclarationTool.CreateBaseTypeCaches(
12570   NodeStack: PCodeTreeNodeStack; const Result: TFindContext);
12571 var i: integer;
12572   Entry: PCodeTreeNodeStackEntry;
12573   BaseTypeCache: TBaseTypeCache;
12574   NextEntry: PCodeTreeNodeStackEntry;
12575 begin
12576   {$IFDEF ShowBaseTypeCache}
12577   DbgOut('[TFindDeclarationTool.CreateBaseTypeCaches] ',
12578   ' StackPtr=',DbgS(NodeStack^.StackPtr));
12579   DebugLn(' Self=',MainFilename);
12580   if Result.Node<>nil then
12581     DbgOut(' Result='+Result.Node.DescAsString,
12582        ' Start='+DbgS(Result.Node.StartPos),
12583        ' End='+DbgS(Result.Node.EndPos),
12584        ' "'+copy(Result.Tool.Src,Result.Node.StartPos,15)+'" ',Result.Tool.MainFilename)
12585   else
12586     DbgOut(' Result=nil');
12587   DebugLn('');
12588   {$ENDIF}
12589   for i:=0 to NodeStack^.StackPtr do begin
12590     Entry:=GetNodeStackEntry(NodeStack,i);
12591     if Entry^.Node.Cache=nil then begin
12592       {$IFDEF ShowBaseTypeCache}
12593       DebugLn('  i=',DbgS(i),' Node=',Entry^.Node.DescAsString,' "',copy(Entry^.Tool.Src,Entry^.Node.StartPos,15),'"');
12594       {$ENDIF}
12595       BaseTypeCache:=
12596         CreateNewBaseTypeCache(TFindDeclarationTool(Entry^.Tool),Entry^.Node);
12597       if BaseTypeCache<>nil then begin
12598         BaseTypeCache.BaseNode:=Result.Node;
12599         BaseTypeCache.BaseTool:=Result.Tool;
12600         if i<NodeStack^.StackPtr then begin
12601           NextEntry:=GetNodeStackEntry(NodeStack,i+1);
12602           BaseTypeCache.NextNode:=NextEntry^.Node;
12603           BaseTypeCache.NextTool:=NextEntry^.Tool;
12604         end else begin
12605           BaseTypeCache.NextNode:=Result.Node;
12606           BaseTypeCache.NextTool:=Result.Tool;
12607         end;
12608       end;
12609     end;
12610   end;
12611 end;
12612 
GetExpressionTypeOfTypeIdentifiernull12613 function TFindDeclarationTool.GetExpressionTypeOfTypeIdentifier(
12614   Params: TFindDeclarationParams): TExpressionType;
12615 var
12616   OldFlags: TFindDeclarationFlags;
12617 begin
12618   OldFlags:=Params.Flags;
12619   if FindIdentifierInContext(Params) then begin
12620     Params.Flags:=OldFlags;
12621     Result:=Params.NewCodeTool.ConvertNodeToExpressionType(Params.NewNode,Params);
12622   end else begin
12623     // predefined identifier
12624     Params.Flags:=OldFlags;
12625     Result:=CleanExpressionType;
12626     Result.Desc:=PredefinedIdentToExprTypeDesc(Params.Identifier,Scanner.PascalCompiler);
12627   end;
12628 end;
12629 
FindTermTypeAsStringnull12630 function TFindDeclarationTool.FindTermTypeAsString(TermPos: TAtomPosition;
12631   Params: TFindDeclarationParams;
12632   out ExprType: TExpressionType): string;
12633 var
12634   EdgedBracketsStartPos: integer;
12635   SetNode: TCodeTreeNode;
12636   SetTool: TFindDeclarationTool;
12637   AliasType: TFindContext;
12638 begin
12639   //debugln(['TFindDeclarationTool.FindTermTypeAsString START']);
12640   {$IFDEF CheckNodeTool}CheckNodeTool(Params.ContextNode);{$ENDIF}
12641   Result:='';
12642   AliasType:=CleanFindContext;
12643 
12644   if IsTermEdgedBracket(TermPos,EdgedBracketsStartPos) then begin
12645     // check for constant sets: [enum]
12646     MoveCursorToCleanPos(EdgedBracketsStartPos);
12647     ReadNextAtom;
12648     ReadNextAtom;
12649     if CurPos.Flag=cafWord then begin
12650       {$IFDEF ShowExprEval}
12651       debugln(['TFindDeclarationTool.FindTermTypeAsString "[name" : check for enumeration type ...']);
12652       debugln(['TFindDeclarationTool.FindTermTypeAsString StartContext=',Params.ContextNode.DescAsString,'=',dbgstr(Src,Params.ContextNode.StartPos,15),'"']);
12653       {$ENDIF}
12654       ExprType:=FindExpressionResultType(Params,EdgedBracketsStartPos+1,-1);
12655       {$IFDEF ShowExprEval}
12656       debugln(['TFindDeclarationTool.FindTermTypeAsString "[name" : ',ExprTypeToString(ExprType)]);
12657       {$ENDIF}
12658       if (ExprType.Desc=xtContext)
12659       and (ExprType.Context.Node.Desc in [ctnEnumerationType,ctnEnumIdentifier])
12660       then begin
12661         SetTool:=ExprType.Context.Tool;
12662         SetNode:=SetTool.FindSetOfEnumerationType(ExprType.Context.Node);
12663         if SetNode<>nil then begin
12664           ExprType:=CleanExpressionType;
12665           ExprType.Desc:=xtContext;
12666           ExprType.SubDesc:=xtNone;
12667           ExprType.Context.Tool:=SetTool;
12668           ExprType.Context.Node:=SetNode;
12669           Result:=SetTool.ExtractDefinitionName(SetNode);
12670           exit;
12671         end;
12672       end;
12673     end;
12674   end;
12675 
12676   // check if TermPos is @Name and a pointer (= ^Name) can be found
12677   if IsTermNamedPointer(TermPos,ExprType) then begin
12678     // pointer type
12679   end else begin
12680     ExprType:=CleanExpressionType;
12681     Params.Flags:=[fdfSearchInParentNodes,fdfSearchInAncestors,fdfSearchInHelpers,
12682                    fdfTopLvlResolving,fdfFunctionResult,fdfIgnoreOperatorError]
12683                   +Params.Flags*[fdfOverrideStringTypesWithFirstParamType];
12684     ExprType:=FindExpressionResultType(Params,TermPos.StartPos,TermPos.EndPos,
12685                                        @AliasType);
12686   end;
12687 
12688   if AliasType.Node<>nil then begin
12689     ExprType:=CleanExpressionType;
12690     ExprType.Desc:=xtContext;
12691     ExprType.Context:=AliasType;
12692   end;
12693   Result:=FindExprTypeAsString(ExprType,TermPos.StartPos);
12694 end;
12695 
FindForInTypeAsStringnull12696 function TFindDeclarationTool.FindForInTypeAsString(TermPos: TAtomPosition;
12697   CursorNode: TCodeTreeNode; Params: TFindDeclarationParams; out
12698   ExprType: TExpressionType): string;
12699 
12700   procedure RaiseTermHasNoIterator(id: int64; TermExprType: TExpressionType);
12701   begin
12702     if TermPos.StartPos<1 then
12703       TermPos.StartPos:=1;
12704     MoveCursorToCleanPos(TermPos.StartPos);
12705     debugln(['TFindDeclarationTool.FindForInTypeAsString TermExprType=',ExprTypeToString(TermExprType)]);
12706     RaiseException(id,'Can not find an enumerator for '''+TrimCodeSpace(GetAtom(TermPos))+'''');
12707   end;
12708 
12709   procedure ResolveExpr(SubExprType: TExpressionType);
12710   var
12711     AliasType: TFindContext;
12712     Node: TCodeTreeNode;
12713   begin
12714     {$IFDEF ShowForInEval}
12715     debugln(['  ResolveExpr ',ExprTypeToString(SubExprType)]);
12716     {$ENDIF}
12717     // use default enumerators
12718     case SubExprType.Desc of
12719       xtContext:
12720         begin
12721           case SubExprType.Context.Node.Desc of
12722           ctnSpecialize, ctnClass, ctnRecordType,
12723           ctnClassHelper, ctnRecordHelper, ctnTypeHelper, ctnClassInterface:
12724             begin
12725               AliasType:=CleanFindContext;
12726               if not SubExprType.Context.Tool.FindEnumeratorOfClass(
12727                 SubExprType.Context.Node,true,ExprType,@AliasType, Params)
12728               then
12729                 RaiseTermHasNoIterator(20170421211210,SubExprType);
12730               if (ExprType.Desc = xtContext)
12731               and (ExprType.Context.Node.Desc = ctnGenericParameter) then begin
12732                 Params.UpdateContexWithGenParamValue(ExprType.Context);
12733               end;
12734               Result:=FindExprTypeAsString(ExprType,TermPos.StartPos,@AliasType);
12735             end;
12736           ctnEnumerationType:
12737             begin
12738               Node:=SubExprType.Context.Node.Parent;
12739               if Node.Desc=ctnTypeDefinition then
12740                 Result:=SubExprType.Context.Tool.ExtractIdentifier(Node.StartPos);
12741             end;
12742           ctnSetType:
12743             if SubExprType.Context.Tool.FindEnumerationTypeOfSetType(
12744                                     SubExprType.Context.Node,ExprType.Context)
12745             then begin
12746               ExprType.Desc:=xtContext;
12747               Result:=FindExprTypeAsString(ExprType,TermPos.StartPos);
12748             end;
12749           ctnRangedArrayType,ctnOpenArrayType:
12750             begin
12751               AliasType:=CleanFindContext;
12752               if SubExprType.Context.Tool.FindElementTypeOfArrayType(
12753                                     SubExprType.Context.Node,ExprType,@AliasType,Params)
12754               then begin
12755                 Result:=FindExprTypeAsString(ExprType,TermPos.StartPos,@AliasType);
12756               end;
12757             end;
12758           else
12759             RaiseTermHasNoIterator(20170421211213,SubExprType);
12760           end;
12761         end;
12762       xtChar,
12763       xtSmallInt,
12764       xtShortInt,
12765       xtByte,
12766       xtWord,
12767       xtBoolean,
12768       xtByteBool,
12769       xtWordBool,
12770       xtLongBool,
12771       xtQWordBool,
12772       xtNativeInt,
12773       xtNativeUInt:
12774         Result:=ExpressionTypeDescNames[SubExprType.Desc];
12775       xtNone,
12776       xtWideChar,
12777       xtReal,
12778       xtSingle,
12779       xtDouble,
12780       xtExtended,
12781       xtCExtended,
12782       xtCurrency,
12783       xtComp,
12784       xtInt64,
12785       xtCardinal,
12786       xtQWord,
12787       xtPointer,
12788       xtFile,
12789       xtText,
12790       xtConstOrdInteger,
12791       xtConstReal,
12792       xtConstBoolean,
12793       xtLongint,
12794       xtLongWord,
12795       xtCompilerFunc,
12796       xtVariant,
12797       xtJSValue,
12798       xtNil:
12799         RaiseTermHasNoIterator(20170421211217,SubExprType);
12800       xtString,
12801       xtAnsiString,
12802       xtShortString,
12803       xtPChar,
12804       xtConstString:
12805         begin
12806           ExprType.Desc:=xtChar;
12807           Result:=ExpressionTypeDescNames[ExprType.Desc];
12808         end;
12809       xtWideString,
12810       xtUnicodeString:
12811         begin
12812           ExprType.Desc:=xtWideChar;
12813           Result:=ExpressionTypeDescNames[ExprType.Desc];
12814         end;
12815       xtConstSet:
12816         begin
12817         if SubExprType.Context.Node=nil then
12818           RaiseTermHasNoIterator(20170421211222,SubExprType);
12819         SubExprType:=SubExprType.Context.Tool.FindExpressionTypeOfConstSet(SubExprType.Context.Node);
12820         {$IFDEF ShowForInEval}
12821         debugln(['  ResolveExpr ConstSet Element: ',ExprTypeToString(SubExprType)]);
12822         {$ENDIF}
12823         if SubExprType.Desc=xtConstSet then
12824           RaiseTermHasNoIterator(20170421211222,SubExprType);
12825         ResolveExpr(SubExprType);
12826         end;
12827     else
12828       DebugLn('TFindDeclarationTool.FindForInTypeAsString.ResolveExpr TermExprType=',
12829         ExprTypeToString(SubExprType));
12830       RaiseTermHasNoIterator(20170421211225,SubExprType);
12831     end;
12832   end;
12833 
12834 var
12835   TermExprType: TExpressionType;
12836   OperatorExprType: TExpressionType;
12837 begin
12838   Result:='';
12839   ExprType:=CleanExpressionType;
12840   TermExprType:=CleanExpressionType;
12841   Params.ContextNode:=CursorNode;
12842   Params.Flags:=[fdfSearchInParentNodes,fdfSearchInAncestors,fdfSearchInHelpers,
12843                  fdfTopLvlResolving,fdfFunctionResult];
12844   TermExprType:=FindExpressionResultType(Params,TermPos.StartPos,TermPos.EndPos);
12845 
12846   {$IFDEF ShowForInEval}
12847   DebugLn('TFindDeclarationTool.FindForInTypeAsString TermExprType=',
12848     ExprTypeToString(TermExprType));
12849   {$ENDIF}
12850   // search operator enumerator
12851   if FindOperatorEnumerator(CursorNode,TermExprType,foeEnumeratorCurrentExprType,
12852     OperatorExprType)
12853   then begin
12854     {$IFDEF ShowForInEval}
12855     DebugLn(['TFindDeclarationTool.FindForInTypeAsString Operator=',ExprTypeToString(OperatorExprType)]);
12856     {$ENDIF}
12857     ExprType:=OperatorExprType;
12858     Result:=FindExprTypeAsString(ExprType,TermPos.StartPos);
12859     exit;
12860   end;
12861   // convert to string
12862   ResolveExpr(TermExprType);
12863 
12864   {$IFDEF ShowExprEval}
12865   DebugLn('TFindDeclarationTool.FindForInTypeAsString Result=',Result);
12866   {$ENDIF}
12867 end;
12868 
FindEnumeratorOfClassnull12869 function TFindDeclarationTool.FindEnumeratorOfClass(ClassNode: TCodeTreeNode;
12870   ExceptionOnNotFound: boolean; out ExprType: TExpressionType;
12871   AliasType: PFindContext; ParentParams: TFindDeclarationParams): boolean;
12872 var
12873   Params: TFindDeclarationParams;
12874   ClassTool: TFindDeclarationTool;
12875   ClassContext: TFindContext;
12876   ProcTool: TFindDeclarationTool;
12877   ProcNode: TCodeTreeNode;
12878   EnumeratorContext: TFindContext;
12879   PropTool: TFindDeclarationTool;
12880   PropNode: TCodeTreeNode;
12881   CurrentContext: TFindContext;
12882 begin
12883   Result:=false;
12884   if AliasType<>nil then
12885     AliasType^:=CleanFindContext;
12886   ExprType:=CleanExpressionType;
12887   Params:=TFindDeclarationParams.Create(ParentParams);
12888   try
12889     if ClassNode.Desc = ctnSpecialize then begin
12890       Params.ContextNode:=ClassNode;
12891       Params.Flags:=[fdfEnumIdentifier,fdfTopLvlResolving];
12892       ClassContext := FindBaseTypeOfNode(Params, ClassNode, AliasType);
12893       if (ClassContext.Node = nil)
12894       or not (ClassContext.Node.Desc in [ctnClass,ctnClassInterface,ctnRecordType]) then begin
12895         if ExceptionOnNotFound then begin
12896           MoveCursorToCleanPos(ClassNode.StartPos);
12897           RaiseExceptionFmt(20200505081501,ctsBaseTypeOfNotFound,[GetIdentifier(@Src[ClassNode.StartPos])]);
12898         end else
12899           exit;
12900       end;
12901       ClassTool := ClassContext.Tool;
12902       ClassNode := ClassContext.Node;
12903     end else begin
12904       ClassTool := Self;
12905     end;
12906     // search function 'GetEnumerator'
12907     Params.ContextNode:=ClassNode;
12908     Params.Flags:=[fdfSearchInAncestors,fdfSearchInHelpers];
12909     Params.SetIdentifier(Self,'GetEnumerator',nil);
12910     {$IFDEF ShowForInEval}
12911     DebugLn(['TFindDeclarationTool.FindEnumeratorOfClass searching GetEnumerator for ',ExtractClassName(ClassNode,false),' ...']);
12912     {$ENDIF}
12913     if not ClassTool.FindIdentifierInContext(Params) then begin
12914       if ExceptionOnNotFound then begin
12915         MoveCursorToCleanPos(ClassNode.StartPos);
12916         RaiseException(20170421200638,ctsFunctionGetEnumeratorNotFoundInThisClass);
12917       end else begin
12918         {$IFDEF ShowForInEval}
12919         debugln(['TFindDeclarationTool.FindEnumeratorOfClass GetEnumerator not found for ',ExtractClassName(ClassNode,false)]);
12920         {$ENDIF}
12921         exit;
12922       end;
12923     end;
12924     ProcTool:=Params.NewCodeTool;
12925     ProcNode:=Params.NewNode;
12926     //DebugLn(['TFindDeclarationTool.FindEnumeratorOfClass Proc']);
12927     if (ProcNode=nil) or (ProcNode.Desc<>ctnProcedure) then begin
12928       if ExceptionOnNotFound then begin
12929         MoveCursorToCleanPos(ClassNode.StartPos);
12930         RaiseException(20170421200640,ctsFunctionGetEnumeratorNotFoundInThisClass2);
12931       end else begin
12932         {$IFDEF ShowForInEval}
12933         debugln(['TFindDeclarationTool.FindEnumeratorOfClass GetEnumerator is not a proc, class=',ExtractClassName(ClassNode,false)]);
12934         {$ENDIF}
12935         exit;
12936       end;
12937     end;
12938     // search function type
12939     Params.Clear;
12940     Include(Params.Flags,fdfFunctionResult);
12941     EnumeratorContext:=ProcTool.FindBaseTypeOfNode(Params,ProcNode);
12942     {$IFDEF ShowForInEval}
12943     DebugLn(['TFindDeclarationTool.FindEnumeratorOfClass EnumeratorContext=',FindContextToString(EnumeratorContext)]);
12944     {$ENDIF}
12945     if (EnumeratorContext.Node=nil)
12946     or not (EnumeratorContext.Node.Desc in [ctnClass,ctnClassInterface,ctnRecordType])
12947     then begin
12948       if ExceptionOnNotFound then begin
12949         ProcTool.MoveCursorToCleanPos(ProcNode.StartPos);
12950         ProcTool.RaiseException(20170421200642,ctsResultTypeOfFunctionGetEnumeratorNotFound);
12951       end else
12952         exit;
12953     end;
12954     // search 'Current' in enumerator class
12955     Params.Clear;
12956     Params.ContextNode:=EnumeratorContext.Node;
12957     Params.Flags:=[fdfSearchInAncestors];
12958     if ExceptionOnNotFound then
12959       Include(Params.Flags,fdfExceptionOnNotFound);
12960     Params.SetIdentifier(EnumeratorContext.Tool,'Current',nil);
12961     //DebugLn(['TFindDeclarationTool.FindEnumeratorOfClass search current ...']);
12962     if not EnumeratorContext.Tool.FindIdentifierInContext(Params) then begin
12963       {$IFDEF ShowForInEval}
12964       DebugLn(['TFindDeclarationTool.FindEnumeratorOfClass missing "current" in ',EnumeratorContext.Tool.ExtractClassName(EnumeratorContext.Node,false)]);
12965       {$ENDIF}
12966       exit;
12967     end;
12968     // check if "current" is a property
12969     PropTool:=Params.NewCodeTool;
12970     PropNode:=Params.NewNode;
12971     //DebugLn(['TFindDeclarationTool.FindEnumeratorOfClass PropNode=',PropNode.DescAsString]);
12972     if (PropNode=nil) or (PropNode.Desc<>ctnProperty) then begin
12973       if ExceptionOnNotFound then begin
12974         EnumeratorContext.Tool.MoveCursorToCleanPos(EnumeratorContext.Node.StartPos);
12975         RaiseException(20170421200644,ctsPropertyCurrentNotFound);
12976       end else begin
12977         {$IFDEF ShowForInEval}
12978         DebugLn(['TFindDeclarationTool.FindEnumeratorOfClass "current" is not a property']);
12979         {$ENDIF}
12980         exit;
12981       end;
12982     end;
12983     // search type of Current
12984     Params.Clear;
12985     if ExceptionOnNotFound then
12986       Include(Params.Flags,fdfExceptionOnNotFound);
12987     //DebugLn(['TFindDeclarationTool.FindEnumeratorOfClass searching property type ...']);
12988     CurrentContext:=PropTool.FindBaseTypeOfNode(Params,PropNode,AliasType);
12989     ExprType:=CurrentContext.Tool.ConvertNodeToExpressionType(
12990                                           CurrentContext.Node,Params,AliasType);
12991     {$IFDEF ShowForInEval}
12992     DebugLn(['TFindDeclarationTool.FindEnumeratorOfClass exprtype of CURRENT: ExprType=',ExprTypeToString(ExprType),' Alias=',FindContextToString(AliasType)]);
12993     {$ENDIF}
12994     Result:=ExprType.Desc<>xtNone;
12995   finally
12996     Params.Free;
12997   end;
12998 end;
12999 
FindOperatorEnumeratornull13000 function TFindDeclarationTool.FindOperatorEnumerator(Node: TCodeTreeNode;
13001   ExprType: TExpressionType; Need: TFindOperatorEnumerator; out
13002   ResultExprType: TExpressionType): boolean;
13003 // find a compatible operator overload for 'enumerator' with a parameter
13004 // compatible to ExprType
13005 // for example:
13006 //   operator enumerator (AList: TMyList): TMyListEnumerator;
13007 var
13008   Params: TFindDeclarationParams;
13009   OperatorTool: TFindDeclarationTool;
13010   OperatorNode: TCodeTreeNode;
13011   ClassContext: TFindContext;
13012   EnumeratorCurrentTool: TFindDeclarationTool;
13013   EnumeratorCurrentNode: TCodeTreeNode;
13014 begin
13015   Result:=false;
13016   ResultExprType:=CleanExpressionType;
13017   Params:=TFindDeclarationParams.Create;
13018   try
13019     // search compatible operator enumerator
13020     Params.ContextNode:=Node;
13021     Params.Flags:=[fdfSearchInParentNodes];
13022     Params.Data:=@ExprType;
13023     Params.SetIdentifier(Self,'Enumerator',@CheckOperatorEnumerator);
13024     {$IFDEF ShowForInEval}
13025     DebugLn(['TFindDeclarationTool.FindOperatorEnumerator searching operator enumerator ...']);
13026     {$ENDIF}
13027     if not FindIdentifierInContext(Params) then begin
13028       {$IFDEF ShowForInEval}
13029       DebugLn(['TFindDeclarationTool.FindOperatorEnumerator operator enumerator not found']);
13030       {$ENDIF}
13031       exit;
13032     end;
13033 
13034     // operator found
13035     // now check if it is valid
13036     OperatorTool:=Params.NewCodeTool;
13037     OperatorNode:=Params.NewNode;
13038     {$IFDEF ShowForInEval}
13039     DebugLn(['TFindDeclarationTool.FindOperatorEnumerator Operator="',OperatorTool.ExtractNode(OperatorNode,[]),'"']);
13040     {$ENDIF}
13041     if Need=foeProcNode then begin
13042       ResultExprType.Desc:=xtContext;
13043       ResultExprType.Context.Tool:=OperatorTool;
13044       ResultExprType.Context.Node:=OperatorNode;
13045       exit(true);
13046     end;
13047 
13048     // search class node
13049     Params.Clear;
13050     Params.Flags:=[fdfFunctionResult];
13051     {$IFDEF ShowForInEval}
13052     DebugLn(['TFindDeclarationTool.FindOperatorEnumerator searching operator result object ...']);
13053     {$ENDIF}
13054     ClassContext:=OperatorTool.FindBaseTypeOfNode(Params,OperatorNode);
13055     {$IFDEF ShowForInEval}
13056     DebugLn(['TFindDeclarationTool.FindOperatorEnumerator ClassContext=',FindContextToString(ClassContext)]);
13057     {$ENDIF}
13058     case ClassContext.Node.Desc of
13059     ctnClass,ctnObject,ctnRecordType,ctnClassInterface,ctnDispinterface: ;
13060     else
13061       OperatorTool.MoveCursorToNodeStart(OperatorNode);
13062       OperatorTool.RaiseException(20170421200650,'operator enumerator result type is not object');
13063     end;
13064     if Need=foeResultClassNode then begin
13065       ResultExprType.Desc:=xtContext;
13066       ResultExprType.Context:=ClassContext;
13067       exit(true);
13068     end;
13069 
13070     // search property with modifier enumerator Current
13071     Params.Clear;
13072     Params.ContextNode:=ClassContext.Node;
13073     Params.Flags:=[fdfSearchInAncestors,fdfCollect];
13074     Params.SetIdentifier(Self,'',@CheckModifierEnumeratorCurrent);
13075     {$IFDEF ShowForInEval}
13076     DebugLn(['TFindDeclarationTool.FindOperatorEnumerator searching enumerator current ...']);
13077     {$ENDIF}
13078     if not ClassContext.Tool.FindIdentifierInContext(Params) then begin
13079       ClassContext.Tool.MoveCursorToNodeStart(ClassContext.Node);
13080       ClassContext.Tool.RaiseException(20170421200654,'enumerator ''current'' not found');
13081     end;
13082     EnumeratorCurrentTool:=Params.NewCodeTool;
13083     EnumeratorCurrentNode:=Params.NewNode;
13084     if Need=foeEnumeratorCurrentNode then begin
13085       ResultExprType.Desc:=xtContext;
13086       ResultExprType.Context.Tool:=EnumeratorCurrentTool;
13087       ResultExprType.Context.Node:=EnumeratorCurrentNode;
13088       exit(true);
13089     end;
13090 
13091     // search expression type of 'enumerator current'
13092     Params.Clear;
13093     Params.Flags:=[fdfFunctionResult];
13094     {$IFDEF ShowForInEval}
13095     DebugLn(['TFindDeclarationTool.FindOperatorEnumerator searching enumerator current result ...']);
13096     {$ENDIF}
13097     ResultExprType:=EnumeratorCurrentTool.ConvertNodeToExpressionType(
13098                                                   EnumeratorCurrentNode,Params);
13099     {$IFDEF ShowForInEval}
13100     DebugLn(['TFindDeclarationTool.FindOperatorEnumerator enumerator current result=',ExprTypeToString(ResultExprType)]);
13101     {$ENDIF}
13102     Result:=true;
13103   finally
13104     Params.Free;
13105   end;
13106 end;
13107 
FindEnumerationTypeOfSetTypenull13108 function TFindDeclarationTool.FindEnumerationTypeOfSetType(
13109   SetTypeNode: TCodeTreeNode; out Context: TFindContext): boolean;
13110 var
13111   Params: TFindDeclarationParams;
13112   p: LongInt;
13113 begin
13114   Result:=false;
13115   if (SetTypeNode=nil) or (SetTypeNode.Desc<>ctnSetType) then exit;
13116   MoveCursorToNodeStart(SetTypeNode);
13117   ReadNextAtom; // set
13118   if not UpAtomIs('SET') then exit;
13119   ReadNextAtom; // of
13120   if not UpAtomIs('OF') then exit;
13121   ReadNextAtom;
13122   if not IsIdentStartChar[Src[CurPos.StartPos]] then
13123     // set of ()
13124     exit;
13125   Params:=TFindDeclarationParams.Create;
13126   try
13127     Params.Flags:=fdfDefaultForExpressions;
13128     Params.ContextNode:=SetTypeNode;
13129     p:=CurPos.StartPos;
13130     Params.SetIdentifier(Self,@Src[p],nil);
13131     if not FindIdentifierInContext(Params) then exit;
13132     if (Params.NewNode=nil)
13133     or (Params.NewNode.Desc<>ctnTypeDefinition)
13134     or (Params.NewNode.FirstChild=nil)
13135     or (Params.NewNode.FirstChild.Desc<>ctnEnumerationType) then begin
13136       MoveCursorToCleanPos(p);
13137       ReadNextAtom;
13138       RaiseStringExpectedButAtomFound(20170421200656,ctsEnumerationType);
13139     end;
13140     Context.Tool:=Params.NewCodeTool;
13141     Context.Node:=Params.NewNode;
13142     Result:=true;
13143   finally
13144     Params.Free;
13145   end;
13146 end;
13147 
FindElementTypeOfArrayTypenull13148 function TFindDeclarationTool.FindElementTypeOfArrayType(
13149   ArrayNode: TCodeTreeNode; out ExprType: TExpressionType;
13150   AliasType: PFindContext; ParentParams: TFindDeclarationParams): boolean;
13151 var
13152   Params: TFindDeclarationParams;
13153   p: LongInt;
13154 begin
13155   Result:=false;
13156   ExprType:=CleanExpressionType;
13157   AliasType^:=CleanFindContext;
13158   if (ArrayNode=nil) then exit;
13159   if (ArrayNode.Desc<>ctnOpenArrayType) and (ArrayNode.Desc<>ctnRangedArrayType)
13160   then exit;
13161   if (ArrayNode.Parent <> nil)
13162   and (ArrayNode.Parent.Desc = ctnGenericType)
13163   and (ParentParams <> nil) then begin
13164     ExprType.Desc := xtContext;
13165     ExprType.Context.Node := ParentParams.GenParamValueMappings.SpecializeParamsNode.FirstChild;
13166     ExprType.Context.Tool := ParentParams.GenParamValueMappings.SpecializeParamsTool;
13167     Result:=true;
13168   end else begin
13169     MoveCursorToNodeStart(ArrayNode);
13170     ReadNextAtom; // array
13171     if not UpAtomIs('ARRAY') then exit;
13172     ReadNextAtom; // of
13173     if CurPos.Flag=cafEdgedBracketOpen then begin
13174       ReadTilBracketClose(true);
13175       ReadNextAtom;
13176     end;
13177     if not UpAtomIs('OF') then exit;
13178     ReadNextAtom;
13179     if not AtomIsIdentifier then exit;
13180     Params:=TFindDeclarationParams.Create;
13181     try
13182       Params.Flags:=fdfDefaultForExpressions;
13183       Params.ContextNode:=ArrayNode;
13184       p:=CurPos.StartPos;
13185       Params.SetIdentifier(Self,@Src[p],nil);
13186       ExprType:=FindExpressionResultType(Params,p,-1,AliasType);
13187       Result:=true;
13188     finally
13189       Params.Free;
13190     end;
13191   end;
13192 end;
13193 
CheckOperatorEnumeratornull13194 function TFindDeclarationTool.CheckOperatorEnumerator(
13195   Params: TFindDeclarationParams; const FoundContext: TFindContext
13196   ): TIdentifierFoundResult;
13197 var
13198   Node: TCodeTreeNode;
13199   ExprType: TExpressionType;
13200   Params2: TFindDeclarationParams;
13201 begin
13202   Result:=ifrProceedSearch;
13203   {$IFDEF ShowExprEval}
13204   DebugLn(['TFindDeclarationTool.CheckOperatorEnumerator ',FindContextToString(FoundContext)]);
13205   {$ENDIF}
13206   if not FoundContext.Tool.NodeIsOperator(FoundContext.Node) then exit;
13207   FoundContext.Tool.BuildSubTreeForProcHead(FoundContext.Node);
13208   Node:=FoundContext.Node.FirstChild;
13209   if (Node=nil) or (Node.Desc<>ctnProcedureHead) then exit;
13210   Node:=Node.FirstChild;
13211   if (Node=nil) or (Node.Desc<>ctnParameterList) then exit;
13212   Node:=Node.FirstChild;
13213   if (Node=nil) then exit;
13214   if Node.NextBrother<>nil then exit;
13215   ExprType:=PExpressionType(Params.Data)^;
13216   Params2:=TFindDeclarationParams.Create;
13217   try
13218     if IsCompatible(Node,ExprType,Params2)=tcIncompatible then exit;
13219   finally
13220     Params2.Free;
13221   end;
13222   {$IFDEF ShowExprEval}
13223   DebugLn(['TFindDeclarationTool.CheckOperatorEnumerator FOUND ',FoundContext.Tool.ExtractNode(FoundContext.Node,[])]);
13224   {$ENDIF}
13225   Result:=ifrSuccess;
13226 end;
13227 
CheckModifierEnumeratorCurrentnull13228 function TFindDeclarationTool.CheckModifierEnumeratorCurrent(
13229   Params: TFindDeclarationParams; const FoundContext: TFindContext
13230   ): TIdentifierFoundResult;
13231 begin
13232   Result:=ifrProceedSearch;
13233   //DebugLn(['TFindDeclarationTool.CheckModifierEnumeratorCurrent ',FindContextToString(FoundContext)]);
13234   case FoundContext.Node.Desc of
13235   ctnProperty:
13236     begin
13237       if FoundContext.Tool.PropertyHasSpecifier(FoundContext.Node,'Enumerator',false)
13238       then begin
13239         FoundContext.Tool.ReadNextAtom;
13240         if FoundContext.Tool.UpAtomIs('CURRENT') then
13241           Result:=ifrSuccess;
13242       end;
13243     end;
13244   end;
13245 end;
13246 
IsTermEdgedBracketnull13247 function TFindDeclarationTool.IsTermEdgedBracket(TermPos: TAtomPosition; out
13248   EdgedBracketsStartPos: integer): boolean;
13249 { allowed:
13250    - at least one edged brackets
13251    - identifiers
13252    - functions
13253    - operators: + and -
13254 
13255     [a,b]+[c]-D()*inherited E
13256 
13257   not allowed:
13258     []<>[]
13259 }
13260 var
13261   Lvl: Integer;
13262   EndPos: LongInt;
13263 begin
13264   Result:=false;
13265   EdgedBracketsStartPos:=0;
13266   EndPos:=TermPos.EndPos;
13267   if EndPos>SrcLen then
13268     EndPos:=SrcLen;
13269   MoveCursorToCleanPos(TermPos.StartPos);
13270   Lvl:=0;
13271   repeat
13272     ReadNextAtom;
13273     if (CurPos.StartPos>=EndPos) then
13274       break;
13275     case CurPos.Flag of
13276     cafRoundBracketOpen: ReadTilBracketClose(false);
13277     cafEdgedBracketOpen:
13278       begin
13279         inc(Lvl);
13280         if (Lvl=1) and (EdgedBracketsStartPos<1) then begin
13281           if (not LastAtoms.HasPrior)
13282           or LastAtomIs(-1,'+') or LastAtomIs(-1,'-') or LastAtomIs(-1,'*')
13283           then
13284             EdgedBracketsStartPos:=CurPos.StartPos;
13285         end;
13286       end;
13287     cafEdgedBracketClose:
13288       dec(Lvl);
13289     cafWord:
13290       ;
13291     cafComma:
13292       if Lvl<1 then
13293         break
13294       else if Lvl>1 then
13295         exit;
13296     else
13297       if AtomIsChar('+') or AtomIsChar('-') then begin
13298         // allowed
13299       end else begin
13300         // not allowed
13301         exit;
13302       end;
13303     end;
13304   until false;
13305   Result:=EdgedBracketsStartPos>0;
13306 end;
13307 
IsTermNamedPointernull13308 function TFindDeclarationTool.IsTermNamedPointer(TermPos: TAtomPosition; out
13309   ExprType: TExpressionType): boolean;
13310 // check if TermPos is @Name and a pointer (= ^Name) can be found
13311 var
13312   SubExprType: TExpressionType;
13313   Node: TCodeTreeNode;
13314   PointerTool: TFindDeclarationTool;
13315   Params: TFindDeclarationParams;
13316   PointerNode: TCodeTreeNode;
13317 begin
13318   //debugln(['TFindDeclarationTool.IsTermNamedPointer ',CleanPosToStr(TermPos.StartPos,true),' Term={',copy(Src,TermPos.StartPos,TermPos.EndPos-TermPos.StartPos),'}']);
13319   Result:=false;
13320   MoveCursorToCleanPos(TermPos.StartPos);
13321   ReadNextAtom;
13322   if not AtomIsChar('@') then exit;
13323   // a pointer
13324   ExprType:=CleanExpressionType;
13325   ExprType.Desc:=xtPointer;
13326   Result:=true;
13327   // try to find a name
13328   ReadNextAtom;
13329   if CurPos.StartPos>SrcLen then exit;
13330   Node := FindDeepestNodeAtPos(CurPos.StartPos,true);
13331   Params:=TFindDeclarationParams.Create(Self, Node);
13332   try
13333     SubExprType:=FindExpressionResultType(Params,CurPos.StartPos,-1);
13334   finally
13335     Params.Free;
13336   end;
13337   //debugln(['TFindDeclarationTool.IsTermNamedPointer SubExprType=',ExprTypeToString(SubExprType)]);
13338   if SubExprType.Desc in xtAllPredefinedTypes then begin
13339     ExprType.SubDesc:=SubExprType.Desc;
13340     exit(true);
13341   end else if (SubExprType.Desc=xtContext) then begin
13342     Node:=SubExprType.Context.Node;
13343     if (not (Node.Desc in AllIdentifierDefinitions))
13344     and (Node.Parent<>nil) and (Node.Parent.Desc in AllIdentifierDefinitions) then
13345       Node:=Node.Parent;
13346     if (Node.Desc in AllIdentifierDefinitions) then begin
13347       PointerTool:=SubExprType.Context.Tool;
13348       PointerNode:=PointerTool.FindPointerOfIdentifier(Node);
13349       if PointerNode<>nil then begin
13350         ExprType:=CleanExpressionType;
13351         ExprType.Desc:=xtContext;
13352         ExprType.SubDesc:=xtNone;
13353         ExprType.Context.Tool:=PointerTool;
13354         ExprType.Context.Node:=PointerNode;
13355         exit(true);
13356       end;
13357     end;
13358   end;
13359 end;
13360 
FindSetOfEnumerationTypenull13361 function TFindDeclarationTool.FindSetOfEnumerationType(EnumNode: TCodeTreeNode
13362   ): TCodeTreeNode;
13363 // search in the same type section for a 'set of ' node
13364 var
13365   p: PChar;
13366 
13367  function IsSetOfEnum(Node: TCodeTreeNode): boolean;
13368  begin
13369    Result:=false;
13370    if (Node.Desc<>ctnTypeDefinition)
13371    or (Node.FirstChild=nil)
13372    or (Node.FirstChild.Desc<>ctnSetType) then exit;
13373    MoveCursorToNodeStart(Node.FirstChild);
13374    ReadNextAtom; // read set
13375    if not UpAtomIs('SET') then exit;
13376    ReadNextAtom; // read of
13377    if not UpAtomIs('OF') then exit;
13378    ReadNextAtom; // read of
13379    if CurPos.Flag<>cafWord then exit;
13380    Result:=CompareSrcIdentifiers(CurPos.StartPos,p);
13381  end;
13382 
13383 begin
13384   {$IFDEF ShowExprEval}
13385   debugln(['TFindDeclarationTool.FindSetOfEnumerationType ',EnumNode.DescAsString]);
13386   {$ENDIF}
13387   if EnumNode.Desc=ctnEnumIdentifier then EnumNode:=EnumNode.Parent;
13388   if EnumNode.Desc=ctnEnumerationType then EnumNode:=EnumNode.Parent;
13389   p:=@Src[EnumNode.StartPos];
13390   Result:=EnumNode.Parent.FirstChild;
13391   while Result<>nil do begin
13392     if IsSetOfEnum(Result) then exit;
13393     Result:=Result.NextBrother;
13394   end;
13395 end;
13396 
FindPointerOfIdentifiernull13397 function TFindDeclarationTool.FindPointerOfIdentifier(
13398   TypeNode: TCodeTreeNode): TCodeTreeNode;
13399 // search in the same type section for a '^identifier' node
13400 var
13401   p: PChar;
13402 
13403  function IsPointerOf(Node: TCodeTreeNode): boolean;
13404  begin
13405    Result:=false;
13406    if (Node.Desc<>ctnTypeDefinition)
13407    or (Node.FirstChild=nil)
13408    or (Node.FirstChild.Desc<>ctnPointerType) then exit;
13409    MoveCursorToNodeStart(Node.FirstChild);
13410    ReadNextAtom; // read ^
13411    if not AtomIsChar('^') then exit;
13412    ReadNextAtom; // read identifier
13413    if not AtomIsIdentifier then exit;
13414    Result:=CompareSrcIdentifiers(CurPos.StartPos,p);
13415  end;
13416 
13417 begin
13418   if TypeNode.Desc<>ctnTypeDefinition then exit(nil);
13419   p:=@Src[TypeNode.StartPos];
13420   Result:=TypeNode.Parent.FirstChild;
13421   while Result<>nil do begin
13422     if IsPointerOf(Result) then exit;
13423     Result:=Result.NextBrother;
13424   end;
13425 end;
13426 
FindExprTypeAsStringnull13427 function TFindDeclarationTool.FindExprTypeAsString(
13428   const ExprType: TExpressionType; TermCleanPos: integer;
13429   AliasType: PFindContext): string;
13430 
13431   procedure RaiseTermNotSimple(id: int64);
13432   begin
13433     if TermCleanPos<1 then
13434       TermCleanPos:=1;
13435     MoveCursorToCleanPos(TermCleanPos);
13436     RaiseException(id,ctsTermNotSimple);
13437   end;
13438 
13439 var
13440   FindContext: TFindContext;
13441   ANode: TCodeTreeNode;
13442 begin
13443   {$IFDEF ShowExprEval}
13444   DebugLn('TFindDeclarationTool.FindExprTypeAsString ExprType=',
13445     ExprTypeToString(ExprType),' Alias=',FindContextToString(AliasType));
13446   {$ENDIF}
13447   Result:='';
13448   if (AliasType<>nil) and (AliasType^.Node<>nil) then begin
13449     case AliasType^.Node.Desc of
13450     ctnTypeDefinition:
13451       Result:=GetIdentifier(@AliasType^.Tool.Src[AliasType^.Node.StartPos]);
13452     end;
13453     if Result<>'' then exit;
13454   end;
13455 
13456   case ExprType.Desc of
13457     xtNone:
13458       RaiseTermNotSimple(20170421204649);
13459 
13460     xtContext:
13461       begin
13462         FindContext:=ExprType.Context;
13463 
13464         // ToDo: PPU, DCU
13465 
13466         if FindContext.Node.Parent.Desc=ctnTypeDefinition then
13467           FindContext.Node:=FindContext.Node.Parent;
13468         case FindContext.Node.Desc of
13469 
13470         ctnTypeDefinition:
13471           Result:=GetIdentifier(
13472                               @FindContext.Tool.Src[FindContext.Node.StartPos]);
13473 
13474         ctnVarDefinition,ctnConstDefinition:
13475           begin
13476             ANode:=FindContext.Tool.FindTypeNodeOfDefinition(FindContext.Node);
13477             if (ANode=nil) or (ANode.Desc<>ctnIdentifier) then
13478               RaiseTermNotSimple(20170421204653);
13479             Result:=GetIdentifier(@FindContext.Tool.Src[ANode.StartPos]);
13480           end;
13481 
13482         ctnClass, ctnClassInterface, ctnDispinterface, ctnObject, ctnRecordType,
13483         ctnClassHelper, ctnRecordHelper, ctnTypeHelper,
13484         ctnObjCClass, ctnObjCCategory, ctnObjCProtocol, ctnCPPClass:
13485           if (FindContext.Node.Parent<>nil)
13486           and (FindContext.Node.Parent.Desc in [ctnTypeDefinition,ctnGenericType])
13487           then
13488             Result:=GetIdentifier(
13489                        @FindContext.Tool.Src[FindContext.Node.Parent.StartPos]);
13490 
13491         ctnEnumIdentifier:
13492           if (FindContext.Node.Parent<>nil)
13493           and (FindContext.Node.Parent.Desc=ctnEnumerationType)
13494           and (FindContext.Node.Parent.Parent<>nil)
13495           and (FindContext.Node.Parent.Parent.Desc=ctnTypeDefinition)
13496           then
13497             Result:=GetIdentifier(
13498                      @FindContext.Tool.Src[FindContext.Node.Parent.Parent.StartPos]);
13499 
13500         ctnEnumerationType:
13501           if (FindContext.Node.Parent<>nil)
13502           and (FindContext.Node.Parent.Desc=ctnTypeDefinition)
13503           then
13504             Result:=GetIdentifier(
13505                      @FindContext.Tool.Src[FindContext.Node.Parent.StartPos]);
13506 
13507         ctnProperty,ctnGlobalProperty:
13508           begin
13509             FindContext.Tool.MoveCursorToPropType(FindContext.Node);
13510             Result:=FindContext.Tool.GetAtom;
13511           end;
13512 
13513         ctnIdentifier:
13514           begin
13515             Result:=GetIdentifier(
13516                               @FindContext.Tool.Src[FindContext.Node.StartPos]);
13517           end;
13518 
13519         ctnProcedureHead:
13520           begin
13521           ANode:=GetProcResultNode(FindContext.Node);
13522           if ANode<>nil then
13523             Result:=FindContext.Tool.ExtractNode(ANode,[]);
13524           end;
13525 
13526         end;
13527 
13528         if Result='' then begin
13529           DebugLn('TFindDeclarationTool.FindExprTypeAsString ContextNode=',
13530             FindContext.Node.DescAsString,' ',dbgsFC(FindContext));
13531           RaiseTermNotSimple(20170421204655);
13532         end;
13533       end;
13534 
13535     xtChar,
13536     xtWideChar,
13537     xtReal,
13538     xtSingle,
13539     xtDouble,
13540     xtExtended,
13541     xtCExtended,
13542     xtCurrency,
13543     xtComp,
13544     xtInt64,
13545     xtCardinal,
13546     xtQWord,
13547     xtPChar:
13548       Result:=ExpressionTypeDescNames[ExprType.Desc];
13549 
13550     xtPointer:
13551       begin
13552         case ExprType.SubDesc of
13553         xtChar,
13554         xtWideChar,
13555         xtReal,
13556         xtSingle,
13557         xtDouble,
13558         xtExtended,
13559         xtCExtended,
13560         xtCurrency,
13561         xtComp,
13562         xtInt64,
13563         xtCardinal,
13564         xtQWord,
13565         xtBoolean,
13566         xtByteBool,
13567         xtWordBool,
13568         xtLongBool,
13569         xtQWordBool,
13570         xtString,
13571         xtAnsiString,
13572         xtShortString,
13573         xtWideString,
13574         xtUnicodeString,
13575         xtLongint,
13576         xtLongWord,
13577         xtWord,
13578         xtSmallInt,
13579         xtShortInt,
13580         xtByte,
13581         xtNativeInt,
13582         xtNativeUInt:
13583           Result:='P'+ExpressionTypeDescNames[ExprType.SubDesc];
13584         else
13585           Result:=ExpressionTypeDescNames[xtPointer];
13586         end;
13587       end;
13588 
13589     xtFile,
13590     xtText,
13591     xtLongint,
13592     xtLongWord,
13593     xtSmallInt,
13594     xtWord,
13595     xtShortInt,
13596     xtByte,
13597     xtNativeInt,
13598     xtNativeUInt:
13599       Result:=ExpressionTypeDescNames[ExprType.Desc];
13600 
13601     xtBoolean,
13602     xtByteBool,
13603     xtWordBool,
13604     xtLongBool,
13605     xtQWordBool:
13606       Result:=ExpressionTypeDescNames[xtBoolean];
13607 
13608     xtString,
13609     xtAnsiString,
13610     xtShortString:
13611       Result:=ExpressionTypeDescNames[xtString];
13612 
13613     xtWideString, xtUnicodeString:
13614       Result:=ExpressionTypeDescNames[ExprType.Desc];
13615 
13616     xtConstOrdInteger:
13617       Result:='Integer';
13618     xtConstString:
13619       Result:=ExpressionTypeDescNames[xtString];
13620     xtConstReal:
13621       Result:=ExpressionTypeDescNames[xtExtended];
13622     xtConstSet:
13623       begin
13624         // eventually try to find the 'set of ' type
13625         RaiseTermNotSimple(20170421204658);
13626       end;
13627     xtConstBoolean:
13628       Result:=ExpressionTypeDescNames[xtBoolean];
13629     xtJSValue:
13630       Result:=ExpressionTypeDescNames[ExprType.Desc];
13631     xtNil:
13632       RaiseTermNotSimple(20170421204702);
13633   else
13634     DebugLn('TCodeCompletionCodeTool.FindExprTypeAsString ExprType=',
13635       ExprTypeToString(ExprType),' Alias=',FindContextToString(AliasType));
13636     RaiseTermNotSimple(20170421204705);
13637   end;
13638 end;
13639 
FindExtendedExprOfHelpernull13640 function TFindDeclarationTool.FindExtendedExprOfHelper(HelperNode: TCodeTreeNode
13641   ): TExpressionType;
13642 // returns the expression type of the extended class/type of a "helper for"
13643 var
13644   ForNode: TCodeTreeNode;
13645   Params: TFindDeclarationParams;
13646 begin
13647   case HelperNode.Desc of
13648   ctnClassHelper,ctnRecordHelper,ctnTypeHelper:
13649     ForNode:=FindHelperForNode(HelperNode);
13650   ctnObjCCategory:
13651     ForNode:=FindInheritanceNode(HelperNode);
13652   else
13653     exit(CleanExpressionType);
13654   end;
13655   if Assigned(ForNode) and Assigned(ForNode.FirstChild) then
13656   begin
13657     Params:=TFindDeclarationParams.Create;
13658     try
13659       Params.Flags:=fdfDefaultForExpressions-[fdfSearchInHelpers,fdfSearchInAncestors]+[fdfTypeType];
13660       Params.ContextNode:=ForNode;
13661       Result:=FindExpressionTypeOfTerm(ForNode.FirstChild.StartPos,ForNode.FirstChild.EndPos,Params,false);
13662     finally
13663       Params.Free;
13664     end;
13665   end else
13666     Result := CleanExpressionType;
13667 end;
13668 
13669 { TFindDeclarationParams }
13670 
13671 procedure TFindDeclarationParams.ClearFoundProc;
13672 begin
13673   if FoundProc=nil then exit;
13674   //DebugLn(['TFindDeclarationParams.ClearFoundProc ',dbgs(FoundProc),' Saved=',FoundProc^.Owner<>nil]);
13675   if FoundProc^.Owner=nil then
13676     // the FoundProc is not saved
13677     FreeFoundProc(FoundProc,true)
13678   else if FoundProc^.Next<>nil then
13679     // the FoundProc is saved (release the later FoundProcs,
13680     // which are not needed any more)
13681     FreeFoundProc(FoundProc^.Next,true)
13682   else begin
13683     // the FoundProc is owned, that means someo other function is reponsible for freeing it
13684   end;
13685   FoundProc:=nil;
13686 end;
13687 
13688 procedure TFindDeclarationParams.FreeFoundProc(aFoundProc: PFoundProc; FreeNext: boolean);
13689 var
13690   Next: PFoundProc;
13691 begin
13692   //DebugLn(['TFindDeclarationParams.FreeFoundProc ',dbgs(aFoundProc)]);
13693   while aFoundProc<>nil do begin
13694     if (aFoundProc^.Owner<>Self)
13695     and ((FFoundProcStackFirst=aFoundProc)
13696          or (aFoundProc^.Prior<>nil) or (aFoundProc^.Next<>nil))
13697     then
13698       raise Exception.Create('FoundProc is in list, but not owned');
13699     if FreeNext then
13700       Next:=aFoundProc^.Next
13701     else
13702       Next:=nil;
13703     RemoveFoundProcFromList(aFoundProc);
13704     with aFoundProc^ do begin
13705       //DebugLn(['TFindDeclarationParams.FreeFoundProc ExprInputList=',dbgs(ExprInputList)]);
13706       if ExprInputList<>nil then
13707         FreeAndNil(ExprInputList);
13708       //DebugLn(['TFindDeclarationParams.FreeFoundProc ParamCompatibilityList=',dbgs(ParamCompatibilityList)]);
13709       if ParamCompatibilityList<>nil then begin
13710         FreeMem(ParamCompatibilityList);
13711         ParamCompatibilityList:=nil;
13712       end;
13713       CacheValid:=false;
13714     end;
13715     //DebugLn(['TFindDeclarationParams.FreeFoundProc Dispose ',dbgs(aFoundProc)]);
13716     Dispose(aFoundProc);
13717     aFoundProc:=Next;
13718   end;
13719 end;
13720 
13721 procedure TFindDeclarationParams.RemoveFoundProcFromList(aFoundProc: PFoundProc);
13722 begin
13723   //DebugLn(['TFindDeclarationParams.RemoveFoundProcFromList ',dbgs(aFoundProc)]);
13724   if aFoundProc^.Owner<>Self then exit;
13725   if FFoundProcStackFirst=aFoundProc then
13726     FFoundProcStackFirst:=aFoundProc^.Next;
13727   if FFoundProcStackLast=aFoundProc then
13728     FFoundProcStackLast:=aFoundProc^.Next;
13729   with aFoundProc^ do begin
13730     if Next<>nil then
13731       Next^.Prior:=Prior;
13732     if Prior<>nil then
13733       Prior^.Next:=Next;
13734     Prior:=nil;
13735     Next:=nil;
13736     Owner:=nil;
13737   end;
13738 end;
13739 
13740 constructor TFindDeclarationParams.Create(ParentParams: TFindDeclarationParams);
13741 begin
13742   inherited Create;
13743   Clear;
13744   Parent:=ParentParams;
13745 end;
13746 
13747 constructor TFindDeclarationParams.Create(Tool: TFindDeclarationTool;
13748   AContextNode: TCodeTreeNode);
13749 begin
13750   Create(nil);//helper list will be created
13751   StartTool := Tool;
13752   StartNode := AContextNode;
13753   ContextNode := AContextNode;
13754   {$IFDEF CheckNodeTool}
13755   if (StartNode<>nil) and (StartNode.GetRoot<>StartTool.Tree.Root) then begin
13756     debugln(['TFindDeclarationParams.Create Inconsistency']);
13757     CTDumpStack;
13758     raise Exception.Create('TFindDeclarationParams.Create StartNode does not belong to StartTool');
13759   end;
13760   {$ENDIF}
13761   if (StartTool<>nil) and (StartNode<>nil) then
13762     FNeedHelpers:=true;
13763 end;
13764 
13765 destructor TFindDeclarationParams.Destroy;
13766 var
13767   HelperKind: TFDHelpersListKind;
13768 begin
13769   Clear;
13770   FreeFoundProc(FFoundProcStackFirst,true);
13771   for HelperKind in TFDHelpersListKind do
13772     if FFreeHelpers[HelperKind] then
13773       FreeAndNil(FHelpers[HelperKind]);
13774   GenParamValueMappings.FirstParamValueMapping.Free;
13775   inherited Destroy;
13776 end;
13777 
13778 procedure TFindDeclarationParams.Clear;
13779 begin
13780   ClearInput;
13781   ClearFoundProc;
13782   ClearResult(false);
13783   OnTopLvlIdentifierFound:=nil;
13784 end;
13785 
13786 procedure TFindDeclarationParams.Save(out Input: TFindDeclarationInput);
13787 begin
13788   Input.Flags:=Flags;
13789   Input.Identifier:=Identifier;
13790   Input.ContextNode:=ContextNode;
13791   Input.OnIdentifierFound:=OnIdentifierFound;
13792   Input.IdentifierTool:=IdentifierTool;
13793   Input.FoundProc:=FoundProc;
13794   if (FoundProc<>nil) and (FoundProc^.Owner=nil) then begin
13795     // add to list of saved FoundProcs
13796     //DebugLn(['TFindDeclarationParams.Save ',dbgs(FoundProc)]);
13797     FoundProc^.Prior:=FFoundProcStackLast;
13798     if FFoundProcStackLast<>nil then
13799       FFoundProcStackLast^.Next:=FoundProc;
13800     FFoundProcStackLast:=FoundProc;
13801     if FFoundProcStackFirst=nil then
13802       FFoundProcStackFirst:=FoundProc;
13803     FoundProc^.Owner:=Self;
13804   end;
13805 end;
13806 
13807 procedure TFindDeclarationParams.Load(Input: TFindDeclarationInput;
13808   FreeInput: boolean);
13809 // set FreeInput to true, if the Input is not needed anymore and the dynamic
13810 // data can be freed.
13811 begin
13812   Flags:=Input.Flags;
13813   Identifier:=Input.Identifier;
13814   ContextNode:=Input.ContextNode;
13815   OnIdentifierFound:=Input.OnIdentifierFound;
13816   IdentifierTool:=Input.IdentifierTool;
13817   if FoundProc<>Input.FoundProc then begin
13818     // clear current FoundProc
13819     if FoundProc<>nil then
13820       ClearFoundProc;
13821     // use saved FoundProc
13822     FoundProc:=Input.FoundProc;
13823     // free all FoundProcs, that were saved later
13824     if (FoundProc<>nil) then begin
13825       FreeFoundProc(FoundProc^.Next,true);
13826       if FreeInput then begin
13827         Input.FoundProc:=nil;
13828         RemoveFoundProcFromList(FoundProc);
13829       end;
13830     end;
13831   end;
13832 end;
13833 
13834 procedure TFindDeclarationParams.ClearResult(CopyCacheFlags: boolean);
13835 begin
13836   NewPos.Code:=nil;
13837   NewPos.X:=-1;
13838   NewPos.Y:=-1;
13839   NewTopLine:=-1;
13840   NewNode:=nil;
13841   NewCleanPos:=-1;
13842   NewCodeTool:=nil;
13843   NewFlags:=[];
13844   if CopyCacheFlags and (fdfDoNotCache in Flags) then
13845     Include(NewFlags,fodDoNotCache);
13846 end;
13847 
13848 procedure TFindDeclarationParams.SetResult(const AFindContext: TFindContext);
13849 begin
13850   ClearResult(true);
13851   NewCodeTool:=AFindContext.Tool;
13852   NewNode:=AFindContext.Node;
13853 end;
13854 
13855 procedure TFindDeclarationParams.SetResult(ANewCodeTool: TFindDeclarationTool;
13856   ANewNode: TCodeTreeNode);
13857 begin
13858   ClearResult(true);
13859   NewCodeTool:=ANewCodeTool;
13860   NewNode:=ANewNode;
13861   {$IFDEF CheckNodeTool}if NewCodeTool<>nil then NewCodeTool.CheckNodeTool(NewNode);{$ENDIF}
13862 end;
13863 
13864 procedure TFindDeclarationParams.SetResult(ANewCodeTool: TFindDeclarationTool;
13865   ANewNode: TCodeTreeNode; ANewCleanPos: integer);
13866 begin
13867   ClearResult(true);
13868   NewCodeTool:=ANewCodeTool;
13869   NewNode:=ANewNode;
13870   NewCleanPos:=ANewCleanPos;
13871   {$IFDEF CheckNodeTool}if NewCodeTool<>nil then NewCodeTool.CheckNodeTool(NewNode);{$ENDIF}
13872 end;
13873 
13874 procedure TFindDeclarationParams.ConvertResultCleanPosToCaretPos;
13875 begin
13876   NewPos.Code:=nil;
13877   if NewCodeTool<>nil then begin
13878     if (NewCleanPos>=1) then
13879       NewCodeTool.CleanPosToCaretAndTopLine(NewCleanPos,NewPos,NewTopLine)
13880     else if (NewNode<>nil) then
13881       NewCodeTool.CleanPosToCaretAndTopLine(NewNode.StartPos,NewPos,NewTopLine);
13882   end;
13883 end;
13884 
13885 procedure TFindDeclarationParams.ClearInput;
13886 begin
13887   Flags:=[];
13888   Identifier:=nil;
13889   ContextNode:=nil;
13890   OnIdentifierFound:=nil;
13891   IdentifierTool:=nil;
13892 end;
13893 
13894 procedure TFindDeclarationParams.WriteDebugReport;
13895 begin
13896   DebugLn('TFindDeclarationParams.WriteDebugReport Self=',DbgS(Self));
13897 
13898   // input parameters:
13899   DebugLn(' Flags=',dbgs(Flags));
13900   DebugLn(' Identifier=',GetIdentifier(Identifier));
13901   if ContextNode<>nil then
13902     DebugLn(' ContextNode=',ContextNode.DescAsString)
13903   else
13904     DebugLn(' ContextNode=nil');
13905   if OnIdentifierFound<>nil then
13906     DebugLn(' OnIdentifierFound=',TFindDeclarationTool(TMethod(OnIdentifierFound).Data).MainFilename);
13907   if IdentifierTool<>nil then
13908     DebugLn(' IdentifierTool=',IdentifierTool.MainFilename)
13909   else
13910     DebugLn(' IdentifierTool=nil');
13911   if FoundProc<>nil then begin
13912     if FoundProc^.Context.Node<>nil then
13913       DebugLn(' FoundProc=',FoundProc^.Context.Tool.CleanPosToStr(FoundProc^.Context.Node.StartPos,true))
13914     else
13915       DebugLn(' FoundProc<>nil');
13916   end;
13917 
13918   // global params
13919   if OnTopLvlIdentifierFound<>nil then
13920     DebugLn(' OnTopLvlIdentifierFound=',TFindDeclarationTool(TMethod(OnTopLvlIdentifierFound).Code).MainFilename);
13921 
13922   // results:
13923   if NewNode<>nil then
13924     DebugLn(' NewNode=',NewNode.DescAsString)
13925   else
13926     DebugLn(' NewNode=nil');
13927   DebugLn(' NewCleanPos=',dbgs(NewCleanPos));
13928   if NewCodeTool<>nil then begin
13929     DebugLn(' NewCodeTool=',NewCodeTool.MainFilename,' at ',NewCodeTool.CleanPosToStr(NewCleanPos,false))
13930   end else begin
13931     DebugLn([' NewCodeTool=nil NewCleanPos=',NewCleanPos]);
13932   end;
13933   if NewPos.Code<>nil then
13934     DebugLn([' NewPos=',NewPos.Code.Filename,' x=',NewPos.X,' y=',NewPos.Y,' topline=',NewTopLine])
13935   else
13936     DebugLn(' NewPos=nil');
13937   DebugLn(' NewFlags=',dbgs(NewFlags));
13938   DebugLn('');
13939 end;
13940 
GetHelpersnull13941 function TFindDeclarationParams.GetHelpers(HelperKind: TFDHelpersListKind;
13942   CreateIfNotExists: boolean): TFDHelpersList;
13943 begin
13944   if Parent<>nil then
13945     exit(Parent.GetHelpers(HelperKind,CreateIfNotExists));
13946   if FNeedHelpers then
13947     StartTool.FindHelpersInContext(Self); // beware: this calls GetHelpers
13948   Result:=FHelpers[HelperKind];
13949   if (Result=nil) and CreateIfNotExists then begin
13950     Result:=TFDHelpersList.Create(HelperKind);
13951     FHelpers[HelperKind]:=Result;
13952     FFreeHelpers[HelperKind]:=true;
13953     //if HelperKind=fdhlkDelphiHelper then
13954     //  debugln(['TFindDeclarationParams.GetHelpers Self=',dbgs(Pointer(Self)),' Helper=',dbgs(Pointer(FHelpers[HelperKind]))]);
13955   end;
13956 end;
13957 
13958 procedure TFindDeclarationParams.SetIdentifier(
13959   NewIdentifierTool: TFindDeclarationTool; NewIdentifier: PChar;
13960   NewOnIdentifierFound: TOnIdentifierFound);
13961 begin
13962   Identifier:=NewIdentifier;
13963   IdentifierTool:=NewIdentifierTool;
13964   OnIdentifierFound:=NewOnIdentifierFound;
13965   ClearFoundProc;
13966 end;
13967 
13968 procedure TFindDeclarationParams.SetFoundProc(
13969   const ProcContext: TFindContext);
13970 begin
13971   //DebugLn(['TFindDeclarationParams.SetFirstFoundProc Old=',dbgs(FoundProc)]);
13972   if FoundProc<>nil then
13973     ClearFoundProc;
13974   New(FoundProc);
13975   //DebugLn(['TFindDeclarationParams.SetFirstFoundProc New=',dbgs(FoundProc)]);
13976   FillChar(FoundProc^,SizeOf(TFoundProc),0);
13977   FoundProc^.Context:=ProcContext;
13978 end;
13979 
13980 procedure TFindDeclarationParams.SetGenericParamValues(
13981   SpecializeParamsTool: TFindDeclarationTool;
13982   SpecializeNode: TCodeTreeNode);
13983 begin
13984   GenParams.ParamValuesTool := SpecializeParamsTool;
13985   GenParams.SpecializeParamsNode := SpecializeNode.FirstChild.NextBrother;
13986 end;
13987 
13988 procedure TFindDeclarationParams.UpdateGenericParamMapping(SpecializeParamsTool: TFindDeclarationTool;
13989   SpecializeParamsNode: TCodeTreeNode; GenericParamsNode: TCodeTreeNode);
13990 
13991   procedure ForwardParamMapping;
13992   var
13993     lGenericParamNode,
13994     lSpecializeParamNode,
13995     lGenericParamValueNode: TCodeTreeNode;
13996     lFirstMapping,
13997     lMapping,
13998     lLoopMapping: TGenericParamValueMapping;
13999     lFound: Boolean;
14000   begin
14001     lFirstMapping := nil;
14002     lMapping := nil;
14003     // GenericParams: GObject1<V1, V2> = class(GObject2<V2, V1>)
14004     //                         ^^^^^^
14005     // SpecializeParams: GObject1<V1, V2> = class(GObject2<V2, V1>)
14006     //                                                     ^^^^^^
14007     if GenParamValueMappings.FirstParamValueMapping = nil then begin
14008       // first mapping: values from GenParamValueMappings.SpecializeParamsNode
14009       lSpecializeParamNode := SpecializeParamsNode.FirstChild;
14010       while lSpecializeParamNode <> nil do begin
14011         //find generic param / generic param value
14012         lGenericParamNode := GenericParamsNode.FirstChild;
14013         lGenericParamValueNode := GenParamValueMappings.SpecializeParamsNode.FirstChild;
14014         lFound := false;
14015         while (lGenericParamNode <> nil)
14016         and (lGenericParamValueNode <> nil) do begin
14017           if SpecializeParamsTool.CompareSrcIdentifiers(lSpecializeParamNode.StartPos, lGenericParamNode.StartPos) then begin
14018             // found generic param
14019             lMapping := TGenericParamValueMapping.Create(lMapping, lSpecializeParamNode, lGenericParamValueNode);
14020             if lFirstMapping = nil then
14021               lFirstMapping := lMapping;
14022             lFound := true;
14023             break;
14024           end;
14025           lGenericParamNode := lGenericParamNode.NextBrother;
14026           lGenericParamValueNode := lGenericParamValueNode.NextBrother;
14027         end;
14028         if not lFound then begin
14029 
14030         end;
14031         lSpecializeParamNode := lSpecializeParamNode.NextBrother;
14032       end;
14033       GenParamValueMappings.FirstParamValueMapping := lFirstMapping;
14034       GenParamValueMappings.SpecializeValuesTool := GenParamValueMappings.SpecializeParamsTool;
14035     end else begin
14036       // further mapping: values from GenParamValueMappings.FirstParamValueMapping
14037       lSpecializeParamNode := SpecializeParamsNode.FirstChild;
14038       while lSpecializeParamNode <> nil do begin
14039         //find generic param / generic param value
14040         lLoopMapping := GenParamValueMappings.FirstParamValueMapping;
14041         lGenericParamNode := GenericParamsNode.FirstChild;
14042         lFound := false;
14043         while (lLoopMapping <> nil) do begin
14044           lGenericParamValueNode := lLoopMapping.SpecializeValueNode;
14045           if SpecializeParamsTool.CompareSrcIdentifiers(lSpecializeParamNode.StartPos, lGenericParamNode.StartPos) then begin
14046             // found generic param
14047             lMapping := TGenericParamValueMapping.Create(lMapping, lSpecializeParamNode, lGenericParamValueNode);
14048             if lFirstMapping = nil then
14049               lFirstMapping := lMapping;
14050             lFound := true;
14051             break;
14052           end;
14053           lGenericParamNode := lGenericParamNode.NextBrother;
14054           lLoopMapping := lLoopMapping.NextBrother;
14055         end;
14056         if not lFound then begin
14057 
14058         end;
14059         lSpecializeParamNode := lSpecializeParamNode.NextBrother;
14060       end;
14061       GenParamValueMappings.FirstParamValueMapping.Free;
14062       GenParamValueMappings.FirstParamValueMapping := lFirstMapping;
14063     end;
14064   end;
14065 
14066 begin
14067   if Parent <> nil then begin
14068     Parent.UpdateGenericParamMapping(SpecializeParamsTool, SpecializeParamsNode, GenericParamsNode);
14069     exit;
14070   end;
14071   if (GenericParamsNode <> nil)
14072   and (GenParamValueMappings.SpecializeParamsNode <> nil) then
14073     ForwardParamMapping;
14074   GenParamValueMappings.SpecializeParamsTool := SpecializeParamsTool;
14075   GenParamValueMappings.SpecializeParamsNode := SpecializeParamsNode;
14076 end;
14077 
14078 procedure TFindDeclarationParams.UpdateContexWithGenParamValue(var SpecializeParamContext: TFindContext);
14079 var
14080   lMapping: TGenericParamValueMapping;
14081   lPNode, lVNode: TCodeTreeNode;
14082   lPTool, lVTool: TFindDeclarationTool;
14083 begin
14084   lMapping := GenParamValueMappings.FirstParamValueMapping;
14085   while lMapping <> nil do begin
14086     lPNode := lMapping.GenericParamNode;
14087     lPTool := GenParamValueMappings.SpecializeParamsTool;
14088     lVNode := lMapping.SpecializeValueNode;
14089     lVTool := GenParamValueMappings.SpecializeValuesTool;
14090     if SpecializeParamContext.Tool.CompareSrcIdentifiers(SpecializeParamContext.Node.StartPos, @lPTool.Src[lPNode.StartPos]) then begin
14091       SpecializeParamContext.Node := lVNode;
14092       SpecializeParamContext.Tool := lVTool;
14093       exit;
14094     end;
14095     lMapping := lMapping.NextBrother;
14096   end;
14097 end;
14098 
FindGenericParamTypenull14099 function TFindDeclarationParams.FindGenericParamType: Boolean;
14100 var
14101   i, n: integer;
14102   GenParamType: TCodeTreeNode;
14103 begin
14104   // NewCodeTool, NewNode=GenericParamType
14105   if not Assigned(NewCodeTool) or not Assigned(NewNode)
14106   or not Assigned(GenParams.ParamValuesTool)
14107   or not Assigned(GenParams.SpecializeParamsNode) then exit(false);
14108   n:=0;
14109   GenParamType:=NewNode;
14110   while GenParamType<>nil do begin
14111     GenParamType:=GenParamType.PriorBrother;
14112     inc(n);
14113   end;
14114   with GenParams.ParamValuesTool do begin
14115     MoveCursorToNodeStart(GenParams.SpecializeParamsNode);
14116     ReadNextAtom;
14117     // maybe all this syntax check is redundant
14118     if not AtomIsChar('<') then
14119       RaiseExceptionFmt(20170421200701,ctsStrExpectedButAtomFound,['<']);
14120     ReadNextAtom;
14121     if CurPos.Flag<>cafWord then
14122       RaiseExceptionFmt(20170421200703,ctsIdentExpectedButAtomFound,[GetAtom]);
14123     for i:=2 to n do begin
14124       ReadNextAtom;
14125       if AtomIsChar('>') then
14126         RaiseException(20170421200705,ctsNotEnoughGenParams);
14127       if not AtomIsChar(',') then
14128         RaiseExceptionFmt(20170421200707,ctsStrExpectedButAtomFound,['>']);
14129       ReadNextAtom;
14130       if CurPos.Flag<>cafWord then
14131         RaiseExceptionFmt(20170421200710,ctsIdentExpectedButAtomFound,[GetAtom]);
14132     end;
14133     Identifier:=@Src[CurPos.StartPos];
14134     IdentifierTool:=GenParams.ParamValuesTool;
14135     ContextNode:=GenParams.SpecializeParamsNode;
14136     Result:=FindIdentifierInContext(Self);
14137   end;
14138 end;
14139 
14140 procedure TFindDeclarationParams.AddOperandPart(aPart: string);
14141 begin
14142   FExtractedOperand := FExtractedOperand + aPart;
14143 end;
14144 
14145 procedure TFindDeclarationParams.ChangeFoundProc(
14146   const ProcContext: TFindContext;
14147   ProcCompatibility: TTypeCompatibility;
14148   ParamCompatibilityList: TTypeCompatibilityList);
14149 begin
14150   FoundProc^.Context:=ProcContext;
14151   FoundProc^.ProcCompatibility:=ProcCompatibility;
14152   if (FoundProc^.ParamCompatibilityList<>ParamCompatibilityList) then begin
14153     //DebugLn(['TFindDeclarationParams.ChangeFoundProc Old ParamCompatibilityList=',dbgs(FoundProc^.ParamCompatibilityList)]);
14154     if (FoundProc^.ParamCompatibilityList<>nil) then
14155       FreeMem(FoundProc^.ParamCompatibilityList);
14156     FoundProc^.ParamCompatibilityList:=ParamCompatibilityList;
14157     //DebugLn(['TFindDeclarationParams.ChangeFoundProc New ParamCompatibilityList=',dbgs(FoundProc^.ParamCompatibilityList)]);
14158   end;
14159 end;
14160 
IsFoundProcFinalnull14161 function TFindDeclarationParams.IsFoundProcFinal: boolean;
14162 begin
14163   Result:=(FoundProc=nil)
14164        or (FoundProc^.CacheValid and (FoundProc^.ProcCompatibility=tcExact));
14165 end;
14166 
14167 procedure TFindDeclarationParams.PrettifyResult;
14168 begin
14169   // adjust result for nicer position
14170   if (NewNode<>nil) then begin
14171     {$IFDEF CheckNodeTool}
14172     if NewCodeTool<>nil then
14173       NewCodeTool.CheckNodeTool(NewNode);
14174     {$ENDIF}
14175     case NewNode.Desc of
14176     ctnProcedure:
14177       if (NewNode.FirstChild<>nil)
14178       and (NewNode.FirstChild.Desc=ctnProcedureHead) then begin
14179         // Instead of jumping to the procedure keyword,
14180         // jump to the procedure name
14181         NewNode:=NewNode.FirstChild;
14182         NewCleanPos:=NewNode.StartPos;
14183       end;
14184     ctnGenericType:
14185       if (NewNode.FirstChild<>nil) then begin
14186         // Instead of jumping to the generic keyword,
14187         // jump to the name
14188         NewNode:=NewNode.FirstChild;
14189         NewCleanPos:=NewNode.StartPos;
14190       end;
14191     ctnProperty:
14192       // jump to the name of the property
14193       if NewCodeTool.MoveCursorToPropName(NewNode) then
14194         NewCleanPos:=NewCodeTool.CurPos.StartPos;
14195     end;
14196   end;
14197 end;
14198 
14199 procedure TFindDeclarationParams.SetResult(
14200   NodeCacheEntry: PCodeTreeNodeCacheEntry);
14201 begin
14202   ClearResult(true);
14203   NewCodeTool:=TFindDeclarationTool(NodeCacheEntry^.NewTool);
14204   NewNode:=NodeCacheEntry^.NewNode;
14205   NewCleanPos:=NodeCacheEntry^.NewCleanPos;
14206 end;
14207 
14208 
14209 { TExprTypeList }
14210 
14211 destructor TExprTypeList.Destroy;
14212 begin
14213   if Items<>nil then begin
14214     FreeMem(Items);
14215     Freemem(AliasTypes);
14216   end;
14217 end;
14218 
AsStringnull14219 function TExprTypeList.AsString: string;
14220 var i: integer;
14221 begin
14222   Result:='';
14223   for i:=0 to Count-1 do begin
14224     Result:=Result+'{'+IntToStr(i)+'/'+IntToStr(Count)+':'+ExprTypeToString(Items[i])+'}'+LineEnding;
14225   end;
14226 end;
14227 
CalcMemSizenull14228 function TExprTypeList.CalcMemSize: PtrUInt;
14229 begin
14230   Result:=PtrUInt(InstanceSize)
14231     +PtrUInt(FCapacity)*SizeOf(TExpressionType);
14232 end;
14233 
14234 procedure TExprTypeList.SetCapacity(const AValue: integer);
14235 var NewSize, NewAliasSize: integer;
14236 begin
14237   if FCapacity=AValue then exit;
14238   FCapacity:=AValue;
14239   NewSize:=FCapacity*SizeOf(TExpressionType);
14240   NewAliasSize:=FCapacity*SizeOf(TFindContext);
14241   if Items=nil then begin
14242     GetMem(Items,NewSize);
14243     GetMem(AliasTypes,NewAliasSize);
14244   end
14245   else begin
14246     ReAllocMem(Items,NewSize);
14247     ReAllocMem(AliasTypes,NewAliasSize);
14248   end;
14249   if Count>Capacity then Count:=Capacity;
14250 end;
14251 
14252 procedure TExprTypeList.Grow;
14253 begin
14254   Capacity:=Capacity*2+4;
14255 end;
14256 
14257 procedure TExprTypeList.Add(const ExprType: TExpressionType);
14258 begin
14259   inc(Count);
14260   if Count>Capacity then Grow;
14261   Items[Count-1]:=ExprType;
14262   AliasTypes[Count-1]:=CleanFindContext;
14263 end;
14264 
14265 procedure TExprTypeList.Add(const ExprType: TExpressionType;
14266   const AliasType: TFindContext);
14267 begin
14268   inc(Count);
14269   if Count>Capacity then Grow;
14270   Items[Count-1]:=ExprType;
14271   AliasTypes[Count-1]:=AliasType;
14272 end;
14273 
14274 procedure TExprTypeList.AddFirst(const ExprType: TExpressionType);
14275 begin
14276   inc(Count);
14277   if Count>Capacity then Grow;
14278   if Count>1 then
14279     Move(Items[0],Items[1],SizeOf(TExpressionType)*(Count-1));
14280   Items[0]:=ExprType;
14281 end;
14282 
14283 
14284 finalization
14285   FreeAndNil(FBooleanTypesOrderList);
14286   FreeAndNil(FIntegerTypesOrderList);
14287   FreeAndNil(FRealTypesOrderList);
14288   FreeAndNil(FStringTypesOrderList);
14289 
14290 end.
14291 
14292