Browse Source

--- Merging r34357 into '.':
U packages/fcl-passrc/fpmake.pp
A packages/fcl-passrc/tests/tcresolver.pas
U packages/fcl-passrc/tests/testpassrc.lpi
U packages/fcl-passrc/tests/tcbaseparser.pas
U packages/fcl-passrc/tests/tcstatements.pas
U packages/fcl-passrc/tests/tcscanner.pas
U packages/fcl-passrc/tests/tcexprparser.pas
U packages/fcl-passrc/tests/tctypeparser.pas
U packages/fcl-passrc/tests/testpassrc.lpr
U packages/fcl-passrc/tests/tconstparser.pas
U packages/fcl-passrc/src/pparser.pp
U packages/fcl-passrc/src/pastree.pp
A packages/fcl-passrc/src/pasresolver.pp
U packages/fcl-passrc/src/pscanner.pp
U packages/pastojs/tests/tcconverter.pp
U packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r34357 into '.':
U .
--- Merging r34429 into '.':
G packages/fcl-passrc/tests/tctypeparser.pas
U packages/fcl-passrc/tests/tcresolver.pas
G packages/fcl-passrc/tests/tcbaseparser.pas
G packages/fcl-passrc/tests/tcstatements.pas
G packages/fcl-passrc/src/pparser.pp
G packages/fcl-passrc/src/pastree.pp
U packages/fcl-passrc/src/pasresolver.pp
G packages/fcl-passrc/src/pscanner.pp
--- Recording mergeinfo for merge of r34429 into '.':
G .

# revisions: 34357,34429

git-svn-id: branches/fixes_3_0@35976 -

marco 8 years ago
parent
commit
6ed7b60dc6

+ 2 - 0
.gitattributes

@@ -2521,6 +2521,7 @@ packages/fcl-passrc/Makefile.fpc.fpcmake svneol=native#text/plain
 packages/fcl-passrc/examples/test_parser.pp svneol=native#text/plain
 packages/fcl-passrc/examples/testunit1.pp svneol=native#text/plain
 packages/fcl-passrc/fpmake.pp svneol=native#text/plain
+packages/fcl-passrc/src/pasresolver.pp svneol=native#text/plain
 packages/fcl-passrc/src/passrcutil.pp svneol=native#text/plain
 packages/fcl-passrc/src/pastounittest.pp svneol=native#text/plain
 packages/fcl-passrc/src/pastree.pp svneol=native#text/plain
@@ -2535,6 +2536,7 @@ packages/fcl-passrc/tests/tcmoduleparser.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tconstparser.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcpassrcutil.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcprocfunc.pas svneol=native#text/plain
+packages/fcl-passrc/tests/tcresolver.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcscanner.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcstatements.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tctypeparser.pas svneol=native#text/plain

+ 7 - 0
packages/fcl-passrc/fpmake.pp

@@ -39,6 +39,13 @@ begin
           AddUnit('pastree');
           AddUnit('pscanner');
         end;
+    T:=P.Targets.AddUnit('pasresolver.pp');
+      with T.Dependencies do
+        begin
+          AddUnit('pastree');
+          AddUnit('pscanner');
+          AddUnit('pparser');
+        end;
     T.ResourceStrings := True;
     T:=P.Targets.AddUnit('pastounittest.pp');
       with T.Dependencies do

+ 2395 - 0
packages/fcl-passrc/src/pasresolver.pp

@@ -0,0 +1,2395 @@
+{
+    This file is part of the Free Component Library
+
+    Pascal source parser
+    Copyright (c) 2000-2005 by
+      Areca Systems GmbH / Sebastian Guenther, [email protected]
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************
+
+ Abstract:
+  Resolves references by setting TPasElement.CustomData as TResolvedReference.
+  Creates search scopes for elements with sub identifiers by setting
+    TPasElement.CustomData as TPasScope: unit, program, library, interface,
+    implementation, procs
+
+ Works:
+  - built-in types as TPasUnresolvedSymbolRef: longint, int64, string, pointer, ...
+  - references in statements, error if not found
+  - interface and implementation types, vars, const
+  - params, local types, vars, const
+  - nested procedures
+  - search in used units
+  - unitname.identifier
+  - alias types, 'type a=b'
+  - type alias type 'type a=type b'
+  - choose the compatible overloaded procedure
+  - while do
+  - repeat until
+  - if then else
+  - binary operators
+  - case of
+  - try..finally..except, on, else, raise
+  - for loop
+
+ ToDo:
+  - spot duplicates
+  - check if types only refer types
+  - nested forward procs, nested must be resolved before proc body
+  - program/library/implementation forward procs
+  - check if constant is longint or int64
+  - built-in functions
+  - enums - TPasEnumType, TPasEnumValue
+    - propagate to parent scopes
+  - ranges TPasRangeType
+  - records - TPasRecordType,
+    - variant - TPasVariant
+    - const  TRecordValues
+  - arrays  TPasArrayType
+    - const TArrayValues
+  - pointer TPasPointerType
+  - untyped parameters
+  - sets - TPasSetType
+  - forwards of ^pointer and class of - must be queued and resolved at end of type section
+  - with - TPasImplWithDo
+  - classes - TPasClassType
+  - interfaces
+  - properties - TPasProperty
+    - read, write, index properties, implements, stored
+  - default property
+  - TPasResString
+  - TPasFileType
+  - generics, nested param lists
+  - visibility (private, protected, strict private, strict protected)
+  - check const expression types, e.g. bark on "const c:string=3;"
+  - dotted unitnames
+  - labels
+  - helpers
+  - generics
+  - many more: search for "ToDo:"
+
+ Debug flags: -d<x>
+   VerbosePasResolver
+}
+unit PasResolver;
+
+{$mode objfpc}{$H+}
+{$inline on}
+
+interface
+
+uses
+  Classes, SysUtils, contnrs, PasTree, PParser, PScanner;
+
+const
+  ParserMaxEmbeddedColumn = 2048;
+  ParserMaxEmbeddedRow = $7fffffff div ParserMaxEmbeddedColumn;
+
+// message numbers
+const
+  nIdentifierNotFound = 3001;
+  nNotYetImplemented = 3002;
+  nIllegalQualifier = 3003;
+  nSyntaxErrorExpectedButFound = 3004;
+  nWrongNumberOfParametersForCallTo = 3005;
+  nIncompatibleTypeArgNo = 3006;
+  nIncompatibleTypeArgNoVarParamMustMatchExactly = 3007;
+  nVariableIdentifierExpected = 3008;
+
+// resourcestring patterns of messages
+resourcestring
+  sIdentifierNotFound = 'identifier not found "%s"';
+  sNotYetImplemented = 'not yet implemented: %s';
+  sIllegalQualifier = 'illegal qualifier "%s"';
+  sSyntaxErrorExpectedButFound = 'Syntax error, "%s" expected but "%s" found';
+  sWrongNumberOfParametersForCallTo = 'Wrong number of parameters specified for call to "%s"';
+  sIncompatibleTypeArgNo = 'Incompatible type arg no. %s: Got "%s", expected "%s"';
+  sIncompatibleTypeArgNoVarParamMustMatchExactly = 'Incompatible type arg no. %s: Got "%s", expected "%s". Var param must match exactly.';
+  sVariableIdentifierExpected = 'Variable identifier expected';
+
+type
+  TResolveBaseType = (
+    btNone,        // undefined
+    btContext,     // a TPasType
+    btUntyped,     // TPasArgument without ArgType
+    btChar,        // char
+    btWideChar,    // widechar
+    btString,      // string
+    btAnsiString,  // ansistring
+    btShortString, // shortstring
+    btWideString,  // widestring
+    btUnicodeString,// unicodestring
+    btReal,        // real  platform, single or double
+    btSingle,      // single  1.5E-45..3.4E38, digits 7-8, bytes 4
+    btDouble,      // double  5.0E-324..1.7E308, digits 15-16, bytes 8
+    btExtended,    // extended  platform, double or 1.9E-4932..1.1E4932, digits 19-20, bytes 10
+    btCExtended,   // cextended
+    btComp,        // comp  -2E64+1..2E63-1, digits 19-20, bytes 8
+    btCurrency,    // currency  ?, bytes 8
+    btBoolean,     // boolean
+    btByteBool,    // bytebool  true=not zero
+    btWordBool,    // wordbool  true=not zero
+    btLongBool,    // longbool  true=not zero
+    btQWordBool,   // qwordbool true=not zero
+    btByte,        // byte  0..255
+    btShortInt,    // shortint -128..127
+    btWord,        // word  unsigned 2 bytes
+    btSmallInt,    // smallint signed 2 bytes
+    btLongWord,    // longword unsigned 4 bytes
+    btCardinal,    // cardinal see longword
+    btLongint,     // longint  signed 4 bytes
+    btQWord,       // qword   0..18446744073709551615, bytes 8
+    btInt64,       // int64   -9223372036854775808..9223372036854775807, bytes 8
+    btPointer,     // pointer
+    btFile,        // file
+    btText,        // text
+    btVariant,     // variant
+    btNil,         // nil = pointer, class, procedure, method, ...
+    btCompilerFunc// SUCC, PREC, LOW, HIGH, ORD, LENGTH, COPY
+    );
+  TResolveBaseTypes = set of TResolveBaseType;
+const
+  btAllNumbers = [btComp,btCurrency,btByte,btShortInt,btWord,btSmallInt,
+    btLongWord,btCardinal,btLongint,btQWord,btInt64];
+  btAllStrings = [btChar,btWideChar,btString,btAnsiString,btShortString,
+    btWideString,btUnicodeString];
+  btAllFloats = [btReal,btSingle,btDouble,btExtended,btCExtended];
+  btAllBooleans = [btBoolean,btByteBool,btWordBool,btLongBool,btQWordBool];
+  btAllStandardTypes = [
+    btChar,
+    btWideChar,
+    btString,
+    btAnsiString,
+    btShortString,
+    btWideString,
+    btUnicodeString,
+    btReal,
+    btSingle,
+    btDouble,
+    btExtended,
+    btCExtended,
+    btComp,
+    btCurrency,
+    btBoolean,
+    btByteBool,
+    btWordBool,
+    btLongBool,
+    btQWordBool,
+    btByte,
+    btShortInt,
+    btWord,
+    btSmallInt,
+    btLongWord,
+    btCardinal,
+    btLongint,
+    btQWord,
+    btInt64,
+    btPointer,
+    btFile,
+    btText,
+    btVariant
+    ];
+
+  BaseTypeNames: array[TResolveBaseType] of shortstring =(
+    'None',
+    'Context',
+    'Untyped',
+    'Char',
+    'WideChar',
+    'String',
+    'AnsiString',
+    'ShortString',
+    'WideString',
+    'UnicodeString',
+    'Real',
+    'Single',
+    'Double',
+    'Extended',
+    'CExtended',
+    'Comp',
+    'Currency',
+    'Boolean',
+    'ByteBool',
+    'WordBool',
+    'LongBool',
+    'QWordBool',
+    'Byte',
+    'ShortInt',
+    'Word',
+    'SmallInt',
+    'LongWord',
+    'Cardinal',
+    'Longint',
+    'QWord',
+    'Int64',
+    'Pointer',
+    'File',
+    'Text',
+    'Variant',
+    'Nil',
+    'CompilerFunc'
+    );
+
+const
+  ResolverResultVar = 'Result';
+
+type
+
+  { EPasResolve }
+
+  EPasResolve = class(Exception)
+  private
+    FPasElement: TPasElement;
+    procedure SetPasElement(AValue: TPasElement);
+  public
+    MsgNumber: integer;
+    Args: TMessageArgs;
+    destructor Destroy; override;
+    property PasElement: TPasElement read FPasElement write SetPasElement;
+  end;
+
+  { TResolveData - base class for data stored in TPasElement.CustomData }
+
+  TResolveData = Class
+  private
+    FElement: TPasElement;
+    procedure SetElement(AValue: TPasElement);
+  public
+    Owner: TObject; // e.g. a TPasResolver
+    Next: TResolveData;
+    CustomData: TObject;
+    constructor Create; virtual;
+    destructor Destroy; override;
+    property Element: TPasElement read FElement write SetElement;
+  end;
+  TResolveDataClass = class of TResolveData;
+
+  { TResolvedReference - CustomData for normal references }
+
+  TResolvedReference = Class(TResolveData)
+  private
+    FDeclaration: TPasElement;
+    procedure SetDeclaration(AValue: TPasElement);
+  public
+    destructor Destroy; override;
+    property Declaration: TPasElement read FDeclaration write SetDeclaration;
+  end;
+
+  { TResolvedCustom - CustomData for compiler built-in identifiers like 'length' }
+
+  TResolvedCustom = Class(TResolveData)
+  public
+    //pas2js creates descendants of this
+  end;
+
+  TPasScope = class;
+
+  TIterateScopeElement = procedure(El: TPasElement; Scope: TPasScope;
+    Data: Pointer; var Abort: boolean) of object;
+
+  { TPasScope - CustomData for elements with sub identifiers }
+
+  TPasScope = Class(TResolveData)
+  public
+    class function IsStoredInElement: boolean; virtual;
+    procedure IterateElements(const aName: string;
+      const OnIterateElement: TIterateScopeElement; Data: Pointer;
+      var Abort: boolean); virtual;
+    procedure WriteIdentifiers(Prefix: string); virtual;
+  end;
+  TPasScopeClass = class of TPasScope;
+
+  { TPasModuleScope }
+
+  TPasModuleScope = class(TPasScope)
+  public
+    procedure IterateElements(const aName: string;
+      const OnIterateElement: TIterateScopeElement; Data: Pointer;
+      var Abort: boolean); override;
+  end;
+
+  TPasIdentifierKind = (
+    pikNone, // not yet initialized
+    pikCustom, // built-in identifiers
+    pikSimple, // simple vars, consts, types, enums
+    pikProc // may need parameter list with round brackets
+    {
+    pikIndexedProperty, // may need parameter list with edged brackets
+    pikGeneric, // may need parameter list with angle brackets
+    pikDottedUses // namespace, needs dotted identifierss }
+    );
+  TPasIdentifierKinds = set of TPasIdentifierKind;
+
+  { TPasIdentifier }
+
+  TPasIdentifier = Class(TObject)
+  private
+    FElement: TPasElement;
+    procedure SetElement(AValue: TPasElement);
+  public
+    Identifier: String;
+    NextSameIdentifier: TPasIdentifier; // next identifier with same name
+    Kind: TPasIdentifierKind;
+    destructor Destroy; override;
+    property Element: TPasElement read FElement write SetElement;
+  end;
+
+  { TPasIdentifierScope - elements with a list of sub identifiers }
+
+  TPasIdentifierScope = Class(TPasScope)
+  private
+    FItems: TFPHashList;
+    procedure InternalAdd(Item: TPasIdentifier);
+    procedure OnClearItem(Item, Dummy: pointer);
+    procedure OnWriteItem(Item, Dummy: pointer);
+  public
+    constructor Create; override;
+    destructor Destroy; override;
+    function FindIdentifier(const Identifier: String): TPasIdentifier; virtual;
+    function AddIdentifier(const Identifier: String; El: TPasElement;
+      const Kind: TPasIdentifierKind): TPasIdentifier;
+    function FindElement(const aName: string): TPasElement;
+    procedure IterateElements(const aName: string;
+      const OnIterateElement: TIterateScopeElement; Data: Pointer;
+      var Abort: boolean); override;
+    procedure WriteIdentifiers(Prefix: string); override;
+  end;
+
+  { TPasDefaultScope - root scope }
+
+  TPasDefaultScope = class(TPasIdentifierScope)
+  public
+    class function IsStoredInElement: boolean; override;
+  end;
+
+  { TPasSectionScope - e.g. interface, implementation, program, library }
+
+  TPasSectionScope = Class(TPasIdentifierScope)
+  public
+    UsesList: TFPList; // list of TPasSectionScope
+    constructor Create; override;
+    destructor Destroy; override;
+    function FindIdentifierInSection(const Identifier: String): TPasIdentifier;
+    function FindIdentifier(const Identifier: String): TPasIdentifier; override;
+    procedure IterateElements(const aName: string;
+      const OnIterateElement: TIterateScopeElement; Data: Pointer;
+      var Abort: boolean); override;
+  end;
+
+  { TPasProcedureScope }
+
+  TPasProcedureScope = Class(TPasIdentifierScope)
+  end;
+
+  { TPasExceptOnScope }
+
+  TPasExceptOnScope = Class(TPasIdentifierScope)
+  end;
+
+  { TPasSubScope - base class for sub scopes }
+
+  TPasSubScope = Class(TPasIdentifierScope)
+  public
+    class function IsStoredInElement: boolean; override;
+  end;
+
+  { TPasIterateFilterData }
+
+  TPasIterateFilterData = record
+    OnIterate: TIterateScopeElement;
+    Data: Pointer;
+  end;
+  PPasIterateFilterData = ^TPasIterateFilterData;
+
+  { TPasSubModuleScope - scope for searching unitname.<identifier> }
+
+  TPasSubModuleScope = Class(TPasSubScope)
+  private
+    FCurModule: TPasModule;
+    procedure OnInternalIterate(El: TPasElement; Scope: TPasScope;
+      Data: Pointer; var Abort: boolean);
+    procedure SetCurModule(AValue: TPasModule);
+  public
+    InterfaceScope: TPasSectionScope;
+    ImplementationScope: TPasSectionScope;
+    destructor Destroy; override;
+    function FindIdentifier(const Identifier: String): TPasIdentifier; override;
+    procedure IterateElements(const aName: string;
+      const OnIterateElement: TIterateScopeElement; Data: Pointer;
+      var Abort: boolean); override;
+    property CurModule: TPasModule read FCurModule write SetCurModule;
+  end;
+
+  TPasResolvedKind = (
+    rkNone,
+    rkIdentifier, // IdentEl is a type, var, const, property, proc, etc, built-in types have IdentEl=nil
+                  // TypeEl is the resolved type
+    rkExpr, // ExprEl is a const, e.g. 3, 'pas', 1..2, [1,2+3]
+    rkArrayOf, // array of <TypeEl>, IdentEl might be nil
+    rkPointer // @<IdentEl>, pointer of TypeEl
+    );
+
+  TPasResolvedType = record
+    Kind: TPasResolvedKind;
+    BaseType: TResolveBaseType;
+    IdentEl: TPasElement;
+    TypeEl: TPasType;
+    ExprEl: TPasExpr;
+  end;
+  PPasResolvedType = ^TPasResolvedType;
+
+  { TPasResolver }
+
+  TPasResolver = Class(TPasTreeContainer)
+  private
+    FDefaultScope: TPasDefaultScope;
+    FLastElement: TPasElement;
+    FLastCreatedData: TResolveData;
+    FLastMsg: string;
+    FLastMsgArgs: TMessageArgs;
+    FLastMsgElement: TPasElement;
+    FLastMsgNumber: integer;
+    FLastMsgPattern: string;
+    FLastMsgType: TMessageType;
+    FScopes: array of TPasScope; // stack of scopes
+    FScopeCount: integer;
+    FStoreSrcColumns: boolean;
+    FRootElement: TPasElement;
+    FTopScope: TPasScope;
+    function GetScopes(Index: integer): TPasScope; inline;
+  protected
+    type
+      TFindFirstElementData = record
+        ErrorPosEl: TPasElement;
+        Found: TPasElement;
+      end;
+      PFindFirstElementData = ^TFindFirstElementData;
+    procedure OnFindFirstElement(El: TPasElement; Scope: TPasScope;
+      FindFirstElementData: Pointer; var Abort: boolean); virtual;
+  protected
+    type
+      TProcCompatibility = (
+        pcIncompatible,
+        pcCompatible, // e.g. assign a longint to an int64
+        pcExact
+        );
+      TFindProcsData = record
+        Params: TParamsExpr;
+        Found: TPasProcedure;
+        Compatible: TProcCompatibility;
+        Count: integer;
+      end;
+      PFindProcsData = ^TFindProcsData;
+    procedure OnFindProc(El: TPasElement; Scope: TPasScope;
+      FindProcsData: Pointer; var Abort: boolean); virtual;
+  protected
+    procedure SetCurrentParser(AValue: TPasParser); override;
+    procedure CheckTopScope(ExpectedClass: TPasScopeClass);
+    procedure AddModule(El: TPasModule);
+    procedure AddSection(El: TPasSection);
+    procedure AddType(El: TPasType);
+    procedure AddVariable(El: TPasVariable);
+    procedure AddProcedure(El: TPasProcedure);
+    procedure AddArgument(El: TPasArgument);
+    procedure AddFunctionResult(El: TPasResultElement);
+    procedure AddExceptOn(El: TPasImplExceptOn);
+    procedure StartProcedureBody(El: TProcedureBody);
+    procedure FinishModule;
+    procedure FinishUsesList;
+    procedure FinishTypeSection;
+    procedure FinishProcedure;
+    procedure FinishProcedureHeader;
+    procedure FinishExceptOnExpr;
+    procedure FinishExceptOnStatement;
+    procedure ResolveImplBlock(Block: TPasImplBlock);
+    procedure ResolveImplElement(El: TPasImplElement);
+    procedure ResolveImplCaseOf(CaseOf: TPasImplCaseOf);
+    procedure ResolveImplLabelMark(Mark: TPasImplLabelMark);
+    procedure ResolveImplForLoop(Loop: TPasImplForLoop);
+    procedure ResolveExpr(El: TPasExpr);
+    procedure ResolveBinaryExpr(El: TBinaryExpr);
+    procedure ResolveSubIdent(El: TBinaryExpr);
+    procedure ResolveParamsExpr(Params: TParamsExpr);
+    procedure WriteScopes;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    function CreateElement(AClass: TPTreeElement; const AName: String;
+      AParent: TPasElement; AVisibility: TPasMemberVisibility;
+      const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
+      overload; override;
+    function CreateElement(AClass: TPTreeElement; const AName: String;
+      AParent: TPasElement; AVisibility: TPasMemberVisibility;
+      const ASrcPos: TPasSourcePos): TPasElement;
+      overload; override;
+    function FindElement(const AName: String): TPasElement; override;
+    function FindFirstElement(const AName: String; ErrorPosEl: TPasElement): TPasElement;
+    procedure IterateElements(const aName: string;
+      const OnIterateElement: TIterateScopeElement; Data: Pointer;
+      var Abort: boolean); virtual;
+    procedure FinishScope(ScopeType: TPasScopeType); override;
+    class procedure UnmangleSourceLineNumber(LineNumber: integer;
+      out Line, Column: integer);
+    procedure Clear; virtual;
+    procedure AddObjFPCBuiltInIdentifiers(BaseTypes: TResolveBaseTypes = btAllStandardTypes);
+    function CreateReference(DeclEl, RefEl: TPasElement): TResolvedReference; virtual;
+    function CreateScope(El: TPasElement; ScopeClass: TPasScopeClass): TPasScope; virtual;
+    procedure PopScope;
+    procedure PushScope(Scope: TPasScope); overload;
+    function PushScope(El: TPasElement; ScopeClass: TPasScopeClass): TPasScope; inline; overload;
+    procedure SetLastMsg(MsgType: TMessageType; MsgNumber: integer;
+      Const Fmt : String; Args : Array of const; Element: TPasElement);
+    procedure RaiseMsg(MsgNumber: integer; const Fmt: String;
+      Args: Array of const; ErrorPosEl: TPasElement);
+    procedure RaiseNotYetImplemented(El: TPasElement; Msg: string = ''); virtual;
+    procedure RaiseInternalError(const Msg: string);
+    procedure RaiseInvalidScopeForElement(El: TPasElement; const Msg: string = '');
+    procedure RaiseIdentifierNotFound(Identifier: string; El: TPasElement);
+    function CheckProcCompatibility(Proc: TPasProcedure;
+      Params: TParamsExpr; RaiseOnError: boolean): TProcCompatibility;
+    function CheckParamCompatibility(Expr: TPasExpr; Param: TPasArgument;
+      ParamNo: integer; RaiseOnError: boolean): TProcCompatibility;
+    procedure GetResolvedType(El: TPasElement; SkipTypeAlias: boolean;
+      out ResolvedType: TPasResolvedType);
+  public
+    property LastElement: TPasElement read FLastElement;
+    property StoreSrcColumns: boolean read FStoreSrcColumns write FStoreSrcColumns; {
+       If true Line and Column is mangled together in TPasElement.SourceLineNumber.
+       Use method UnmangleSourceLineNumber to extract. }
+    property Scopes[Index: integer]: TPasScope read GetScopes;
+    property ScopeCount: integer read FScopeCount;
+    property TopScope: TPasScope read FTopScope;
+    property RootElement: TPasElement read FRootElement;
+    property DefaultScope: TPasDefaultScope read FDefaultScope write FDefaultScope;
+    property LastMsg: string read FLastMsg write FLastMsg;
+    property LastMsgNumber: integer read FLastMsgNumber write FLastMsgNumber;
+    property LastMsgType: TMessageType read FLastMsgType write FLastMsgType;
+    property LastMsgPattern: string read FLastMsgPattern write FLastMsgPattern;
+    property LastMsgArgs: TMessageArgs read FLastMsgArgs write FLastMsgArgs;
+    property LastMsgElement: TPasElement read FLastMsgElement write FLastMsgElement;
+  end;
+
+function GetObjName(o: TObject): string;
+function GetProcDesc(Proc: TPasProcedure): string;
+function GetTypeDesc(aType: TPasType): string;
+function GetTreeDesc(El: TPasElement; Indent: integer = 0): string;
+function GetResolvedTypeDesc(const T: TPasResolvedType): string;
+procedure SetResolvedType(out ResolvedType: TPasResolvedType;
+  Kind: TPasResolvedKind; BaseType: TResolveBaseType; IdentEl: TPasElement;
+  TypeEl: TPasType); overload;
+procedure SetResolvedTypeExpr(out ResolvedType: TPasResolvedType;
+  BaseType: TResolveBaseType; ExprEl: TPasExpr); overload;
+
+implementation
+
+function GetObjName(o: TObject): string;
+begin
+  if o=nil then
+    Result:='nil'
+  else if o is TPasElement then
+    Result:=TPasElement(o).Name+':'+o.ClassName
+  else
+    Result:=o.ClassName;
+end;
+
+function GetProcDesc(Proc: TPasProcedure): string;
+var
+  Args: TFPList;
+  i: Integer;
+  Arg: TPasArgument;
+begin
+  if Proc=nil then exit('nil');
+  Result:=Proc.Name+'(';
+  Args:=Proc.ProcType.Args;
+  for i:=0 to Args.Count-1 do
+    begin
+    if i>0 then Result:=Result+';';
+    Arg:=TPasArgument(Args[i]);
+    if AccessNames[Arg.Access]<>'' then
+      Result:=Result+AccessNames[Arg.Access]+' ';
+    if Arg.ArgType=nil then
+      Result:=Result+'untyped'
+    else
+      Result:=Result+GetTypeDesc(Arg.ArgType);
+    end;
+  Result:=Result+')';
+  if cCallingConventions[Proc.ProcType.CallingConvention]<>'' then
+    Result:=Result+';'+cCallingConventions[Proc.ProcType.CallingConvention];
+end;
+
+function GetTypeDesc(aType: TPasType): string;
+begin
+  if aType=nil then exit('nil');
+  if (aType.ClassType=TPasUnresolvedSymbolRef)
+      or (aType.ClassType=TPasUnresolvedTypeRef) then
+    Result:=aType.Name
+  else if aType.ClassType=TPasPointerType then
+    Result:='^'+GetTypeDesc(TPasPointerType(aType).DestType)
+  else if aType.ClassType=TPasAliasType then
+    Result:=GetTypeDesc(TPasAliasType(aType).DestType)
+  else if aType.ClassType=TPasTypeAliasType then
+    Result:='type '+GetTypeDesc(TPasTypeAliasType(aType).DestType)
+  else if aType.ClassType=TPasClassOfType then
+    Result:='class of '+TPasClassOfType(aType).DestType.Name
+  else if aType.ClassType=TPasArrayType then
+    Result:='array['+TPasArrayType(aType).IndexRange+'] of '+GetTypeDesc(TPasArrayType(aType).ElType)
+  else
+    Result:=aType.ElementTypeName;
+end;
+
+function GetTreeDesc(El: TPasElement; Indent: integer): string;
+
+  procedure LineBreak(SubIndent: integer);
+  begin
+    Inc(Indent,SubIndent);
+    Result:=Result+LineEnding+Space(Indent);
+  end;
+
+var
+  i, l: Integer;
+begin
+  if El=nil then exit('nil');
+  Result:=El.Name+':'+El.ClassName+'=';
+  if El is TPasExpr then
+    begin
+    if El.ClassType<>TBinaryExpr then
+      Result:=Result+OpcodeStrings[TPasExpr(El).OpCode];
+    if El.ClassType=TUnaryExpr then
+      Result:=Result+GetTreeDesc(TUnaryExpr(El).Operand,Indent)
+    else if El.ClassType=TBinaryExpr then
+      Result:=Result+GetTreeDesc(TBinaryExpr(El).left,Indent)
+         +OpcodeStrings[TPasExpr(El).OpCode]
+         +GetTreeDesc(TBinaryExpr(El).right,Indent)
+    else if El.ClassType=TPrimitiveExpr then
+      Result:=Result+TPrimitiveExpr(El).Value
+    else if El.ClassType=TBoolConstExpr then
+      Result:=Result+BoolToStr(TBoolConstExpr(El).Value,'true','false')
+    else if El.ClassType=TNilExpr then
+      Result:=Result+'nil'
+    else if El.ClassType=TInheritedExpr then
+      Result:=Result+'inherited'
+    else if El.ClassType=TSelfExpr then
+      Result:=Result+'Self'
+    else if El.ClassType=TParamsExpr then
+      begin
+      LineBreak(2);
+      Result:=Result+GetTreeDesc(TParamsExpr(El).Value,Indent)+'(';
+      l:=length(TParamsExpr(El).Params);
+      if l>0 then
+        begin
+        inc(Indent,2);
+        for i:=0 to l-1 do
+          begin
+          LineBreak(0);
+          Result:=Result+GetTreeDesc(TParamsExpr(El).Params[i],Indent);
+          if i<l-1 then
+            Result:=Result+','
+          end;
+        dec(Indent,2);
+        end;
+      Result:=Result+')';
+      end
+    else if El.ClassType=TRecordValues then
+      begin
+      Result:=Result+'(';
+      l:=length(TRecordValues(El).Fields);
+      if l>0 then
+        begin
+        inc(Indent,2);
+        for i:=0 to l-1 do
+          begin
+          LineBreak(0);
+          Result:=Result+TRecordValues(El).Fields[i].Name+':'
+            +GetTreeDesc(TRecordValues(El).Fields[i].ValueExp,Indent);
+          if i<l-1 then
+            Result:=Result+','
+          end;
+        dec(Indent,2);
+        end;
+      Result:=Result+')';
+      end
+    else if El.ClassType=TArrayValues then
+      begin
+      Result:=Result+'[';
+      l:=length(TArrayValues(El).Values);
+      if l>0 then
+        begin
+        inc(Indent,2);
+        for i:=0 to l-1 do
+          begin
+          LineBreak(0);
+          Result:=Result+GetTreeDesc(TArrayValues(El).Values[i],Indent);
+          if i<l-1 then
+            Result:=Result+','
+          end;
+        dec(Indent,2);
+        end;
+      Result:=Result+']';
+      end;
+    end
+  else if El is TPasProcedure then
+    begin
+    Result:=Result+GetTreeDesc(TPasProcedure(El).ProcType,Indent);
+    end
+  else if El is TPasProcedureType then
+    begin
+    Result:=Result+'(';
+    l:=TPasProcedureType(El).Args.Count;
+    if l>0 then
+      begin
+      inc(Indent,2);
+      for i:=0 to l-1 do
+        begin
+        LineBreak(0);
+        Result:=Result+GetTreeDesc(TPasArgument(TPasProcedureType(El).Args[i]),Indent);
+        if i<l-1 then
+          Result:=Result+';'
+        end;
+      dec(Indent,2);
+      end;
+    Result:=Result+')';
+    if El is TPasFunction then
+      Result:=Result+':'+GetTreeDesc(TPasFunctionType(TPasFunction(El).ProcType).ResultEl,Indent);
+    if TPasProcedureType(El).IsOfObject then
+      Result:=Result+' of object';
+    if TPasProcedureType(El).IsNested then
+      Result:=Result+' of nested';
+    if cCallingConventions[TPasProcedureType(El).CallingConvention]<>'' then
+      Result:=Result+'; '+cCallingConventions[TPasProcedureType(El).CallingConvention];
+    end
+  else if El.ClassType=TPasResultElement then
+    Result:=Result+GetTreeDesc(TPasResultElement(El).ResultType,Indent)
+  else if El.ClassType=TPasArgument then
+    begin
+    if AccessNames[TPasArgument(El).Access]<>'' then
+      Result:=Result+AccessNames[TPasArgument(El).Access]+' ';
+    if TPasArgument(El).ArgType=nil then
+      Result:=Result+'untyped'
+    else
+      Result:=Result+GetTreeDesc(TPasArgument(El).ArgType,Indent);
+    end;
+end;
+
+function GetResolvedTypeDesc(const T: TPasResolvedType): string;
+begin
+  case T.Kind of
+  rkNone: Result:='<none>';
+  rkIdentifier: Result:=GetObjName(T.IdentEl)+':'+GetTypeDesc(T.TypeEl as TPasType)+'='+BaseTypeNames[T.BaseType];
+  rkExpr: Result:=GetTreeDesc(T.ExprEl)+'='+BaseTypeNames[T.BaseType];
+  rkArrayOf: Result:='array of '+GetTypeDesc(T.TypeEl as TPasType)+'='+BaseTypeNames[T.BaseType];
+  rkPointer: Result:='^'+GetTypeDesc(T.TypeEl as TPasType)+'='+BaseTypeNames[T.BaseType];
+  else Result:='<Ouch, unknown kind>';
+  end;
+end;
+
+procedure SetResolvedType(out ResolvedType: TPasResolvedType;
+  Kind: TPasResolvedKind; BaseType: TResolveBaseType; IdentEl: TPasElement;
+  TypeEl: TPasType);
+begin
+  ResolvedType.Kind:=Kind;
+  ResolvedType.BaseType:=BaseType;
+  ResolvedType.IdentEl:=IdentEl;
+  ResolvedType.TypeEl:=TypeEl;
+  ResolvedType.ExprEl:=nil;
+end;
+
+procedure SetResolvedTypeExpr(out ResolvedType: TPasResolvedType;
+  BaseType: TResolveBaseType; ExprEl: TPasExpr);
+begin
+  ResolvedType.Kind:=rkExpr;
+  ResolvedType.BaseType:=BaseType;
+  ResolvedType.IdentEl:=nil;
+  ResolvedType.TypeEl:=nil;
+  ResolvedType.ExprEl:=ExprEl;
+end;
+
+{ TPasIdentifier }
+
+procedure TPasIdentifier.SetElement(AValue: TPasElement);
+begin
+  if FElement=AValue then Exit;
+  if Element<>nil then
+    Element.Release;
+  FElement:=AValue;
+  if Element<>nil then
+    Element.AddRef;
+end;
+
+destructor TPasIdentifier.Destroy;
+begin
+  Element:=nil;
+  inherited Destroy;
+end;
+
+{ EPasResolve }
+
+procedure EPasResolve.SetPasElement(AValue: TPasElement);
+begin
+  if FPasElement=AValue then Exit;
+  if PasElement<>nil then
+    PasElement.Release;
+  FPasElement:=AValue;
+  if PasElement<>nil then
+    PasElement.AddRef;
+end;
+
+destructor EPasResolve.Destroy;
+begin
+  PasElement:=nil;
+  inherited Destroy;
+end;
+
+{ TResolvedReference }
+
+procedure TResolvedReference.SetDeclaration(AValue: TPasElement);
+begin
+  if FDeclaration=AValue then Exit;
+  if Declaration<>nil then
+    Declaration.Release;
+  FDeclaration:=AValue;
+  if Declaration<>nil then
+    Declaration.AddRef;
+end;
+
+destructor TResolvedReference.Destroy;
+begin
+  Declaration:=nil;
+  inherited Destroy;
+end;
+
+{ TPasSubScope }
+
+class function TPasSubScope.IsStoredInElement: boolean;
+begin
+  Result:=false;
+end;
+
+{ TPasSubModuleScope }
+
+procedure TPasSubModuleScope.OnInternalIterate(El: TPasElement;
+  Scope: TPasScope; Data: Pointer; var Abort: boolean);
+var
+  FilterData: PPasIterateFilterData absolute Data;
+begin
+  if El.ClassType=TPasModule then
+    exit; // skip used units
+  // call the original iterator
+  FilterData^.OnIterate(El,Scope,FilterData^.Data,Abort);
+end;
+
+procedure TPasSubModuleScope.SetCurModule(AValue: TPasModule);
+begin
+  if FCurModule=AValue then Exit;
+  if CurModule<>nil then
+    CurModule.Release;
+  FCurModule:=AValue;
+  if CurModule<>nil then
+    CurModule.AddRef;
+end;
+
+destructor TPasSubModuleScope.Destroy;
+begin
+  CurModule:=nil;
+  inherited Destroy;
+end;
+
+function TPasSubModuleScope.FindIdentifier(const Identifier: String
+  ): TPasIdentifier;
+begin
+  if ImplementationScope<>nil then
+    begin
+    Result:=ImplementationScope.FindIdentifierInSection(Identifier);
+    if (Result<>nil) and (Result.Element.ClassType<>TPasModule) then
+      exit;
+    end;
+  if InterfaceScope<>nil then
+    Result:=InterfaceScope.FindIdentifierInSection(Identifier)
+  else
+    Result:=nil;
+end;
+
+procedure TPasSubModuleScope.IterateElements(const aName: string;
+  const OnIterateElement: TIterateScopeElement; Data: Pointer;
+  var Abort: boolean);
+var
+  FilterData: TPasIterateFilterData;
+begin
+  FilterData.OnIterate:=OnIterateElement;
+  FilterData.Data:=Data;
+  if ImplementationScope<>nil then
+    begin
+    ImplementationScope.IterateElements(aName,@OnInternalIterate,@FilterData,Abort);
+    if Abort then exit;
+    end;
+  if InterfaceScope<>nil then
+    InterfaceScope.IterateElements(aName,@OnInternalIterate,@FilterData,Abort);
+end;
+
+{ TPasSectionScope }
+
+constructor TPasSectionScope.Create;
+begin
+  inherited Create;
+  UsesList:=TFPList.Create;
+end;
+
+destructor TPasSectionScope.Destroy;
+begin
+  FreeAndNil(UsesList);
+  inherited Destroy;
+end;
+
+function TPasSectionScope.FindIdentifierInSection(const Identifier: String
+  ): TPasIdentifier;
+begin
+  Result:=inherited FindIdentifier(Identifier);
+end;
+
+function TPasSectionScope.FindIdentifier(const Identifier: String
+  ): TPasIdentifier;
+var
+  i: Integer;
+  UsesScope: TPasIdentifierScope;
+begin
+  Result:=inherited FindIdentifier(Identifier);
+  if Result<>nil then
+    exit;
+  for i:=0 to UsesList.Count-1 do
+    begin
+    UsesScope:=TPasIdentifierScope(UsesList[i]);
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasSectionScope.FindIdentifier "',Identifier,'" in used unit ',GetObjName(UsesScope.Element));
+    {$ENDIF}
+    Result:=UsesScope.FindIdentifier(Identifier);
+    if Result<>nil then exit;
+    end;
+end;
+
+procedure TPasSectionScope.IterateElements(const aName: string;
+  const OnIterateElement: TIterateScopeElement; Data: Pointer;
+  var Abort: boolean);
+var
+  i: Integer;
+  UsesScope: TPasIdentifierScope;
+begin
+  inherited IterateElements(aName, OnIterateElement, Data, Abort);
+  if Abort then exit;
+  for i:=0 to UsesList.Count-1 do
+    begin
+    UsesScope:=TPasIdentifierScope(UsesList[i]);
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasSectionScope.IterateElements "',aName,'" in used unit ',GetObjName(UsesScope.Element));
+    {$ENDIF}
+    UsesScope.IterateElements(aName,OnIterateElement,Data,Abort);
+    if Abort then exit;
+    end;
+end;
+
+{ TPasModuleScope }
+
+procedure TPasModuleScope.IterateElements(const aName: string;
+  const OnIterateElement: TIterateScopeElement; Data: Pointer;
+  var Abort: boolean);
+begin
+  if CompareText(aName,Element.Name)<>0 then exit;
+  OnIterateElement(Element,Self,Data,Abort);
+end;
+
+{ TPasDefaultScope }
+
+class function TPasDefaultScope.IsStoredInElement: boolean;
+begin
+  Result:=false;
+end;
+
+{ TResolveData }
+
+procedure TResolveData.SetElement(AValue: TPasElement);
+begin
+  if FElement=AValue then Exit;
+  if Element<>nil then
+    Element.Release;
+  FElement:=AValue;
+  if Element<>nil then
+    Element.AddRef;
+end;
+
+constructor TResolveData.Create;
+begin
+
+end;
+
+destructor TResolveData.Destroy;
+begin
+  Element:=nil;
+  inherited Destroy;
+end;
+
+{ TPasScope }
+
+class function TPasScope.IsStoredInElement: boolean;
+begin
+  Result:=true;
+end;
+
+procedure TPasScope.IterateElements(const aName: string;
+  const OnIterateElement: TIterateScopeElement; Data: Pointer;
+  var Abort: boolean);
+begin
+  if aName='' then ;
+  if Data=nil then ;
+  if OnIterateElement=nil then ;
+  if Abort then ;
+end;
+
+procedure TPasScope.WriteIdentifiers(Prefix: string);
+begin
+  writeln(Prefix,'Element: ',GetObjName(Element));
+end;
+
+{ TPasResolver }
+
+// inline
+function TPasResolver.PushScope(El: TPasElement; ScopeClass: TPasScopeClass
+  ): TPasScope;
+begin
+  Result:=CreateScope(El,ScopeClass);
+  PushScope(Result);
+end;
+
+// inline
+function TPasResolver.GetScopes(Index: integer): TPasScope;
+begin
+  Result:=FScopes[Index];
+end;
+
+procedure TPasResolver.OnFindFirstElement(El: TPasElement; Scope: TPasScope;
+  FindFirstElementData: Pointer; var Abort: boolean);
+var
+  Data: PFindFirstElementData absolute FindFirstElementData;
+begin
+  Data^.Found:=El;
+  Abort:=true;
+  if Scope=nil then ;
+end;
+
+procedure TPasResolver.OnFindProc(El: TPasElement; Scope: TPasScope;
+  FindProcsData: Pointer; var Abort: boolean);
+var
+  Data: PFindProcsData absolute FindProcsData;
+  Proc: TPasProcedure;
+  Compatible: TProcCompatibility;
+begin
+  if not (El is TPasProcedure) then
+    begin
+    // identifier is not a proc
+    Abort:=true;
+    if Data^.Found=nil then
+      begin
+      // ToDo: use the ( as error position
+      RaiseMsg(nSyntaxErrorExpectedButFound,sSyntaxErrorExpectedButFound,[';','('],
+        Data^.Params.Value);
+      end
+    else
+      exit;
+  end;
+  // identifier is a proc
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.OnFindProc ',GetTreeDesc(El,2));
+  {$ENDIF}
+  Proc:=TPasProcedure(El);
+  if Scope=nil then ;
+  Compatible:=CheckProcCompatibility(Proc,Data^.Params,false);
+  if (Data^.Found=nil) or (ord(Compatible)>ord(Data^.Compatible)) then
+    begin
+    Data^.Found:=Proc;
+    Data^.Compatible:=Compatible;
+    Data^.Count:=1;
+    end
+  else if Compatible=Data^.Compatible then
+    inc(Data^.Count);
+end;
+
+procedure TPasResolver.SetCurrentParser(AValue: TPasParser);
+begin
+  //writeln('TPasResolver.SetCurrentParser ',AValue<>nil);
+  if AValue=CurrentParser then exit;
+  Clear;
+  inherited SetCurrentParser(AValue);
+  if CurrentParser<>nil then
+    CurrentParser.Options:=CurrentParser.Options+[po_resolvestandardtypes];
+end;
+
+procedure TPasResolver.CheckTopScope(ExpectedClass: TPasScopeClass);
+begin
+  if TopScope=nil then
+    RaiseInternalError('Expected TopScope='+ExpectedClass.ClassName+' but found nil');
+  if TopScope.ClassType<>ExpectedClass then
+    RaiseInternalError('Expected TopScope='+ExpectedClass.ClassName+' but found '+TopScope.ClassName);
+end;
+
+procedure TPasResolver.FinishModule;
+var
+  CurModuleClass: TClass;
+  CurModule: TPasModule;
+begin
+  CurModule:=CurrentParser.CurModule;
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.FinishModule START ',CurModule.Name);
+  {$ENDIF}
+  CurModuleClass:=CurModule.ClassType;
+  if (CurModuleClass=TPasProgram) or (CurModuleClass=TPasLibrary) then
+    begin
+    // resolve begin..end block
+    ResolveImplBlock(CurModule.InitializationSection);
+    end
+  else if (CurModuleClass=TPasModule) then
+    begin
+    if CurModule.FinalizationSection<>nil then
+      // finalization section finished -> resolve
+      ResolveImplBlock(CurModule.FinalizationSection)
+    else if CurModule.InitializationSection<>nil then
+      // initialization section finished -> resolve
+      ResolveImplBlock(CurModule.InitializationSection)
+    else
+      begin
+      // ToDo: check if all forward procs are implemented
+      end;
+    end
+  else
+    RaiseInternalError(''); // unknown module
+
+  // close all sections
+  while (TopScope<>nil) and (TopScope.ClassType=TPasSectionScope) do
+    PopScope;
+  CheckTopScope(TPasModuleScope);
+  PopScope;
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.FinishModule END ',CurModule.Name);
+  {$ENDIF}
+end;
+
+procedure TPasResolver.FinishUsesList;
+var
+  Section: TPasSection;
+  i: Integer;
+  El, PublicEl: TPasElement;
+  Scope: TPasSectionScope;
+  UsesScope: TPasIdentifierScope;
+begin
+  CheckTopScope(TPasSectionScope);
+  Scope:=TPasSectionScope(TopScope);
+  Section:=TPasSection(Scope.Element);
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.FinishUsesList Section=',Section.ClassName,' Section.UsesList.Count=',Section.UsesList.Count);
+  {$ENDIF}
+  for i:=0 to Section.UsesList.Count-1 do
+    begin
+    El:=TPasElement(Section.UsesList[i]);
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasResolver.FinishUsesList ',GetObjName(El));
+    {$ENDIF}
+    if (El.ClassType=TProgramSection) then
+      RaiseInternalError('used unit is a program: '+GetObjName(El));
+
+    Scope.AddIdentifier(El.Name,El,pikSimple);
+
+    // check used unit
+    PublicEl:=nil;
+    if (El.ClassType=TLibrarySection) then
+      PublicEl:=El
+    else if (El.ClassType=TPasModule) then
+      PublicEl:=TPasModule(El).InterfaceSection;
+    if PublicEl=nil then
+      RaiseInternalError('uses element has no interface section: '+GetObjName(El));
+    if PublicEl.CustomData=nil then
+      RaiseInternalError('uses element has no resolver data: '
+        +El.Name+'->'+GetObjName(PublicEl));
+    if not (PublicEl.CustomData is TPasIdentifierScope) then
+      RaiseInternalError('uses element has invalid resolver data: '
+        +El.Name+'->'+GetObjName(PublicEl)+'->'+PublicEl.CustomData.ClassName);
+
+    UsesScope:=TPasIdentifierScope(PublicEl.CustomData);
+    Scope.UsesList.Add(UsesScope);
+    end;
+end;
+
+procedure TPasResolver.FinishTypeSection;
+begin
+  // ToDo: resolve pending forwards
+end;
+
+procedure TPasResolver.FinishProcedure;
+var
+  aProc: TPasProcedure;
+begin
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.FinishProcedure START');
+  {$ENDIF}
+  CheckTopScope(TPasProcedureScope);
+  aProc:=TPasProcedureScope(TopScope).Element as TPasProcedure;
+  if aProc.Body<>nil then
+    ResolveImplBlock(aProc.Body.Body);
+  PopScope;
+end;
+
+procedure TPasResolver.FinishProcedureHeader;
+begin
+  CheckTopScope(TPasProcedureScope);
+  // ToDo: check class
+end;
+
+procedure TPasResolver.FinishExceptOnExpr;
+var
+  El: TPasImplExceptOn;
+  Expr: TPrimitiveExpr;
+begin
+  CheckTopScope(TPasExceptOnScope);
+  El:=TPasImplExceptOn(FTopScope.Element);
+  if El.VarExpr<>nil then
+    begin
+    if El.VarExpr.ClassType<>TPrimitiveExpr then
+      RaiseNotYetImplemented(El.VarExpr);
+    Expr:=TPrimitiveExpr(El.VarExpr);
+    if Expr.Kind<>pekIdent then
+      RaiseNotYetImplemented(Expr);
+    TPasExceptOnScope(FTopScope).AddIdentifier(Expr.Value,Expr,pikSimple);
+    end;
+  if El.TypeExpr<>nil then
+    ResolveExpr(El.TypeExpr);
+end;
+
+procedure TPasResolver.FinishExceptOnStatement;
+begin
+  //writeln('TPasResolver.FinishExceptOnStatement START');
+  CheckTopScope(TPasExceptOnScope);
+  ResolveImplElement(TPasImplExceptOn(FTopScope.Element).Body);
+  PopScope;
+end;
+
+procedure TPasResolver.ResolveImplBlock(Block: TPasImplBlock);
+var
+  i: Integer;
+begin
+  if Block=nil then exit;
+  for i:=0 to Block.Elements.Count-1 do
+    ResolveImplElement(TPasImplElement(Block.Elements[i]));
+end;
+
+procedure TPasResolver.ResolveImplElement(El: TPasImplElement);
+begin
+  //writeln('TPasResolver.ResolveImplElement ',GetObjName(El));
+  if El=nil then
+  else if El.ClassType=TPasImplAssign then
+    begin
+    ResolveExpr(TPasImplAssign(El).left);
+    ResolveExpr(TPasImplAssign(El).right);
+    end
+  else if El.ClassType=TPasImplSimple then
+    ResolveExpr(TPasImplSimple(El).expr)
+  else if El.ClassType=TPasImplBlock then
+    ResolveImplBlock(TPasImplBlock(El))
+  else if El.ClassType=TPasImplRepeatUntil then
+    begin
+    ResolveImplBlock(TPasImplBlock(El));
+    ResolveExpr(TPasImplRepeatUntil(El).ConditionExpr);
+    end
+  else if El.ClassType=TPasImplIfElse then
+    begin
+    ResolveExpr(TPasImplIfElse(El).ConditionExpr);
+    ResolveImplElement(TPasImplIfElse(El).IfBranch);
+    ResolveImplElement(TPasImplIfElse(El).ElseBranch);
+    end
+  else if El.ClassType=TPasImplWhileDo then
+    begin
+    ResolveExpr(TPasImplWhileDo(El).ConditionExpr);
+    ResolveImplElement(TPasImplWhileDo(El).Body);
+    end
+  else if El.ClassType=TPasImplCaseOf then
+    ResolveImplCaseOf(TPasImplCaseOf(El))
+  else if El.ClassType=TPasImplLabelMark then
+    ResolveImplLabelMark(TPasImplLabelMark(El))
+  else if El.ClassType=TPasImplForLoop then
+    ResolveImplForLoop(TPasImplForLoop(El))
+  else if El.ClassType=TPasImplTry then
+    begin
+    ResolveImplBlock(TPasImplTry(El));
+    ResolveImplBlock(TPasImplTry(El).FinallyExcept);
+    ResolveImplBlock(TPasImplTry(El).ElseBranch);
+    end
+  else if El.ClassType=TPasImplExceptOn then
+    // handled in FinishExceptOnStatement
+  else if El.ClassType=TPasImplRaise then
+    begin
+    ResolveExpr(TPasImplRaise(El).ExceptObject);
+    ResolveExpr(TPasImplRaise(El).ExceptAddr);
+    end
+  else if El.ClassType=TPasImplCommand then
+    begin
+    if TPasImplCommand(El).Command<>'' then
+      RaiseNotYetImplemented(El);
+    end
+  else
+    RaiseNotYetImplemented(El);
+end;
+
+procedure TPasResolver.ResolveImplCaseOf(CaseOf: TPasImplCaseOf);
+var
+  i, j: Integer;
+  El: TPasElement;
+  Stat: TPasImplCaseStatement;
+begin
+  ResolveExpr(CaseOf.CaseExpr);
+  for i:=0 to CaseOf.Elements.Count-1 do
+    begin
+    El:=TPasElement(CaseOf.Elements[i]);
+    if El.ClassType=TPasImplCaseStatement then
+      begin
+      Stat:=TPasImplCaseStatement(El);
+      for j:=0 to Stat.Expressions.Count-1 do
+        begin
+        //writeln('TPasResolver.ResolveImplCaseOf Stat.Expr[',j,']=',GetObjName(El));
+        ResolveExpr(TPasExpr(Stat.Expressions[j]));
+        end;
+      ResolveImplElement(Stat.Body);
+      end
+    else if El.ClassType=TPasImplCaseElse then
+      ResolveImplBlock(TPasImplCaseElse(El))
+    else
+      RaiseNotYetImplemented(El);
+    end;
+  // CaseOf.ElseBranch was already resolved via Elements
+end;
+
+procedure TPasResolver.ResolveImplLabelMark(Mark: TPasImplLabelMark);
+var
+  DeclEl: TPasElement;
+begin
+  DeclEl:=FindFirstElement(Mark.LabelId,Mark);
+  // ToDo: check if DeclEl is a label and check duplicate
+  CreateReference(DeclEl,Mark);
+end;
+
+procedure TPasResolver.ResolveImplForLoop(Loop: TPasImplForLoop);
+begin
+  ResolveExpr(Loop.VariableName);
+  ResolveExpr(Loop.StartExpr);
+  ResolveExpr(Loop.EndExpr);
+  ResolveImplElement(Loop.Body);
+end;
+
+procedure TPasResolver.ResolveExpr(El: TPasExpr);
+var
+  Primitive: TPrimitiveExpr;
+  DeclEl: TPasElement;
+begin
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.ResolveExpr ',GetObjName(El));
+  {$ENDIF}
+  if El=nil then
+  else if El.ClassType=TPrimitiveExpr then
+    begin
+    Primitive:=TPrimitiveExpr(El);
+    case Primitive.Kind of
+    pekIdent:
+      begin
+      DeclEl:=FindFirstElement(Primitive.Value,El);
+      //writeln('TPasResolver.ResolveExpr Ref=',GetObjName(El)+' Decl='+GetObjName(DeclEl));
+      CreateReference(DeclEl,El);
+      end;
+    pekNumber,pekString,pekNil,pekBoolConst: exit;
+    else
+      RaiseNotYetImplemented(El);
+    end;
+    end
+  else if El.ClassType=TUnaryExpr then
+    ResolveExpr(TUnaryExpr(El).Operand)
+  else if El.ClassType=TBinaryExpr then
+    ResolveBinaryExpr(TBinaryExpr(El))
+  else if El.ClassType=TParamsExpr then
+    ResolveParamsExpr(TParamsExpr(El))
+  else if El.ClassType=TBoolConstExpr then
+  else if El.ClassType=TNilExpr then
+  else
+    RaiseNotYetImplemented(El);
+end;
+
+procedure TPasResolver.ResolveBinaryExpr(El: TBinaryExpr);
+begin
+  ResolveExpr(El.left);
+  if El.right=nil then exit;
+  case El.OpCode of
+  eopNone,
+  eopAdd,
+  eopSubtract,
+  eopMultiply,
+  eopDivide,
+  eopDiv,
+  eopMod,
+  eopPower,
+  eopShr,
+  eopShl,
+  eopNot,
+  eopAnd,
+  eopOr,
+  eopXor,
+  eopEqual,
+  eopNotEqual,
+  eopLessThan,
+  eopGreaterThan,
+  eopLessthanEqual,
+  eopGreaterThanEqual,
+  eopIn,
+  eopIs,
+  eopAs,
+  eopSymmetricaldifference:
+    begin
+    // ToDo: check if left operand supports operator
+    ResolveExpr(El.right);
+    // ToDo: check if operator fits
+    end;
+  //eopAddress: ;
+  //eopDeref: ;
+  eopSubIdent:
+    ResolveSubIdent(El);
+  else
+    RaiseNotYetImplemented(El,OpcodeStrings[El.OpCode]);
+  end;
+end;
+
+procedure TPasResolver.ResolveSubIdent(El: TBinaryExpr);
+var
+  DeclEl: TPasElement;
+  ModuleScope: TPasSubModuleScope;
+  aModule: TPasModule;
+begin
+  //writeln('TPasResolver.ResolveSubIdent El.left=',GetObjName(El.left));
+  if El.left.ClassType=TPrimitiveExpr then
+    begin
+    //writeln('TPasResolver.ResolveSubIdent El.left.CustomData=',GetObjName(El.left.CustomData));
+    if El.left.CustomData is TResolvedReference then
+      begin
+      DeclEl:=TResolvedReference(El.left.CustomData).Declaration;
+      //writeln('TPasResolver.ResolveSubIdent Decl=',GetObjName(DeclEl));
+      if DeclEl is TPasModule then
+        begin
+        // e.g. unitname.identifier
+        // => search in interface and if this is our module in the implementation
+        aModule:=TPasModule(DeclEl);
+        ModuleScope:=TPasSubModuleScope.Create;
+        ModuleScope.Owner:=Self;
+        ModuleScope.CurModule:=aModule;
+        if aModule is TPasProgram then
+          begin // program
+          if TPasProgram(aModule).ProgramSection<>nil then
+            ModuleScope.InterfaceScope:=
+              TPasProgram(aModule).ProgramSection.CustomData as TPasSectionScope;
+          end
+        else if aModule is TPasLibrary then
+          begin // library
+          if TPasLibrary(aModule).LibrarySection<>nil then
+            ModuleScope.InterfaceScope:=
+              TPasLibrary(aModule).LibrarySection.CustomData as TPasSectionScope;
+          end
+        else
+          begin // unit
+          if aModule.InterfaceSection<>nil then
+            ModuleScope.InterfaceScope:=
+              aModule.InterfaceSection.CustomData as TPasSectionScope;
+          if (aModule=CurrentParser.CurModule)
+              and (aModule.ImplementationSection<>nil)
+              and (aModule.ImplementationSection.CustomData<>nil)
+          then
+            ModuleScope.ImplementationScope:=aModule.ImplementationSection.CustomData as TPasSectionScope;
+          end;
+        PushScope(ModuleScope);
+        ResolveExpr(El.right);
+        PopScope;
+        end;
+      end
+    else
+      RaiseMsg(nIllegalQualifier,sIllegalQualifier,['.'],El);
+    end
+  else
+    RaiseMsg(nIllegalQualifier,sIllegalQualifier,['.'],El);
+end;
+
+procedure TPasResolver.ResolveParamsExpr(Params: TParamsExpr);
+var
+  i: Integer;
+  ProcName: String;
+  FindData: TFindProcsData;
+  Abort: boolean;
+begin
+  // first resolve params
+  for i:=0 to length(Params.Params)-1 do
+    ResolveExpr(Params.Params[i]);
+  // then search the best fitting proc
+  if Params.Value.ClassType=TPrimitiveExpr then
+    begin
+    ProcName:=TPrimitiveExpr(Params.Value).Value;
+    FindData:=Default(TFindProcsData);
+    FindData.Params:=Params;
+    Abort:=false;
+    IterateElements(ProcName,@OnFindProc,@FindData,Abort);
+    if FindData.Found=nil then
+      RaiseIdentifierNotFound(ProcName,Params.Value);
+    if FindData.Compatible=pcIncompatible then
+      begin
+      // found one proc, but it was incompatible => raise error
+      {$IFDEF VerbosePasResolver}
+      writeln('TPasResolver.ResolveParamsExpr found one proc, but it was incompatible => check again to raise error');
+      {$ENDIF}
+      CheckProcCompatibility(FindData.Found,Params,true);
+      end;
+    if FindData.Count>1 then
+      begin
+      // ToDo: multiple overloads fit => search again and list the candidates
+      RaiseMsg(nIdentifierNotFound,sIdentifierNotFound,[],Params.Value);
+      end;
+    // found compatible proc
+    CreateReference(FindData.Found,Params.Value);
+    end
+  else
+    RaiseNotYetImplemented(Params,' with parameters');
+end;
+
+procedure TPasResolver.AddModule(El: TPasModule);
+begin
+  if TopScope<>DefaultScope then
+    RaiseInvalidScopeForElement(El);
+  PushScope(El,TPasModuleScope);
+end;
+
+procedure TPasResolver.AddSection(El: TPasSection);
+// TInterfaceSection, TImplementationSection, TProgramSection, TLibrarySection
+// Note: implementation scope is within the interface scope
+var
+  CurModuleClass: TClass;
+begin
+  CurModuleClass:=CurrentParser.CurModule.ClassType;
+  if (CurModuleClass=TPasProgram) or (CurModuleClass=TPasLibrary) then
+    begin
+    if El.ClassType=TInitializationSection then
+      ; // ToDo: check if all forward procs are implemented
+    end
+  else if CurModuleClass=TPasModule then
+    begin
+    if El.ClassType=TInitializationSection then
+      begin
+      // finished implementation
+      // ToDo: check if all forward procs are implemented
+      end
+    else if El.ClassType=TFinalizationSection then
+      begin
+      if CurrentParser.CurModule.InitializationSection<>nil then
+        begin
+        // resolve initialization section
+        ResolveImplBlock(CurrentParser.CurModule.InitializationSection);
+        end
+      else
+        begin
+        // finished implementation
+        // ToDo: check if all forward procs are implemented
+        end;
+      end;
+    end
+  else
+    RaiseInternalError(''); // unknown module
+  PushScope(El,TPasSectionScope);
+end;
+
+procedure TPasResolver.AddType(El: TPasType);
+begin
+  if (El.Name='') then exit; // sub type
+  if El is TPasUnresolvedTypeRef then exit; // built-in type
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.AddType El=',GetObjName(El),' El.Parent=',GetObjName(El.Parent));
+  {$ENDIF}
+  if not (TopScope is TPasIdentifierScope) then
+    RaiseInvalidScopeForElement(El);
+  TPasIdentifierScope(TopScope).AddIdentifier(El.Name,El,pikSimple);
+end;
+
+procedure TPasResolver.AddVariable(El: TPasVariable);
+begin
+  if (El.Name='') then exit; // anonymous var
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.AddVariable ',GetObjName(El));
+  {$ENDIF}
+  if not (TopScope is TPasIdentifierScope) then
+    RaiseInvalidScopeForElement(El);
+  TPasIdentifierScope(TopScope).AddIdentifier(El.Name,El,pikSimple);
+end;
+
+procedure TPasResolver.AddProcedure(El: TPasProcedure);
+begin
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.AddProcedure ',GetObjName(El));
+  {$ENDIF}
+  if not (TopScope is TPasIdentifierScope) then
+    RaiseInvalidScopeForElement(El);
+  TPasIdentifierScope(TopScope).AddIdentifier(El.Name,El,pikProc);
+  PushScope(El,TPasProcedureScope);
+end;
+
+procedure TPasResolver.AddArgument(El: TPasArgument);
+begin
+  if (El.Name='') then
+    RaiseInternalError(GetObjName(El));
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.AddArgument ',GetObjName(El));
+  {$ENDIF}
+  if not (TopScope is TPasProcedureScope) then
+    RaiseInvalidScopeForElement(El);
+  TPasProcedureScope(TopScope).AddIdentifier(El.Name,El,pikSimple);
+end;
+
+procedure TPasResolver.AddFunctionResult(El: TPasResultElement);
+begin
+  if TopScope.ClassType<>TPasProcedureScope then
+    RaiseInvalidScopeForElement(El);
+  TPasProcedureScope(TopScope).AddIdentifier(ResolverResultVar,El,pikSimple);
+end;
+
+procedure TPasResolver.AddExceptOn(El: TPasImplExceptOn);
+begin
+  PushScope(El,TPasExceptOnScope);
+end;
+
+procedure TPasResolver.StartProcedureBody(El: TProcedureBody);
+begin
+  if El=nil then ;
+  // ToDo: check if all nested forward procs are resolved
+  CheckTopScope(TPasProcedureScope);
+end;
+
+procedure TPasResolver.WriteScopes;
+var
+  i: Integer;
+  Scope: TPasScope;
+begin
+  writeln('TPasResolver.WriteScopes ScopeCount=',ScopeCount);
+  for i:=ScopeCount-1 downto 0 do
+    begin
+    Scope:=Scopes[i];
+    writeln('  ',i,'/',ScopeCount,' ',GetObjName(Scope));
+    Scope.WriteIdentifiers('  ');
+    end;
+end;
+
+constructor TPasResolver.Create;
+begin
+  inherited Create;
+  FDefaultScope:=TPasDefaultScope.Create;
+  PushScope(FDefaultScope);
+end;
+
+function TPasResolver.CreateElement(AClass: TPTreeElement; const AName: String;
+  AParent: TPasElement; AVisibility: TPasMemberVisibility;
+  const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
+var
+  aScanner: TPascalScanner;
+  SrcPos: TPasSourcePos;
+begin
+  // get source position for good error messages
+  aScanner:=CurrentParser.Scanner;
+  if (ASourceFilename='') or StoreSrcColumns then
+    begin
+    SrcPos.FileName:=aScanner.CurFilename;
+    SrcPos.Row:=aScanner.CurRow;
+    SrcPos.Column:=aScanner.CurColumn;
+    end
+  else
+    begin
+    SrcPos.FileName:=ASourceFilename;
+    SrcPos.Row:=ASourceLinenumber;
+    SrcPos.Column:=0;
+    end;
+  Result:=CreateElement(AClass,AName,AParent,AVisibility,SrcPos);
+end;
+
+function TPasResolver.CreateElement(AClass: TPTreeElement; const AName: String;
+  AParent: TPasElement; AVisibility: TPasMemberVisibility;
+  const ASrcPos: TPasSourcePos): TPasElement;
+var
+  El: TPasElement;
+  SrcY: integer;
+begin
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.CreateElement ',AClass.ClassName,' Name=',AName,' Parent=',GetObjName(AParent),' (',ASrcPos.Row,',',ASrcPos.Column,')');
+  {$ENDIF}
+  if (AParent=nil) and (FRootElement<>nil)
+  and (not AClass.InheritsFrom(TPasUnresolvedTypeRef)) then
+    RaiseInternalError('TPasResolver.CreateElement more than one root element Class="'+AClass.ClassName+'" Root='+GetObjName(FRootElement));
+
+  if ASrcPos.FileName='' then
+    RaiseInternalError('TPasResolver.CreateElement missing filename');
+  SrcY:=ASrcPos.Row;
+  if StoreSrcColumns then
+    begin
+    if (ASrcPos.Column<ParserMaxEmbeddedColumn)
+        and (SrcY<ParserMaxEmbeddedRow) then
+      SrcY:=-(SrcY*ParserMaxEmbeddedColumn+ASrcPos.Column);
+    end;
+
+  // create element
+  El:=AClass.Create(AName,AParent);
+  FLastElement:=El;
+  Result:=FLastElement;
+  El.Visibility:=AVisibility;
+  El.SourceFilename:=ASrcPos.FileName;
+  El.SourceLinenumber:=SrcY;
+  if FRootElement=nil then
+    FRootElement:=Result;
+
+  // create scope
+  if AClass.InheritsFrom(TPasType) then
+    AddType(TPasType(El))
+  else if (AClass.ClassType=TPasVariable)
+      or (AClass.ClassType=TPasConst)
+      or (AClass.ClassType=TPasProperty) then
+    AddVariable(TPasVariable(El))
+  else if AClass.ClassType=TPasArgument then
+    AddArgument(TPasArgument(El))
+  else if AClass.InheritsFrom(TPasProcedure) then
+    AddProcedure(TPasProcedure(El))
+  else if AClass.ClassType=TPasResultElement then
+    AddFunctionResult(TPasResultElement(El))
+  else if AClass.ClassType=TProcedureBody then
+    StartProcedureBody(TProcedureBody(El))
+  else if AClass.InheritsFrom(TPasSection) then
+    AddSection(TPasSection(El))
+  else if AClass.InheritsFrom(TPasModule) then
+    AddModule(TPasModule(El))
+  else if AClass.InheritsFrom(TPasExpr) then
+  else if AClass.ClassType=TPasImplExceptOn then
+    AddExceptOn(TPasImplExceptOn(El))
+  else if AClass.InheritsFrom(TPasImplBlock) then
+  else if AClass.ClassType=TPasImplLabelMark then
+  else if AClass.ClassType=TPasOverloadedProc then
+  else
+    RaiseNotYetImplemented(El);
+end;
+
+function TPasResolver.FindElement(const AName: String): TPasElement;
+begin
+  //writeln('TPasResolver.FindElement Name="',AName,'"');
+  Result:=FindFirstElement(AName,LastElement);
+end;
+
+function TPasResolver.FindFirstElement(const AName: String;
+  ErrorPosEl: TPasElement): TPasElement;
+var
+  FindFirstData: TFindFirstElementData;
+  Abort: boolean;
+begin
+  //writeln('TPasResolver.FindIdentifier Name="',AName,'"');
+  Result:=Nil;
+  Abort:=false;
+  FindFirstData:=Default(TFindFirstElementData);
+  IterateElements(AName,@OnFindFirstElement,@FindFirstData,Abort);
+  Result:=FindFirstData.Found;
+  if Result<>nil then exit;
+  RaiseIdentifierNotFound(AName,ErrorPosEl);
+end;
+
+procedure TPasResolver.IterateElements(const aName: string;
+  const OnIterateElement: TIterateScopeElement; Data: Pointer;
+  var Abort: boolean);
+var
+  i: Integer;
+  Scope: TPasScope;
+begin
+  for i:=FScopeCount-1 downto 0 do
+    begin
+    Scope:=Scopes[i];
+    Scope.IterateElements(AName,OnIterateElement,Data,Abort);
+    if Abort then
+      exit;
+    if Scope is TPasSubScope then break;
+    end;
+end;
+
+procedure TPasResolver.FinishScope(ScopeType: TPasScopeType);
+begin
+  case ScopeType of
+  stModule: FinishModule;
+  stUsesList: FinishUsesList;
+  stTypeSection: FinishTypeSection;
+  stTypeDef: ;
+  stProcedure: FinishProcedure;
+  stProcedureHeader: FinishProcedureHeader;
+  stExceptOnExpr: FinishExceptOnExpr;
+  stExceptOnStatement: FinishExceptOnStatement;
+  else
+    RaiseMsg(nNotYetImplemented,sNotYetImplemented+' FinishScope',[IntToStr(ord(ScopeType))],nil);
+  end;
+end;
+
+class procedure TPasResolver.UnmangleSourceLineNumber(LineNumber: integer; out
+  Line, Column: integer);
+begin
+  Line:=Linenumber;
+  Column:=0;
+  if Line<0 then begin
+    Line:=-Line;
+    Column:=Line mod ParserMaxEmbeddedColumn;
+    Line:=Line div ParserMaxEmbeddedColumn;
+  end;
+end;
+
+destructor TPasResolver.Destroy;
+begin
+  Clear;
+  PopScope; // free default scope
+  inherited Destroy;
+end;
+
+procedure TPasResolver.Clear;
+var
+  Data: TResolveData;
+begin
+  // clear stack, keep DefaultScope
+  while (FScopeCount>0) and (FTopScope<>DefaultScope) do
+    PopScope;
+  // clear CustomData
+  while FLastCreatedData<>nil do
+    begin
+    Data:=FLastCreatedData;
+    Data.Element.CustomData:=nil;
+    FLastCreatedData:=Data.Next;
+    Data.Free;
+    end;
+end;
+
+procedure TPasResolver.AddObjFPCBuiltInIdentifiers(BaseTypes: TResolveBaseTypes
+  );
+var
+  bt: TResolveBaseType;
+begin
+  for bt in BaseTypes do
+    FDefaultScope.AddIdentifier(BaseTypeNames[bt],
+      TPasUnresolvedSymbolRef.Create(BaseTypeNames[bt],nil),pikCustom);
+end;
+
+function TPasResolver.CreateReference(DeclEl, RefEl: TPasElement
+  ): TResolvedReference;
+
+  procedure RaiseAlreadySet;
+  var
+    aLine, aCol: integer;
+    FormerDeclEl: TPasElement;
+  begin
+    writeln('RaiseAlreadySet RefEl=',GetObjName(RefEl),' DeclEl=',GetObjName(DeclEl));
+    UnmangleSourceLineNumber(RefEl.SourceLinenumber,aLine,aCol);
+    writeln('  RefEl at ',RefEl.SourceFilename,'(',aLine,',',aCol,')');
+    writeln('  RefEl.CustomData=',GetObjName(RefEl.CustomData));
+    if RefEl.CustomData is TResolvedReference then
+      begin
+        FormerDeclEl:=TResolvedReference(RefEl.CustomData).Declaration;
+      writeln('  TResolvedReference(RefEl.CustomData).Declaration=',GetObjName(FormerDeclEl),
+       ' IsSame=',FormerDeclEl=DeclEl);
+      end;
+    RaiseInternalError('TPasResolver.CreateReference customdata<>nil');
+  end;
+
+begin
+  if RefEl.CustomData<>nil then
+    RaiseAlreadySet;
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.CreateReference RefEl=',GetObjName(RefEl),' DeclEl=',GetObjName(DeclEl));
+  {$ENDIF}
+  Result:=TResolvedReference.Create;
+  Result.Element:=RefEl;
+  Result.Owner:=Self;
+  Result.Next:=FLastCreatedData;
+  Result.Declaration:=DeclEl;
+  FLastCreatedData:=Result;
+  RefEl.CustomData:=Result;
+end;
+
+function TPasResolver.CreateScope(El: TPasElement; ScopeClass: TPasScopeClass
+  ): TPasScope;
+begin
+  if El.CustomData<>nil then
+    raise EPasResolve.Create('TPasResolver.CreateScope customdata<>nil');
+
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.CreateScope El=',GetObjName(El),' ScopeClass=',ScopeClass.ClassName);
+  {$ENDIF}
+  Result:=ScopeClass.Create;
+  Result.Element:=El;
+  Result.Owner:=Self;
+  Result.Next:=FLastCreatedData;
+  FLastCreatedData:=Result;
+  El.CustomData:=Result;
+end;
+
+procedure TPasResolver.PopScope;
+var
+  Scope: TPasScope;
+begin
+  if FScopeCount=0 then
+    RaiseInternalError('PopScope');
+  {$IFDEF VerbosePasResolver}
+  //writeln('TPasResolver.PopScope ',FScopeCount,' ',FTopScope<>nil,' IsDefault=',FTopScope=FDefaultScope);
+  writeln('TPasResolver.PopScope ',FTopScope.ClassName,' IsStoredInElement=',FTopScope.IsStoredInElement,' Element=',GetObjName(FTopScope.Element));
+  {$ENDIF}
+  dec(FScopeCount);
+  if not FTopScope.IsStoredInElement then
+    begin
+    Scope:=FScopes[FScopeCount];
+    if Scope.Element<>nil then
+      Scope.Element.CustomData:=nil;
+    if Scope=FDefaultScope then
+      FDefaultScope:=nil;
+    Scope.Free;
+    FScopes[FScopeCount]:=nil;
+    end;
+  if FScopeCount>0 then
+    FTopScope:=FScopes[FScopeCount-1]
+  else
+    FTopScope:=nil;
+end;
+
+procedure TPasResolver.PushScope(Scope: TPasScope);
+begin
+  if Scope=nil then
+    RaiseInternalError('TPasResolver.PushScope nil');
+  if length(FScopes)=FScopeCount then
+    SetLength(FScopes,FScopeCount*2+10);
+  FScopes[FScopeCount]:=Scope;
+  inc(FScopeCount);
+  FTopScope:=Scope;
+  writeln('TPasResolver.PushScope ScopeCount=',ScopeCount,' ',GetObjName(FTopScope),' IsDefault=',FDefaultScope=FTopScope);
+end;
+
+procedure TPasResolver.SetLastMsg(MsgType: TMessageType; MsgNumber: integer;
+  const Fmt: String; Args: array of const; Element: TPasElement);
+begin
+  FLastMsgType := MsgType;
+  FLastMsgNumber := MsgNumber;
+  FLastMsgPattern := Fmt;
+  FLastMsg := Format(Fmt,Args);
+  FLastElement := Element;
+  CreateMsgArgs(FLastMsgArgs,Args);
+end;
+
+procedure TPasResolver.RaiseMsg(MsgNumber: integer; const Fmt: String;
+  Args: array of const; ErrorPosEl: TPasElement);
+var
+  E: EPasResolve;
+begin
+  SetLastMsg(mtError,MsgNumber,Fmt,Args,ErrorPosEl);
+  E:=EPasResolve.Create(FLastMsg);
+  E.PasElement:=ErrorPosEl;
+  E.MsgNumber:=MsgNumber;
+  E.Args:=FLastMsgArgs;
+  raise E;
+end;
+
+procedure TPasResolver.RaiseNotYetImplemented(El: TPasElement; Msg: string);
+begin
+  RaiseMsg(nNotYetImplemented,sNotYetImplemented+Msg,[GetObjName(El)],El);
+end;
+
+procedure TPasResolver.RaiseInternalError(const Msg: string);
+begin
+  raise Exception.Create('Internal error: '+Msg);
+end;
+
+procedure TPasResolver.RaiseInvalidScopeForElement(El: TPasElement;
+  const Msg: string);
+var
+  i: Integer;
+  s: String;
+begin
+  s:='invalid scope for "'+GetObjName(El)+'": ';
+  for i:=0 to ScopeCount-1 do
+    begin
+    if i>0 then s:=s+',';
+    s:=s+Scopes[i].ClassName;
+    end;
+  if Msg<>'' then
+    s:=s+': '+Msg;
+  RaiseInternalError(s);
+end;
+
+procedure TPasResolver.RaiseIdentifierNotFound(Identifier: string;
+  El: TPasElement);
+begin
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.RaiseIdentifierNotFound START "',Identifier,'"');
+  WriteScopes;
+  {$ENDIF}
+  RaiseMsg(nIdentifierNotFound,sIdentifierNotFound,[Identifier],El);
+end;
+
+function TPasResolver.CheckProcCompatibility(Proc: TPasProcedure;
+  Params: TParamsExpr; RaiseOnError: boolean): TProcCompatibility;
+var
+  ProcArgs: TFPList;
+  i, ParamCnt: Integer;
+  Param: TPasExpr;
+  ParamCompatibility: TProcCompatibility;
+begin
+  Result:=pcExact;
+  ProcArgs:=Proc.ProcType.Args;
+  // check args
+  ParamCnt:=length(Params.Params);
+  i:=0;
+  while i<ParamCnt do
+    begin
+    Param:=Params.Params[i];
+    if i>=ProcArgs.Count then
+      begin
+      // too many arguments
+      if RaiseOnError then
+        RaiseMsg(nWrongNumberOfParametersForCallTo,
+          sWrongNumberOfParametersForCallTo,[GetProcDesc(Proc)],Param);
+      exit(pcIncompatible);
+      end;
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasResolver.CheckProcCompatibility ',i,'/',ParamCnt);
+    {$ENDIF}
+    ParamCompatibility:=CheckParamCompatibility(Param,TPasArgument(ProcArgs[i]),i+1,RaiseOnError);
+    if ParamCompatibility=pcIncompatible then
+      exit(pcIncompatible);
+    if ord(ParamCompatibility)<ord(Result) then
+      Result:=ParamCompatibility;
+    inc(i);
+    end;
+  if (i<ProcArgs.Count) and (TPasArgument(ProcArgs[i]).ValueExpr=nil) then
+    begin
+    // not enough arguments
+    if RaiseOnError then
+      // ToDo: position cursor on identifier
+      RaiseMsg(nWrongNumberOfParametersForCallTo,
+        sWrongNumberOfParametersForCallTo,[GetProcDesc(Proc)],Params.Value);
+    exit(pcIncompatible);
+    end;
+end;
+
+function TPasResolver.CheckParamCompatibility(Expr: TPasExpr;
+  Param: TPasArgument; ParamNo: integer; RaiseOnError: boolean
+  ): TProcCompatibility;
+var
+  ExprType, ParamType: TPasResolvedType;
+
+  function ExprCanBeVarParam: boolean;
+  begin
+    Result:=false;
+    if (ExprType.Kind<>rkIdentifier) then exit;
+    if ExprType.IdentEl=nil then exit;
+    if ExprType.IdentEl.ClassType=TPasVariable then exit(true);
+    if (ExprType.IdentEl.ClassType=TPasConst)
+        and (TPasConst(ExprType.IdentEl).VarType<>nil) then
+      exit(true); // typed const are writable
+  end;
+
+var
+  MustFitExactly: Boolean;
+begin
+  Result:=pcIncompatible;
+  MustFitExactly:=Param.Access in [argVar, argOut];
+
+  GetResolvedType(Expr,not MustFitExactly,ExprType);
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.CheckParamCompatibility Expr=',GetTreeDesc(Expr,2),' ResolvedExpr=',GetResolvedTypeDesc(ExprType));
+  {$ENDIF}
+  if ExprType.Kind=rkNone then
+    RaiseInternalError('GetResolvedType returned rkNone for '+GetTreeDesc(Expr));
+
+  if MustFitExactly then
+    begin
+    // Expr must be a variable
+    if not ExprCanBeVarParam then
+      begin
+      if RaiseOnError then
+        RaiseMsg(nVariableIdentifierExpected,sVariableIdentifierExpected,[],Expr);
+      exit;
+      end;
+    end;
+
+  GetResolvedType(Param,not MustFitExactly,ParamType);
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.CheckParamCompatibility Param=',GetTreeDesc(Param,2),' ResolvedParam=',GetResolvedTypeDesc(ParamType));
+  {$ENDIF}
+  if ExprType.Kind=rkNone then
+    RaiseInternalError('GetResolvedType returned rkNone for '+GetTreeDesc(Param));
+  if (ParamType.TypeEl=nil) and (Param.ArgType<>nil) then
+    RaiseInternalError('GetResolvedType returned TypeEl=nil for '+GetTreeDesc(Param));
+
+  if MustFitExactly then
+    begin
+    if (ParamType.Kind=ExprType.Kind)
+        or (ParamType.BaseType=ExprType.BaseType) then
+      begin
+      if (ParamType.TypeEl<>nil) and (ParamType.TypeEl=ExprType.TypeEl) then
+        exit(pcExact);
+      end;
+    if RaiseOnError then
+      RaiseMsg(nIncompatibleTypeArgNoVarParamMustMatchExactly,
+        sIncompatibleTypeArgNoVarParamMustMatchExactly,
+        [ParamNo,GetTypeDesc(ExprType.TypeEl),GetTypeDesc(ParamType.TypeEl)],
+        Expr);
+    exit(pcIncompatible);
+    end;
+
+  // check if the Expr can be converted to Param
+  case ParamType.Kind of
+    rkIdentifier,
+    rkExpr:
+      if ExprType.Kind in [rkExpr,rkIdentifier] then
+      begin
+        if ParamType.TypeEl=nil then
+          begin
+          // ToDo: untyped parameter
+          end
+        else if ParamType.BaseType=ExprType.BaseType then
+          begin
+          // ToDo: check btFile, btText
+          exit(pcExact); // same base type, maybe not same type name (e.g. longint and integer)
+          end
+        else if (ParamType.BaseType in btAllNumbers)
+            and (ExprType.BaseType in btAllNumbers) then
+          exit(pcCompatible) // ToDo: range check for Expr
+        else if (ParamType.BaseType in btAllBooleans)
+            and (ExprType.BaseType in btAllBooleans) then
+          exit(pcCompatible)
+        else if (ParamType.BaseType in btAllStrings)
+            and (ExprType.BaseType in btAllStrings) then
+          exit(pcCompatible) // ToDo: check Expr if Param=btChar/btWideChar
+        else if (ParamType.BaseType in btAllFloats)
+            and (ExprType.BaseType in btAllFloats) then
+          exit(pcCompatible)
+        else if ExprType.BaseType=btNil then
+          begin
+            if ParamType.BaseType=btPointer then
+              exit(pcExact);
+            // ToDo: allow classes and custom pointers
+          end
+        else
+          exit(pcIncompatible);
+      end;
+    //rkArrayOf: ;
+    //rkPointer: ;
+  else
+  end;
+
+  RaiseNotYetImplemented(Expr,':TPasResolver.CheckParamCompatibility: Param='+GetResolvedTypeDesc(ParamType)+' '+GetResolvedTypeDesc(ExprType));
+end;
+
+procedure TPasResolver.GetResolvedType(El: TPasElement; SkipTypeAlias: boolean; out
+  ResolvedType: TPasResolvedType);
+var
+  bt: TResolveBaseType;
+begin
+  ResolvedType:=Default(TPasResolvedType);
+  if El=nil then
+    exit;
+  if El.ClassType=TPrimitiveExpr then
+    begin
+    case TPrimitiveExpr(El).Kind of
+      pekIdent:
+        begin
+        if El.CustomData is TResolvedReference then
+          GetResolvedType(TResolvedReference(El.CustomData).Declaration,SkipTypeAlias,ResolvedType)
+        else
+          RaiseNotYetImplemented(El,': cannot resolve this');
+        end;
+      pekNumber:
+        // ToDo: check if btByte, btSmallInt, ...
+        SetResolvedTypeExpr(ResolvedType,btLongint,TPrimitiveExpr(El));
+      pekString:
+        SetResolvedTypeExpr(ResolvedType,btString,TPrimitiveExpr(El));
+      //pekSet:
+      pekNil:
+        SetResolvedTypeExpr(ResolvedType,btNil,TPrimitiveExpr(El));
+      pekBoolConst:
+        SetResolvedTypeExpr(ResolvedType,btBoolean,TPrimitiveExpr(El));
+      //pekRange:
+      //pekUnary:
+      //pekBinary:
+      //pekFuncParams:
+      //pekArrayParams:
+      //pekListOfExp:
+      //pekInherited:
+      //pekSelf:
+    else
+      RaiseNotYetImplemented(El,': cannot resolve this');
+    end;
+    end
+  else if El.ClassType=TPasUnresolvedSymbolRef then
+    begin
+    // built-in type
+    for bt in TResolveBaseType do
+      if CompareText(BaseTypeNames[bt],El.Name)=0 then
+        begin
+        SetResolvedType(ResolvedType,rkIdentifier,bt,nil,TPasUnresolvedSymbolRef(El));
+        break;
+        end;
+    end
+  else if El.ClassType=TPasAliasType then
+    // e.f. 'var a: b' -> resolve b
+    GetResolvedType(TPasTypeAliasType(El).DestType,true,ResolvedType)
+  else if (El.ClassType=TPasTypeAliasType) and SkipTypeAlias then
+    // e.g. 'type a = type b;' -> resolve b
+    GetResolvedType(TPasTypeAliasType(El).DestType,true,ResolvedType)
+  else if (El.ClassType=TPasVariable) or (El.ClassType=TPasConst)
+      or (El.ClassType=TPasProperty) then
+    begin
+    // e.g. 'var a:b' -> resolve b, use a as IdentEl
+    GetResolvedType(TPasVariable(El).VarType,SkipTypeAlias,ResolvedType);
+    ResolvedType.IdentEl:=El;
+    end
+  else if El.ClassType=TPasArgument then
+    begin
+    if TPasArgument(El).ArgType=nil then
+      // untyped parameter
+      SetResolvedType(ResolvedType,rkIdentifier,btUntyped,El,nil)
+    else
+      begin
+      // typed parameter -> use param as IdentEl, resolve type
+      GetResolvedType(TPasArgument(El).ArgType,SkipTypeAlias,ResolvedType);
+      ResolvedType.IdentEl:=El;
+      end;
+    end
+  else
+    RaiseNotYetImplemented(El,': cannot resolve this');
+end;
+
+{ TPasIdentifierScope }
+
+procedure TPasIdentifierScope.OnClearItem(Item, Dummy: pointer);
+var
+  PasIdentifier: TPasIdentifier absolute Item;
+  Ident: TPasIdentifier;
+begin
+  if Dummy=nil then ;
+  //writeln('TPasIdentifierScope.OnClearItem ',PasIdentifier.Identifier+':'+PasIdentifier.ClassName);
+  while PasIdentifier<>nil do
+    begin
+    Ident:=PasIdentifier;
+    PasIdentifier:=PasIdentifier.NextSameIdentifier;
+    Ident.Free;
+    end;
+end;
+
+procedure TPasIdentifierScope.OnWriteItem(Item, Dummy: pointer);
+var
+  PasIdentifier: TPasIdentifier absolute Item;
+  Prefix: String;
+begin
+  Prefix:=AnsiString(Dummy);
+  while PasIdentifier<>nil do
+    begin
+    writeln(Prefix,'Identifier="',PasIdentifier.Identifier,'" Element=',GetObjName(PasIdentifier.Element));
+    PasIdentifier:=PasIdentifier.NextSameIdentifier;
+    end;
+end;
+
+procedure TPasIdentifierScope.InternalAdd(Item: TPasIdentifier);
+var
+  Index: Integer;
+  OldItem: TPasIdentifier;
+  LoName: ShortString;
+begin
+  LoName:=lowercase(Item.Identifier);
+  Index:=FItems.FindIndexOf(LoName);
+  //writeln('  Index=',Index);
+  if Index>=0 then
+    begin
+    // insert LIFO - last in, first out
+    OldItem:=TPasIdentifier(FItems.List^[Index].Data);
+    Item.NextSameIdentifier:=OldItem;
+    FItems.List^[Index].Data:=Item;
+    end
+  else
+    FItems.Add(LoName, Item);
+end;
+
+constructor TPasIdentifierScope.Create;
+begin
+  FItems:=TFPHashList.Create;
+end;
+
+destructor TPasIdentifierScope.Destroy;
+begin
+  FItems.ForEachCall(@OnClearItem,nil);
+  FItems.Clear;
+  FreeAndNil(FItems);
+  inherited Destroy;
+end;
+
+function TPasIdentifierScope.FindIdentifier(const Identifier: String
+  ): TPasIdentifier;
+var
+  LoName: ShortString;
+begin
+  LoName:=lowercase(Identifier);
+  Result:=TPasIdentifier(FItems.Find(LoName));
+end;
+
+function TPasIdentifierScope.AddIdentifier(const Identifier: String;
+  El: TPasElement; const Kind: TPasIdentifierKind): TPasIdentifier;
+var
+  Item: TPasIdentifier;
+begin
+  //writeln('TPasIdentifierScope.AddIdentifier Identifier="',Identifier,'" El=',GetObjName(El));
+  Item:=TPasIdentifier.Create;
+  Item.Identifier:=Identifier;
+  Item.Element:=El;
+  Item.Kind:=Kind;
+
+  InternalAdd(Item);
+  //writeln('TPasIdentifierScope.AddIdentifier END');
+  Result:=Item;
+end;
+
+function TPasIdentifierScope.FindElement(const aName: string): TPasElement;
+var
+  Item: TPasIdentifier;
+begin
+  //writeln('TPasIdentifierScope.FindElement "',aName,'"');
+  Item:=FindIdentifier(aName);
+  if Item=nil then
+    Result:=nil
+  else
+    Result:=Item.Element;
+  //writeln('TPasIdentifierScope.FindElement Found="',GetObjName(Result),'"');
+end;
+
+procedure TPasIdentifierScope.IterateElements(const aName: string;
+  const OnIterateElement: TIterateScopeElement; Data: Pointer;
+  var Abort: boolean);
+var
+  Item: TPasIdentifier;
+begin
+  Item:=FindIdentifier(aName);
+  while Item<>nil do
+    begin
+    // writeln('TPasIdentifierScope.IterateElements ',Item.Identifier,' ',GetObjName(Item.Element));
+    OnIterateElement(Item.Element,Self,Data,Abort);
+    if Abort then exit;
+    Item:=Item.NextSameIdentifier;
+    end;
+end;
+
+procedure TPasIdentifierScope.WriteIdentifiers(Prefix: string);
+begin
+  inherited WriteIdentifiers(Prefix);
+  Prefix:=Prefix+'  ';
+  FItems.ForEachCall(@OnWriteItem,Pointer(Prefix));
+end;
+
+end.
+

File diff suppressed because it is too large
+ 301 - 118
packages/fcl-passrc/src/pastree.pp


File diff suppressed because it is too large
+ 276 - 161
packages/fcl-passrc/src/pparser.pp


+ 22 - 2
packages/fcl-passrc/src/pscanner.pp

@@ -317,6 +317,7 @@ type
     function FindSourceFile(const AName: string): TLineReader; override;
     function FindIncludeFile(const AName: string): TLineReader; override;
     Property OwnsStreams : Boolean Read FOwnsStreams write SetOwnsStreams;
+    Property Streams: TStringList read FStreams;
   end;
 
   EScannerError       = class(Exception);
@@ -324,9 +325,20 @@ type
 
   TPascalScannerPPSkipMode = (ppSkipNone, ppSkipIfBranch, ppSkipElseBranch, ppSkipAll);
 
-  TPOption = (po_delphi,po_cassignments);
+  TPOption = (
+    po_delphi, // Delphi mode: forbid nested comments
+    po_cassignments,  // allow C-operators += -= *= /=
+    po_resolvestandardtypes // search for 'longint', 'string', etc., do not use dummies, TPasResolver sets this to use its declarations
+    );
   TPOptions = set of TPOption;
 
+type
+  TPasSourcePos = Record
+    FileName: String;
+    Row, Column: Cardinal;
+  end;
+
+type
   { TPascalScanner }
 
   TPScannerLogHandler = Procedure (Sender : TObject; Const Msg : String) of object;
@@ -390,6 +402,7 @@ type
     function FetchToken: TToken;
     Procedure AddDefine(S : String);
     Procedure RemoveDefine(S : String);
+    function CurSourcePos: TPasSourcePos;
 
     property FileResolver: TBaseFileResolver read FFileResolver;
     property CurSourceFile: TLineReader read FCurSourceFile;
@@ -751,7 +764,7 @@ begin
     While (I=-1) and (J<IncludePaths.Count-1) do
       begin
       FN:=IncludeTrailingPathDelimiter(IncludePaths[i])+AName;
-      I:=FStreams.INdexOf(FN);
+      I:=FStreams.IndexOf(FN);
       Inc(J);
       end;
     end;
@@ -1950,4 +1963,11 @@ begin
     FDefines.Delete(I);
 end;
 
+function TPascalScanner.CurSourcePos: TPasSourcePos;
+begin
+  Result.FileName:=CurFilename;
+  Result.Row:=CurRow;
+  Result.Column:=CurColumn;
+end;
+
 end.

+ 317 - 9
packages/fcl-passrc/tests/tcbaseparser.pas

@@ -7,6 +7,8 @@ interface
 uses
   Classes, SysUtils, fpcunit, pastree, pscanner, pparser, testregistry;
 
+const
+  MainFilename = 'afile.pp';
 Type
   { TTestEngine }
 
@@ -29,7 +31,7 @@ Type
   Private
     FDeclarations: TPasDeclarations;
     FDefinition: TPasElement;
-    FEngine : TTestEngine;
+    FEngine : TPasTreeContainer;
     FModule: TPasModule;
     FParseResult: TPasElement;
     FScanner : TPascalScanner;
@@ -48,6 +50,7 @@ Type
   protected
     procedure SetUp; override;
     procedure TearDown; override;
+    procedure CreateEngine(var TheEngine: TPasTreeContainer); virtual;
     Procedure StartUnit(AUnitName : String);
     Procedure StartProgram(AFileName : String; AIn : String = ''; AOut : String = '');
     Procedure StartLibrary(AFileName : String);
@@ -78,10 +81,11 @@ Type
     Procedure AssertEquals(Const Msg : String; AExpected, AActual: TAssignKind); overload;
     Procedure AssertEquals(Const Msg : String; AExpected, AActual: TProcedureMessageType); overload;
     Procedure AssertEquals(Const Msg : String; AExpected, AActual: TOperatorType); overload;
+    Procedure AssertSame(Const Msg : String; AExpected, AActual: TPasElement); overload;
     Procedure HaveHint(AHint : TPasMemberHint; AHints : TPasMemberHints);
     Property Resolver : TStreamResolver Read FResolver;
     Property Scanner : TPascalScanner Read FScanner;
-    Property Engine : TTestEngine read FEngine;
+    Property Engine : TPasTreeContainer read FEngine;
     Property Parser : TTestPasParser read FParser ;
     Property Source : TStrings Read FSource;
     Property Module : TPasModule Read FModule;
@@ -94,9 +98,296 @@ Type
     Property UseImplementation : Boolean Read FUseImplementation Write FUseImplementation;
   end;
 
+function ExtractFileUnitName(aFilename: string): string;
+function GetPasElementDesc(El: TPasElement): string;
+procedure ReadNextPascalToken(var Position: PChar; out TokenStart: PChar;
+  NestedComments: boolean; SkipDirectives: boolean);
+
 implementation
 
 uses typinfo;
+
+function ExtractFileUnitName(aFilename: string): string;
+var
+  p: Integer;
+begin
+  Result:=ExtractFileName(aFilename);
+  if Result='' then exit;
+  for p:=length(Result) downto 1 do
+    case Result[p] of
+    '/','\': exit;
+    '.':
+      begin
+      Delete(Result,p,length(Result));
+      exit;
+      end;
+    end;
+end;
+
+function GetPasElementDesc(El: TPasElement): string;
+begin
+  if El=nil then exit('nil');
+  Result:=El.Name+':'+El.ClassName+'['+El.SourceFilename+','+IntToStr(El.SourceLinenumber)+']';
+end;
+
+procedure ReadNextPascalToken(var Position: PChar; out TokenStart: PChar;
+  NestedComments: boolean; SkipDirectives: boolean);
+const
+  IdentChars = ['a'..'z','A'..'Z','_','0'..'9'];
+  HexNumberChars = ['0'..'9','a'..'f','A'..'F'];
+var
+  c1:char;
+  CommentLvl: Integer;
+  Src: PChar;
+begin
+  Src:=Position;
+  // read till next atom
+  while true do
+    begin
+    case Src^ of
+    #0: break;
+    #1..#32:  // spaces and special characters
+      inc(Src);
+    #$EF:
+      if (Src[1]=#$BB)
+      and (Src[2]=#$BF) then
+        begin
+        // skip UTF BOM
+        inc(Src,3);
+        end
+      else
+        break;
+    '{':    // comment start or compiler directive
+      if (Src[1]='$') and (not SkipDirectives) then
+        // compiler directive
+        break
+      else begin
+        // Pascal comment => skip
+        CommentLvl:=1;
+        while true do
+          begin
+          inc(Src);
+          case Src^ of
+          #0: break;
+          '{':
+            if NestedComments then
+              inc(CommentLvl);
+          '}':
+            begin
+            dec(CommentLvl);
+            if CommentLvl=0 then
+              begin
+              inc(Src);
+              break;
+              end;
+            end;
+          end;
+        end;
+      end;
+    '/':  // comment or real division
+      if (Src[1]='/') then
+        begin
+        // comment start -> read til line end
+        inc(Src);
+        while not (Src^ in [#0,#10,#13]) do
+          inc(Src);
+        end
+      else
+        break;
+    '(':  // comment, bracket or compiler directive
+      if (Src[1]='*') then
+        begin
+        if (Src[2]='$') and (not SkipDirectives) then
+          // compiler directive
+          break
+        else
+          begin
+          // comment start -> read til comment end
+          inc(Src,2);
+          CommentLvl:=1;
+          while true do
+            begin
+            case Src^ of
+            #0: break;
+            '(':
+              if NestedComments and (Src[1]='*') then
+                inc(CommentLvl);
+            '*':
+              if (Src[1]=')') then
+                begin
+                dec(CommentLvl);
+                if CommentLvl=0 then
+                  begin
+                  inc(Src,2);
+                  break;
+                  end;
+                inc(Position);
+                end;
+            end;
+            inc(Src);
+            end;
+        end;
+      end else
+        // round bracket open
+        break;
+    else
+      break;
+    end;
+    end;
+  // read token
+  TokenStart:=Src;
+  c1:=Src^;
+  case c1 of
+  #0:
+    ;
+  'A'..'Z','a'..'z','_':
+    begin
+    // identifier
+    inc(Src);
+    while Src^ in IdentChars do
+      inc(Src);
+    end;
+  '0'..'9': // number
+    begin
+    inc(Src);
+    // read numbers
+    while (Src^ in ['0'..'9']) do
+      inc(Src);
+    if (Src^='.') and (Src[1]<>'.') then
+      begin
+      // real type number
+      inc(Src);
+      while (Src^ in ['0'..'9']) do
+        inc(Src);
+      end;
+    if (Src^ in ['e','E']) then
+      begin
+      // read exponent
+      inc(Src);
+      if (Src^='-') then inc(Src);
+      while (Src^ in ['0'..'9']) do
+        inc(Src);
+      end;
+    end;
+  '''','#':  // string constant
+    while true do
+      case Src^ of
+      #0: break;
+      '#':
+        begin
+        inc(Src);
+        while Src^ in ['0'..'9'] do
+          inc(Src);
+        end;
+      '''':
+        begin
+        inc(Src);
+        while not (Src^ in ['''',#0]) do
+          inc(Src);
+        if Src^='''' then
+          inc(Src);
+        end;
+      else
+        break;
+      end;
+  '$':  // hex constant
+    begin
+    inc(Src);
+    while Src^ in HexNumberChars do
+      inc(Src);
+    end;
+  '&':  // octal constant or keyword as identifier (e.g. &label)
+    begin
+    inc(Src);
+    if Src^ in ['0'..'7'] then
+      while Src^ in ['0'..'7'] do
+        inc(Src)
+    else
+      while Src^ in IdentChars do
+        inc(Src);
+    end;
+  '{':  // compiler directive (it can't be a comment, because see above)
+    begin
+    CommentLvl:=1;
+    while true do
+      begin
+      inc(Src);
+      case Src^ of
+      #0: break;
+      '{':
+        if NestedComments then
+          inc(CommentLvl);
+      '}':
+        begin
+        dec(CommentLvl);
+        if CommentLvl=0 then
+          begin
+          inc(Src);
+          break;
+          end;
+        end;
+      end;
+      end;
+    end;
+  '(':  // bracket or compiler directive
+    if (Src[1]='*') then
+      begin
+      // compiler directive -> read til comment end
+      inc(Src,2);
+      while (Src^<>#0) and ((Src^<>'*') or (Src[1]<>')')) do
+        inc(Src);
+      inc(Src,2);
+      end
+    else
+      // round bracket open
+      inc(Src);
+  #192..#255:
+    begin
+    // read UTF8 character
+    inc(Src);
+    if ((ord(c1) and %11100000) = %11000000) then
+      begin
+      // could be 2 byte character
+      if (ord(Src[0]) and %11000000) = %10000000 then
+        inc(Src);
+      end
+    else if ((ord(c1) and %11110000) = %11100000) then
+      begin
+      // could be 3 byte character
+      if ((ord(Src[0]) and %11000000) = %10000000)
+      and ((ord(Src[1]) and %11000000) = %10000000) then
+        inc(Src,2);
+      end
+    else if ((ord(c1) and %11111000) = %11110000) then
+      begin
+      // could be 4 byte character
+      if ((ord(Src[0]) and %11000000) = %10000000)
+      and ((ord(Src[1]) and %11000000) = %10000000)
+      and ((ord(Src[2]) and %11000000) = %10000000) then
+        inc(Src,3);
+      end;
+    end;
+  else
+    inc(Src);
+    case c1 of
+    '<': if Src^ in ['>','='] then inc(Src);
+    '.': if Src^='.' then inc(Src);
+    '@':
+      if Src^='@' then
+        begin
+        // @@ label
+        repeat
+          inc(Src);
+        until not (Src^ in IdentChars);
+        end
+    else
+      if (Src^='=') and (c1 in [':','+','-','/','*','<','>']) then
+        inc(Src);
+    end;
+  end;
+  Position:=Src;
+end;
+
 { TTestEngine }
 
 destructor TTestEngine.Destroy;
@@ -158,7 +449,7 @@ begin
   FResolver:=TStreamResolver.Create;
   FResolver.OwnsStreams:=True;
   FScanner:=TPascalScanner.Create(FResolver);
-  FEngine:=TTestEngine.Create;
+  CreateEngine(FEngine);
   FParser:=TTestPasParser.Create(FScanner,FResolver,FEngine);
   FSource:=TStringList.Create;
   FModule:=Nil;
@@ -178,7 +469,11 @@ begin
   FImplementation:=False;
   FEndSource:=False;
   FIsUnit:=False;
-  FreeAndNil(FModule);
+  if Assigned(FModule) then
+    begin
+    FModule.Release;
+    FModule:=nil;
+    end;
   FreeAndNil(FSource);
   FreeAndNil(FParseResult);
   FreeAndNil(FParser);
@@ -206,11 +501,16 @@ begin
   Inherited;
 end;
 
+procedure TTestParser.CreateEngine(var TheEngine: TPasTreeContainer);
+begin
+  TheEngine:=TTestEngine.Create;
+end;
+
 procedure TTestParser.StartUnit(AUnitName: String);
 begin
   FIsUnit:=True;
   If (AUnitName='') then
-    AUnitName:='afile';
+    AUnitName:=ExtractFileUnitName(MainFilename);
   Add('unit '+aUnitName+';');
   Add('');
   Add('interface');
@@ -228,7 +528,7 @@ begin
     begin
     AFileName:=AFileName+'('+AIn;
     if (AOut<>'') then
-      AFileName:=AFIleName+','+AOut;
+      AFileName:=AFileName+','+AOut;
     AFileName:=AFileName+')';
     end;
   Add('program '+AFileName+';');
@@ -304,8 +604,8 @@ begin
     StartImplementation;
   EndSource;
   If (FFileName='') then
-    FFileName:='afile.pp';
-  FResolver.AddStream(FFileName,TStringStream.Create(FSource.text));
+    FFileName:=MainFilename;
+  FResolver.AddStream(FFileName,TStringStream.Create(FSource.Text));
   FScanner.OpenFile(FFileName);
   Writeln('// Test : ',Self.TestName);
   Writeln(FSource.Text);
@@ -345,6 +645,7 @@ end;
 function TTestParser.AssertExpression(const Msg: String; AExpr: TPasExpr;
   aKind: TPasExprKind; AClass: TClass): TPasExpr;
 begin
+  AssertNotNull(AExpr);
   AssertEquals(Msg+': Correct expression kind',aKind,AExpr.Kind);
   AssertEquals(Msg+': Correct expression class',AClass,AExpr.ClassType);
   Result:=AExpr;
@@ -521,7 +822,14 @@ procedure TTestParser.AssertEquals(const Msg: String; AExpected,
   AActual: TOperatorType);
 begin
   AssertEquals(Msg,GetEnumName(TypeInfo(TOperatorType),Ord(AExpected)),
-                   GetEnumName(TypeInfo(TOperatorType),Ord(AExpected)));
+                   GetEnumName(TypeInfo(TOperatorType),Ord(AActual)));
+end;
+
+procedure TTestParser.AssertSame(const Msg: String; AExpected,
+  AActual: TPasElement);
+begin
+  if AExpected=AActual then exit;
+  AssertEquals(Msg,GetPasElementDesc(AExpected),GetPasElementDesc(AActual));
 end;
 
 procedure TTestParser.HaveHint(AHint: TPasMemberHint; AHints: TPasMemberHints);

+ 9 - 2
packages/fcl-passrc/tests/tcexprparser.pas

@@ -211,12 +211,14 @@ begin
   DeclareVar('record a : array[1..2] of integer; end ','b');
   ParseExpression('b.a[1]');
   P:=TParamsExpr(AssertExpression('Simple identifier',theExpr,pekArrayParams,TParamsExpr));
-  B:=AssertExpression('Name of array',P.Value,pekBinary,TBInaryExpr) as TBInaryExpr;
+  B:=AssertExpression('Name of array',P.Value,pekBinary,TBInaryExpr) as TBinaryExpr;
   AssertEquals('name is Subident',eopSubIdent,B.Opcode);
   AssertExpression('Name of array',B.Left,pekIdent,'b');
   AssertExpression('Name of array',B.Right,pekIdent,'a');
   AssertEquals('One dimension',1,Length(p.params));
   AssertExpression('Simple identifier',p.params[0],pekNumber,'1');
+  TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
+  TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
 end;
 
 procedure TTestExpressions.TestArrayElement2Dims;
@@ -291,6 +293,9 @@ begin
   B:=TBinaryExpr(AssertExpression('First element is range',P.Params[0],pekRange,TBinaryExpr));
   AssertExpression('Left is 0',B.Left,pekNumber,'0');
   AssertExpression('Right is 10',B.Right,pekNumber,'10');
+  B:=TBinaryExpr(TheExpr);
+  TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
+  TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
 end;
 
 procedure TTestExpressions.TestBracketsTotal;
@@ -868,7 +873,7 @@ Var
   I : Integer;
 
 begin
-  StartProgram('afile');
+  StartProgram(ExtractFileUnitName(MainFilename));
   if FVariables.Count=0 then
     DeclareVar('integer');
   Add('Var');
@@ -913,6 +918,8 @@ begin
   ARight:=Result.Right;
   AssertNotNull('Have left',ALeft);
   AssertNotNull('Have right',ARight);
+  TAssert.AssertSame('Result.left.parent=B',Result,Result.left.Parent);
+  TAssert.AssertSame('Result.right.parent=B',Result,Result.right.Parent);
 end;
 
 function TTestExpressions.AssertUnaryExpr(const Msg: String; Op: TExprOpCode;

+ 20 - 9
packages/fcl-passrc/tests/tconstparser.pas

@@ -205,6 +205,8 @@ begin
   ParseConst('1 + 2');
   CheckExprNameKindClass(pekBinary,TBinaryExpr);
   B:=TBinaryExpr(TheExpr);
+  TAssert.AssertSame('B.Left.Parent=B',B,B.left.Parent);
+  TAssert.AssertSame('B.right.Parent=B',B,B.right.Parent);
   AssertExpression('Left expression',B.Left,pekNumber,'1');
   AssertExpression('Right expression',B.Right,pekNumber,'2');
 end;
@@ -547,24 +549,33 @@ begin
 end;
 
 procedure TTestResourcestringParser.DoTestSum;
+var
+  B: TBinaryExpr;
 begin
   ParseResourcestring('''Something''+'' else''');
   CheckExprNameKindClass(pekBinary,TBinaryExpr);
-  AssertEquals('Correct left',TPrimitiveExpr,TBinaryExpr(TheExpr).Left.ClassType);
-  AssertEquals('Correct right',TPrimitiveExpr,TBinaryExpr(TheExpr).Right.ClassType);
-  AssertEquals('Correct left expression value','''Something''',TPrimitiveExpr(TBinaryExpr(TheExpr).Left).Value);
-  AssertEquals('Correct right expression value',''' else''',TPrimitiveExpr(TBinaryExpr(TheExpr).Right).Value);
+  B:=TBinaryExpr(TheExpr);
+  TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
+  TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
+  AssertEquals('Correct left',TPrimitiveExpr,B.Left.ClassType);
+  AssertEquals('Correct right',TPrimitiveExpr,B.Right.ClassType);
+  AssertEquals('Correct left expression value','''Something''',TPrimitiveExpr(B.Left).Value);
+  AssertEquals('Correct right expression value',''' else''',TPrimitiveExpr(B.Right).Value);
 end;
 
 procedure TTestResourcestringParser.DoTestSum2;
+var
+  B: TBinaryExpr;
 begin
   ParseResourcestring('''Something''+different');
   CheckExprNameKindClass(pekBinary,TBinaryExpr);
-  AssertEquals('Correct left',TPrimitiveExpr,TBinaryExpr(TheExpr).Left.ClassType);
-  AssertEquals('Correct right',TPrimitiveExpr,TBinaryExpr(TheExpr).Right.ClassType);
-  AssertEquals('Correct left expression value','''Something''',TPrimitiveExpr(TBinaryExpr(TheExpr).Left).Value);
-  AssertEquals('Correct right expression value','different',TPrimitiveExpr(TBinaryExpr(TheExpr).Right).Value);
-
+  B:=TBinaryExpr(TheExpr);
+  TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
+  TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
+  AssertEquals('Correct left',TPrimitiveExpr,B.Left.ClassType);
+  AssertEquals('Correct right',TPrimitiveExpr,B.Right.ClassType);
+  AssertEquals('Correct left expression value','''Something''',TPrimitiveExpr(B.Left).Value);
+  AssertEquals('Correct right expression value','different',TPrimitiveExpr(B.Right).Value);
 end;
 
 procedure TTestResourcestringParser.TestSimple;

+ 1424 - 0
packages/fcl-passrc/tests/tcresolver.pas

@@ -0,0 +1,1424 @@
+{
+  Examples:
+    ./testpassrc --suite=TTestResolver.TestEmpty
+}
+(*
+  CheckReferenceDirectives:
+    {#a} label "a", labels all elements at the following token
+    {@a} reference "a", search at next token for an element e with
+           TResolvedReference(e.CustomData).Declaration points to an element
+           labeled "a".
+    {=a} is "a", search at next token for a TPasAliasType t with t.DestType
+           points to an element labeled "a"
+*)
+unit tcresolver;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, PasTree, PScanner, PParser, PasResolver,
+  tcbaseparser, testregistry, contnrs;
+
+Type
+  TOnFindUnit = function(const aUnitName: String): TPasModule of object;
+
+  { TTestEnginePasResolver }
+
+  TTestEnginePasResolver = class(TPasResolver)
+  private
+    FFilename: string;
+    FModule: TPasModule;
+    FOnFindUnit: TOnFindUnit;
+    FParser: TPasParser;
+    FResolver: TStreamResolver;
+    FScanner: TPascalScanner;
+    FSource: string;
+    procedure SetModule(AValue: TPasModule);
+  public
+    constructor Create;
+    destructor Destroy; override;
+    function FindModule(const AName: String): TPasModule; override;
+    property OnFindUnit: TOnFindUnit read FOnFindUnit write FOnFindUnit;
+    property Filename: string read FFilename write FFilename;
+    property Resolver: TStreamResolver read FResolver write FResolver;
+    property Scanner: TPascalScanner read FScanner write FScanner;
+    property Parser: TPasParser read FParser write FParser;
+    property Source: string read FSource write FSource;
+    property Module: TPasModule read FModule write SetModule;
+  end;
+
+  TTestResolverReferenceData = record
+    Filename: string;
+    Line: integer;
+    StartCol: integer;
+    EndCol: integer;
+    Found: TFPList; // list of TPasElement at this token
+  end;
+  PTestResolverReferenceData = ^TTestResolverReferenceData;
+
+  { TTestResolver }
+
+  TTestResolver = Class(TTestParser)
+  Private
+    FFirstStatement: TPasImplBlock;
+    FModules: TObjectList;// list of TTestEnginePasResolver
+    FPasResolver: TTestEnginePasResolver;
+    function GetModuleCount: integer;
+    function GetModules(Index: integer): TTestEnginePasResolver;
+    function OnPasResolverFindUnit(const aUnitName: String): TPasModule;
+    procedure OnFindReference(Element, FindData: pointer);
+  Protected
+    Procedure SetUp; override;
+    Procedure TearDown; override;
+    procedure CreateEngine(var TheEngine: TPasTreeContainer); override;
+    procedure ParseProgram;
+    procedure ParseUnit;
+    procedure CheckReferenceDirectives;
+  Public
+    function FindModuleWithFilename(aFilename: string): TTestEnginePasResolver;
+    function AddModule(aFilename: string): TTestEnginePasResolver;
+    function AddModuleWithSrc(aFilename, Src: string): TTestEnginePasResolver;
+    function AddModuleWithIntfImplSrc(aFilename, InterfaceSrc,
+      ImplementationSrc: string): TTestEnginePasResolver;
+    procedure AddSystemUnit;
+    procedure StartProgram(NeedSystemUnit: boolean);
+    procedure StartUnit(NeedSystemUnit: boolean);
+    property Modules[Index: integer]: TTestEnginePasResolver read GetModules;
+    property ModuleCount: integer read GetModuleCount;
+  Published
+    Procedure TestEmpty;
+    Procedure TestAliasType;
+    Procedure TestAlias2Type;
+    Procedure TestAliasTypeRefs;
+    Procedure TestVarLongint;
+    Procedure TestVarInteger;
+    Procedure TestConstInteger;
+    Procedure TestPrgAssignment;
+    Procedure TestPrgProcVar;
+    Procedure TestUnitProcVar;
+    Procedure TestForLoop;
+    Procedure TestStatements;
+    Procedure TestCaseStatement;
+    Procedure TestTryStatement;
+    Procedure TestStatementsRefs;
+    Procedure TestUnitRef;
+    Procedure TestProcParam;
+    Procedure TestFunctionResult;
+    Procedure TestProcOverload;
+    Procedure TestProcOverloadRefs;
+    Procedure TestNestedProc;
+    property PasResolver: TTestEnginePasResolver read FPasResolver;
+  end;
+
+function LinesToStr(Args: array of const): string;
+
+implementation
+
+function LinesToStr(Args: array of const): string;
+var
+  s: String;
+  i: Integer;
+begin
+  s:='';
+  for i:=Low(Args) to High(Args) do
+    case Args[i].VType of
+      vtChar:         s += Args[i].VChar+LineEnding;
+      vtString:       s += Args[i].VString^+LineEnding;
+      vtPChar:        s += Args[i].VPChar+LineEnding;
+      vtWideChar:     s += AnsiString(Args[i].VWideChar)+LineEnding;
+      vtPWideChar:    s += AnsiString(Args[i].VPWideChar)+LineEnding;
+      vtAnsiString:   s += AnsiString(Args[i].VAnsiString)+LineEnding;
+      vtWidestring:   s += AnsiString(WideString(Args[i].VWideString))+LineEnding;
+      vtUnicodeString:s += AnsiString(UnicodeString(Args[i].VUnicodeString))+LineEnding;
+    end;
+  Result:=s;
+end;
+
+{ TTestEnginePasResolver }
+
+procedure TTestEnginePasResolver.SetModule(AValue: TPasModule);
+begin
+  if FModule=AValue then Exit;
+  if Module<>nil then
+    Module.Release;
+  FModule:=AValue;
+  if Module<>nil then
+    Module.AddRef;
+end;
+
+constructor TTestEnginePasResolver.Create;
+begin
+  inherited Create;
+  StoreSrcColumns:=true;
+end;
+
+destructor TTestEnginePasResolver.Destroy;
+begin
+  FreeAndNil(FResolver);
+  Module:=nil;
+  FreeAndNil(FParser);
+  FreeAndNil(FScanner);
+  FreeAndNil(FResolver);
+  inherited Destroy;
+end;
+
+function TTestEnginePasResolver.FindModule(const AName: String): TPasModule;
+begin
+  Result:=nil;
+  if Assigned(OnFindUnit) then
+    Result:=OnFindUnit(AName);
+end;
+
+{ TTestResolver }
+
+procedure TTestResolver.SetUp;
+begin
+  FModules:=TObjectList.Create(true);
+  inherited SetUp;
+  Parser.Options:=Parser.Options+[po_resolvestandardtypes];
+end;
+
+procedure TTestResolver.TearDown;
+begin
+  PasResolver.Clear;
+  if FModules<>nil then
+    begin
+    FModules.OwnsObjects:=false;
+    FModules.Remove(PasResolver); // remove reference
+    FModules.OwnsObjects:=true;
+    FreeAndNil(FModules);// free all other modules
+    end;
+  inherited TearDown;
+  FPasResolver:=nil;
+end;
+
+procedure TTestResolver.CreateEngine(var TheEngine: TPasTreeContainer);
+begin
+  FPasResolver:=AddModule(MainFilename);
+  TheEngine:=PasResolver;
+end;
+
+procedure TTestResolver.ParseProgram;
+begin
+  FFirstStatement:=nil;
+  try
+    ParseModule;
+  except
+    on E: EParserError do
+      begin
+      writeln('ERROR: TTestResolver.ParseProgram Parser: '+E.ClassName+':'+E.Message
+        +' File='+Scanner.CurFilename
+        +' LineNo='+IntToStr(Scanner.CurRow)
+        +' Col='+IntToStr(Scanner.CurColumn)
+        +' Line="'+Scanner.CurLine+'"'
+        );
+      raise E;
+      end;
+    on E: EPasResolve do
+      begin
+      writeln('ERROR: TTestResolver.ParseProgram PasResolver: '+E.ClassName+':'+E.Message
+        +' File='+Scanner.CurFilename
+        +' LineNo='+IntToStr(Scanner.CurRow)
+        +' Col='+IntToStr(Scanner.CurColumn)
+        +' Line="'+Scanner.CurLine+'"'
+        );
+      raise E;
+      end;
+    on E: Exception do
+      begin
+      writeln('ERROR: TTestResolver.ParseProgram Exception: '+E.ClassName+':'+E.Message);
+      raise E;
+      end;
+  end;
+  TAssert.AssertSame('Has resolver',PasResolver,Parser.Engine);
+  AssertEquals('Has program',TPasProgram,Module.ClassType);
+  AssertNotNull('Has program section',PasProgram.ProgramSection);
+  AssertNotNull('Has initialization section',PasProgram.InitializationSection);
+  if (PasProgram.InitializationSection.Elements.Count>0) then
+    if TObject(PasProgram.InitializationSection.Elements[0]) is TPasImplBlock then
+      FFirstStatement:=TPasImplBlock(PasProgram.InitializationSection.Elements[0]);
+  CheckReferenceDirectives;
+end;
+
+procedure TTestResolver.ParseUnit;
+begin
+  FFirstStatement:=nil;
+  try
+    ParseModule;
+  except
+    on E: EParserError do
+      begin
+      writeln('ERROR: TTestResolver.ParseUnit Parser: '+E.ClassName+':'+E.Message
+        +' File='+Scanner.CurFilename
+        +' LineNo='+IntToStr(Scanner.CurRow)
+        +' Col='+IntToStr(Scanner.CurColumn)
+        +' Line="'+Scanner.CurLine+'"'
+        );
+      raise E;
+      end;
+    on E: EPasResolve do
+      begin
+      writeln('ERROR: TTestResolver.ParseUnit PasResolver: '+E.ClassName+':'+E.Message
+        +' File='+Scanner.CurFilename
+        +' LineNo='+IntToStr(Scanner.CurRow)
+        +' Col='+IntToStr(Scanner.CurColumn)
+        +' Line="'+Scanner.CurLine+'"'
+        );
+      raise E;
+      end;
+    on E: Exception do
+      begin
+      writeln('ERROR: TTestResolver.ParseUnit Exception: '+E.ClassName+':'+E.Message);
+      raise E;
+      end;
+  end;
+  TAssert.AssertSame('Has resolver',PasResolver,Parser.Engine);
+  AssertEquals('Has unit',TPasModule,Module.ClassType);
+  AssertNotNull('Has interface section',Module.InterfaceSection);
+  AssertNotNull('Has implementation section',Module.ImplementationSection);
+  if (Module.InitializationSection<>nil)
+  and (Module.InitializationSection.Elements.Count>0) then
+    if TObject(Module.InitializationSection.Elements[0]) is TPasImplBlock then
+      FFirstStatement:=TPasImplBlock(Module.InitializationSection.Elements[0]);
+  CheckReferenceDirectives;
+end;
+
+procedure TTestResolver.CheckReferenceDirectives;
+type
+  TMarkerKind = (
+    mkLabel,
+    mkResolverReference,
+    mkDirectReference
+    );
+  PMarker = ^TMarker;
+  TMarker = record
+    Kind: TMarkerKind;
+    Filename: string;
+    LineNumber: integer;
+    StartCol, EndCol: integer; // token start, end column
+    Identifier: string;
+    Next: PMarker;
+  end;
+
+var
+  FirstMarker, LastMarker: PMarker;
+  Filename: string;
+  LineNumber: Integer;
+  SrcLine: String;
+  CommentStartP, CommentEndP: PChar;
+  FoundRefs: TTestResolverReferenceData;
+
+  procedure GetSrc(Index: integer; out SrcLines: TStringList; out aFilename: string);
+  var
+    aStream: TStream;
+  begin
+    SrcLines:=TStringList.Create;
+    aStream:=Resolver.Streams.Objects[Index] as TStream;
+    aStream.Position:=0;
+    SrcLines.LoadFromStream(aStream);
+    aFilename:=Resolver.Streams[Index];
+  end;
+
+  procedure RaiseErrorAt(Msg: string; const aFilename: string; aLine, aCol: integer);
+  var
+    s, SrcFilename: String;
+    i, j: Integer;
+    SrcLines: TStringList;
+  begin
+    // write all source files
+    for i:=0 to Resolver.Streams.Count-1 do
+      begin
+      GetSrc(i,SrcLines,SrcFilename);
+      writeln('Testcode:-File="',SrcFilename,'"----------------------------------:');
+      for j:=1 to SrcLines.Count do
+        writeln(Format('%:4d: ',[j]),SrcLines[j-1]);
+      SrcLines.Free;
+      end;
+    s:=Msg+' at '+aFilename+' line='+IntToStr(aLine)+', col='+IntToStr(aCol);
+    writeln('ERROR: TTestResolver.CheckReferenceDirectives: ',s);
+    raise Exception.Create('TTestResolver.CheckReferenceDirectives: '+s);
+  end;
+
+  procedure RaiseErrorAt(Msg: string; aMarker: PMarker);
+  begin
+    RaiseErrorAt(Msg,aMarker^.Filename,aMarker^.LineNumber,aMarker^.StartCol);
+  end;
+
+  procedure RaiseError(Msg: string; p: PChar);
+  begin
+    RaiseErrorAt(Msg,Filename,LineNumber,p-PChar(SrcLine)+1);
+  end;
+
+  procedure AddMarker(Marker: PMarker);
+  begin
+    if LastMarker<>nil then
+      LastMarker^.Next:=Marker
+    else
+      FirstMarker:=Marker;
+    LastMarker:=Marker;
+  end;
+
+  function AddMarker(Kind: TMarkerKind; const aFilename: string;
+    aLine, aStartCol, aEndCol: integer; const Identifier: string): PMarker;
+  begin
+    New(Result);
+    Result^.Kind:=Kind;
+    Result^.Filename:=aFilename;
+    Result^.LineNumber:=aLine;
+    Result^.StartCol:=aStartCol;
+    Result^.EndCol:=aEndCol;
+    Result^.Identifier:=Identifier;
+    Result^.Next:=nil;
+    //writeln('AddMarker Line="',SrcLine,'" Identifier=',Identifier,' Col=',aStartCol,'-',aEndCol,' "',copy(SrcLine,aStartCol,aEndCol-aStartCol),'"');
+    AddMarker(Result);
+  end;
+
+  function AddMarkerForTokenBehindComment(Kind: TMarkerKind;
+    const Identifer: string): PMarker;
+  var
+    TokenStart, p: PChar;
+  begin
+    p:=CommentEndP;
+    ReadNextPascalToken(p,TokenStart,false,false);
+    Result:=AddMarker(Kind,Filename,LineNumber,
+      CommentEndP-PChar(SrcLine)+1,p-PChar(SrcLine)+1,Identifer);
+  end;
+
+  function FindLabel(const Identifier: string): PMarker;
+  begin
+    Result:=FirstMarker;
+    while Result<>nil do
+      begin
+      if (Result^.Kind=mkLabel)
+      and (CompareText(Result^.Identifier,Identifier)=0) then
+        exit;
+      Result:=Result^.Next;
+      end;
+  end;
+
+  function ReadIdentifier(var p: PChar): string;
+  var
+    StartP: PChar;
+  begin
+    if not (p^ in ['a'..'z','A'..'Z','_']) then
+      RaiseError('identifier expected',p);
+    StartP:=p;
+    inc(p);
+    while p^ in ['a'..'z','A'..'Z','_','0'..'9'] do inc(p);
+    SetLength(Result,p-StartP);
+    Move(StartP^,Result[1],length(Result));
+  end;
+
+  procedure AddLabel;
+  var
+    Identifier: String;
+    p: PChar;
+  begin
+    p:=CommentStartP+2;
+    Identifier:=ReadIdentifier(p);
+    //writeln('TTestResolver.CheckReferenceDirectives.AddLabel ',Identifier);
+    if FindLabel(Identifier)<>nil then
+      RaiseError('duplicate label "'+Identifier+'"',p);
+    AddMarkerForTokenBehindComment(mkLabel,Identifier);
+  end;
+
+  procedure AddResolverReference;
+  var
+    Identifier: String;
+    p: PChar;
+  begin
+    p:=CommentStartP+2;
+    Identifier:=ReadIdentifier(p);
+    //writeln('TTestResolver.CheckReferenceDirectives.AddReference ',Identifier);
+    AddMarkerForTokenBehindComment(mkResolverReference,Identifier);
+  end;
+
+  procedure AddDirectReference;
+  var
+    Identifier: String;
+    p: PChar;
+  begin
+    p:=CommentStartP+2;
+    Identifier:=ReadIdentifier(p);
+    //writeln('TTestResolver.CheckReferenceDirectives.AddPointer ',Identifier);
+    AddMarkerForTokenBehindComment(mkDirectReference,Identifier);
+  end;
+
+  procedure ParseCode(SrcLines: TStringList; aFilename: string);
+  var
+    p: PChar;
+    IsDirective: Boolean;
+  begin
+    //writeln('TTestResolver.CheckReferenceDirectives.ParseCode File=',aFilename);
+    Filename:=aFilename;
+    // parse code, find all labels
+    LineNumber:=0;
+    while LineNumber<SrcLines.Count do
+      begin
+      inc(LineNumber);
+      SrcLine:=SrcLines[LineNumber-1];
+      if SrcLine='' then continue;
+      //writeln('TTestResolver.CheckReferenceDirectives Line=',SrcLine);
+      p:=PChar(SrcLine);
+      repeat
+        case p^ of
+          #0: if (p-PChar(SrcLine)=length(SrcLine)) then break;
+          '{':
+            begin
+            CommentStartP:=p;
+            inc(p);
+            IsDirective:=p^ in ['#','@','='];
+
+            // skip to end of comment
+            repeat
+              case p^ of
+              #0:
+                if (p-PChar(SrcLine)=length(SrcLine)) then
+                  begin
+                  // multi line comment
+                  if IsDirective then
+                    RaiseError('directive missing closing bracket',CommentStartP);
+                  repeat
+                    inc(LineNumber);
+                    if LineNumber>SrcLines.Count then exit;
+                    SrcLine:=SrcLines[LineNumber-1];
+                    //writeln('TTestResolver.CheckReferenceDirectives Comment Line=',SrcLine);
+                  until SrcLine<>'';
+                  p:=PChar(SrcLine);
+                  continue;
+                  end;
+              '}':
+                begin
+                inc(p);
+                break;
+                end;
+              end;
+              inc(p);
+            until false;
+
+            CommentEndP:=p;
+            case CommentStartP[1] of
+            '#': AddLabel;
+            '@': AddResolverReference;
+            '=': AddDirectReference;
+            end;
+            p:=CommentEndP;
+            continue;
+
+            end;
+          '/':
+            if p[1]='/' then
+              break; // rest of line is comment -> skip
+        end;
+        inc(p);
+      until false;
+      end;
+  end;
+
+  function FindElementsAt(aFilename: string; aLine, aStartCol, aEndCol: integer): TFPList;
+  var
+    ok: Boolean;
+  begin
+    FoundRefs.Filename:=aFilename;
+    FoundRefs.Line:=aLine;
+    FoundRefs.StartCol:=aStartCol;
+    FoundRefs.EndCol:=aEndCol;
+    FoundRefs.Found:=TFPList.Create;
+    ok:=false;
+    try
+      Module.ForEachCall(@OnFindReference,@FoundRefs);
+      ok:=true;
+    finally
+      if not ok then
+        FreeAndNil(FoundRefs.Found);
+    end;
+    Result:=FoundRefs.Found;
+    FoundRefs.Found:=nil;
+  end;
+
+  procedure CheckResolverReference(aMarker: PMarker);
+  // check if one element at {@a} has a TResolvedReference to an element labeled {#a}
+  var
+    aLabel: PMarker;
+    ReferenceElements, LabelElements: TFPList;
+    i, j, aLine, aCol: Integer;
+    El, LabelEl: TPasElement;
+    Ref: TResolvedReference;
+  begin
+    //writeln('CheckReference searching reference: ',aMarker^.Filename,' Line=',aMarker^.LineNumber,' Col=',aMarker^.StartCol,'-',aMarker^.EndCol,' Label="',aMarker^.Identifier,'"');
+    aLabel:=FindLabel(aMarker^.Identifier);
+    if aLabel=nil then
+      RaiseErrorAt('label "'+aMarker^.Identifier+'" not found',aMarker^.Filename,aMarker^.LineNumber,aMarker^.StartCol);
+
+    LabelElements:=nil;
+    ReferenceElements:=nil;
+    try
+      LabelElements:=FindElementsAt(aLabel^.Filename,aLabel^.LineNumber,aLabel^.StartCol,aLabel^.EndCol);
+      if LabelElements.Count=0 then
+        RaiseErrorAt('label "'+aLabel^.Identifier+'" has no elements',aLabel);
+
+      ReferenceElements:=FindElementsAt(aMarker^.Filename,aMarker^.LineNumber,aMarker^.StartCol,aMarker^.EndCol);
+      if ReferenceElements.Count=0 then
+        RaiseErrorAt('reference "'+aMarker^.Identifier+'" has no elements',aMarker);
+
+      for i:=0 to ReferenceElements.Count-1 do
+        begin
+        El:=TPasElement(ReferenceElements[i]);
+        if El.CustomData is TResolvedReference then
+          begin
+          Ref:=TResolvedReference(El.CustomData);
+          for j:=0 to LabelElements.Count-1 do
+            begin
+            LabelEl:=TPasElement(LabelElements[j]);
+            if Ref.Declaration=LabelEl then
+              exit; // success
+            end;
+          end;
+        end;
+
+      // failure write candidates
+      for i:=0 to ReferenceElements.Count-1 do
+        begin
+        El:=TPasElement(ReferenceElements[i]);
+        write('Reference candidate for "',aMarker^.Identifier,'" at reference ',aMarker^.Filename,'(',aMarker^.LineNumber,',',aMarker^.StartCol,'-',aMarker^.EndCol,')');
+        write(' El=',GetObjName(El));
+        if El.CustomData is TResolvedReference then
+          begin
+          Ref:=TResolvedReference(El.CustomData);
+          write(' Decl=',GetObjName(Ref.Declaration));
+          PasResolver.UnmangleSourceLineNumber(Ref.Declaration.SourceLinenumber,aLine,aCol);
+          write(Ref.Declaration.SourceFilename,'(',aLine,',',aCol,')');
+          end
+        else
+          write(' has no TResolvedReference');
+        writeln;
+        end;
+      for i:=0 to LabelElements.Count-1 do
+        begin
+        El:=TPasElement(LabelElements[i]);
+        write('Label candidate for "',aLabel^.Identifier,'" at reference ',aLabel^.Filename,'(',aLabel^.LineNumber,',',aLabel^.StartCol,'-',aLabel^.EndCol,')');
+        write(' El=',GetObjName(El));
+        writeln;
+        end;
+
+      RaiseErrorAt('wrong resolved reference "'+aMarker^.Identifier+'"',aMarker);
+    finally
+      LabelElements.Free;
+      ReferenceElements.Free;
+    end;
+  end;
+
+  procedure CheckDirectReference(aMarker: PMarker);
+  // check if one element at {=a} is a TPasAliasType pointing to an element labeled {#a}
+  var
+    aLabel: PMarker;
+    ReferenceElements: TFPList;
+    i, LabelLine, LabelCol: Integer;
+    El: TPasElement;
+    DeclEl: TPasType;
+  begin
+    //writeln('CheckPointer searching pointer: ',aMarker^.Filename,' Line=',aMarker^.LineNumber,' Col=',aMarker^.StartCol,'-',aMarker^.EndCol,' Label="',aMarker^.Identifier,'"');
+    aLabel:=FindLabel(aMarker^.Identifier);
+    if aLabel=nil then
+      RaiseErrorAt('label "'+aMarker^.Identifier+'" not found',aMarker^.Filename,aMarker^.LineNumber,aMarker^.StartCol);
+
+    ReferenceElements:=nil;
+    try
+      ReferenceElements:=FindElementsAt(aMarker^.Filename,aMarker^.LineNumber,aMarker^.StartCol,aMarker^.EndCol);
+      if ReferenceElements.Count=0 then
+        RaiseErrorAt('reference "'+aMarker^.Identifier+'" has no elements',aMarker);
+
+      for i:=0 to ReferenceElements.Count-1 do
+        begin
+        El:=TPasElement(ReferenceElements[i]);
+        if El.ClassType=TPasAliasType then
+          begin
+          DeclEl:=TPasAliasType(El).DestType;
+          PasResolver.UnmangleSourceLineNumber(DeclEl.SourceLinenumber,LabelLine,LabelCol);
+          if (aLabel^.Filename=DeclEl.SourceFilename)
+          and (aLabel^.LineNumber=LabelLine)
+          and (aLabel^.StartCol<=LabelCol)
+          and (aLabel^.EndCol>=LabelCol) then
+            exit; // success
+          writeln('CheckDirectReference Decl at ',DeclEl.SourceFilename,'(',LabelLine,',',LabelCol,')');
+          RaiseErrorAt('wrong direct reference "'+aMarker^.Identifier+'"',aMarker);
+          end;
+        end;
+    finally
+    end;
+
+  end;
+
+var
+  aMarker: PMarker;
+  i: Integer;
+  SrcLines: TStringList;
+begin
+  FirstMarker:=nil;
+  LastMarker:=nil;
+  FoundRefs:=Default(TTestResolverReferenceData);
+  try
+    // find all markers
+    for i:=0 to Resolver.Streams.Count-1 do
+      begin
+      GetSrc(i,SrcLines,Filename);
+      ParseCode(SrcLines,Filename);
+      SrcLines.Free;
+      end;
+
+    // check references
+    aMarker:=FirstMarker;
+    while aMarker<>nil do
+      begin
+      case aMarker^.Kind of
+      mkResolverReference: CheckResolverReference(aMarker);
+      mkDirectReference: CheckDirectReference(aMarker);
+      end;
+      aMarker:=aMarker^.Next;
+      end;
+
+  finally
+    while FirstMarker<>nil do
+      begin
+      aMarker:=FirstMarker;
+      FirstMarker:=FirstMarker^.Next;
+      Dispose(aMarker);
+      end;
+  end;
+end;
+
+function TTestResolver.FindModuleWithFilename(aFilename: string
+  ): TTestEnginePasResolver;
+var
+  i: Integer;
+begin
+  for i:=0 to ModuleCount-1 do
+    if CompareText(Modules[i].Filename,aFilename)=0 then
+      exit(Modules[i]);
+  Result:=nil;
+end;
+
+function TTestResolver.AddModule(aFilename: string): TTestEnginePasResolver;
+begin
+  //writeln('TTestResolver.AddModule ',aFilename);
+  if FindModuleWithFilename(aFilename)<>nil then
+    raise Exception.Create('TTestResolver.AddModule: file "'+aFilename+'" already exists');
+  Result:=TTestEnginePasResolver.Create;
+  Result.Filename:=aFilename;
+  Result.AddObjFPCBuiltInIdentifiers;
+  Result.OnFindUnit:=@OnPasResolverFindUnit;
+  FModules.Add(Result);
+end;
+
+function TTestResolver.AddModuleWithSrc(aFilename, Src: string
+  ): TTestEnginePasResolver;
+begin
+  Result:=AddModule(aFilename);
+  Result.Source:=Src;
+end;
+
+function TTestResolver.AddModuleWithIntfImplSrc(aFilename, InterfaceSrc,
+  ImplementationSrc: string): TTestEnginePasResolver;
+var
+  Src: String;
+begin
+  Src:='unit '+ExtractFileUnitName(aFilename)+';'+LineEnding;
+  Src+=LineEnding;
+  Src+='interface'+LineEnding;
+  Src+=LineEnding;
+  Src+=InterfaceSrc;
+  Src+='implementation'+LineEnding;
+  Src+=LineEnding;
+  Src+=ImplementationSrc;
+  Src+='end.'+LineEnding;
+  Result:=AddModuleWithSrc(aFilename,Src);
+end;
+
+procedure TTestResolver.AddSystemUnit;
+begin
+  AddModuleWithIntfImplSrc('system.pp',
+    // interface
+    LinesToStr([
+    'type',
+    '  integer=longint;',
+    '  sizeint=int64;',
+    //'const',
+    //'  LineEnding = #10;',
+    //'  DirectorySeparator = ''/'';',
+    //'  DriveSeparator = '''';',
+    //'  AllowDirectorySeparators : set of char = [''\'',''/''];',
+    //'  AllowDriveSeparators : set of char = [];',
+    'var',
+    '  ExitCode: Longint;',
+    //'Procedure Move(const source;var dest;count:SizeInt);',
+    ''
+    // implementation
+    ]),LinesToStr([
+   // 'Procedure Move(const source;var dest;count:SizeInt);',
+   // 'begin',
+   // 'end;',
+    ''
+    ]));
+end;
+
+procedure TTestResolver.StartProgram(NeedSystemUnit: boolean);
+begin
+  if NeedSystemUnit then
+    AddSystemUnit
+  else
+    Parser.ImplicitUses.Clear;
+  Add('program '+ExtractFileUnitName(MainFilename)+';');
+end;
+
+procedure TTestResolver.StartUnit(NeedSystemUnit: boolean);
+begin
+  if NeedSystemUnit then
+    AddSystemUnit
+  else
+    Parser.ImplicitUses.Clear;
+  Add('unit '+ExtractFileUnitName(MainFilename)+';');
+end;
+
+function TTestResolver.OnPasResolverFindUnit(const aUnitName: String
+  ): TPasModule;
+var
+  i: Integer;
+  CurEngine: TTestEnginePasResolver;
+  CurUnitName: String;
+begin
+  //writeln('TTestResolver.OnPasResolverFindUnit START Unit="',aUnitName,'"');
+  Result:=nil;
+  for i:=0 to ModuleCount-1 do
+    begin
+    CurEngine:=Modules[i];
+    CurUnitName:=ExtractFileUnitName(CurEngine.Filename);
+    //writeln('TTestResolver.OnPasResolverFindUnit Checking ',i,'/',ModuleCount,' ',CurEngine.Filename,' ',CurUnitName);
+    if CompareText(aUnitName,CurUnitName)=0 then
+      begin
+      Result:=CurEngine.Module;
+      if Result<>nil then exit;
+      //writeln('TTestResolver.OnPasResolverFindUnit PARSING unit "',CurEngine.Filename,'"');
+      Resolver.FindSourceFile(aUnitName);
+
+      CurEngine.Resolver:=TStreamResolver.Create;
+      CurEngine.Resolver.OwnsStreams:=True;
+      //writeln('TTestResolver.OnPasResolverFindUnit SOURCE=',CurEngine.Source);
+      CurEngine.Resolver.AddStream(CurEngine.FileName,TStringStream.Create(CurEngine.Source));
+      CurEngine.Scanner:=TPascalScanner.Create(CurEngine.Resolver);
+      CurEngine.Parser:=TPasParser.Create(CurEngine.Scanner,CurEngine.Resolver,CurEngine);
+      if CompareText(CurUnitName,'System')=0 then
+        CurEngine.Parser.ImplicitUses.Clear;
+      CurEngine.Scanner.OpenFile(CurEngine.Filename);
+      try
+        CurEngine.Parser.NextToken;
+        CurEngine.Parser.ParseUnit(CurEngine.FModule);
+      except
+        on E: Exception do
+          begin
+          writeln('ERROR: TTestResolver.OnPasResolverFindUnit during parsing: '+E.ClassName+':'+E.Message
+            +' File='+CurEngine.Scanner.CurFilename
+            +' LineNo='+IntToStr(CurEngine.Scanner.CurRow)
+            +' Col='+IntToStr(CurEngine.Scanner.CurColumn)
+            +' Line="'+CurEngine.Scanner.CurLine+'"'
+            );
+          raise E;
+          end;
+      end;
+      //writeln('TTestResolver.OnPasResolverFindUnit END ',CurUnitName);
+      Result:=CurEngine.Module;
+      exit;
+      end;
+    end;
+  writeln('TTestResolver.OnPasResolverFindUnit missing unit "',aUnitName,'"');
+  raise Exception.Create('can''t find unit "'+aUnitName+'"');
+end;
+
+procedure TTestResolver.OnFindReference(Element, FindData: pointer);
+var
+  El: TPasElement absolute Element;
+  Data: PTestResolverReferenceData absolute FindData;
+  Line, Col: integer;
+begin
+  PasResolver.UnmangleSourceLineNumber(El.SourceLinenumber,Line,Col);
+  //writeln('TTestResolver.OnFindReference ',GetObjName(El),' ',El.SourceFilename,' Line=',Line,',Col=',Col,' SearchFile=',Data^.Filename,',Line=',Data^.Line,',Col=',Data^.StartCol,'-',Data^.EndCol);
+  if (Data^.Filename=El.SourceFilename)
+  and (Data^.Line=Line)
+  and (Data^.StartCol<=Col)
+  and (Data^.EndCol>=Col)
+  then
+    Data^.Found.Add(El);
+end;
+
+function TTestResolver.GetModules(Index: integer): TTestEnginePasResolver;
+begin
+  Result:=TTestEnginePasResolver(FModules[Index]);
+end;
+
+function TTestResolver.GetModuleCount: integer;
+begin
+  Result:=FModules.Count;
+end;
+
+procedure TTestResolver.TestEmpty;
+begin
+  StartProgram(false);
+  Add('begin');
+  ParseProgram;
+  AssertEquals('No statements',0,PasProgram.InitializationSection.Elements.Count);
+end;
+
+procedure TTestResolver.TestAliasType;
+var
+  El: TPasElement;
+  T: TPasAliasType;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  tint=longint;');
+  Add('begin');
+  ParseProgram;
+  AssertEquals('1 declaration',1,PasProgram.ProgramSection.Declarations.Count);
+  El:=TPasElement(PasProgram.ProgramSection.Declarations[0]);
+  AssertEquals('Type',TPasAliasType,El.ClassType);
+  T:=TPasAliasType(El);
+  AssertEquals('Type tint','tint',T.Name);
+  AssertEquals('Type built-in',TPasUnresolvedSymbolRef,T.DestType.ClassType);
+  AssertEquals('longint type','longint',lowercase(T.DestType.Name));
+end;
+
+procedure TTestResolver.TestAlias2Type;
+var
+  El: TPasElement;
+  T1, T2: TPasAliasType;
+  DestT1, DestT2: TPasType;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  tint1=longint;');
+  Add('  tint2=tint1;');
+  Add('begin');
+  ParseProgram;
+  AssertEquals('2 declaration',2,PasProgram.ProgramSection.Declarations.Count);
+
+  El:=TPasElement(PasProgram.ProgramSection.Declarations[0]);
+  AssertEquals('Type',TPasAliasType,El.ClassType);
+  T1:=TPasAliasType(El);
+  AssertEquals('Type tint1','tint1',T1.Name);
+  DestT1:=T1.DestType;
+  AssertEquals('built-in',TPasUnresolvedSymbolRef,DestT1.ClassType);
+  AssertEquals('built-in longint','longint',lowercase(DestT1.Name));
+
+  El:=TPasElement(PasProgram.ProgramSection.Declarations[1]);
+  AssertEquals('Type',TPasAliasType,El.ClassType);
+  T2:=TPasAliasType(El);
+  AssertEquals('Type tint2','tint2',T2.Name);
+  DestT2:=T2.DestType;
+  AssertEquals('points to alias type',TPasAliasType,DestT2.ClassType);
+  AssertEquals('points to tint1','tint1',DestT2.Name);
+end;
+
+procedure TTestResolver.TestAliasTypeRefs;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#a}a=longint;');
+  Add('  {#b}{=a}b=a;');
+  Add('var');
+  Add('  {=a}c: a;');
+  Add('  {=b}d: b;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestVarLongint;
+var
+  El: TPasElement;
+  V1: TPasVariable;
+  DestT1: TPasType;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  v1:longint;');
+  Add('begin');
+  ParseProgram;
+  AssertEquals('1 declaration',1,PasProgram.ProgramSection.Declarations.Count);
+
+  El:=TPasElement(PasProgram.ProgramSection.Declarations[0]);
+  AssertEquals('var',TPasVariable,El.ClassType);
+  V1:=TPasVariable(El);
+  AssertEquals('var v1','v1',V1.Name);
+  DestT1:=V1.VarType;
+  AssertEquals('built-in',TPasUnresolvedSymbolRef,DestT1.ClassType);
+  AssertEquals('built-in longint','longint',lowercase(DestT1.Name));
+end;
+
+procedure TTestResolver.TestVarInteger;
+var
+  El: TPasElement;
+  V1: TPasVariable;
+  DestT1: TPasType;
+begin
+  StartProgram(true);
+  Add('var');
+  Add('  v1:integer;'); // defined in system.pp
+  Add('begin');
+  ParseProgram;
+  AssertEquals('1 declaration',1,PasProgram.ProgramSection.Declarations.Count);
+
+  El:=TPasElement(PasProgram.ProgramSection.Declarations[0]);
+  AssertEquals('var',TPasVariable,El.ClassType);
+  V1:=TPasVariable(El);
+  AssertEquals('var v1','v1',V1.Name);
+  DestT1:=V1.VarType;
+  AssertNotNull('v1 type',DestT1);
+  AssertEquals('built-in',TPasAliasType,DestT1.ClassType);
+  AssertEquals('built-in integer','integer',DestT1.Name);
+  AssertNull('v1 no expr',V1.Expr);
+end;
+
+procedure TTestResolver.TestConstInteger;
+var
+  El: TPasElement;
+  C1: TPasConst;
+  DestT1: TPasType;
+  ExprC1: TPrimitiveExpr;
+begin
+  StartProgram(true);
+  Add('const');
+  Add('  c1:integer=3;'); // defined in system.pp
+  Add('begin');
+  ParseProgram;
+  AssertEquals('1 declaration',1,PasProgram.ProgramSection.Declarations.Count);
+
+  El:=TPasElement(PasProgram.ProgramSection.Declarations[0]);
+  AssertEquals('const',TPasConst,El.ClassType);
+  C1:=TPasConst(El);
+  AssertEquals('const c1','c1',C1.Name);
+  DestT1:=C1.VarType;
+  AssertNotNull('c1 type',DestT1);
+  AssertEquals('built-in',TPasAliasType,DestT1.ClassType);
+  AssertEquals('built-in integer','integer',DestT1.Name);
+  ExprC1:=TPrimitiveExpr(C1.Expr);
+  AssertNotNull('c1 expr',ExprC1);
+  AssertEquals('c1 expr primitive',TPrimitiveExpr,ExprC1.ClassType);
+  AssertEquals('c1 expr value','3',ExprC1.Value);
+end;
+
+procedure TTestResolver.TestPrgAssignment;
+var
+  El: TPasElement;
+  V1: TPasVariable;
+  ImplAssign: TPasImplAssign;
+  Ref1: TPrimitiveExpr;
+  Resolver1: TResolvedReference;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  v1:longint;');
+  Add('begin');
+  Add('  v1:=3;');
+  ParseProgram;
+  AssertEquals('1 declaration',1,PasProgram.ProgramSection.Declarations.Count);
+
+  El:=TPasElement(PasProgram.ProgramSection.Declarations[0]);
+  AssertEquals('var',TPasVariable,El.ClassType);
+  V1:=TPasVariable(El);
+  AssertEquals('var v1','v1',V1.Name);
+
+  AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
+  AssertEquals('Assignment statement',TPasImplAssign,FFirstStatement.ClassType);
+  ImplAssign:=FFirstStatement as TPasImplAssign;
+  AssertEquals('Normal assignment',akDefault,ImplAssign.Kind);
+  AssertExpression('Right side is constant',ImplAssign.Right,pekNumber,'3');
+  AssertExpression('Left side is variable',ImplAssign.Left,pekIdent,'v1');
+  AssertEquals('Left side is variable, primitive',TPrimitiveExpr,ImplAssign.Left.ClassType);
+  Ref1:=TPrimitiveExpr(ImplAssign.Left);
+  AssertNotNull('variable has customdata',Ref1.CustomData);
+  AssertEquals('variable has resolver',TResolvedReference,Ref1.CustomData.ClassType);
+  Resolver1:=TResolvedReference(Ref1.CustomData);
+  AssertSame('variable resolver element',Resolver1.Element,Ref1);
+  AssertSame('variable resolver declaration v1',Resolver1.Declaration,V1);
+end;
+
+procedure TTestResolver.TestPrgProcVar;
+begin
+  StartProgram(false);
+  Add('procedure Proc1;');
+  Add('type');
+  Add('  t1=longint;');
+  Add('var');
+  Add('  v1:t1;');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  ParseProgram;
+  AssertEquals('1 declaration',1,PasProgram.ProgramSection.Declarations.Count);
+end;
+
+procedure TTestResolver.TestUnitProcVar;
+var
+  El: TPasElement;
+  IntfProc1, ImplProc1: TPasProcedure;
+  IntfType1, ProcSubType1: TPasAliasType;
+  ImplVar1, ProcSubVar1: TPasVariable;
+  ImplVar1Type, ProcSubVar1Type: TPasType;
+begin
+  StartUnit(false);
+  Add('interface');
+  Add('');
+  Add('type t1=string; // unit scope');
+  Add('procedure Proc1;');
+  Add('');
+  Add('implementation');
+  Add('');
+  Add('procedure Proc1;');
+  Add('type t1=longint; // local proc scope');
+  Add('var  v1:t1; // using local t1');
+  Add('begin');
+  Add('end;');
+  Add('var  v2:t1; // using interface t1');
+  ParseUnit;
+
+  // interface
+  AssertEquals('2 intf declarations',2,Module.InterfaceSection.Declarations.Count);
+  El:=TPasElement(Module.InterfaceSection.Declarations[0]);
+  AssertEquals('intf type',TPasAliasType,El.ClassType);
+  IntfType1:=TPasAliasType(El);
+  AssertEquals('intf type t1','t1',IntfType1.Name);
+
+  El:=TPasElement(Module.InterfaceSection.Declarations[1]);
+  AssertEquals('intf proc',TPasProcedure,El.ClassType);
+  IntfProc1:=TPasProcedure(El);
+  AssertEquals('intf proc Proc1','Proc1',IntfProc1.Name);
+
+  // implementation
+  AssertEquals('2 impl declarations',2,Module.ImplementationSection.Declarations.Count);
+  El:=TPasElement(Module.ImplementationSection.Declarations[0]);
+  AssertEquals('impl proc',TPasProcedure,El.ClassType);
+  ImplProc1:=TPasProcedure(El);
+  AssertEquals('impl proc Proc1','Proc1',ImplProc1.Name);
+
+  El:=TPasElement(Module.ImplementationSection.Declarations[1]);
+  AssertEquals('impl var',TPasVariable,El.ClassType);
+  ImplVar1:=TPasVariable(El);
+  AssertEquals('impl var v2','v2',ImplVar1.Name);
+  ImplVar1Type:=TPasType(ImplVar1.VarType);
+  AssertSame('impl var type is intf t1',IntfType1,ImplVar1Type);
+
+  // proc
+  AssertEquals('2 proc sub declarations',2,ImplProc1.Body.Declarations.Count);
+
+  // proc sub type t1
+  El:=TPasElement(ImplProc1.Body.Declarations[0]);
+  AssertEquals('proc sub type',TPasAliasType,El.ClassType);
+  ProcSubType1:=TPasAliasType(El);
+  AssertEquals('proc sub type t1','t1',ProcSubType1.Name);
+
+  // proc sub var v1
+  El:=TPasElement(ImplProc1.Body.Declarations[1]);
+  AssertEquals('proc sub var',TPasVariable,El.ClassType);
+  ProcSubVar1:=TPasVariable(El);
+  AssertEquals('proc sub var v1','v1',ProcSubVar1.Name);
+  ProcSubVar1Type:=TPasType(ProcSubVar1.VarType);
+  AssertSame('proc sub var type is proc sub t1',ProcSubType1,ProcSubVar1Type);
+end;
+
+procedure TTestResolver.TestForLoop;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  {#v1}v1,{#v2}v2,{#v3}v3:longint;');
+  Add('begin');
+  Add('  for {@v1}v1:=');
+  Add('    {@v2}v2');
+  Add('    to {@v3}v3 do ;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestStatements;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  v1,v2,v3:longint;');
+  Add('begin');
+  Add('  v1:=1;');
+  Add('  v2:=v1+v1*v1+v1 div v1;');
+  Add('  v3:=-v1;');
+  Add('  repeat');
+  Add('    v1:=v1+1;');
+  Add('  until v1>=5;');
+  Add('  while v1>=0 do');
+  Add('    v1:=v1-v2;');
+  Add('  for v1:=v2 to v3 do v2:=v1;');
+  Add('  if v1<v2 then v3:=v1 else v3:=v2;');
+  ParseProgram;
+  AssertEquals('3 declarations',3,PasProgram.ProgramSection.Declarations.Count);
+end;
+
+procedure TTestResolver.TestCaseStatement;
+begin
+  StartProgram(false);
+  Add('const');
+  Add('  {#c1}c1=1;');
+  Add('  {#c2}c2=1;');
+  Add('var');
+  Add('  {#v1}v1,{#v2}v2,{#v3}v3:longint;');
+  Add('begin');
+  Add('  Case {@v1}v1+{@v2}v2 of');
+  Add('  {@c1}c1:');
+  Add('    {@v2}v2:={@v3}v3;');
+  Add('  {@c1}c1,{@c2}c2: ;');
+  Add('  {@c1}c1..{@c2}c2: ;');
+  Add('  {@c1}c1+{@c2}c2: ;');
+  Add('  else');
+  Add('    {@v1}v1:=3;');
+  Add('  end;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestTryStatement;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#Exec}Exception = longint;');
+  Add('var');
+  Add('  {#v1}v1,{#e1}e:longint;');
+  Add('begin');
+  Add('  try');
+  Add('    {@v1}v1:={@e1}e;');
+  Add('  finally');
+  Add('    {@v1}v1:={@e1}e;');
+  Add('  end');
+  Add('  try');
+  Add('    {@v1}v1:={@e1}e;');
+  Add('  except');
+  Add('    {@v1}v1:={@e1}e;');
+  Add('  end');
+  Add('  try');
+  Add('    {@v1}v1:={@e1}e;');
+  Add('  except');
+  Add('    on {#e2}E: {@Exec}Exception do');
+  Add('      if {@e2}e=nil then ;');
+  Add('    on {#e3}E: {@Exec}Exception do');
+  Add('      raise {@e3}e;');
+  Add('    else');
+  Add('      {@v1}v1:={@e1}e;');
+  Add('  end');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestStatementsRefs;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  {#v1}v1,{#v2}v2,{#v3}v3:longint;');
+  Add('begin');
+  Add('  {@v1}v1:=1;');
+  Add('  {@v2}v2:=');
+  Add('    {@v1}v1+');
+  Add('    {@v1}v1*{@v1}v1');
+  Add('    +{@v1}v1 div {@v1}v1;');
+  Add('  {@v3}v3:=');
+  Add('    -{@v1}v1;');
+  Add('  repeat');
+  Add('    {@v1}v1:=');
+  Add('      {@v1}v1+1;');
+  Add('  until {@v1}v1>=5;');
+  Add('  while {@v1}v1>=0 do');
+  Add('    {@v1}v1');
+  Add('    :={@v1}v1-{@v2}v2;');
+  Add('  if {@v1}v1<{@v2}v2 then');
+  Add('    {@v3}v3:={@v1}v1');
+  Add('  else {@v3}v3:=');
+  Add('    {@v2}v2;');
+  ParseProgram;
+  AssertEquals('3 declarations',3,PasProgram.ProgramSection.Declarations.Count);
+end;
+
+procedure TTestResolver.TestUnitRef;
+var
+  El, DeclEl, OtherUnit: TPasElement;
+  LocalVar: TPasVariable;
+  Assign1, Assign2, Assign3: TPasImplAssign;
+  Prim1, Prim2: TPrimitiveExpr;
+  BinExp: TBinaryExpr;
+begin
+  StartUnit(true);
+  Add('interface');
+  Add('var exitCOde: string;');
+  Add('implementation');
+  Add('initialization');
+  Add('  ExitcodE:=''3'';');
+  Add('  afile.eXitCode:=3;');
+  Add('  System.exiTCode:=3;');
+  ParseUnit;
+
+  // interface
+  AssertEquals('1 intf declaration',1,Module.InterfaceSection.Declarations.Count);
+  El:=TPasElement(Module.InterfaceSection.Declarations[0]);
+  AssertEquals('local var',TPasVariable,El.ClassType);
+  LocalVar:=TPasVariable(El);
+  AssertEquals('local var exitcode','exitCOde',LocalVar.Name);
+
+  // initialization
+  AssertEquals('3 initialization statements',3,Module.InitializationSection.Elements.Count);
+
+  // check direct assignment to local var
+  El:=TPasElement(Module.InitializationSection.Elements[0]);
+  AssertEquals('direct assign',TPasImplAssign,El.ClassType);
+  Assign1:=TPasImplAssign(El);
+  AssertEquals('direct assign left',TPrimitiveExpr,Assign1.left.ClassType);
+  Prim1:=TPrimitiveExpr(Assign1.left);
+  AssertNotNull(Prim1.CustomData);
+  AssertEquals('direct assign left ref',TResolvedReference,Prim1.CustomData.ClassType);
+  DeclEl:=TResolvedReference(Prim1.CustomData).Declaration;
+  AssertSame('direct assign local var',LocalVar,DeclEl);
+
+  // check indirect assignment to local var: "afile.eXitCode"
+  El:=TPasElement(Module.InitializationSection.Elements[1]);
+  AssertEquals('indirect assign',TPasImplAssign,El.ClassType);
+  Assign2:=TPasImplAssign(El);
+  AssertEquals('indirect assign left',TBinaryExpr,Assign2.left.ClassType);
+  BinExp:=TBinaryExpr(Assign2.left);
+  AssertEquals('indirect assign first token',TPrimitiveExpr,BinExp.left.ClassType);
+  Prim1:=TPrimitiveExpr(BinExp.left);
+  AssertEquals('indirect assign first token','afile',Prim1.Value);
+  AssertNotNull(Prim1.CustomData);
+  AssertEquals('indirect assign unit ref resolved',TResolvedReference,Prim1.CustomData.ClassType);
+  DeclEl:=TResolvedReference(Prim1.CustomData).Declaration;
+  AssertSame('indirect assign unit ref',Module,DeclEl);
+
+  AssertEquals('indirect assign dot',eopSubIdent,BinExp.OpCode);
+
+  AssertEquals('indirect assign second token',TPrimitiveExpr,BinExp.right.ClassType);
+  Prim2:=TPrimitiveExpr(BinExp.right);
+  AssertEquals('indirect assign second token','eXitCode',Prim2.Value);
+  AssertNotNull(Prim2.CustomData);
+  AssertEquals('indirect assign var ref resolved',TResolvedReference,Prim2.CustomData.ClassType);
+  AssertEquals('indirect assign left ref',TResolvedReference,Prim2.CustomData.ClassType);
+  DeclEl:=TResolvedReference(Prim2.CustomData).Declaration;
+  AssertSame('indirect assign local var',LocalVar,DeclEl);
+
+  // check assignment to "system.ExitCode"
+  El:=TPasElement(Module.InitializationSection.Elements[2]);
+  AssertEquals('other unit assign',TPasImplAssign,El.ClassType);
+  Assign3:=TPasImplAssign(El);
+  AssertEquals('other unit assign left',TBinaryExpr,Assign3.left.ClassType);
+  BinExp:=TBinaryExpr(Assign3.left);
+  AssertEquals('othe unit assign first token',TPrimitiveExpr,BinExp.left.ClassType);
+  Prim1:=TPrimitiveExpr(BinExp.left);
+  AssertEquals('other unit assign first token','System',Prim1.Value);
+  AssertNotNull(Prim1.CustomData);
+  AssertEquals('other unit assign unit ref resolved',TResolvedReference,Prim1.CustomData.ClassType);
+  DeclEl:=TResolvedReference(Prim1.CustomData).Declaration;
+  OtherUnit:=DeclEl;
+  AssertEquals('other unit assign unit ref',TPasModule,DeclEl.ClassType);
+  AssertEquals('other unit assign unit ref system','system',lowercase(DeclEl.Name));
+
+  AssertEquals('other unit assign dot',eopSubIdent,BinExp.OpCode);
+
+  AssertEquals('other unit assign second token',TPrimitiveExpr,BinExp.right.ClassType);
+  Prim2:=TPrimitiveExpr(BinExp.right);
+  AssertEquals('other unit assign second token','exiTCode',Prim2.Value);
+  AssertNotNull(Prim2.CustomData);
+  AssertEquals('other unit assign var ref resolved',TResolvedReference,Prim2.CustomData.ClassType);
+  AssertEquals('other unit assign left ref',TResolvedReference,Prim2.CustomData.ClassType);
+  DeclEl:=TResolvedReference(Prim2.CustomData).Declaration;
+  AssertEquals('other unit assign var',TPasVariable,DeclEl.ClassType);
+  AssertEquals('other unit assign var exitcode','exitcode',lowercase(DeclEl.Name));
+  AssertSame('other unit assign var exitcode',OtherUnit,DeclEl.GetModule);
+end;
+
+procedure TTestResolver.TestProcParam;
+begin
+  StartProgram(false);
+  Add('procedure Proc1(a: longint);');
+  Add('begin');
+  Add('  a:=3;');
+  Add('end;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestFunctionResult;
+begin
+  StartProgram(false);
+  Add('function Func1: longint;');
+  Add('begin');
+  Add('  Result:=3;');
+  Add('end;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcOverload;
+var
+  El: TPasElement;
+begin
+  StartProgram(false);
+  Add('function Func1(i: longint; j: longint = 0): longint; overload;');
+  Add('begin');
+  Add('  Result:=1;');
+  Add('end;');
+  Add('function Func1(s: string): longint; overload;');
+  Add('begin');
+  Add('  Result:=2;');
+  Add('end;');
+  Add('begin');
+  Add('  Func1(3);');
+  ParseProgram;
+  AssertEquals('1 declarations',1,PasProgram.ProgramSection.Declarations.Count);
+
+  El:=TPasElement(PasProgram.ProgramSection.Declarations[0]);
+  AssertEquals('overloaded proc',TPasOverloadedProc,El.ClassType);
+
+  AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
+end;
+
+procedure TTestResolver.TestProcOverloadRefs;
+begin
+  StartProgram(false);
+  Add('function {#A}Func1(i: longint; j: longint = 0): longint; overload;');
+  Add('begin');
+  Add('  Result:=1;');
+  Add('end;');
+  Add('function {#B}Func1(s: string): longint; overload;');
+  Add('begin');
+  Add('  Result:=2;');
+  Add('end;');
+  Add('begin');
+  Add('  {@A}Func1(3);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestNestedProc;
+begin
+  StartProgram(false);
+  Add('function DoIt({#a1}a,{#d1}d: longint): longint;');
+  Add('var');
+  Add('  {#b1}b: longint;');
+  Add('  {#c1}c: longint;');
+  Add('  function {#Nesty1}Nesty({#a2}a: longint): longint; ');
+  Add('  var {#b2}b: longint;');
+  Add('  begin');
+  Add('    Result:={@a2}a');
+  Add('      +{@b2}b');
+  Add('      +{@c1}c');
+  Add('      +{@d1}d;');
+  Add('  end;');
+  Add('begin');
+  Add('  Result:={@a1}a');
+  Add('      +{@b1}b');
+  Add('      +{@c1}c;');
+  Add('end;');
+  Add('begin');
+  ParseProgram;
+end;
+
+initialization
+  RegisterTests([TTestResolver]);
+
+end.
+

+ 0 - 3
packages/fcl-passrc/tests/tcscanner.pas

@@ -1381,9 +1381,6 @@ begin
   AssertEQuals('Correct identifier', 'somethingweird',LastIdentifier);
 end;
 
-
-
-
 initialization
   RegisterTests([TTestTokenFinder,TTestStreamLineReader,TTestScanner]);
 end.

+ 10 - 9
packages/fcl-passrc/tests/tcstatements.pas

@@ -121,7 +121,7 @@ procedure TTestStatementParser.AddStatements(ASource: array of string);
 Var
   I :Integer;
 begin
-  StartProgram('afile');
+  StartProgram(ExtractFileUnitName(MainFilename));
   if FVariables.Count>0 then
     begin
     Add('Var');
@@ -369,9 +369,10 @@ begin
   S:=Statement as TPasImplSimple;
   AssertExpression('Doit call',S.Expr,pekBinary,TBinaryExpr);
   B:=S.Expr as TBinaryExpr;
+  TAssert.AssertSame('B.left.Parent=B',B,B.left.Parent);
+  TAssert.AssertSame('B.right.Parent=B',B,B.right.Parent);
   AssertExpression('Unit name',B.Left,pekIdent,'Unita');
   AssertExpression('Doit call',B.Right,pekIdent,'Doit');
-
 end;
 
 procedure TTestStatementParser.TestCallQualified2;
@@ -662,7 +663,7 @@ begin
   DeclareVar('integer');
   TestStatement(['For a:=1 to 10 do',';']);
   F:=AssertStatement('For statement',TPasImplForLoop) as TPasImplForLoop;
-  AssertEquals('Loop variable name','a',F.VariableName);
+  AssertExpression('Loop variable name',F.VariableName,pekIdent,'a');
   AssertEquals('Loop type',ltNormal,F.Looptype);
   AssertEquals('Up loop',False,F.Down);
   AssertExpression('Start value',F.StartExpr,pekNumber,'1');
@@ -679,7 +680,7 @@ begin
   DeclareVar('integer');
   TestStatement(['For a in SomeSet Do',';']);
   F:=AssertStatement('For statement',TPasImplForLoop) as TPasImplForLoop;
-  AssertEquals('Loop variable name','a',F.VariableName);
+  AssertExpression('Loop variable name',F.VariableName,pekIdent,'a');
   AssertEquals('Loop type',ltIn,F.Looptype);
   AssertEquals('In loop',False,F.Down);
   AssertExpression('Start value',F.StartExpr,pekIdent,'SomeSet');
@@ -696,7 +697,7 @@ begin
   DeclareVar('integer');
   TestStatement(['For a:=1+1 to 5+5 do',';']);
   F:=AssertStatement('For statement',TPasImplForLoop) as TPasImplForLoop;
-  AssertEquals('Loop variable name','a',F.VariableName);
+  AssertExpression('Loop variable name',F.VariableName,pekIdent,'a');
   AssertEquals('Up loop',False,F.Down);
   AssertExpression('Start expression',F.StartExpr,pekBinary,TBinaryExpr);
   B:=F.StartExpr as TBinaryExpr;
@@ -718,7 +719,7 @@ begin
   DeclareVar('integer');
   TestStatement(['For a:=1 to 10 do','begin','end']);
   F:=AssertStatement('For statement',TPasImplForLoop) as TPasImplForLoop;
-  AssertEquals('Loop variable name','a',F.VariableName);
+  AssertExpression('Loop variable name',F.VariableName,pekIdent,'a');
   AssertEquals('Up loop',False,F.Down);
   AssertExpression('Start value',F.StartExpr,pekNumber,'1');
   AssertExpression('End value',F.EndExpr,pekNumber,'10');
@@ -736,7 +737,7 @@ begin
   DeclareVar('integer');
   TestStatement(['For a:=10 downto 1 do','begin','end']);
   F:=AssertStatement('For statement',TPasImplForLoop) as TPasImplForLoop;
-  AssertEquals('Loop variable name','a',F.VariableName);
+  AssertExpression('Loop variable name',F.VariableName,pekIdent,'a');
   AssertEquals('Down loop',True,F.Down);
   AssertExpression('Start value',F.StartExpr,pekNumber,'10');
   AssertExpression('End value',F.EndExpr,pekNumber,'1');
@@ -754,14 +755,14 @@ begin
   DeclareVar('integer','b');
   TestStatement(['For a:=1 to 10 do','For b:=11 to 20 do','begin','end']);
   F:=AssertStatement('For statement',TPasImplForLoop) as TPasImplForLoop;
-  AssertEquals('Loop variable name','a',F.VariableName);
+  AssertExpression('Loop variable name',F.VariableName,pekIdent,'a');
   AssertEquals('Up loop',False,F.Down);
   AssertExpression('Start value',F.StartExpr,pekNumber,'1');
   AssertExpression('End value',F.EndExpr,pekNumber,'10');
   AssertNotNull('Have while body',F.Body);
   AssertEquals('begin end block',TPasImplForLoop,F.Body.ClassType);
   F:=F.Body as TPasImplForLoop;
-  AssertEquals('Loop variable name','b',F.VariableName);
+  AssertExpression('Loop variable name',F.VariableName,pekIdent,'b');
   AssertEquals('Up loop',False,F.Down);
   AssertExpression('Start value',F.StartExpr,pekNumber,'11');
   AssertExpression('End value',F.EndExpr,pekNumber,'20');

+ 10 - 1
packages/fcl-passrc/tests/tctypeparser.pas

@@ -695,6 +695,8 @@ begin
   AssertNotNull('have right expr', B.Right);
   AssertEquals('argument right expr type', TPrimitiveExpr, B.right.ClassType);
   AssertEquals('argument right expr value', '2', TPrimitiveExpr(B.right).Value);
+  TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
+  TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
 end;
 
 procedure TTestProcedureTypeParser.DoTestProcedureOneArgDefaultSet(
@@ -1744,6 +1746,7 @@ procedure TTestRecordTypeParser.TestTwoFieldPrivateNoDelphi;
 Var
   EC : TClass;
 begin
+  EC:=nil;
   try
     TestFields(['private','x : integer'],'',False);
     Fail('Need po_Delphi for visibility specifier');
@@ -1759,16 +1762,22 @@ end;
 procedure TTestRecordTypeParser.TestTwoFieldProtected;
 Var
   B : Boolean;
+  EName: String;
 begin
+  B:=false;
+  EName:='';
   try
     TestFields(['protected','x : integer'],'',False);
     Fail('Protected not allowed as record visibility specifier')
   except
     on E : Exception do
+      begin
+      EName:=E.ClassName;
       B:=E is EParserError;
+      end;
   end;
   If not B then
-    Fail('Wrong exception class.');
+    Fail('Wrong exception class "'+EName+'".');
 end;
 
 procedure TTestRecordTypeParser.TestTwoFieldPrivate;

+ 5 - 1
packages/fcl-passrc/tests/testpassrc.lpi

@@ -38,7 +38,7 @@
         <PackageName Value="FCL"/>
       </Item1>
     </RequiredPackages>
-    <Units Count="12">
+    <Units Count="13">
       <Unit0>
         <Filename Value="testpassrc.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -87,6 +87,10 @@
         <Filename Value="tcpassrcutil.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit11>
+      <Unit12>
+        <Filename Value="tcresolver.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit12>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

+ 1 - 1
packages/fcl-passrc/tests/testpassrc.lpr

@@ -5,7 +5,7 @@ program testpassrc;
 uses
   Classes, consoletestrunner, tcscanner, tctypeparser, tcstatements,
   tcbaseparser, tcmoduleparser, tconstparser, tcvarparser, tcclasstype,
-  tcexprparser, tcprocfunc, tcpassrcutil;
+  tcexprparser, tcprocfunc, tcpassrcutil, tcresolver;
 
 type
 

File diff suppressed because it is too large
+ 340 - 181
packages/pastojs/src/fppas2js.pp


+ 11 - 9
packages/pastojs/tests/tcconverter.pp

@@ -63,6 +63,8 @@ type
     Class Function CreateCondition: TPasExpr;
   end;
 
+  { TTestTestConverter }
+
   TTestTestConverter = class(TTestConverter)
   published
     procedure TestEmpty;
@@ -584,7 +586,7 @@ begin
   AssertNull('No second statement',L.B);
   L:=AssertListStatement('try..except block is statement list',El.BCatch);
   AssertAssignStatement('Correct assignment in except..end block',L.A,'b','c');
-  AssertEquals('Correct exception object name',DefaultJSExceptionObject,El.Ident);
+  AssertEquals('Correct exception object name',lowercase(DefaultJSExceptionObject),El.Ident);
   AssertNull('No second statement',L.B);
 end;
 
@@ -621,18 +623,18 @@ begin
   O.Body:=CreateAssignStatement('b','c');
   // Convert
   El:=TJSTryFinallyStatement(Convert(T,TJSTryCatchStatement));
-  AssertEquals('Correct exception object name',DefaultJSExceptionObject,EL.Ident);
+  AssertEquals('Correct exception object name',lowercase(DefaultJSExceptionObject),EL.Ident);
   L:=AssertListStatement('try..except block is statement list',El.BCatch);
   AssertNull('No second statement',L.B);
   I:=TJSIfStatement(AssertElement('On block is if',TJSIfStatement,L.A));
   Ic:=TJSRelationalExpressionInstanceOf(AssertElement('If condition is InstanceOf expression',TJSRelationalExpressionInstanceOf,I.Cond));
-  Assertidentifier('InstanceOf left is exception object',Ic.A,DefaultJSExceptionObject);
+  Assertidentifier('InstanceOf left is exception object',Ic.A,lowercase(DefaultJSExceptionObject));
   // Lowercased exception - May need checking
   Assertidentifier('InstanceOf right is original exception type',Ic.B,'exception');
   L:=AssertListStatement('On block is always a list',i.btrue);
   V:=TJSVarDeclaration(AssertElement('First statement in list is a var declaration',TJSVarDeclaration,L.A));
   AssertEquals('Variable name is identifier in On A : Ex do','e',V.Name);
-  Assertidentifier('Variable init is exception object',v.init,DefaultJSExceptionObject);
+  Assertidentifier('Variable init is exception object',v.init,lowercase(DefaultJSExceptionObject));
   L:=AssertListStatement('Second statement is again list',L.B);
   AssertAssignStatement('Original assignment in second statement',L.A,'b','c');
 end;
@@ -669,20 +671,20 @@ begin
   O.Body:=TPasImplRaise.Create('',Nil);
   // Convert
   El:=TJSTryFinallyStatement(Convert(T,TJSTryCatchStatement));
-  AssertEquals('Correct exception object name',DefaultJSExceptionObject,EL.Ident);
+  AssertEquals('Correct exception object name',lowercase(DefaultJSExceptionObject),EL.Ident);
   L:=AssertListStatement('try..except block is statement list',El.BCatch);
   AssertNull('No second statement',L.B);
   I:=TJSIfStatement(AssertElement('On block is if',TJSIfStatement,L.A));
   Ic:=TJSRelationalExpressionInstanceOf(AssertElement('If condition is InstanceOf expression',TJSRelationalExpressionInstanceOf,I.Cond));
-  Assertidentifier('InstanceOf left is exception object',Ic.A,DefaultJSExceptionObject);
+  Assertidentifier('InstanceOf left is exception object',Ic.A,lowercase(DefaultJSExceptionObject));
   // Lowercased exception - May need checking
   L:=AssertListStatement('On block is always a list',i.btrue);
   V:=TJSVarDeclaration(AssertElement('First statement in list is a var declaration',TJSVarDeclaration,L.A));
   AssertEquals('Variable name is identifier in On A : Ex do','e',V.Name);
-  Assertidentifier('Variable init is exception object',v.init,DefaultJSExceptionObject);
+  Assertidentifier('Variable init is exception object',v.init,lowercase(DefaultJSExceptionObject));
   L:=AssertListStatement('Second statement is again list',L.B);
   R:=TJSThrowStatement(AssertElement('On block is throw statement',TJSThrowStatement,L.A));
-  Assertidentifier('R expression is original exception ',R.A,DefaultJSExceptionObject);
+  Assertidentifier('R expression is original exception ',R.A,lowercase(DefaultJSExceptionObject));
 end;
 
 Procedure TTestStatementConverter.TestVariableStatement;
@@ -1206,7 +1208,7 @@ Function TTestConverter.Convert(AElement: TPasElement; AClass: TJSElementClass
   ): TJSElement;
 begin
   FSource:=AElement;
-  Result:=FConverter.ConvertElement(AElement);
+  Result:=FConverter.ConvertPasElement(AElement,nil);
   FRes:=Result;
   if (AClass<>Nil) then
     begin

Some files were not shown because too many files changed in this diff