Browse Source

* Patch from Mattias Gaertner:
pasresolver.pp: new unit, implements TPasResolver, already supports simple
types, vars, const, arguments, some expressions, calls and used units.

tcresolver: testing TPasResolver,

pastree: fixed some Free with Release calls, added comments, added ForEachCall methods.

pscanner: added option po_resolvestandardtypes. Making built-in types configurable.

pparser: added FinishScope, fixed some Free calls with Release, check proc default values, fixed some typos

Updated tests.

fppas2js: property UseLowerCase to choose between lowercase and declaration case (default true),
using TResolver data, added msg strings, improved error handling, added converter contexts,
function results, local vars, unit vars

git-svn-id: trunk@34357 -

michael 9 years ago
parent
commit
0ab6477081

+ 2 - 0
.gitattributes

@@ -2559,6 +2559,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/test_parser.pp svneol=native#text/plain
 packages/fcl-passrc/examples/testunit1.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/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/passrcutil.pp svneol=native#text/plain
 packages/fcl-passrc/src/pastounittest.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
 packages/fcl-passrc/src/pastree.pp svneol=native#text/plain
@@ -2573,6 +2574,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/tconstparser.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcpassrcutil.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/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/tcscanner.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcstatements.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
 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('pastree');
           AddUnit('pscanner');
           AddUnit('pscanner');
         end;
         end;
+    T:=P.Targets.AddUnit('pasresolver.pp');
+      with T.Dependencies do
+        begin
+          AddUnit('pastree');
+          AddUnit('pscanner');
+          AddUnit('pparser');
+        end;
     T.ResourceStrings := True;
     T.ResourceStrings := True;
     T:=P.Targets.AddUnit('pastounittest.pp');
     T:=P.Targets.AddUnit('pastounittest.pp');
       with T.Dependencies do
       with T.Dependencies do

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

@@ -0,0 +1,2280 @@
+{
+    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
+
+ ToDo:
+  - spot duplicates
+  - check if types only refer types
+  - check if constant is longint or int64
+  - built-in functions
+  - enums, propagate to parent scopes
+  - records
+  - arrays
+  - pointer
+  - untyped parameters
+  - ranges
+  - sets
+  - forwards of ^pointer and class of - must be queued and resolved at end of type section
+  - with
+  - classes
+  - interfaces
+  - properties
+    - read
+    - write
+    - index properties
+  - default property
+  - 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
+  - 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)
+  public
+  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 FinishModule;
+    procedure FinishUsesList;
+    procedure FinishTypeSection;
+    procedure FinishProcedure;
+    procedure FinishProcedureHeader;
+    procedure ResolveImplBlock(Block: TPasImplBlock);
+    procedure ResolveImplElement(El: TPasImplElement);
+    procedure ResolveImplCaseOf(CaseOf: TPasImplCaseOf);
+    procedure ResolveImplForLoop(Loop: TPasImplForLoop);
+    procedure ResolveExpr(El: TPasExpr);
+    procedure ResolveBinaryExpr(El: TBinaryExpr);
+    procedure ResolveSubIdent(El: TBinaryExpr);
+    procedure ResolveParamsExpr(Params: TParamsExpr);
+    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 StartProcedureBody(El: TProcedureBody);
+    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 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.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=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
+    begin
+    ResolveExpr(TPasImplExceptOn(El).VarExpr);
+    ResolveExpr(TPasImplExceptOn(El).TypeExpr);
+    ResolveImplElement(TPasImplExceptOn(El).Body);
+    end
+  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;
+  Stat: TPasImplCaseStatement;
+begin
+  ResolveExpr(CaseOf.CaseExpr);
+  for i:=0 to CaseOf.Elements.Count-1 do
+    begin
+    Stat:=TPasImplCaseStatement(CaseOf.Elements[i]);
+    for j:=0 to Stat.Expressions.Count-1 do
+      ResolveExpr(TPasExpr(Stat.Expressions[j]));
+    ResolveImplElement(Stat.Body);
+    end;
+  ResolveImplBlock(CaseOf.ElseBranch);
+end;
+
+procedure TPasResolver.ResolveImplForLoop(Loop: TPasImplForLoop);
+var
+  DeclEl: TPasElement;
+begin
+  DeclEl:=FindFirstElement(Loop.VariableName,Loop);
+  //writeln('TPasResolver.ResolveImplForLoop Ref=',GetObjName(Loop)+' Decl='+GetObjName(DeclEl));
+  CreateReference(DeclEl,Loop);
+  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.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.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
+  SrcFile: String;
+  aScanner: TPascalScanner;
+  SrcY, SrcX: Integer;
+  El: TPasElement;
+begin
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.CreateElement ',AClass.ClassName,' Name=',AName,' Parent=',GetObjName(AParent));
+  {$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));
+
+  // get source position for good error messages
+  aScanner:=CurrentParser.Scanner;
+  SrcFile:=ASourceFilename;
+  SrcY:=ASourceLinenumber;
+  if (SrcFile='') or StoreSrcColumns then
+    begin
+    SrcFile:=aScanner.CurFilename;
+    SrcY:=aScanner.CurRow;
+    end;
+  if SrcFile='' then
+    RaiseInternalError('TPasResolver.CreateElement missing filename');
+  if StoreSrcColumns then
+    begin
+    SrcX:=aScanner.CurColumn;
+    if (SrcX<ParserMaxEmbeddedColumn) and (SrcY<ParserMaxEmbeddedRow) then
+      SrcY:=-(SrcY*ParserMaxEmbeddedColumn+SrcX);
+    end;
+
+  // create element
+  El:=AClass.Create(AName,AParent);
+  FLastElement:=El;
+  Result:=FLastElement;
+  El.Visibility:=AVisibility;
+  El.SourceFilename:=SrcFile;
+  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.InheritsFrom(TPasImplBlock) 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;
+  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;
+begin
+  if RefEl.CustomData<>nil then
+    raise EPasResolve.Create('TPasResolver.CreateReference customdata<>nil');
+  {$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');
+  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
+ 393 - 106
packages/fcl-passrc/src/pastree.pp


+ 194 - 123
packages/fcl-passrc/src/pparser.pp

@@ -71,6 +71,7 @@ const
   nParserGenericArray1Element = 2044;
   nParserGenericArray1Element = 2044;
   nParserGenericClassOrArray = 2045;
   nParserGenericClassOrArray = 2045;
   nParserDuplicateIdentifier = 2046;
   nParserDuplicateIdentifier = 2046;
+  nParserDefaultParameterRequiredFor = 2047;
 
 
 
 
 // resourcestring patterns of messages
 // resourcestring patterns of messages
@@ -121,8 +122,23 @@ resourcestring
   SParserGenericArray1Element = 'Generic arrays can have only 1 template element';
   SParserGenericArray1Element = 'Generic arrays can have only 1 template element';
   SParserGenericClassOrArray = 'Generic can only be used with classes or arrays';
   SParserGenericClassOrArray = 'Generic can only be used with classes or arrays';
   SParserDuplicateIdentifier = 'Duplicate identifier "%s"';
   SParserDuplicateIdentifier = 'Duplicate identifier "%s"';
+  SParserDefaultParameterRequiredFor = 'Default parameter required for "%s"';
 
 
 type
 type
+  TPasScopeType = (
+    stModule,  // e.g. unit, program, library
+    stUsesList,
+    stTypeSection,
+    stTypeDef, // e.g. the B in 'type A=B;'
+    //stConstDef, // e.g. the B in 'const A=B;'
+    stProcedure, // also method, procedure, constructor, destructor, ...
+    stProcedureHeader
+    //stDeclaration, // e.g. the A in 'type A=B;'
+    //stStatement,
+    //stAncestors // the list of ancestors and interfaces of a class
+    );
+  TPasScopeTypes = set of TPasScopeType;
+
   TPasParserLogHandler = Procedure (Sender : TObject; Const Msg : String) of object;
   TPasParserLogHandler = Procedure (Sender : TObject; Const Msg : String) of object;
   TPParserLogEvent = (pleInterface,pleImplementation);
   TPParserLogEvent = (pleInterface,pleImplementation);
   TPParserLogEvents = set of TPParserLogEvent;
   TPParserLogEvents = set of TPParserLogEvent;
@@ -140,6 +156,7 @@ type
   protected
   protected
     FPackage: TPasPackage;
     FPackage: TPasPackage;
     FInterfaceOnly : Boolean;
     FInterfaceOnly : Boolean;
+    procedure SetCurrentParser(AValue: TPasParser); virtual;
   public
   public
     function CreateElement(AClass: TPTreeElement; const AName: String;
     function CreateElement(AClass: TPTreeElement; const AName: String;
       AParent: TPasElement; const ASourceFilename: String;
       AParent: TPasElement; const ASourceFilename: String;
@@ -152,14 +169,15 @@ type
       UseParentAsResultParent: Boolean; const ASourceFilename: String;
       UseParentAsResultParent: Boolean; const ASourceFilename: String;
       ASourceLinenumber: Integer): TPasFunctionType;
       ASourceLinenumber: Integer): TPasFunctionType;
     function FindElement(const AName: String): TPasElement; virtual; abstract;
     function FindElement(const AName: String): TPasElement; virtual; abstract;
+    procedure FinishScope(ScopeType: TPasScopeType); virtual;
     function FindModule(const AName: String): TPasModule; virtual;
     function FindModule(const AName: String): TPasModule; virtual;
     property Package: TPasPackage read FPackage;
     property Package: TPasPackage read FPackage;
     property InterfaceOnly : Boolean Read FInterfaceOnly Write FInterFaceOnly;
     property InterfaceOnly : Boolean Read FInterfaceOnly Write FInterFaceOnly;
-    Property ScannerLogEvents : TPScannerLogEvents Read FScannerLogEvents Write FScannerLogEvents;
-    Property ParserLogEvents : TPParserLogEvents Read FPParserLogEvents Write FPParserLogEvents;
-    Property OnLog : TPasParserLogHandler Read FOnLog Write FOnLog;
-    Property CurrentParser : TPasParser Read FCurrentParser;
-    Property NeedComments : Boolean Read FNeedComments Write FNeedComments;
+    property ScannerLogEvents : TPScannerLogEvents Read FScannerLogEvents Write FScannerLogEvents;
+    property ParserLogEvents : TPParserLogEvents Read FPParserLogEvents Write FPParserLogEvents;
+    property OnLog : TPasParserLogHandler Read FOnLog Write FOnLog;
+    property CurrentParser : TPasParser Read FCurrentParser Write SetCurrentParser;
+    property NeedComments : Boolean Read FNeedComments Write FNeedComments;
   end;
   end;
 
 
   EParserError = class(Exception)
   EParserError = class(Exception)
@@ -233,7 +251,9 @@ type
     procedure ParseClassMembers(AType: TPasClassType);
     procedure ParseClassMembers(AType: TPasClassType);
     procedure ProcessMethod(AType: TPasClassType; IsClass : Boolean; AVisibility : TPasMemberVisibility);
     procedure ProcessMethod(AType: TPasClassType; IsClass : Boolean; AVisibility : TPasMemberVisibility);
     procedure ReadGenericArguments(List : TFPList;Parent : TPasElement);
     procedure ReadGenericArguments(List : TFPList;Parent : TPasElement);
-    function CheckProcedureArgs(Parent: TPasElement; Args: TFPList; Mandatory: Boolean): boolean;
+    function CheckProcedureArgs(Parent: TPasElement;
+      Args: TFPList; // list of TPasArgument
+      Mandatory: Boolean): boolean;
     function CheckVisibility(S: String; var AVisibility: TPasMemberVisibility): Boolean;
     function CheckVisibility(S: String; var AVisibility: TPasMemberVisibility): Boolean;
     procedure ParseExc(MsgNumber: integer; const Msg: String);
     procedure ParseExc(MsgNumber: integer; const Msg: String);
     procedure ParseExc(MsgNumber: integer; const Fmt: String; Args : Array of const);
     procedure ParseExc(MsgNumber: integer; const Fmt: String; Args : Array of const);
@@ -332,7 +352,9 @@ type
     procedure ParseProcBeginBlock(Parent: TProcedureBody);
     procedure ParseProcBeginBlock(Parent: TProcedureBody);
     // Function/Procedure declaration
     // Function/Procedure declaration
     function  ParseProcedureOrFunctionDecl(Parent: TPasElement; ProcType: TProcType;AVisibility : TPasMemberVisibility = VisDefault): TPasProcedure;
     function  ParseProcedureOrFunctionDecl(Parent: TPasElement; ProcType: TProcType;AVisibility : TPasMemberVisibility = VisDefault): TPasProcedure;
-    procedure ParseArgList(Parent: TPasElement; Args: TFPList; EndToken: TToken);
+    procedure ParseArgList(Parent: TPasElement;
+      Args: TFPList; // list of TPasArgument
+      EndToken: TToken);
     procedure ParseProcedureOrFunctionHeader(Parent: TPasElement; Element: TPasProcedureType; ProcType: TProcType; OfObjectPossible: Boolean);
     procedure ParseProcedureOrFunctionHeader(Parent: TPasElement; Element: TPasProcedureType; ProcType: TProcType; OfObjectPossible: Boolean);
     procedure ParseProcedureBody(Parent: TPasElement);
     procedure ParseProcedureBody(Parent: TPasElement);
     // Properties for external access
     // Properties for external access
@@ -586,6 +608,12 @@ end;
   TPasTreeContainer
   TPasTreeContainer
   ---------------------------------------------------------------------}
   ---------------------------------------------------------------------}
 
 
+procedure TPasTreeContainer.SetCurrentParser(AValue: TPasParser);
+begin
+  if FCurrentParser=AValue then Exit;
+  FCurrentParser:=AValue;
+end;
+
 function TPasTreeContainer.CreateElement(AClass: TPTreeElement;
 function TPasTreeContainer.CreateElement(AClass: TPTreeElement;
   const AName: String; AParent: TPasElement; const ASourceFilename: String;
   const AName: String; AParent: TPasElement; const ASourceFilename: String;
   ASourceLinenumber: Integer): TPasElement;
   ASourceLinenumber: Integer): TPasElement;
@@ -613,6 +641,11 @@ begin
     ASourceFilename, ASourceLinenumber));
     ASourceFilename, ASourceLinenumber));
 end;
 end;
 
 
+procedure TPasTreeContainer.FinishScope(ScopeType: TPasScopeType);
+begin
+  if ScopeType=stModule then ;
+end;
+
 function TPasTreeContainer.FindModule(const AName: String): TPasModule;
 function TPasTreeContainer.FindModule(const AName: String): TPasModule;
 begin
 begin
   if AName='' then ;
   if AName='' then ;
@@ -677,7 +710,7 @@ begin
   FCommentsBuffer[1]:=TStringList.Create;
   FCommentsBuffer[1]:=TStringList.Create;
   if Assigned(FEngine) then
   if Assigned(FEngine) then
     begin
     begin
-    FEngine.FCurrentParser:=Self;
+    FEngine.CurrentParser:=Self;
     If FEngine.NeedComments then
     If FEngine.NeedComments then
       FScanner.SkipComments:=Not FEngine.NeedComments;
       FScanner.SkipComments:=Not FEngine.NeedComments;
     end;
     end;
@@ -687,11 +720,14 @@ end;
 
 
 destructor TPasParser.Destroy;
 destructor TPasParser.Destroy;
 begin
 begin
+  if Assigned(FEngine) then
+    begin
+    FEngine.CurrentParser:=Nil;
+    FEngine:=nil;
+    end;
   FreeAndNil(FImplicitUses);
   FreeAndNil(FImplicitUses);
   FreeAndNil(FCommentsBuffer[0]);
   FreeAndNil(FCommentsBuffer[0]);
   FreeAndNil(FCommentsBuffer[1]);
   FreeAndNil(FCommentsBuffer[1]);
-  if Assigned(FEngine) then
-    FEngine.FCurrentParser:=Nil;
   inherited Destroy;
   inherited Destroy;
 end;
 end;
 
 
@@ -934,9 +970,11 @@ function TPasParser.ParseStringType(Parent: TPasElement; const TypeName: String
 
 
 Var
 Var
   S : String;
   S : String;
+  ok: Boolean;
 
 
 begin
 begin
   Result := TPasAliasType(CreateElement(TPasAliasType, TypeName, Parent));
   Result := TPasAliasType(CreateElement(TPasAliasType, TypeName, Parent));
+  ok:=false;
   try
   try
     If (Result.Name='') then
     If (Result.Name='') then
       Result.Name:='string';
       Result.Name:='string';
@@ -953,11 +991,12 @@ begin
       end
       end
     else
     else
       UngetToken;
       UngetToken;
-    Result.DestType:=TPasStringType(CreateElement(TPasStringType,'string',Nil));
+    Result.DestType:=TPasStringType(CreateElement(TPasStringType,'string',Parent));
     TPasStringType(Result.DestType).LengthExpr:=S;
     TPasStringType(Result.DestType).LengthExpr:=S;
-  except
-    FreeAndNil(Result);
-    Raise;
+    ok:=true;
+  finally
+    if not ok then
+      FreeAndNil(Result);
   end;
   end;
 end;
 end;
 
 
@@ -986,8 +1025,13 @@ begin
     begin
     begin
     if (CurToken=tkSemicolon) or isCurTokenHint then // Type A = B;
     if (CurToken=tkSemicolon) or isCurTokenHint then // Type A = B;
       K:=stkAlias
       K:=stkAlias
-    else if (CurToken=tkSquaredBraceOpen) then // Type A = String[12];
-      K:=stkString
+    else if (CurToken=tkSquaredBraceOpen) then
+      begin
+      if ((LowerCase(Name)='string') or (LowerCase(Name)='ansistring')) then // Type A = String[12];
+        K:=stkString
+      else
+        ParseExcSyntaxError;
+      end
     else // Type A = A..B;
     else // Type A = A..B;
       K:=stkRange;
       K:=stkRange;
     UnGetToken;
     UnGetToken;
@@ -1001,7 +1045,7 @@ begin
     begin
     begin
     UnGetToken;
     UnGetToken;
     K:=stkAlias;
     K:=stkAlias;
-    if (LowerCase(Name)='string') then
+    if (not (po_resolvestandardtypes in Options)) and (LowerCase(Name)='string') then
       K:=stkString;
       K:=stkString;
     end;
     end;
   Case K of
   Case K of
@@ -1017,11 +1061,11 @@ begin
     stkAlias:
     stkAlias:
       begin
       begin
       Ref:=Nil;
       Ref:=Nil;
-      SS:=isSimpleTypeToken(Name);
+      SS:=(not (po_resolvestandardtypes in FOptions)) and isSimpleTypeToken(Name);
       if not SS then
       if not SS then
         Ref:=Engine.FindElement(Name);
         Ref:=Engine.FindElement(Name);
       if (Ref=Nil) then
       if (Ref=Nil) then
-        Ref:=TPasUnresolvedTypeRef(CreateElement(TPasUnresolvedTypeRef,Name,Nil))
+        Ref:=TPasUnresolvedTypeRef(CreateElement(TPasUnresolvedTypeRef,Name,Parent))
       else
       else
         Ref.AddRef;
         Ref.AddRef;
       if isFull then
       if isFull then
@@ -1107,7 +1151,7 @@ begin
     ExpectToken(tkOf);
     ExpectToken(tkOf);
     Result.EnumType := ParseType(Result,'',False);
     Result.EnumType := ParseType(Result,'',False);
   except
   except
-    Result.Free;
+    Result.Release;
     raise;
     raise;
   end;
   end;
 end;
 end;
@@ -1308,7 +1352,7 @@ begin
     NextToken;
     NextToken;
     Result:=params;
     Result:=params;
   finally
   finally
-    if not Assigned(Result) then params.Free;
+    if not Assigned(Result) then params.Release;
   end;
   end;
 end;
 end;
 
 
@@ -1374,7 +1418,7 @@ begin
         b:=CreateBinaryExpr(AParent,Last, DoParseExpression(AParent), eopNone);
         b:=CreateBinaryExpr(AParent,Last, DoParseExpression(AParent), eopNone);
         if not Assigned(b.right) then
         if not Assigned(b.right) then
           begin
           begin
-          B.Free;
+          B.Release;
           Exit; // error
           Exit; // error
           end;
           end;
         Last:=b;
         Last:=b;
@@ -1394,7 +1438,7 @@ begin
         b:=CreateBinaryExpr(AParent,Last, ParseExpIdent(AParent), TokenToExprOp(optk));
         b:=CreateBinaryExpr(AParent,Last, ParseExpIdent(AParent), TokenToExprOp(optk));
         if not Assigned(b.right) then
         if not Assigned(b.right) then
           begin
           begin
-          B.Free;
+          B.Release;
           Exit; // error
           Exit; // error
           end;
           end;
          Last:=b;
          Last:=b;
@@ -1510,7 +1554,8 @@ end;
 function TPasParser.DoParseExpression(Aparent : TPaselement;InitExpr: TPasExpr): TPasExpr;
 function TPasParser.DoParseExpression(Aparent : TPaselement;InitExpr: TPasExpr): TPasExpr;
 var
 var
   expstack  : TFPList;
   expstack  : TFPList;
-  opstack   : TFPList;
+  opstack   : array of TToken;
+  opstackTop: integer;
   pcount    : Integer;
   pcount    : Integer;
   x         : TPasExpr;
   x         : TPasExpr;
   i         : Integer;
   i         : Integer;
@@ -1536,19 +1581,22 @@ const
 
 
   procedure PushOper(token: TToken); inline;
   procedure PushOper(token: TToken); inline;
   begin
   begin
-    opstack.Add( Pointer(PtrInt(token)) );
+    inc(opstackTop);
+    if opstackTop=length(opstack) then
+      SetLength(opstack,length(opstack)*2+4);
+    opstack[opstackTop]:=token;
   end;
   end;
 
 
   function PeekOper: TToken; inline;
   function PeekOper: TToken; inline;
   begin
   begin
-    if opstack.Count>0 then Result:=TToken(PtrUInt(opstack[ opstack.Count-1]))
-    else Result:=tkEOF
+    if opstackTop>=0 then Result:=opstack[opstackTop]
+    else Result:=tkEOF;
   end;
   end;
 
 
   function PopOper: TToken; inline;
   function PopOper: TToken; inline;
   begin
   begin
     Result:=PeekOper;
     Result:=PeekOper;
-    if Result<>tkEOF then opstack.Delete(opstack.Count-1);
+    if Result<>tkEOF then dec(opstackTop);
   end;
   end;
 
 
   procedure PopAndPushOperator;
   procedure PopAndPushOperator;
@@ -1575,7 +1623,8 @@ begin
   //DumpCurToken('Entry',iaIndent);
   //DumpCurToken('Entry',iaIndent);
   Result:=nil;
   Result:=nil;
   expstack := TFPList.Create;
   expstack := TFPList.Create;
-  opstack := TFPList.Create;
+  SetLength(opstack,4);
+  opstackTop:=-1;
   try
   try
     repeat
     repeat
       NotBinary:=True;
       NotBinary:=True;
@@ -1608,7 +1657,7 @@ begin
           x:=DoParseExpression(AParent);
           x:=DoParseExpression(AParent);
           if CurToken<>tkBraceClose then
           if CurToken<>tkBraceClose then
             begin
             begin
-            x.free;
+            x.Release;
             Exit;
             Exit;
             end;
             end;
           NextToken;
           NextToken;
@@ -1654,7 +1703,7 @@ begin
         // Adjusting order of the operations
         // Adjusting order of the operations
         NotBinary:=False;
         NotBinary:=False;
         tempop:=PeekOper;
         tempop:=PeekOper;
-        while (opstack.Count>0) and (OpLevel(tempop)>=OpLevel(CurToken)) do begin
+        while (opstackTop>=0) and (OpLevel(tempop)>=OpLevel(CurToken)) do begin
           PopAndPushOperator;
           PopAndPushOperator;
           tempop:=PeekOper;
           tempop:=PeekOper;
         end;
         end;
@@ -1666,7 +1715,7 @@ begin
 
 
     if not NotBinary then ParseExcExpectedIdentifier;
     if not NotBinary then ParseExcExpectedIdentifier;
 
 
-    while opstack.Count>0 do PopAndPushOperator;
+    while opstackTop>=0 do PopAndPushOperator;
 
 
     // only 1 expression should be on the stack, at the end of the correct expression
     // only 1 expression should be on the stack, at the end of the correct expression
     if expstack.Count=1 then Result:=TPasExpr(expstack[0]);
     if expstack.Count=1 then Result:=TPasExpr(expstack[0]);
@@ -1679,9 +1728,9 @@ begin
     if not Assigned(Result) then begin
     if not Assigned(Result) then begin
       // expression error!
       // expression error!
       for i:=0 to expstack.Count-1 do
       for i:=0 to expstack.Count-1 do
-        TObject(expstack[i]).Free;
+        TPasExpr(expstack[i]).Release;
     end;
     end;
-    opstack.Free;
+    SetLength(opstack,0);
     expstack.Free;
     expstack.Free;
   end;
   end;
 end;
 end;
@@ -1828,7 +1877,7 @@ begin
     end;
     end;
 end;
 end;
 
 
-// Return the parent of a function declaration. This is APArent,
+// Return the parent of a function declaration. This is AParent,
 // except when AParent is a class, and the function is overloaded.
 // except when AParent is a class, and the function is overloaded.
 // Then the parent is the overload object.
 // Then the parent is the overload object.
 function TPasParser.CheckIfOverloaded(AParent: TPasElement; const AName: String): TPasElement;
 function TPasParser.CheckIfOverloaded(AParent: TPasElement; const AName: String): TPasElement;
@@ -1896,6 +1945,7 @@ begin
     If LogEvent(pleInterface) then
     If LogEvent(pleInterface) then
       DoLog(mtInfo,nLogStartInterface,SLogStartInterface);
       DoLog(mtInfo,nLogStartInterface,SLogStartInterface);
     ParseInterface;
     ParseInterface;
+    Engine.FinishScope(stModule);
   finally
   finally
     FCurModule:=nil;
     FCurModule:=nil;
   end;
   end;
@@ -1945,6 +1995,7 @@ begin
     PP.ProgramSection := Section;
     PP.ProgramSection := Section;
     ParseOptionalUsesList(Section);
     ParseOptionalUsesList(Section);
     ParseDeclarations(Section);
     ParseDeclarations(Section);
+    Engine.FinishScope(stModule);
   finally
   finally
     FCurModule:=nil;
     FCurModule:=nil;
   end;
   end;
@@ -1973,6 +2024,7 @@ begin
     PP.LibrarySection := Section;
     PP.LibrarySection := Section;
     ParseOptionalUsesList(Section);
     ParseOptionalUsesList(Section);
     ParseDeclarations(Section);
     ParseDeclarations(Section);
+    Engine.FinishScope(stModule);
   finally
   finally
     FCurModule:=nil;
     FCurModule:=nil;
   end;
   end;
@@ -1986,6 +2038,7 @@ begin
     ParseUsesList(ASection)
     ParseUsesList(ASection)
   else begin
   else begin
     CheckImplicitUsedUnits(ASection);
     CheckImplicitUsedUnits(ASection);
+    Engine.FinishScope(stUsesList);
     UngetToken;
     UngetToken;
   end;
   end;
 end;
 end;
@@ -1998,7 +2051,7 @@ begin
   Section := TInterfaceSection(CreateElement(TInterfaceSection, '', CurModule));
   Section := TInterfaceSection(CreateElement(TInterfaceSection, '', CurModule));
   CurModule.InterfaceSection := Section;
   CurModule.InterfaceSection := Section;
   ParseOptionalUsesList(Section);
   ParseOptionalUsesList(Section);
-  ParseDeclarations(Section);
+  ParseDeclarations(Section); // this also parses the Implementation section
 end;
 end;
 
 
 // Starts after the "implementation" token
 // Starts after the "implementation" token
@@ -2104,6 +2157,16 @@ end;
 procedure TPasParser.ParseDeclarations(Declarations: TPasDeclarations);
 procedure TPasParser.ParseDeclarations(Declarations: TPasDeclarations);
 var
 var
   CurBlock: TDeclType;
   CurBlock: TDeclType;
+
+  procedure SetBlock(NewBlock: TDeclType);
+  begin
+    if CurBlock=NewBlock then exit;
+    if CurBlock=declType then
+      Engine.FinishScope(stTypeDef);
+    CurBlock:=NewBlock;
+  end;
+
+var
   ConstEl: TPasConst;
   ConstEl: TPasConst;
   ResStrEl: TPasResString;
   ResStrEl: TPasResString;
   TypeEl: TPasType;
   TypeEl: TPasType;
@@ -2164,25 +2227,25 @@ begin
         else
         else
           ParseExcSyntaxError;
           ParseExcSyntaxError;
       tkConst:
       tkConst:
-        CurBlock := declConst;
+        SetBlock(declConst);
       tkexports:
       tkexports:
-        CurBlock := declExports;
+        SetBlock(declExports);
       tkResourcestring:
       tkResourcestring:
-        CurBlock := declResourcestring;
+        SetBlock(declResourcestring);
       tkType:
       tkType:
-        CurBlock := declType;
+        SetBlock(declType);
       tkVar:
       tkVar:
-        CurBlock := declVar;
+        SetBlock(declVar);
       tkThreadVar:
       tkThreadVar:
-        CurBlock := declThreadVar;
+        SetBlock(declThreadVar);
       tkProperty:
       tkProperty:
-        CurBlock := declProperty;
+        SetBlock(declProperty);
       tkProcedure, tkFunction, tkConstructor, tkDestructor,tkOperator:
       tkProcedure, tkFunction, tkConstructor, tkDestructor,tkOperator:
         begin
         begin
         SaveComments;
         SaveComments;
         pt:=GetProcTypeFromToken(CurToken);
         pt:=GetProcTypeFromToken(CurToken);
         AddProcOrFunction(Declarations, ParseProcedureOrFunctionDecl(Declarations, pt));
         AddProcOrFunction(Declarations, ParseProcedureOrFunctionDecl(Declarations, pt));
-        CurBlock := declNone;
+        SetBlock(declNone);
         end;
         end;
       tkClass:
       tkClass:
         begin
         begin
@@ -2192,7 +2255,7 @@ begin
             begin
             begin
             pt:=GetProcTypeFromToken(CurToken,True);
             pt:=GetProcTypeFromToken(CurToken,True);
             AddProcOrFunction(Declarations,ParseProcedureOrFunctionDecl(Declarations, pt));
             AddProcOrFunction(Declarations,ParseProcedureOrFunctionDecl(Declarations, pt));
-            CurBlock := declNone;
+            SetBlock(declNone);
             end
             end
           else
           else
             ExpectToken(tkprocedure);
             ExpectToken(tkprocedure);
@@ -2440,6 +2503,8 @@ begin
     if Not (CurToken in [tkComma,tkSemicolon]) then
     if Not (CurToken in [tkComma,tkSemicolon]) then
       ParseExc(nParserExpectedCommaSemicolon,SParserExpectedCommaSemicolon);
       ParseExc(nParserExpectedCommaSemicolon,SParserExpectedCommaSemicolon);
   Until (CurToken=tkSemicolon);
   Until (CurToken=tkSemicolon);
+
+  Engine.FinishScope(stUsesList);
 end;
 end;
 
 
 // Starts after the variable name
 // Starts after the variable name
@@ -2828,7 +2893,7 @@ end;
 procedure TPasParser.ParseArgList(Parent: TPasElement; Args: TFPList; EndToken: TToken);
 procedure TPasParser.ParseArgList(Parent: TPasElement; Args: TFPList; EndToken: TToken);
 var
 var
   ArgNames: TStringList;
   ArgNames: TStringList;
-  IsUntyped, ok: Boolean;
+  IsUntyped, ok, LastHadDefaultValue: Boolean;
   Name : String;
   Name : String;
   Value : TPasExpr;
   Value : TPasExpr;
   i: Integer;
   i: Integer;
@@ -2836,6 +2901,7 @@ var
   Access: TArgumentAccess;
   Access: TArgumentAccess;
   ArgType: TPasType;
   ArgType: TPasType;
 begin
 begin
+  LastHadDefaultValue := false;
   ArgNames := TStringList.Create;
   ArgNames := TStringList.Create;
   try
   try
     while True do
     while True do
@@ -2885,7 +2951,7 @@ begin
       Value:=Nil;
       Value:=Nil;
       if not IsUntyped then
       if not IsUntyped then
         begin
         begin
-        ArgType := ParseType(nil);
+        ArgType := ParseType(Parent);
         ok:=false;
         ok:=false;
         try
         try
           NextToken;
           NextToken;
@@ -2899,7 +2965,10 @@ begin
             NextToken;
             NextToken;
             Value := DoParseExpression(Parent,Nil);
             Value := DoParseExpression(Parent,Nil);
             // After this, we're on ), which must be unget.
             // After this, we're on ), which must be unget.
-            end;
+            LastHadDefaultValue:=true;
+            end
+          else if LastHadDefaultValue then
+            ParseExc(nParserDefaultParameterRequiredFor,SParserDefaultParameterRequiredFor,[ArgNames[0]]);
           UngetToken;
           UngetToken;
           ok:=true;
           ok:=true;
         finally
         finally
@@ -3205,6 +3274,7 @@ begin
     ConsumeSemi;
     ConsumeSemi;
   if (ProcType in [ptOperator,ptClassOperator]) and (Parent is TPasOperator) then
   if (ProcType in [ptOperator,ptClassOperator]) and (Parent is TPasOperator) then
     TPasOperator(Parent).CorrectName;
     TPasOperator(Parent).CorrectName;
+  Engine.FinishScope(stProcedureHeader);
   if (Parent is TPasProcedure)
   if (Parent is TPasProcedure)
   and (not TPasProcedure(Parent).IsForward)
   and (not TPasProcedure(Parent).IsForward)
   and (not TPasProcedure(Parent).IsExternal)
   and (not TPasProcedure(Parent).IsExternal)
@@ -3212,6 +3282,7 @@ begin
      or (Parent.Parent is TProcedureBody))
      or (Parent.Parent is TProcedureBody))
   then
   then
     ParseProcedureBody(Parent);
     ParseProcedureBody(Parent);
+  Engine.FinishScope(stProcedure);
 end;
 end;
 
 
 // starts after the semicolon
 // starts after the semicolon
@@ -3446,7 +3517,7 @@ var
   CmdElem: TPasImplElement;
   CmdElem: TPasImplElement;
   left: TPasExpr;
   left: TPasExpr;
   right: TPasExpr;
   right: TPasExpr;
-  el : TPasImplElement;
+  El : TPasImplElement;
   ak : TAssignKind;
   ak : TAssignKind;
   lt : TLoopType;
   lt : TLoopType;
 
 
@@ -3460,30 +3531,30 @@ begin
     case CurToken of
     case CurToken of
     tkasm :
     tkasm :
       begin
       begin
-      el:=TPasImplElement(CreateElement(TPasImplAsmStatement,'',CurBlock));
-      ParseAsmBlock(TPasImplAsmStatement(el));
-      CurBlock.AddElement(el);
+      El:=TPasImplElement(CreateElement(TPasImplAsmStatement,'',CurBlock));
+      ParseAsmBlock(TPasImplAsmStatement(El));
+      CurBlock.AddElement(El);
       NewImplElement:=El;
       NewImplElement:=El;
       end;
       end;
     tkbegin:
     tkbegin:
       begin
       begin
-      el:=TPasImplElement(CreateElement(TPasImplBeginBlock,'',CurBlock));
-      CreateBlock(TPasImplBeginBlock(el));
+      El:=TPasImplElement(CreateElement(TPasImplBeginBlock,'',CurBlock));
+      CreateBlock(TPasImplBeginBlock(El));
       end;
       end;
     tkrepeat:
     tkrepeat:
       begin
       begin
-      el:=TPasImplRepeatUntil(CreateElement(TPasImplRepeatUntil,'',CurBlock));
-      CreateBlock(TPasImplRepeatUntil(el));
+      El:=TPasImplRepeatUntil(CreateElement(TPasImplRepeatUntil,'',CurBlock));
+      CreateBlock(TPasImplRepeatUntil(El));
       end;
       end;
     tkIf:
     tkIf:
       begin
       begin
         NextToken;
         NextToken;
         Left:=DoParseExpression(CurBlock);
         Left:=DoParseExpression(CurBlock);
         UNgettoken;
         UNgettoken;
-        el:=TPasImplIfElse(CreateElement(TPasImplIfElse,'',CurBlock));
-        TPasImplIfElse(el).ConditionExpr:=Left;
+        El:=TPasImplIfElse(CreateElement(TPasImplIfElse,'',CurBlock));
+        TPasImplIfElse(El).ConditionExpr:=Left;
         //WriteLn(i,'IF Condition="',Condition,'" Token=',CurTokenText);
         //WriteLn(i,'IF Condition="',Condition,'" Token=',CurTokenText);
-        CreateBlock(TPasImplIfElse(el));
+        CreateBlock(TPasImplIfElse(El));
         ExpectToken(tkthen);
         ExpectToken(tkthen);
       end;
       end;
     tkelse:
     tkelse:
@@ -3491,8 +3562,8 @@ begin
       begin
       begin
         if TPasImplIfElse(CurBlock).IfBranch=nil then
         if TPasImplIfElse(CurBlock).IfBranch=nil then
         begin
         begin
-        el:=TPasImplCommand(CreateElement(TPasImplCommand,'', CurBlock));
-        CurBlock.AddElement(el);
+        El:=TPasImplCommand(CreateElement(TPasImplCommand,'', CurBlock));
+        CurBlock.AddElement(El);
         end;
         end;
         if TPasImplIfElse(CurBlock).ElseBranch<>nil then
         if TPasImplIfElse(CurBlock).ElseBranch<>nil then
         begin
         begin
@@ -3518,9 +3589,9 @@ begin
       end else if (CurBlock is TPasImplTryExcept) then
       end else if (CurBlock is TPasImplTryExcept) then
       begin
       begin
         CloseBlock;
         CloseBlock;
-        el:=TPasImplTryExceptElse(CreateElement(TPasImplTryExceptElse,'',CurBlock));
-        TPasImplTry(CurBlock).ElseBranch:=TPasImplTryExceptElse(el);
-        CurBlock:=TPasImplTryExceptElse(el);
+        El:=TPasImplTryExceptElse(CreateElement(TPasImplTryExceptElse,'',CurBlock));
+        TPasImplTry(CurBlock).ElseBranch:=TPasImplTryExceptElse(El);
+        CurBlock:=TPasImplTryExceptElse(El);
       end else
       end else
         ParseExcSyntaxError;
         ParseExcSyntaxError;
     tkwhile:
     tkwhile:
@@ -3530,9 +3601,9 @@ begin
         left:=DoParseExpression(Parent);
         left:=DoParseExpression(Parent);
         ungettoken;
         ungettoken;
         //WriteLn(i,'WHILE Condition="',Condition,'" Token=',CurTokenText);
         //WriteLn(i,'WHILE Condition="',Condition,'" Token=',CurTokenText);
-        el:=TPasImplWhileDo(CreateElement(TPasImplWhileDo,'',CurBlock));
-        TPasImplWhileDo(el).ConditionExpr:=left;
-        CreateBlock(TPasImplWhileDo(el));
+        El:=TPasImplWhileDo(CreateElement(TPasImplWhileDo,'',CurBlock));
+        TPasImplWhileDo(El).ConditionExpr:=left;
+        CreateBlock(TPasImplWhileDo(El));
         ExpectToken(tkdo);
         ExpectToken(tkdo);
       end;
       end;
     tkgoto:
     tkgoto:
@@ -3575,12 +3646,12 @@ begin
           FreeAndNil(Right);
           FreeAndNil(Right);
           Raise;
           Raise;
         end;
         end;
-        el:=TPasImplForLoop(CreateElement(TPasImplForLoop,'',CurBlock));
-        TPasImplForLoop(el).VariableName:=VarName;
-        TPasImplForLoop(el).StartExpr:=Left;
-        TPasImplForLoop(el).EndExpr:=Right;
-        TPasImplForLoop(el).LoopType:=lt;
-        CreateBlock(TPasImplForLoop(el));
+        El:=TPasImplForLoop(CreateElement(TPasImplForLoop,'',CurBlock));
+        TPasImplForLoop(El).VariableName:=VarName;
+        TPasImplForLoop(El).StartExpr:=Left;
+        TPasImplForLoop(El).EndExpr:=Right;
+        TPasImplForLoop(El).LoopType:=lt;
+        CreateBlock(TPasImplForLoop(El));
         //WriteLn(i,'FOR "',VarName,'" := ',StartValue,' to ',EndValue,' Token=',CurTokenText);
         //WriteLn(i,'FOR "',VarName,'" := ',StartValue,' to ',EndValue,' Token=',CurTokenText);
       end;
       end;
     tkwith:
     tkwith:
@@ -3590,9 +3661,9 @@ begin
         NextToken;
         NextToken;
         Left:=DoParseExpression(Parent);
         Left:=DoParseExpression(Parent);
         //writeln(i,'WITH Expr="',Expr,'" Token=',CurTokenText);
         //writeln(i,'WITH Expr="',Expr,'" Token=',CurTokenText);
-        el:=TPasImplWithDo(CreateElement(TPasImplWithDo,'',CurBlock));
-        TPasImplWithDo(el).AddExpression(Left);
-        CreateBlock(TPasImplWithDo(el));
+        El:=TPasImplWithDo(CreateElement(TPasImplWithDo,'',CurBlock));
+        TPasImplWithDo(El).AddExpression(Left);
+        CreateBlock(TPasImplWithDo(El));
         repeat
         repeat
           if CurToken=tkdo then break;
           if CurToken=tkdo then break;
           if CurToken<>tkComma then
           if CurToken<>tkComma then
@@ -3610,9 +3681,9 @@ begin
         UngetToken;
         UngetToken;
         //writeln(i,'CASE OF Expr="',Expr,'" Token=',CurTokenText);
         //writeln(i,'CASE OF Expr="',Expr,'" Token=',CurTokenText);
         ExpectToken(tkof);
         ExpectToken(tkof);
-        el:=TPasImplCaseOf(CreateElement(TPasImplCaseOf,'',CurBlock));
-        TPasImplCaseOf(el).CaseExpr:=Left;
-        CreateBlock(TPasImplCaseOf(el));
+        El:=TPasImplCaseOf(CreateElement(TPasImplCaseOf,'',CurBlock));
+        TPasImplCaseOf(El).CaseExpr:=Left;
+        CreateBlock(TPasImplCaseOf(El));
         repeat
         repeat
           NextToken;
           NextToken;
           //writeln(i,'CASE OF Token=',CurTokenText);
           //writeln(i,'CASE OF Token=',CurTokenText);
@@ -3626,9 +3697,9 @@ begin
           tkelse:
           tkelse:
             begin
             begin
               // create case-else block
               // create case-else block
-              el:=TPasImplCaseElse(CreateElement(TPasImplCaseElse,'',CurBlock));
-              TPasImplCaseOf(CurBlock).ElseBranch:=TPasImplCaseElse(el);
-              CreateBlock(TPasImplCaseElse(el));
+              El:=TPasImplCaseElse(CreateElement(TPasImplCaseElse,'',CurBlock));
+              TPasImplCaseOf(CurBlock).ElseBranch:=TPasImplCaseElse(El);
+              CreateBlock(TPasImplCaseElse(El));
               break;
               break;
             end
             end
           else
           else
@@ -3636,9 +3707,9 @@ begin
             if (curToken=tkIdentifier) and (LowerCase(CurtokenString)='otherwise') then
             if (curToken=tkIdentifier) and (LowerCase(CurtokenString)='otherwise') then
               begin
               begin
               // create case-else block
               // create case-else block
-              el:=TPasImplCaseElse(CreateElement(TPasImplCaseElse,'',CurBlock));
-              TPasImplCaseOf(CurBlock).ElseBranch:=TPasImplCaseElse(el);
-              CreateBlock(TPasImplCaseElse(el));
+              El:=TPasImplCaseElse(CreateElement(TPasImplCaseElse,'',CurBlock));
+              TPasImplCaseOf(CurBlock).ElseBranch:=TPasImplCaseElse(El);
+              CreateBlock(TPasImplCaseElse(El));
               break;
               break;
               end
               end
             else
             else
@@ -3649,10 +3720,10 @@ begin
                   TPasImplCaseStatement(CurBlock).Expressions.Add(Left)
                   TPasImplCaseStatement(CurBlock).Expressions.Add(Left)
                 else
                 else
                   begin
                   begin
-                  el:=TPasImplCaseStatement(CreateElement(TPasImplCaseStatement,'',CurBlock));
-                  TPasImplCaseStatement(el).AddExpression(Left);
-                  CurBlock.AddElement(el);
-                  CurBlock:=TPasImplCaseStatement(el);
+                  El:=TPasImplCaseStatement(CreateElement(TPasImplCaseStatement,'',CurBlock));
+                  TPasImplCaseStatement(El).AddExpression(Left);
+                  CurBlock.AddElement(El);
+                  CurBlock:=TPasImplCaseStatement(El);
                   end;
                   end;
                 //writeln(i,'CASE after value Token=',CurTokenText);
                 //writeln(i,'CASE after value Token=',CurTokenText);
                 if (CurToken=tkComma) then
                 if (CurToken=tkComma) then
@@ -3681,8 +3752,8 @@ begin
       end;
       end;
     tktry:
     tktry:
       begin
       begin
-      el:=TPasImplTry(CreateElement(TPasImplTry,'',Curblock));
-      CreateBlock(TPasImplTry(el));
+      El:=TPasImplTry(CreateElement(TPasImplTry,'',CurBlock));
+      CreateBlock(TPasImplTry(El));
       end;
       end;
     tkfinally:
     tkfinally:
       begin
       begin
@@ -3693,9 +3764,9 @@ begin
         end;
         end;
         if CurBlock is TPasImplTry then
         if CurBlock is TPasImplTry then
         begin
         begin
-          el:=TPasImplTryFinally(CreateElement(TPasImplTryFinally,'',Curblock));
-          TPasImplTry(CurBlock).FinallyExcept:=TPasImplTryFinally(el);
-          CurBlock:=TPasImplTryFinally(el);
+          El:=TPasImplTryFinally(CreateElement(TPasImplTryFinally,'',CurBlock));
+          TPasImplTry(CurBlock).FinallyExcept:=TPasImplTryFinally(El);
+          CurBlock:=TPasImplTryFinally(El);
         end else
         end else
           ParseExcSyntaxError;
           ParseExcSyntaxError;
       end;
       end;
@@ -3709,9 +3780,9 @@ begin
         if CurBlock is TPasImplTry then
         if CurBlock is TPasImplTry then
         begin
         begin
           //writeln(i,'EXCEPT');
           //writeln(i,'EXCEPT');
-          el:=TPasImplTryExcept(CreateElement(TPasImplTryExcept,'',CurBlock));
-          TPasImplTry(CurBlock).FinallyExcept:=TPasImplTryExcept(el);
-          CurBlock:=TPasImplTryExcept(el);
+          El:=TPasImplTryExcept(CreateElement(TPasImplTryExcept,'',CurBlock));
+          TPasImplTry(CurBlock).FinallyExcept:=TPasImplTryExcept(El);
+          CurBlock:=TPasImplTryExcept(El);
         end else
         end else
           ParseExcSyntaxError;
           ParseExcSyntaxError;
       end;
       end;
@@ -3736,29 +3807,29 @@ begin
             end;
             end;
 //          else
 //          else
           UngetToken;
           UngetToken;
-          el:=TPasImplExceptOn(CreateElement(TPasImplExceptOn,'',CurBlock));
-          TPasImplExceptOn(el).VarExpr:=Left;
-          TPasImplExceptOn(el).TypeExpr:=Right;
-          CurBlock.AddElement(el);
-          CurBlock:=TPasImplExceptOn(el);
+          El:=TPasImplExceptOn(CreateElement(TPasImplExceptOn,'',CurBlock));
+          TPasImplExceptOn(El).VarExpr:=Left;
+          TPasImplExceptOn(El).TypeExpr:=Right;
+          CurBlock.AddElement(El);
+          CurBlock:=TPasImplExceptOn(El);
           ExpectToken(tkDo);
           ExpectToken(tkDo);
         end else
         end else
           ParseExcSyntaxError;
           ParseExcSyntaxError;
       end;
       end;
     tkraise:
     tkraise:
       begin
       begin
-      el:=TPasImplRaise(CreateElement(TPasImplRaise,'',CurBlock));
-      CreateBlock(TPasImplRaise(el));
+      El:=TPasImplRaise(CreateElement(TPasImplRaise,'',CurBlock));
+      CreateBlock(TPasImplRaise(El));
       NextToken;
       NextToken;
       If Curtoken=tkSemicolon then
       If Curtoken=tkSemicolon then
         UnGetToken
         UnGetToken
       else
       else
         begin
         begin
-        TPasImplRaise(el).ExceptObject:=DoParseExpression(el);
+        TPasImplRaise(El).ExceptObject:=DoParseExpression(El);
         if (CurToken=tkIdentifier) and (Uppercase(CurtokenString)='AT') then
         if (CurToken=tkIdentifier) and (Uppercase(CurtokenString)='AT') then
           begin
           begin
           NextToken;
           NextToken;
-          TPasImplRaise(el).ExceptAddr:=DoParseExpression(el);
+          TPasImplRaise(El).ExceptAddr:=DoParseExpression(El);
           end;
           end;
         if Curtoken in [tkSemicolon,tkEnd] then
         if Curtoken in [tkSemicolon,tkEnd] then
           UngetToken
           UngetToken
@@ -3821,14 +3892,14 @@ begin
           Ak:=TokenToAssignKind(CurToken);
           Ak:=TokenToAssignKind(CurToken);
           NextToken;
           NextToken;
           right:=DoParseExpression(Parent); // this may solve TPasImplWhileDo.AddElement BUG
           right:=DoParseExpression(Parent); // this may solve TPasImplWhileDo.AddElement BUG
-          el:=TPasImplAssign(CreateElement(TPasImplAssign,'',CurBlock));
-          left.Parent:=el;
-          right.Parent:=el;
-          TPasImplAssign(el).left:=Left;
-          TPasImplAssign(el).right:=Right;
-          TPasImplAssign(el).Kind:=ak;
-          CurBlock.AddElement(el);
-          CmdElem:=TPasImplAssign(el);
+          El:=TPasImplAssign(CreateElement(TPasImplAssign,'',CurBlock));
+          left.Parent:=El;
+          right.Parent:=El;
+          TPasImplAssign(El).left:=Left;
+          TPasImplAssign(El).right:=Right;
+          TPasImplAssign(El).Kind:=ak;
+          CurBlock.AddElement(El);
+          CmdElem:=TPasImplAssign(El);
           UngetToken;
           UngetToken;
         end;
         end;
         tkColon:
         tkColon:
@@ -3836,18 +3907,18 @@ begin
           if not (left is TPrimitiveExpr) then
           if not (left is TPrimitiveExpr) then
             ParseExcTokenError(TokenInfos[tkSemicolon]);
             ParseExcTokenError(TokenInfos[tkSemicolon]);
           // label mark. todo: check mark identifier in the list of labels
           // label mark. todo: check mark identifier in the list of labels
-          el:=TPasImplLabelMark(CreateElement(TPasImplLabelMark,'', CurBlock));
-          TPasImplLabelMark(el).LabelId:=TPrimitiveExpr(left).Value;
-          CurBlock.AddElement(el);
-          CmdElem:=TPasImplLabelMark(el);
+          El:=TPasImplLabelMark(CreateElement(TPasImplLabelMark,'', CurBlock));
+          TPasImplLabelMark(El).LabelId:=TPrimitiveExpr(left).Value;
+          CurBlock.AddElement(El);
+          CmdElem:=TPasImplLabelMark(El);
           left.Free;
           left.Free;
         end;
         end;
       else
       else
         // simple statement (function call)
         // simple statement (function call)
-        el:=TPasImplSimple(CreateElement(TPasImplSimple,'',CurBlock));
-        TPasImplSimple(el).expr:=Left;
-        CurBlock.AddElement(el);
-        CmdElem:=TPasImplSimple(el);
+        El:=TPasImplSimple(CreateElement(TPasImplSimple,'',CurBlock));
+        TPasImplSimple(El).expr:=Left;
+        CurBlock.AddElement(El);
+        CmdElem:=TPasImplSimple(El);
         UngetToken;
         UngetToken;
       end;
       end;
 
 
@@ -4070,7 +4141,7 @@ begin
         begin
         begin
         if Not AllowMethods then
         if Not AllowMethods then
           ParseExc(nErrRecordMethodsNotAllowed,SErrRecordMethodsNotAllowed);
           ParseExc(nErrRecordMethodsNotAllowed,SErrRecordMethodsNotAllowed);
-        ProcType:=GetProcTypeFromtoken(CurToken,isClass);
+        ProcType:=GetProcTypeFromToken(CurToken,isClass);
         Proc:=ParseProcedureOrFunctionDecl(ARec,ProcType,v);
         Proc:=ParseProcedureOrFunctionDecl(ARec,ProcType,v);
         if Proc.Parent is TPasOverloadedProc then
         if Proc.Parent is TPasOverloadedProc then
           TPasOverloadedProc(Proc.Parent).Overloads.Add(Proc)
           TPasOverloadedProc(Proc.Parent).Overloads.Add(Proc)

+ 5 - 1
packages/fcl-passrc/src/pscanner.pp

@@ -324,7 +324,11 @@ type
 
 
   TPascalScannerPPSkipMode = (ppSkipNone, ppSkipIfBranch, ppSkipElseBranch, ppSkipAll);
   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;
   TPOptions = set of TPOption;
 
 
   { TPascalScanner }
   { TPascalScanner }

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

@@ -7,6 +7,8 @@ interface
 uses
 uses
   Classes, SysUtils, fpcunit, pastree, pscanner, pparser, testregistry;
   Classes, SysUtils, fpcunit, pastree, pscanner, pparser, testregistry;
 
 
+const
+  MainFilename = 'afile.pp';
 Type
 Type
   { TTestEngine }
   { TTestEngine }
 
 
@@ -29,7 +31,7 @@ Type
   Private
   Private
     FDeclarations: TPasDeclarations;
     FDeclarations: TPasDeclarations;
     FDefinition: TPasElement;
     FDefinition: TPasElement;
-    FEngine : TTestEngine;
+    FEngine : TPasTreeContainer;
     FModule: TPasModule;
     FModule: TPasModule;
     FParseResult: TPasElement;
     FParseResult: TPasElement;
     FScanner : TPascalScanner;
     FScanner : TPascalScanner;
@@ -48,6 +50,7 @@ Type
   protected
   protected
     procedure SetUp; override;
     procedure SetUp; override;
     procedure TearDown; override;
     procedure TearDown; override;
+    procedure CreateEngine(var TheEngine: TPasTreeContainer); virtual;
     Procedure StartUnit(AUnitName : String);
     Procedure StartUnit(AUnitName : String);
     Procedure StartProgram(AFileName : String; AIn : String = ''; AOut : String = '');
     Procedure StartProgram(AFileName : String; AIn : String = ''; AOut : String = '');
     Procedure StartLibrary(AFileName : 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: TAssignKind); overload;
     Procedure AssertEquals(Const Msg : String; AExpected, AActual: TProcedureMessageType); overload;
     Procedure AssertEquals(Const Msg : String; AExpected, AActual: TProcedureMessageType); overload;
     Procedure AssertEquals(Const Msg : String; AExpected, AActual: TOperatorType); 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);
     Procedure HaveHint(AHint : TPasMemberHint; AHints : TPasMemberHints);
     Property Resolver : TStreamResolver Read FResolver;
     Property Resolver : TStreamResolver Read FResolver;
     Property Scanner : TPascalScanner Read FScanner;
     Property Scanner : TPascalScanner Read FScanner;
-    Property Engine : TTestEngine read FEngine;
+    Property Engine : TPasTreeContainer read FEngine;
     Property Parser : TTestPasParser read FParser ;
     Property Parser : TTestPasParser read FParser ;
     Property Source : TStrings Read FSource;
     Property Source : TStrings Read FSource;
     Property Module : TPasModule Read FModule;
     Property Module : TPasModule Read FModule;
@@ -94,9 +98,37 @@ Type
     Property UseImplementation : Boolean Read FUseImplementation Write FUseImplementation;
     Property UseImplementation : Boolean Read FUseImplementation Write FUseImplementation;
   end;
   end;
 
 
+function ExtractFileUnitName(aFilename: string): string;
+function GetPasElementDesc(El: TPasElement): string;
+
 implementation
 implementation
 
 
 uses typinfo;
 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;
+
+
 { TTestEngine }
 { TTestEngine }
 
 
 destructor TTestEngine.Destroy;
 destructor TTestEngine.Destroy;
@@ -158,7 +190,7 @@ begin
   FResolver:=TStreamResolver.Create;
   FResolver:=TStreamResolver.Create;
   FResolver.OwnsStreams:=True;
   FResolver.OwnsStreams:=True;
   FScanner:=TPascalScanner.Create(FResolver);
   FScanner:=TPascalScanner.Create(FResolver);
-  FEngine:=TTestEngine.Create;
+  CreateEngine(FEngine);
   FParser:=TTestPasParser.Create(FScanner,FResolver,FEngine);
   FParser:=TTestPasParser.Create(FScanner,FResolver,FEngine);
   FSource:=TStringList.Create;
   FSource:=TStringList.Create;
   FModule:=Nil;
   FModule:=Nil;
@@ -178,7 +210,11 @@ begin
   FImplementation:=False;
   FImplementation:=False;
   FEndSource:=False;
   FEndSource:=False;
   FIsUnit:=False;
   FIsUnit:=False;
-  FreeAndNil(FModule);
+  if Assigned(FModule) then
+    begin
+    FModule.Release;
+    FModule:=nil;
+    end;
   FreeAndNil(FSource);
   FreeAndNil(FSource);
   FreeAndNil(FParseResult);
   FreeAndNil(FParseResult);
   FreeAndNil(FParser);
   FreeAndNil(FParser);
@@ -206,11 +242,16 @@ begin
   Inherited;
   Inherited;
 end;
 end;
 
 
+procedure TTestParser.CreateEngine(var TheEngine: TPasTreeContainer);
+begin
+  TheEngine:=TTestEngine.Create;
+end;
+
 procedure TTestParser.StartUnit(AUnitName: String);
 procedure TTestParser.StartUnit(AUnitName: String);
 begin
 begin
   FIsUnit:=True;
   FIsUnit:=True;
   If (AUnitName='') then
   If (AUnitName='') then
-    AUnitName:='afile';
+    AUnitName:=ExtractFileUnitName(MainFilename);
   Add('unit '+aUnitName+';');
   Add('unit '+aUnitName+';');
   Add('');
   Add('');
   Add('interface');
   Add('interface');
@@ -228,7 +269,7 @@ begin
     begin
     begin
     AFileName:=AFileName+'('+AIn;
     AFileName:=AFileName+'('+AIn;
     if (AOut<>'') then
     if (AOut<>'') then
-      AFileName:=AFIleName+','+AOut;
+      AFileName:=AFileName+','+AOut;
     AFileName:=AFileName+')';
     AFileName:=AFileName+')';
     end;
     end;
   Add('program '+AFileName+';');
   Add('program '+AFileName+';');
@@ -304,8 +345,8 @@ begin
     StartImplementation;
     StartImplementation;
   EndSource;
   EndSource;
   If (FFileName='') then
   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);
   FScanner.OpenFile(FFileName);
   Writeln('// Test : ',Self.TestName);
   Writeln('// Test : ',Self.TestName);
   Writeln(FSource.Text);
   Writeln(FSource.Text);
@@ -521,7 +562,14 @@ procedure TTestParser.AssertEquals(const Msg: String; AExpected,
   AActual: TOperatorType);
   AActual: TOperatorType);
 begin
 begin
   AssertEquals(Msg,GetEnumName(TypeInfo(TOperatorType),Ord(AExpected)),
   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;
 end;
 
 
 procedure TTestParser.HaveHint(AHint: TPasMemberHint; AHints: TPasMemberHints);
 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');
   DeclareVar('record a : array[1..2] of integer; end ','b');
   ParseExpression('b.a[1]');
   ParseExpression('b.a[1]');
   P:=TParamsExpr(AssertExpression('Simple identifier',theExpr,pekArrayParams,TParamsExpr));
   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);
   AssertEquals('name is Subident',eopSubIdent,B.Opcode);
   AssertExpression('Name of array',B.Left,pekIdent,'b');
   AssertExpression('Name of array',B.Left,pekIdent,'b');
   AssertExpression('Name of array',B.Right,pekIdent,'a');
   AssertExpression('Name of array',B.Right,pekIdent,'a');
   AssertEquals('One dimension',1,Length(p.params));
   AssertEquals('One dimension',1,Length(p.params));
   AssertExpression('Simple identifier',p.params[0],pekNumber,'1');
   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;
 end;
 
 
 procedure TTestExpressions.TestArrayElement2Dims;
 procedure TTestExpressions.TestArrayElement2Dims;
@@ -291,6 +293,9 @@ begin
   B:=TBinaryExpr(AssertExpression('First element is range',P.Params[0],pekRange,TBinaryExpr));
   B:=TBinaryExpr(AssertExpression('First element is range',P.Params[0],pekRange,TBinaryExpr));
   AssertExpression('Left is 0',B.Left,pekNumber,'0');
   AssertExpression('Left is 0',B.Left,pekNumber,'0');
   AssertExpression('Right is 10',B.Right,pekNumber,'10');
   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;
 end;
 
 
 procedure TTestExpressions.TestBracketsTotal;
 procedure TTestExpressions.TestBracketsTotal;
@@ -868,7 +873,7 @@ Var
   I : Integer;
   I : Integer;
 
 
 begin
 begin
-  StartProgram('afile');
+  StartProgram(ExtractFileUnitName(MainFilename));
   if FVariables.Count=0 then
   if FVariables.Count=0 then
     DeclareVar('integer');
     DeclareVar('integer');
   Add('Var');
   Add('Var');
@@ -913,6 +918,8 @@ begin
   ARight:=Result.Right;
   ARight:=Result.Right;
   AssertNotNull('Have left',ALeft);
   AssertNotNull('Have left',ALeft);
   AssertNotNull('Have right',ARight);
   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;
 end;
 
 
 function TTestExpressions.AssertUnaryExpr(const Msg: String; Op: TExprOpCode;
 function TTestExpressions.AssertUnaryExpr(const Msg: String; Op: TExprOpCode;

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

@@ -205,6 +205,8 @@ begin
   ParseConst('1 + 2');
   ParseConst('1 + 2');
   CheckExprNameKindClass(pekBinary,TBinaryExpr);
   CheckExprNameKindClass(pekBinary,TBinaryExpr);
   B:=TBinaryExpr(TheExpr);
   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('Left expression',B.Left,pekNumber,'1');
   AssertExpression('Right expression',B.Right,pekNumber,'2');
   AssertExpression('Right expression',B.Right,pekNumber,'2');
 end;
 end;
@@ -547,24 +549,33 @@ begin
 end;
 end;
 
 
 procedure TTestResourcestringParser.DoTestSum;
 procedure TTestResourcestringParser.DoTestSum;
+var
+  B: TBinaryExpr;
 begin
 begin
   ParseResourcestring('''Something''+'' else''');
   ParseResourcestring('''Something''+'' else''');
   CheckExprNameKindClass(pekBinary,TBinaryExpr);
   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;
 end;
 
 
 procedure TTestResourcestringParser.DoTestSum2;
 procedure TTestResourcestringParser.DoTestSum2;
+var
+  B: TBinaryExpr;
 begin
 begin
   ParseResourcestring('''Something''+different');
   ParseResourcestring('''Something''+different');
   CheckExprNameKindClass(pekBinary,TBinaryExpr);
   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;
 end;
 
 
 procedure TTestResourcestringParser.TestSimple;
 procedure TTestResourcestringParser.TestSimple;

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

@@ -0,0 +1,821 @@
+{
+  Examples:
+    ./testpassrc --suite=TTestResolver.TestEmpty
+}
+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;
+
+  { 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;
+  Protected
+    Procedure SetUp; override;
+    Procedure TearDown; override;
+    procedure CreateEngine(var TheEngine: TPasTreeContainer); override;
+    procedure ParseProgram;
+    procedure ParseUnit;
+  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 TestVarLongint;
+    Procedure TestVarInteger;
+    Procedure TestConstInteger;
+    Procedure TestPrgAssignment;
+    Procedure TestPrgProcVar;
+    Procedure TestUnitProcVar;
+    Procedure TestStatements;
+    Procedure TestUnitRef;
+    Procedure TestProcParam;
+    Procedure TestFunctionResult;
+    Procedure TestProcOverload;
+    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;
+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]);
+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]);
+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;
+
+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.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.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.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;
+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;
+end;
+
+initialization
+  RegisterTests([TTestResolver]);
+
+end.
+

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

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

+ 3 - 2
packages/fcl-passrc/tests/tcstatements.pas

@@ -121,7 +121,7 @@ procedure TTestStatementParser.AddStatements(ASource: array of string);
 Var
 Var
   I :Integer;
   I :Integer;
 begin
 begin
-  StartProgram('afile');
+  StartProgram(ExtractFileUnitName(MainFilename));
   if FVariables.Count>0 then
   if FVariables.Count>0 then
     begin
     begin
     Add('Var');
     Add('Var');
@@ -369,9 +369,10 @@ begin
   S:=Statement as TPasImplSimple;
   S:=Statement as TPasImplSimple;
   AssertExpression('Doit call',S.Expr,pekBinary,TBinaryExpr);
   AssertExpression('Doit call',S.Expr,pekBinary,TBinaryExpr);
   B:=S.Expr as 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('Unit name',B.Left,pekIdent,'Unita');
   AssertExpression('Doit call',B.Right,pekIdent,'Doit');
   AssertExpression('Doit call',B.Right,pekIdent,'Doit');
-
 end;
 end;
 
 
 procedure TTestStatementParser.TestCallQualified2;
 procedure TTestStatementParser.TestCallQualified2;

+ 2 - 0
packages/fcl-passrc/tests/tctypeparser.pas

@@ -695,6 +695,8 @@ begin
   AssertNotNull('have right expr', B.Right);
   AssertNotNull('have right expr', B.Right);
   AssertEquals('argument right expr type', TPrimitiveExpr, B.right.ClassType);
   AssertEquals('argument right expr type', TPrimitiveExpr, B.right.ClassType);
   AssertEquals('argument right expr value', '2', TPrimitiveExpr(B.right).Value);
   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;
 end;
 
 
 procedure TTestProcedureTypeParser.DoTestProcedureOneArgDefaultSet(
 procedure TTestProcedureTypeParser.DoTestProcedureOneArgDefaultSet(

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

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

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

@@ -5,7 +5,7 @@ program testpassrc;
 uses
 uses
   Classes, consoletestrunner, tcscanner, tctypeparser, tcstatements,
   Classes, consoletestrunner, tcscanner, tctypeparser, tcstatements,
   tcbaseparser, tcmoduleparser, tconstparser, tcvarparser, tcclasstype,
   tcbaseparser, tcmoduleparser, tconstparser, tcvarparser, tcclasstype,
-  tcexprparser, tcprocfunc, tcpassrcutil;
+  tcexprparser, tcprocfunc, tcpassrcutil, tcresolver;
 
 
 type
 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;
     Class Function CreateCondition: TPasExpr;
   end;
   end;
 
 
+  { TTestTestConverter }
+
   TTestTestConverter = class(TTestConverter)
   TTestTestConverter = class(TTestConverter)
   published
   published
     procedure TestEmpty;
     procedure TestEmpty;
@@ -584,7 +586,7 @@ begin
   AssertNull('No second statement',L.B);
   AssertNull('No second statement',L.B);
   L:=AssertListStatement('try..except block is statement list',El.BCatch);
   L:=AssertListStatement('try..except block is statement list',El.BCatch);
   AssertAssignStatement('Correct assignment in except..end block',L.A,'b','c');
   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);
   AssertNull('No second statement',L.B);
 end;
 end;
 
 
@@ -621,18 +623,18 @@ begin
   O.Body:=CreateAssignStatement('b','c');
   O.Body:=CreateAssignStatement('b','c');
   // Convert
   // Convert
   El:=TJSTryFinallyStatement(Convert(T,TJSTryCatchStatement));
   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);
   L:=AssertListStatement('try..except block is statement list',El.BCatch);
   AssertNull('No second statement',L.B);
   AssertNull('No second statement',L.B);
   I:=TJSIfStatement(AssertElement('On block is if',TJSIfStatement,L.A));
   I:=TJSIfStatement(AssertElement('On block is if',TJSIfStatement,L.A));
   Ic:=TJSRelationalExpressionInstanceOf(AssertElement('If condition is InstanceOf expression',TJSRelationalExpressionInstanceOf,I.Cond));
   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
   // Lowercased exception - May need checking
   Assertidentifier('InstanceOf right is original exception type',Ic.B,'exception');
   Assertidentifier('InstanceOf right is original exception type',Ic.B,'exception');
   L:=AssertListStatement('On block is always a list',i.btrue);
   L:=AssertListStatement('On block is always a list',i.btrue);
   V:=TJSVarDeclaration(AssertElement('First statement in list is a var declaration',TJSVarDeclaration,L.A));
   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);
   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);
   L:=AssertListStatement('Second statement is again list',L.B);
   AssertAssignStatement('Original assignment in second statement',L.A,'b','c');
   AssertAssignStatement('Original assignment in second statement',L.A,'b','c');
 end;
 end;
@@ -669,20 +671,20 @@ begin
   O.Body:=TPasImplRaise.Create('',Nil);
   O.Body:=TPasImplRaise.Create('',Nil);
   // Convert
   // Convert
   El:=TJSTryFinallyStatement(Convert(T,TJSTryCatchStatement));
   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);
   L:=AssertListStatement('try..except block is statement list',El.BCatch);
   AssertNull('No second statement',L.B);
   AssertNull('No second statement',L.B);
   I:=TJSIfStatement(AssertElement('On block is if',TJSIfStatement,L.A));
   I:=TJSIfStatement(AssertElement('On block is if',TJSIfStatement,L.A));
   Ic:=TJSRelationalExpressionInstanceOf(AssertElement('If condition is InstanceOf expression',TJSRelationalExpressionInstanceOf,I.Cond));
   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
   // Lowercased exception - May need checking
   L:=AssertListStatement('On block is always a list',i.btrue);
   L:=AssertListStatement('On block is always a list',i.btrue);
   V:=TJSVarDeclaration(AssertElement('First statement in list is a var declaration',TJSVarDeclaration,L.A));
   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);
   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);
   L:=AssertListStatement('Second statement is again list',L.B);
   R:=TJSThrowStatement(AssertElement('On block is throw statement',TJSThrowStatement,L.A));
   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;
 end;
 
 
 Procedure TTestStatementConverter.TestVariableStatement;
 Procedure TTestStatementConverter.TestVariableStatement;
@@ -1206,7 +1208,7 @@ Function TTestConverter.Convert(AElement: TPasElement; AClass: TJSElementClass
   ): TJSElement;
   ): TJSElement;
 begin
 begin
   FSource:=AElement;
   FSource:=AElement;
-  Result:=FConverter.ConvertElement(AElement);
+  Result:=FConverter.ConvertPasElement(AElement,nil);
   FRes:=Result;
   FRes:=Result;
   if (AClass<>Nil) then
   if (AClass<>Nil) then
     begin
     begin

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