Browse Source

fcl-passrc: resolver: allow typecasts string(pointer), pointer(string)

git-svn-id: trunk@39974 -
Mattias Gaertner 6 years ago
parent
commit
74a0ce450e
2 changed files with 173 additions and 87 deletions
  1. 138 59
      packages/fcl-passrc/src/pasresolver.pp
  2. 35 28
      packages/fcl-passrc/tests/tcresolver.pas

+ 138 - 59
packages/fcl-passrc/src/pasresolver.pp

@@ -275,12 +275,19 @@ unit PasResolver;
 {$mode objfpc}{$H+}
 {$mode objfpc}{$H+}
 {$inline on}
 {$inline on}
 
 
+{$ifdef fpc}
+  {$define UsePChar}
+{$endif}
+
 {$IFOPT Q+}{$DEFINE OverflowCheckOn}{$ENDIF}
 {$IFOPT Q+}{$DEFINE OverflowCheckOn}{$ENDIF}
 {$IFOPT R+}{$DEFINE RangeCheckOn}{$ENDIF}
 {$IFOPT R+}{$DEFINE RangeCheckOn}{$ENDIF}
 
 
 interface
 interface
 
 
 uses
 uses
+  {$ifdef pas2js}
+  js,
+  {$endif}
   Classes, SysUtils, Math, Types, contnrs,
   Classes, SysUtils, Math, Types, contnrs,
   PasTree, PScanner, PParser, PasResolveEval;
   PasTree, PScanner, PParser, PasResolveEval;
 
 
@@ -355,6 +362,8 @@ const
   btAllStrings = [btString,btAnsiString,btShortString,
   btAllStrings = [btString,btAnsiString,btShortString,
     btWideString,btUnicodeString,btRawByteString];
     btWideString,btUnicodeString,btRawByteString];
   btAllStringAndChars = btAllStrings+btAllChars;
   btAllStringAndChars = btAllStrings+btAllChars;
+  btAllStringPointer = [btString,btAnsiString,btWideString,btUnicodeString,
+    btRawByteString];
   btAllFloats = [btSingle,btDouble,btExtended,btCExtended,btCurrency];
   btAllFloats = [btSingle,btDouble,btExtended,btCExtended,btCurrency];
   btAllBooleans = [btBoolean,btByteBool,btWordBool,btLongBool,btQWordBool];
   btAllBooleans = [btBoolean,btByteBool,btWordBool,btLongBool,btQWordBool];
   btArrayRangeTypes = btAllChars+btAllBooleans+btAllInteger;
   btArrayRangeTypes = btAllChars+btAllBooleans+btAllInteger;
@@ -516,6 +525,25 @@ const
 const
 const
   ResolverResultVar = 'Result';
   ResolverResultVar = 'Result';
 
 
+type
+  {$ifdef pas2js}
+  TPasResIterate = procedure(Item, Arg: pointer) of object;
+
+  { TPasResHashList }
+
+  TPasResHashList = class(TJSObject)
+  public
+    constructor Create; reintroduce;
+    destructor Destroy;
+    procedure Add(const aName: string; Item: Pointer);
+    function Find(const aName: string): Pointer;
+    procedure ForEachCall(Proc: TPasResIterate; Arg: Pointer);
+    procedure Clear;
+  end;
+  {$else}
+  TPasResHashList = TFPHashList;
+  {$endif}
+
 type
 type
 
 
   { EPasResolve }
   { EPasResolve }
@@ -525,7 +553,7 @@ type
     FPasElement: TPasElement;
     FPasElement: TPasElement;
     procedure SetPasElement(AValue: TPasElement);
     procedure SetPasElement(AValue: TPasElement);
   public
   public
-    Id: int64;
+    Id: TMaxPrecInt;
     MsgType: TMessageType;
     MsgType: TMessageType;
     MsgNumber: integer;
     MsgNumber: integer;
     MsgPattern: String;
     MsgPattern: String;
@@ -579,7 +607,7 @@ type
     procedure OnClearItem(Item, Dummy: pointer);
     procedure OnClearItem(Item, Dummy: pointer);
     procedure OnCollectItem(Item, aList: pointer);
     procedure OnCollectItem(Item, aList: pointer);
   public
   public
-    References: TFPHashList; // hash list of TPasScopeReference
+    References: TPasResHashList; // hash list of TPasScopeReference
     constructor Create(aScope: TPasScope);
     constructor Create(aScope: TPasScope);
     destructor Destroy; override;
     destructor Destroy; override;
     procedure Clear;
     procedure Clear;
@@ -683,7 +711,7 @@ type
 
 
   TPasIdentifierScope = Class(TPasScope)
   TPasIdentifierScope = Class(TPasScope)
   private
   private
-    FItems: TFPHashList;
+    FItems: TPasResHashList;
     procedure InternalAdd(Item: TPasIdentifier);
     procedure InternalAdd(Item: TPasIdentifier);
     procedure OnClearItem(Item, Dummy: pointer);
     procedure OnClearItem(Item, Dummy: pointer);
     procedure OnCollectItem(Item, List: pointer);
     procedure OnCollectItem(Item, List: pointer);
@@ -1167,14 +1195,14 @@ type
     FBuiltInProcs: array[TResolverBuiltInProc] of TResElDataBuiltInProc;
     FBuiltInProcs: array[TResolverBuiltInProc] of TResElDataBuiltInProc;
     FDefaultNameSpace: String;
     FDefaultNameSpace: String;
     FDefaultScope: TPasDefaultScope;
     FDefaultScope: TPasDefaultScope;
-    FDynArrayMaxIndex: int64;
-    FDynArrayMinIndex: int64;
+    FDynArrayMaxIndex: TMaxPrecInt;
+    FDynArrayMinIndex: TMaxPrecInt;
     FLastCreatedData: array[TResolveDataListKind] of TResolveData;
     FLastCreatedData: array[TResolveDataListKind] of TResolveData;
     FLastElement: TPasElement;
     FLastElement: TPasElement;
     FLastMsg: string;
     FLastMsg: string;
     FLastMsgArgs: TMessageArgs;
     FLastMsgArgs: TMessageArgs;
     FLastMsgElement: TPasElement;
     FLastMsgElement: TPasElement;
-    FLastMsgId: int64;
+    FLastMsgId: TMaxPrecInt;
     FLastMsgNumber: integer;
     FLastMsgNumber: integer;
     FLastMsgPattern: string;
     FLastMsgPattern: string;
     FLastMsgType: TMessageType;
     FLastMsgType: TMessageType;
@@ -1403,7 +1431,7 @@ type
       MinCount: integer; RaiseOnError: boolean): boolean;
       MinCount: integer; RaiseOnError: boolean): boolean;
     function CheckBuiltInMaxParamCount(Proc: TResElDataBuiltInProc; Params: TParamsExpr;
     function CheckBuiltInMaxParamCount(Proc: TResElDataBuiltInProc; Params: TParamsExpr;
       MaxCount: integer; RaiseOnError: boolean): integer;
       MaxCount: integer; RaiseOnError: boolean): integer;
-    function CheckRaiseTypeArgNo(id: int64; ArgNo: integer; Param: TPasExpr;
+    function CheckRaiseTypeArgNo(id: TMaxPrecInt; ArgNo: integer; Param: TPasExpr;
       const ParamResolved: TPasResolverResult; Expected: string; RaiseOnError: boolean): integer;
       const ParamResolved: TPasResolverResult; Expected: string; RaiseOnError: boolean): integer;
     function FindUsedUnitInSection(const aName: string; Section: TPasSection): TPasModule;
     function FindUsedUnitInSection(const aName: string; Section: TPasSection): TPasModule;
     function FindUsedUnit(const aName: string; aMod: TPasModule): TPasModule;
     function FindUsedUnit(const aName: string; aMod: TPasModule): TPasModule;
@@ -1416,7 +1444,7 @@ type
     procedure FindRangeErrorConstructors(ErrorEl: TPasElement); virtual;
     procedure FindRangeErrorConstructors(ErrorEl: TPasElement); virtual;
   protected
   protected
     fExprEvaluator: TResExprEvaluator;
     fExprEvaluator: TResExprEvaluator;
-    procedure OnExprEvalLog(Sender: TResExprEvaluator; const id: int64;
+    procedure OnExprEvalLog(Sender: TResExprEvaluator; const id: TMaxPrecInt;
       MsgType: TMessageType; MsgNumber: integer; const Fmt: String;
       MsgType: TMessageType; MsgNumber: integer; const Fmt: String;
       Args: array of const; PosEl: TPasElement); virtual;
       Args: array of const; PosEl: TPasElement); virtual;
     function OnExprEvalIdentifier(Sender: TResExprEvaluator;
     function OnExprEvalIdentifier(Sender: TResExprEvaluator;
@@ -1624,9 +1652,9 @@ type
       out Line, Column: integer);
       out Line, Column: integer);
     class function GetDbgSourcePosStr(El: TPasElement): string;
     class function GetDbgSourcePosStr(El: TPasElement): string;
     function GetElementSourcePosStr(El: TPasElement): string;
     function GetElementSourcePosStr(El: TPasElement): string;
-    procedure SetLastMsg(const id: int64; MsgType: TMessageType; MsgNumber: integer;
+    procedure SetLastMsg(const id: TMaxPrecInt; MsgType: TMessageType; MsgNumber: integer;
       Const Fmt : String; Args : Array of const; PosEl: TPasElement);
       Const Fmt : String; Args : Array of const; PosEl: TPasElement);
-    procedure LogMsg(const id: int64; MsgType: TMessageType; MsgNumber: integer;
+    procedure LogMsg(const id: TMaxPrecInt; MsgType: TMessageType; MsgNumber: integer;
       const Fmt: String; Args: Array of const; PosEl: TPasElement); overload;
       const Fmt: String; Args: Array of const; PosEl: TPasElement); overload;
     class function GetWarnIdentifierNumbers(Identifier: string;
     class function GetWarnIdentifierNumbers(Identifier: string;
       out MsgNumbers: TIntegerDynArray): boolean; virtual;
       out MsgNumbers: TIntegerDynArray): boolean; virtual;
@@ -1634,28 +1662,28 @@ type
       out GotDesc, ExpDesc: String); overload;
       out GotDesc, ExpDesc: String); overload;
     procedure GetIncompatibleTypeDesc(const GotType, ExpType: TPasType;
     procedure GetIncompatibleTypeDesc(const GotType, ExpType: TPasType;
       out GotDesc, ExpDesc: String); overload;
       out GotDesc, ExpDesc: String); overload;
-    procedure RaiseMsg(const Id: int64; MsgNumber: integer; const Fmt: String;
+    procedure RaiseMsg(const Id: TMaxPrecInt; MsgNumber: integer; const Fmt: String;
       Args: Array of const; ErrorPosEl: TPasElement); virtual;
       Args: Array of const; ErrorPosEl: TPasElement); virtual;
-    procedure RaiseNotYetImplemented(id: int64; El: TPasElement; Msg: string = ''); virtual;
-    procedure RaiseInternalError(id: int64; const Msg: string = '');
-    procedure RaiseInvalidScopeForElement(id: int64; El: TPasElement; const Msg: string = '');
-    procedure RaiseIdentifierNotFound(id: int64; Identifier: string; El: TPasElement);
-    procedure RaiseXExpectedButYFound(id: int64; const X,Y: string; El: TPasElement);
-    procedure RaiseContextXExpectedButYFound(id: int64; const C,X,Y: string; El: TPasElement);
-    procedure RaiseContextXInvalidY(id: int64; const X,Y: string; El: TPasElement);
-    procedure RaiseConstantExprExp(id: int64; ErrorEl: TPasElement);
-    procedure RaiseVarExpected(id: int64; ErrorEl: TPasElement; IdentEl: TPasElement);
-    procedure RaiseRangeCheck(id: int64; ErrorEl: TPasElement);
-    procedure RaiseIncompatibleTypeDesc(id: int64; MsgNumber: integer;
+    procedure RaiseNotYetImplemented(id: TMaxPrecInt; El: TPasElement; Msg: string = ''); virtual;
+    procedure RaiseInternalError(id: TMaxPrecInt; const Msg: string = '');
+    procedure RaiseInvalidScopeForElement(id: TMaxPrecInt; El: TPasElement; const Msg: string = '');
+    procedure RaiseIdentifierNotFound(id: TMaxPrecInt; Identifier: string; El: TPasElement);
+    procedure RaiseXExpectedButYFound(id: TMaxPrecInt; const X,Y: string; El: TPasElement);
+    procedure RaiseContextXExpectedButYFound(id: TMaxPrecInt; const C,X,Y: string; El: TPasElement);
+    procedure RaiseContextXInvalidY(id: TMaxPrecInt; const X,Y: string; El: TPasElement);
+    procedure RaiseConstantExprExp(id: TMaxPrecInt; ErrorEl: TPasElement);
+    procedure RaiseVarExpected(id: TMaxPrecInt; ErrorEl: TPasElement; IdentEl: TPasElement);
+    procedure RaiseRangeCheck(id: TMaxPrecInt; ErrorEl: TPasElement);
+    procedure RaiseIncompatibleTypeDesc(id: TMaxPrecInt; MsgNumber: integer;
       const Args: array of const; const GotDesc, ExpDesc: String; ErrorEl: TPasElement);
       const Args: array of const; const GotDesc, ExpDesc: String; ErrorEl: TPasElement);
-    procedure RaiseIncompatibleType(id: int64; MsgNumber: integer;
+    procedure RaiseIncompatibleType(id: TMaxPrecInt; MsgNumber: integer;
       const Args: array of const; GotType, ExpType: TPasType; ErrorEl: TPasElement);
       const Args: array of const; GotType, ExpType: TPasType; ErrorEl: TPasElement);
-    procedure RaiseIncompatibleTypeRes(id: int64; MsgNumber: integer;
+    procedure RaiseIncompatibleTypeRes(id: TMaxPrecInt; MsgNumber: integer;
       const Args: array of const; const GotType, ExpType: TPasResolverResult;
       const Args: array of const; const GotType, ExpType: TPasResolverResult;
       ErrorEl: TPasElement);
       ErrorEl: TPasElement);
-    procedure RaiseInvalidProcTypeModifier(id: int64; ProcType: TPasProcedureType;
+    procedure RaiseInvalidProcTypeModifier(id: TMaxPrecInt; ProcType: TPasProcedureType;
       ptm: TProcTypeModifier; ErrorEl: TPasElement);
       ptm: TProcTypeModifier; ErrorEl: TPasElement);
-    procedure RaiseInvalidProcModifier(id: int64; Proc: TPasProcedure;
+    procedure RaiseInvalidProcModifier(id: TMaxPrecInt; Proc: TPasProcedure;
       pm: TProcedureModifier; ErrorEl: TPasElement);
       pm: TProcedureModifier; ErrorEl: TPasElement);
     procedure WriteScopes;
     procedure WriteScopes;
     // find value and type of an element
     // find value and type of an element
@@ -1806,8 +1834,8 @@ type
     property BaseTypeLength: TResolverBaseType read FBaseTypeLength write FBaseTypeLength;
     property BaseTypeLength: TResolverBaseType read FBaseTypeLength write FBaseTypeLength;
     property BuiltInProcs[bp: TResolverBuiltInProc]: TResElDataBuiltInProc read GetBuiltInProcs;
     property BuiltInProcs[bp: TResolverBuiltInProc]: TResElDataBuiltInProc read GetBuiltInProcs;
     property ExprEvaluator: TResExprEvaluator read fExprEvaluator;
     property ExprEvaluator: TResExprEvaluator read fExprEvaluator;
-    property DynArrayMinIndex: int64 read FDynArrayMinIndex write FDynArrayMinIndex;
-    property DynArrayMaxIndex: int64 read FDynArrayMaxIndex write FDynArrayMaxIndex;
+    property DynArrayMinIndex: TMaxPrecInt read FDynArrayMinIndex write FDynArrayMinIndex;
+    property DynArrayMaxIndex: TMaxPrecInt read FDynArrayMaxIndex write FDynArrayMaxIndex;
     // parsed values
     // parsed values
     property DefaultNameSpace: String read FDefaultNameSpace;
     property DefaultNameSpace: String read FDefaultNameSpace;
     property RootElement: TPasModule read FRootElement write SetRootElement;
     property RootElement: TPasModule read FRootElement write SetRootElement;
@@ -1831,7 +1859,7 @@ type
     property LastMsg: string read FLastMsg write FLastMsg;
     property LastMsg: string read FLastMsg write FLastMsg;
     property LastMsgArgs: TMessageArgs read FLastMsgArgs write FLastMsgArgs;
     property LastMsgArgs: TMessageArgs read FLastMsgArgs write FLastMsgArgs;
     property LastMsgElement: TPasElement read FLastMsgElement write FLastMsgElement;
     property LastMsgElement: TPasElement read FLastMsgElement write FLastMsgElement;
-    property LastMsgId: int64 read FLastMsgId write FLastMsgId;
+    property LastMsgId: TMaxPrecInt read FLastMsgId write FLastMsgId;
     property LastMsgNumber: integer read FLastMsgNumber write FLastMsgNumber;
     property LastMsgNumber: integer read FLastMsgNumber write FLastMsgNumber;
     property LastMsgPattern: string read FLastMsgPattern write FLastMsgPattern;
     property LastMsgPattern: string read FLastMsgPattern write FLastMsgPattern;
     property LastMsgType: TMessageType read FLastMsgType write FLastMsgType;
     property LastMsgType: TMessageType read FLastMsgType write FLastMsgType;
@@ -2471,6 +2499,53 @@ begin
   str(a,Result);
   str(a,Result);
 end;
 end;
 
 
+{$ifdef pas2js}
+{ TPasResHashList }
+
+constructor TPasResHashList.Create;
+begin
+
+end;
+
+destructor TPasResHashList.Destroy;
+begin
+
+end;
+
+procedure TPasResHashList.Add(const aName: string; Item: Pointer);
+begin
+  Properties[aName]:=Item;
+end;
+
+function TPasResHashList.Find(const aName: string): Pointer;
+begin
+  if hasOwnProperty(aName) then
+    Result:=Pointer(Properties[aName])
+  else
+    Result:=nil;
+end;
+
+procedure TPasResHashList.ForEachCall(Proc: TPasResIterate; Arg: Pointer);
+var
+  key: string;
+begin
+  for key in TJSObject(Self) do
+    if hasOwnProperty(key) then
+      Proc(Pointer(Properties[key]),Arg);
+end;
+
+procedure TPasResHashList.Clear;
+var
+  Arr: TStringDynArray;
+  i: Integer;
+begin
+  Arr:=getOwnPropertyNames(Self);
+  for i:=0 to length(Arr)-1 do
+    JSDelete(Self,Arr[i]);
+end;
+
+{$endif}
+
 { TResElDataBuiltInProc }
 { TResElDataBuiltInProc }
 
 
 destructor TResElDataBuiltInProc.Destroy;
 destructor TResElDataBuiltInProc.Destroy;
@@ -2561,14 +2636,18 @@ end;
 
 
 constructor TPasScopeReferences.Create(aScope: TPasScope);
 constructor TPasScopeReferences.Create(aScope: TPasScope);
 begin
 begin
-  References:=TFPHashList.Create;
+  References:=TPasResHashList.Create;
   FScope:=aScope;
   FScope:=aScope;
 end;
 end;
 
 
 destructor TPasScopeReferences.Destroy;
 destructor TPasScopeReferences.Destroy;
 begin
 begin
   Clear;
   Clear;
+  {$ifdef pas2js}
+  References.Free;
+  {$else}
   FreeAndNil(References);
   FreeAndNil(References);
+  {$endif}
   inherited Destroy;
   inherited Destroy;
 end;
 end;
 
 
@@ -11288,7 +11367,7 @@ begin
   Result:=cExact;
   Result:=cExact;
 end;
 end;
 
 
-function TPasResolver.CheckRaiseTypeArgNo(id: int64; ArgNo: integer;
+function TPasResolver.CheckRaiseTypeArgNo(id: TMaxPrecInt; ArgNo: integer;
   Param: TPasExpr; const ParamResolved: TPasResolverResult; Expected: string;
   Param: TPasExpr; const ParamResolved: TPasResolverResult; Expected: string;
   RaiseOnError: boolean): integer;
   RaiseOnError: boolean): integer;
 begin
 begin
@@ -11474,7 +11553,7 @@ begin
 end;
 end;
 
 
 procedure TPasResolver.OnExprEvalLog(Sender: TResExprEvaluator;
 procedure TPasResolver.OnExprEvalLog(Sender: TResExprEvaluator;
-  const id: int64; MsgType: TMessageType; MsgNumber: integer;
+  const id: TMaxPrecInt; MsgType: TMessageType; MsgNumber: integer;
   const Fmt: String; Args: array of const; PosEl: TPasElement);
   const Fmt: String; Args: array of const; PosEl: TPasElement);
 begin
 begin
   if MsgType<=mtError then
   if MsgType<=mtError then
@@ -11747,8 +11826,7 @@ function TPasResolver.EvalBaseTypeCast(Params: TParamsExpr;
 
 
 var
 var
   Value: TResEvalValue;
   Value: TResEvalValue;
-  Int: TMaxPrecInt;
-  MinIntVal, MaxIntVal: int64;
+  Int, MinIntVal, MaxIntVal: TMaxPrecInt;
   Flo: TMaxPrecFloat;
   Flo: TMaxPrecFloat;
   c: Char;
   c: Char;
   w: WideChar;
   w: WideChar;
@@ -12655,9 +12733,8 @@ var
   Value: TResEvalValue;
   Value: TResEvalValue;
   EnumType: TPasEnumType;
   EnumType: TPasEnumType;
   aSet: TResEvalSet;
   aSet: TResEvalSet;
-  Int: TMaxPrecInt;
   bt: TResolverBaseType;
   bt: TResolverBaseType;
-  MinInt, MaxInt: int64;
+  Int, MinInt, MaxInt: TMaxPrecInt;
   i: Integer;
   i: Integer;
   Expr: TPasExpr;
   Expr: TPasExpr;
 begin
 begin
@@ -13722,7 +13799,7 @@ begin
   FBaseTypeExtended:=btDouble;
   FBaseTypeExtended:=btDouble;
   FBaseTypeLength:=btInt64;
   FBaseTypeLength:=btInt64;
   FDynArrayMinIndex:=0;
   FDynArrayMinIndex:=0;
-  FDynArrayMaxIndex:=High(int64);
+  FDynArrayMaxIndex:=High(TMaxPrecInt);
 
 
   cTGUIDToString:=cTypeConversion+1;
   cTGUIDToString:=cTypeConversion+1;
   cStringToTGUID:=cTypeConversion+1;
   cStringToTGUID:=cTypeConversion+1;
@@ -15216,7 +15293,7 @@ begin
     Result:=Line;
     Result:=Line;
 end;
 end;
 
 
-procedure TPasResolver.SetLastMsg(const id: int64; MsgType: TMessageType;
+procedure TPasResolver.SetLastMsg(const id: TMaxPrecInt; MsgType: TMessageType;
   MsgNumber: integer; const Fmt: String; Args: array of const;
   MsgNumber: integer; const Fmt: String; Args: array of const;
   PosEl: TPasElement);
   PosEl: TPasElement);
 var
 var
@@ -15258,7 +15335,7 @@ begin
   {$ENDIF}
   {$ENDIF}
 end;
 end;
 
 
-procedure TPasResolver.RaiseMsg(const Id: int64; MsgNumber: integer;
+procedure TPasResolver.RaiseMsg(const Id: TMaxPrecInt; MsgNumber: integer;
   const Fmt: String; Args: array of const; ErrorPosEl: TPasElement);
   const Fmt: String; Args: array of const; ErrorPosEl: TPasElement);
 var
 var
   E: EPasResolve;
   E: EPasResolve;
@@ -15275,7 +15352,7 @@ begin
   raise E;
   raise E;
 end;
 end;
 
 
-procedure TPasResolver.RaiseNotYetImplemented(id: int64; El: TPasElement;
+procedure TPasResolver.RaiseNotYetImplemented(id: TMaxPrecInt; El: TPasElement;
   Msg: string);
   Msg: string);
 var
 var
   s: String;
   s: String;
@@ -15289,12 +15366,12 @@ begin
   RaiseMsg(id,nNotYetImplemented,s,[GetObjName(El)],El);
   RaiseMsg(id,nNotYetImplemented,s,[GetObjName(El)],El);
 end;
 end;
 
 
-procedure TPasResolver.RaiseInternalError(id: int64; const Msg: string);
+procedure TPasResolver.RaiseInternalError(id: TMaxPrecInt; const Msg: string);
 begin
 begin
   raise Exception.Create('Internal error: ['+IntToStr(id)+'] '+Msg);
   raise Exception.Create('Internal error: ['+IntToStr(id)+'] '+Msg);
 end;
 end;
 
 
-procedure TPasResolver.RaiseInvalidScopeForElement(id: int64; El: TPasElement;
+procedure TPasResolver.RaiseInvalidScopeForElement(id: TMaxPrecInt; El: TPasElement;
   const Msg: string);
   const Msg: string);
 var
 var
   i: Integer;
   i: Integer;
@@ -15311,7 +15388,7 @@ begin
   RaiseInternalError(id,s);
   RaiseInternalError(id,s);
 end;
 end;
 
 
-procedure TPasResolver.RaiseIdentifierNotFound(id: int64; Identifier: string;
+procedure TPasResolver.RaiseIdentifierNotFound(id: TMaxPrecInt; Identifier: string;
   El: TPasElement);
   El: TPasElement);
 begin
 begin
   {$IFDEF VerbosePasResolver}
   {$IFDEF VerbosePasResolver}
@@ -15321,30 +15398,30 @@ begin
   RaiseMsg(id,nIdentifierNotFound,sIdentifierNotFound,[Identifier],El);
   RaiseMsg(id,nIdentifierNotFound,sIdentifierNotFound,[Identifier],El);
 end;
 end;
 
 
-procedure TPasResolver.RaiseXExpectedButYFound(id: int64; const X, Y: string;
+procedure TPasResolver.RaiseXExpectedButYFound(id: TMaxPrecInt; const X, Y: string;
   El: TPasElement);
   El: TPasElement);
 begin
 begin
   RaiseMsg(id,nXExpectedButYFound,sXExpectedButYFound,[X,Y],El);
   RaiseMsg(id,nXExpectedButYFound,sXExpectedButYFound,[X,Y],El);
 end;
 end;
 
 
-procedure TPasResolver.RaiseContextXExpectedButYFound(id: int64; const C, X,
+procedure TPasResolver.RaiseContextXExpectedButYFound(id: TMaxPrecInt; const C, X,
   Y: string; El: TPasElement);
   Y: string; El: TPasElement);
 begin
 begin
   RaiseMsg(id,nContextExpectedXButFoundY,sContextExpectedXButFoundY,[C,X,Y],El);
   RaiseMsg(id,nContextExpectedXButFoundY,sContextExpectedXButFoundY,[C,X,Y],El);
 end;
 end;
 
 
-procedure TPasResolver.RaiseContextXInvalidY(id: int64; const X, Y: string;
+procedure TPasResolver.RaiseContextXInvalidY(id: TMaxPrecInt; const X, Y: string;
   El: TPasElement);
   El: TPasElement);
 begin
 begin
   RaiseMsg(id,nContextXInvalidY,sContextXInvalidY,[X,Y],El);
   RaiseMsg(id,nContextXInvalidY,sContextXInvalidY,[X,Y],El);
 end;
 end;
 
 
-procedure TPasResolver.RaiseConstantExprExp(id: int64; ErrorEl: TPasElement);
+procedure TPasResolver.RaiseConstantExprExp(id: TMaxPrecInt; ErrorEl: TPasElement);
 begin
 begin
   RaiseMsg(id,nConstantExpressionExpected,sConstantExpressionExpected,[],ErrorEl);
   RaiseMsg(id,nConstantExpressionExpected,sConstantExpressionExpected,[],ErrorEl);
 end;
 end;
 
 
-procedure TPasResolver.RaiseVarExpected(id: int64; ErrorEl: TPasElement;
+procedure TPasResolver.RaiseVarExpected(id: TMaxPrecInt; ErrorEl: TPasElement;
   IdentEl: TPasElement);
   IdentEl: TPasElement);
 begin
 begin
   if IdentEl is TPasProperty then
   if IdentEl is TPasProperty then
@@ -15354,12 +15431,12 @@ begin
     RaiseMsg(id,nVariableIdentifierExpected,sVariableIdentifierExpected,[],ErrorEl);
     RaiseMsg(id,nVariableIdentifierExpected,sVariableIdentifierExpected,[],ErrorEl);
 end;
 end;
 
 
-procedure TPasResolver.RaiseRangeCheck(id: int64; ErrorEl: TPasElement);
+procedure TPasResolver.RaiseRangeCheck(id: TMaxPrecInt; ErrorEl: TPasElement);
 begin
 begin
   RaiseMsg(id,nRangeCheckError,sRangeCheckError,[],ErrorEl);
   RaiseMsg(id,nRangeCheckError,sRangeCheckError,[],ErrorEl);
 end;
 end;
 
 
-procedure TPasResolver.RaiseIncompatibleTypeDesc(id: int64; MsgNumber: integer;
+procedure TPasResolver.RaiseIncompatibleTypeDesc(id: TMaxPrecInt; MsgNumber: integer;
   const Args: array of const; const GotDesc, ExpDesc: String; ErrorEl: TPasElement);
   const Args: array of const; const GotDesc, ExpDesc: String; ErrorEl: TPasElement);
 
 
   function GetString(ArgNo: integer): string;
   function GetString(ArgNo: integer): string;
@@ -15397,7 +15474,7 @@ begin
   end;
   end;
 end;
 end;
 
 
-procedure TPasResolver.RaiseIncompatibleType(id: int64; MsgNumber: integer;
+procedure TPasResolver.RaiseIncompatibleType(id: TMaxPrecInt; MsgNumber: integer;
   const Args: array of const; GotType, ExpType: TPasType; ErrorEl: TPasElement);
   const Args: array of const; GotType, ExpType: TPasType; ErrorEl: TPasElement);
 var
 var
   DescA, DescB: String;
   DescA, DescB: String;
@@ -15412,7 +15489,7 @@ begin
   RaiseIncompatibleTypeDesc(id,MsgNumber,Args,DescA,DescB,ErrorEl);
   RaiseIncompatibleTypeDesc(id,MsgNumber,Args,DescA,DescB,ErrorEl);
 end;
 end;
 
 
-procedure TPasResolver.RaiseIncompatibleTypeRes(id: int64; MsgNumber: integer;
+procedure TPasResolver.RaiseIncompatibleTypeRes(id: TMaxPrecInt; MsgNumber: integer;
   const Args: array of const; const GotType, ExpType: TPasResolverResult;
   const Args: array of const; const GotType, ExpType: TPasResolverResult;
   ErrorEl: TPasElement);
   ErrorEl: TPasElement);
 var
 var
@@ -15425,21 +15502,21 @@ begin
   RaiseIncompatibleTypeDesc(id,MsgNumber,Args,GotDesc,ExpDesc,ErrorEl);
   RaiseIncompatibleTypeDesc(id,MsgNumber,Args,GotDesc,ExpDesc,ErrorEl);
 end;
 end;
 
 
-procedure TPasResolver.RaiseInvalidProcTypeModifier(id: int64;
+procedure TPasResolver.RaiseInvalidProcTypeModifier(id: TMaxPrecInt;
   ProcType: TPasProcedureType; ptm: TProcTypeModifier; ErrorEl: TPasElement);
   ProcType: TPasProcedureType; ptm: TProcTypeModifier; ErrorEl: TPasElement);
 begin
 begin
   RaiseMsg(id,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(ProcType),
   RaiseMsg(id,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(ProcType),
     ProcTypeModifiers[ptm]],ErrorEl);
     ProcTypeModifiers[ptm]],ErrorEl);
 end;
 end;
 
 
-procedure TPasResolver.RaiseInvalidProcModifier(id: int64; Proc: TPasProcedure;
+procedure TPasResolver.RaiseInvalidProcModifier(id: TMaxPrecInt; Proc: TPasProcedure;
   pm: TProcedureModifier; ErrorEl: TPasElement);
   pm: TProcedureModifier; ErrorEl: TPasElement);
 begin
 begin
   RaiseMsg(id,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),
   RaiseMsg(id,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),
     ModifierNames[pm]],ErrorEl);
     ModifierNames[pm]],ErrorEl);
 end;
 end;
 
 
-procedure TPasResolver.LogMsg(const id: int64; MsgType: TMessageType;
+procedure TPasResolver.LogMsg(const id: TMaxPrecInt; MsgType: TMessageType;
   MsgNumber: integer; const Fmt: String; Args: array of const;
   MsgNumber: integer; const Fmt: String; Args: array of const;
   PosEl: TPasElement);
   PosEl: TPasElement);
 var
 var
@@ -16109,9 +16186,8 @@ procedure TPasResolver.CheckAssignExprRange(
 // if RHS is a constant check if it fits into range LeftResolved
 // if RHS is a constant check if it fits into range LeftResolved
 var
 var
   LRangeValue, RValue: TResEvalValue;
   LRangeValue, RValue: TResEvalValue;
-  MinVal, MaxVal: int64;
+  Int, MinVal, MaxVal: TMaxPrecInt;
   RangeExpr: TBinaryExpr;
   RangeExpr: TBinaryExpr;
-  Int: TMaxPrecInt;
   C: TClass;
   C: TClass;
   EnumType: TPasEnumType;
   EnumType: TPasEnumType;
   bt: TResolverBaseType;
   bt: TResolverBaseType;
@@ -18667,11 +18743,14 @@ begin
         else if ToTypeBaseType in btAllStrings then
         else if ToTypeBaseType in btAllStrings then
           begin
           begin
           if FromResolved.BaseType in btAllStringAndChars then
           if FromResolved.BaseType in btAllStringAndChars then
-            Result:=cCompatible;
+            Result:=cCompatible
+          else if (FromResolved.BaseType=btPointer)
+              and (ToTypeBaseType in btAllStringPointer) then
+            Result:=cExact;
           end
           end
         else if ToTypeBaseType=btPointer then
         else if ToTypeBaseType=btPointer then
           begin
           begin
-          if FromResolved.BaseType=btPointer then
+          if FromResolved.BaseType in ([btPointer]+btAllStringPointer) then
             Result:=cExact
             Result:=cExact
           else if FromResolved.BaseType=btContext then
           else if FromResolved.BaseType=btContext then
             begin
             begin

+ 35 - 28
packages/fcl-passrc/tests/tcresolver.pas

@@ -13959,34 +13959,41 @@ end;
 procedure TTestResolver.TestPointer;
 procedure TTestResolver.TestPointer;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
-  Add('type');
-  Add('  TObject = class end;');
-  Add('  TClass = class of TObject;');
-  Add('  TMyPtr = pointer;');
-  Add('  TArrInt = array of longint;');
-  Add('  TFunc = function: longint;');
-  Add('procedure DoIt; begin end;');
-  Add('var');
-  Add('  p: TMyPtr;');
-  Add('  Obj: TObject;');
-  Add('  Cl: TClass;');
-  Add('  a: tarrint;');
-  Add('  f: TFunc;');
-  Add('begin');
-  Add('  p:=nil;');
-  Add('  if p=nil then;');
-  Add('  if nil=p then;');
-  Add('  if Assigned(p) then;');
-  Add('  p:=obj;');
-  Add('  p:=cl;');
-  Add('  p:=a;');
-  Add('  p:=Pointer(f);');
-  Add('  p:=@DoIt;');
-  Add('  p:=Pointer(@DoIt);');
-  Add('  obj:=TObject(p);');
-  Add('  cl:=TClass(p);');
-  Add('  a:=TArrInt(p);');
-  Add('  p:=Pointer(a);');
+  Add([
+  'type',
+  '  TObject = class end;',
+  '  TClass = class of TObject;',
+  '  TMyPtr = pointer;',
+  '  TArrInt = array of longint;',
+  '  TFunc = function: longint;',
+  'procedure DoIt; begin end;',
+  'var',
+  '  p: TMyPtr;',
+  '  Obj: TObject;',
+  '  Cl: TClass;',
+  '  a: tarrint;',
+  '  f: TFunc;',
+  '  s: string;',
+  '  u: unicodestring;',
+  'begin',
+  '  p:=nil;',
+  '  if p=nil then;',
+  '  if nil=p then;',
+  '  if Assigned(p) then;',
+  '  p:=obj;',
+  '  p:=cl;',
+  '  p:=a;',
+  '  p:=Pointer(f);',
+  '  p:=@DoIt;',
+  '  p:=Pointer(@DoIt);',
+  '  obj:=TObject(p);',
+  '  cl:=TClass(p);',
+  '  a:=TArrInt(p);',
+  '  p:=Pointer(a);',
+  '  p:=Pointer(s);',
+  '  s:=String(p);',
+  '  p:=pointer(u);',
+  '  u:=UnicodeString(p);']);
   ParseProgram;
   ParseProgram;
 end;
 end;