Browse Source

fcl-passrc: fixed parent of TPasVariable.Expr, added resolver property BuiltInProcs

git-svn-id: trunk@38258 -
Mattias Gaertner 7 years ago
parent
commit
fc8e95f8f5
2 changed files with 35 additions and 3 deletions
  1. 33 2
      packages/fcl-passrc/src/pasresolver.pp
  2. 2 1
      packages/fcl-passrc/src/pparser.pp

+ 33 - 2
packages/fcl-passrc/src/pasresolver.pp

@@ -1001,6 +1001,7 @@ type
     FBaseTypeLength: TResolverBaseType;
     FBaseTypeLength: TResolverBaseType;
     FBaseTypes: array[TResolverBaseType] of TPasUnresolvedSymbolRef;
     FBaseTypes: array[TResolverBaseType] of TPasUnresolvedSymbolRef;
     FBaseTypeString: TResolverBaseType;
     FBaseTypeString: TResolverBaseType;
+    FBuiltInProcs: array[TResolverBuiltInProc] of TResElDataBuiltInProc;
     FDefaultNameSpace: String;
     FDefaultNameSpace: String;
     FDefaultScope: TPasDefaultScope;
     FDefaultScope: TPasDefaultScope;
     FDynArrayMaxIndex: int64;
     FDynArrayMaxIndex: int64;
@@ -1030,6 +1031,7 @@ type
     FTopScope: TPasScope;
     FTopScope: TPasScope;
     procedure ClearResolveDataList(Kind: TResolveDataListKind);
     procedure ClearResolveDataList(Kind: TResolveDataListKind);
     function GetBaseTypeNames(bt: TResolverBaseType): string;
     function GetBaseTypeNames(bt: TResolverBaseType): string;
+    function GetBuiltInProcs(bp: TResolverBuiltInProc): TResElDataBuiltInProc;
   protected
   protected
     const
     const
       cExact = 0;
       cExact = 0;
@@ -1490,7 +1492,6 @@ type
     function ResolvedElCanBeVarParam(const ResolvedEl: TPasResolverResult): boolean;
     function ResolvedElCanBeVarParam(const ResolvedEl: TPasResolverResult): boolean;
     function ResolvedElIsClassInstance(const ResolvedEl: TPasResolverResult): boolean;
     function ResolvedElIsClassInstance(const ResolvedEl: TPasResolverResult): boolean;
     // uility functions
     // uility functions
-    property BaseTypeNames[bt: TResolverBaseType]: string read GetBaseTypeNames;
     function GetProcTypeDescription(ProcType: TPasProcedureType; UseName: boolean = true; AddPaths: boolean = false): string;
     function GetProcTypeDescription(ProcType: TPasProcedureType; UseName: boolean = true; AddPaths: boolean = false): string;
     function GetResolverResultDescription(const T: TPasResolverResult; OnlyType: boolean = false): string;
     function GetResolverResultDescription(const T: TPasResolverResult; OnlyType: boolean = false): string;
     function GetTypeDescription(aType: TPasType; AddPath: boolean = false): string;
     function GetTypeDescription(aType: TPasType; AddPath: boolean = false): string;
@@ -1542,16 +1543,19 @@ type
     function GetCombinedChar(const Char1, Char2: TPasResolverResult; ErrorEl: TPasElement): TResolverBaseType; virtual;
     function GetCombinedChar(const Char1, Char2: TPasResolverResult; ErrorEl: TPasElement): TResolverBaseType; virtual;
     function GetCombinedString(const Str1, Str2: TPasResolverResult; ErrorEl: TPasElement): TResolverBaseType; virtual;
     function GetCombinedString(const Str1, Str2: TPasResolverResult; ErrorEl: TPasElement): TResolverBaseType; virtual;
     function IsElementSkipped(El: TPasElement): boolean; virtual;
     function IsElementSkipped(El: TPasElement): boolean; virtual;
+    function FindLocalBuiltInSymbol(El: TPasElement): TPasElement; virtual;
   public
   public
     // options
     // options
     property Options: TPasResolverOptions read FOptions write FOptions;
     property Options: TPasResolverOptions read FOptions write FOptions;
     property AnonymousElTypePostfix: String read FAnonymousElTypePostfix
     property AnonymousElTypePostfix: String read FAnonymousElTypePostfix
       write FAnonymousElTypePostfix; // default empty, if set, anonymous element types are named ArrayName+Postfix and added to declarations
       write FAnonymousElTypePostfix; // default empty, if set, anonymous element types are named ArrayName+Postfix and added to declarations
     property BaseTypes[bt: TResolverBaseType]: TPasUnresolvedSymbolRef read GetBaseTypes;
     property BaseTypes[bt: TResolverBaseType]: TPasUnresolvedSymbolRef read GetBaseTypes;
+    property BaseTypeNames[bt: TResolverBaseType]: string read GetBaseTypeNames;
     property BaseTypeChar: TResolverBaseType read FBaseTypeChar write FBaseTypeChar;
     property BaseTypeChar: TResolverBaseType read FBaseTypeChar write FBaseTypeChar;
     property BaseTypeExtended: TResolverBaseType read FBaseTypeExtended write FBaseTypeExtended;
     property BaseTypeExtended: TResolverBaseType read FBaseTypeExtended write FBaseTypeExtended;
     property BaseTypeString: TResolverBaseType read FBaseTypeString write FBaseTypeString;
     property BaseTypeString: TResolverBaseType read FBaseTypeString write FBaseTypeString;
     property BaseTypeLength: TResolverBaseType read FBaseTypeLength write FBaseTypeLength;
     property BaseTypeLength: TResolverBaseType read FBaseTypeLength write FBaseTypeLength;
+    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 DynArrayMinIndex: int64 read FDynArrayMinIndex write FDynArrayMinIndex;
     property DynArrayMaxIndex: int64 read FDynArrayMaxIndex write FDynArrayMaxIndex;
     property DynArrayMaxIndex: int64 read FDynArrayMaxIndex write FDynArrayMaxIndex;
@@ -3063,6 +3067,12 @@ begin
     Result:=ResBaseTypeNames[bt];
     Result:=ResBaseTypeNames[bt];
 end;
 end;
 
 
+function TPasResolver.GetBuiltInProcs(bp: TResolverBuiltInProc
+  ): TResElDataBuiltInProc;
+begin
+  Result:=FBuiltInProcs[bp];
+end;
+
 procedure TPasResolver.SetRootElement(const AValue: TPasModule);
 procedure TPasResolver.SetRootElement(const AValue: TPasModule);
 begin
 begin
   if FRootElement=AValue then Exit;
   if FRootElement=AValue then Exit;
@@ -11616,10 +11626,13 @@ end;
 procedure TPasResolver.ClearBuiltInIdentifiers;
 procedure TPasResolver.ClearBuiltInIdentifiers;
 var
 var
   bt: TResolverBaseType;
   bt: TResolverBaseType;
+  bp: TResolverBuiltInProc;
 begin
 begin
   ClearResolveDataList(lkBuiltIn);
   ClearResolveDataList(lkBuiltIn);
   for bt in TResolverBaseType do
   for bt in TResolverBaseType do
     FBaseTypes[bt]:=nil;
     FBaseTypes[bt]:=nil;
+  for bp in TResolverBuiltInProc do
+    FBuiltInProcs[bp]:=nil;
 end;
 end;
 
 
 procedure TPasResolver.AddObjFPCBuiltInIdentifiers(
 procedure TPasResolver.AddObjFPCBuiltInIdentifiers(
@@ -11782,6 +11795,8 @@ begin
   Result.Flags:=Flags;
   Result.Flags:=Flags;
   AddResolveData(El,Result,lkBuiltIn);
   AddResolveData(El,Result,lkBuiltIn);
   FDefaultScope.AddIdentifier(aName,El,pikBuiltInProc);
   FDefaultScope.AddIdentifier(aName,El,pikBuiltInProc);
+  if BuiltIn<>bfCustom then
+    FBuiltInProcs[BuiltIn]:=Result;
 end;
 end;
 
 
 procedure TPasResolver.AddResolveData(El: TPasElement; Data: TResolveData;
 procedure TPasResolver.AddResolveData(El: TPasElement; Data: TResolveData;
@@ -15467,7 +15482,8 @@ begin
   if Store
   if Store
       and (Expr.CustomData=nil)
       and (Expr.CustomData=nil)
       and (Result.Element=nil)
       and (Result.Element=nil)
-      and (not fExprEvaluator.IsSimpleExpr(Expr)) then
+      and (not fExprEvaluator.IsSimpleExpr(Expr))
+      and (Expr.GetModule=RootElement) then
     begin
     begin
     //writeln('TPasResolver.Eval STORE Expr=',GetObjName(Expr),' Result=',Result.AsDebugString);
     //writeln('TPasResolver.Eval STORE Expr=',GetObjName(Expr),' Result=',Result.AsDebugString);
     AddResolveData(Expr,Result,lkModule);
     AddResolveData(Expr,Result,lkModule);
@@ -16283,6 +16299,21 @@ begin
   Result:=false;
   Result:=false;
 end;
 end;
 
 
+function TPasResolver.FindLocalBuiltInSymbol(El: TPasElement): TPasElement;
+var
+  Data: TObject;
+begin
+  Data:=El.CustomData;
+  if Data=nil then
+    RaiseInternalError(20180215185302,GetObjName(El));
+  if Data.ClassType=TResElDataBaseType then
+    Result:=BaseTypes[TResElDataBaseType(Data).BaseType]
+  else if Data.ClassType=TResElDataBuiltInProc then
+    Result:=BuiltInProcs[TResElDataBuiltInProc(Data).BuiltIn].Element
+  else
+    Result:=nil;
+end;
+
 function TPasResolver.CheckSrcIsADstType(const ResolvedSrcType,
 function TPasResolver.CheckSrcIsADstType(const ResolvedSrcType,
   ResolvedDestType: TPasResolverResult; ErrorEl: TPasElement): integer;
   ResolvedDestType: TPasResolverResult; ErrorEl: TPasElement): integer;
 // finds distance between classes SrcType and DestType
 // finds distance between classes SrcType and DestType

+ 2 - 1
packages/fcl-passrc/src/pparser.pp

@@ -3965,7 +3965,8 @@ begin
       NextToken;
       NextToken;
       If Curtoken<>tkSemicolon then
       If Curtoken<>tkSemicolon then
         UnGetToken;
         UnGetToken;
-      Mods:=GetVariableModifiers(Parent,VarMods,aLibName,aExpName,ExternalClass);
+      VarEl:=TPasVariable(VarList[0]);
+      Mods:=GetVariableModifiers(VarEl,VarMods,aLibName,aExpName,ExternalClass);
       if (mods='') and (CurToken<>tkSemicolon) then
       if (mods='') and (CurToken<>tkSemicolon) then
         NextToken;
         NextToken;
       end
       end