fcl-passrc: resolver: use function result.parent functype, added storage for procedure references

git-svn-id: trunk@38298 -

packages/fcl-passrc/src/pasresolver.pp

@@ -670,6 +670,32 @@ type
   end;
   TPasClassScopeClass = class of TPasClassScope;
 
+  TPSRefAccess = (
+    psraNone,
+    psraRead,
+    psraWrite,
+    psraReadWrite,
+    psraWriteRead,
+    psraTypeInfo
+    );
+
+  { TPasProcScopeReference }
+
+  TPasProcScopeReference = class
+  private
+    FElement: TPasElement;
+    procedure SetElement(const AValue: TPasElement);
+  public
+    {$IFDEF VerbosePasResolver}
+    Owner: TObject;
+    {$ENDIF}
+    Access: TPSRefAccess;
+    NeedTypeInfo: boolean;
+    NextSameName: TPasProcScopeReference;
+    destructor Destroy; override;
+    property Element: TPasElement read FElement write SetElement;
+  end;
+
   TPasProcedureScopeFlag = (
     ppsfIsGroupOverload // mode objfpc: one overload is enough for all procs in same scope
     );
@@ -678,6 +704,8 @@ type
   { TPasProcedureScope }
 
   TPasProcedureScope = Class(TPasIdentifierScope)
+  private
+    procedure OnClearReferenceItem(Item, Dummy: pointer);
   public
     DeclarationProc: TPasProcedure; // the corresponding forward declaration
     ImplProc: TPasProcedure; // the corresponding proc with Body
@@ -687,6 +715,7 @@ type
     Mode: TModeSwitch;
     Flags: TPasProcedureScopeFlags;
     BoolSwitches: TBoolSwitches;
+    References: TFPHashList; // list of TPasProcScopeReference, created by TPasAnalyzer
     function FindIdentifier(const Identifier: String): TPasIdentifier; override;
     procedure IterateElements(const aName: string; StartScope: TPasScope;
       const OnIterateElement: TIterateScopeElement; Data: Pointer;
@@ -694,6 +723,9 @@ type
     function GetSelfScope: TPasProcedureScope; // get the next parent procscope with a classcope
     procedure WriteIdentifiers(Prefix: string); override;
     destructor Destroy; override;
+    procedure ClearReferences;
+    function AddReference(El: TPasElement; Access: TPSRefAccess): TPasProcScopeReference;
+    function FindReference(const aName: string): TPasProcScopeReference;
   end;
   TPasProcedureScopeClass = class of TPasProcedureScope;
 
@@ -858,6 +890,19 @@ type
     );
   TPRResolveVarAccesses = set of TResolvedRefAccess;
 
+const
+  ResolvedToPSRefAccess: array[TResolvedRefAccess] of TPSRefAccess = (
+    psraNone, // rraNone
+    psraRead,  // rraRead
+    psraWrite, // rraAssign
+    psraReadWrite, // rraReadAndAssign
+    psraReadWrite, // rraVarParam
+    psraWrite, // rraOutParam
+    psraNone // rraParamToUnknownProc
+    );
+
+type
+
   { TResolvedReference - CustomData for normal references }
 
   TResolvedReference = Class(TResolveData)
@@ -1396,6 +1441,7 @@ type
     procedure RestoreSubScopes(Depth: integer);
     function GetInheritedExprScope(ErrorEl: TPasElement): TPasProcedureScope;
     // log and messages
+    class function MangleSourceLineNumber(Line, Column: integer): integer;
     class procedure UnmangleSourceLineNumber(LineNumber: integer;
       out Line, Column: integer);
     class function GetDbgSourcePosStr(El: TPasElement): string;
@@ -2092,6 +2138,30 @@ begin
   Result:='['+Result+']';
 end;
 
+{ TPasProcScopeReference }
+
+procedure TPasProcScopeReference.SetElement(const AValue: TPasElement);
+begin
+  if FElement=AValue then Exit;
+  if FElement<>nil then
+    FElement.Release;
+  FElement:=AValue;
+  if FElement<>nil then
+    FElement.AddRef;
+end;
+
+destructor TPasProcScopeReference.Destroy;
+begin
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TPasProcScopeReference.Destroy START ',ClassName,' "',GetObjName(Element),'"');
+  {$ENDIF}
+  Element:=nil;
+  inherited Destroy;
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TPasProcScopeReference.Destroy END ',ClassName);
+  {$ENDIF}
+end;
+
 { TPasPropertyScope }
 
 destructor TPasPropertyScope.Destroy;
@@ -2189,6 +2259,21 @@ end;
 
 { TPasProcedureScope }
 
+procedure TPasProcedureScope.OnClearReferenceItem(Item, Dummy: pointer);
+var
+  Ref: TPasProcScopeReference absolute Item;
+  Ref2: TPasProcScopeReference;
+begin
+  if Dummy=nil then ;
+  //writeln('TPasProcedureScope.OnClearReferenceItem ',GetObjName(Ref.Element));
+  while Ref<>nil do
+    begin
+    Ref2:=Ref;
+    Ref:=Ref.NextSameName;
+    Ref2.Free;
+    end;
+end;
+
 function TPasProcedureScope.FindIdentifier(const Identifier: String
   ): TPasIdentifier;
 begin
@@ -2231,6 +2316,7 @@ end;
 
 destructor TPasProcedureScope.Destroy;
 begin
+  ClearReferences;
   {$IFDEF VerbosePasResolverMem}
   writeln('TPasProcedureScope.Destroy START ',ClassName);
   {$ENDIF}
@@ -2241,6 +2327,113 @@ begin
   {$ENDIF}
 end;
 
+procedure TPasProcedureScope.ClearReferences;
+begin
+  if References=nil then exit;
+  References.ForEachCall(@OnClearReferenceItem,nil);
+  References.Clear;
+  FreeAndNil(References);
+end;
+
+function TPasProcedureScope.AddReference(El: TPasElement; Access: TPSRefAccess
+  ): TPasProcScopeReference;
+var
+  LoName: String;
+  OldItem, Item: TPasProcScopeReference;
+  Index: Integer;
+begin
+  if References=nil then
+    References:=TFPHashList.Create;
+  LoName:=lowercase(El.Name);
+  OldItem:=TPasProcScopeReference(References.Find(LoName));
+  Item:=OldItem;
+  while Item<>nil do
+    begin
+    if Item.Element=El then
+      begin
+      // already marked as used -> combine access
+      case Access of
+      psraNone: ;
+      psraRead:
+        case Item.Access of
+          psraNone: Item.Access:=Access;
+          //psraRead: ;
+          psraWrite: Item.Access:=psraWriteRead;
+          //psraReadWrite: ;
+          //psraWriteRead: ;
+          //psraTypeInfo: ;
+        end;
+      psraWrite:
+        case Item.Access of
+          psraNone: Item.Access:=Access;
+          psraRead: Item.Access:=psraReadWrite;
+          //psraWrite: ;
+          //psraReadWrite: ;
+          //psraWriteRead: ;
+          //psraTypeInfo: ;
+        end;
+      psraReadWrite:
+        case Item.Access of
+          psraNone: Item.Access:=Access;
+          psraRead: Item.Access:=psraReadWrite;
+          psraWrite: Item.Access:=psraWriteRead;
+          //psraReadWrite: ;
+          //psraWriteRead: ;
+          //psraTypeInfo: ;
+        end;
+      psraWriteRead:
+        case Item.Access of
+          psraNone: Item.Access:=Access;
+          psraRead: Item.Access:=psraReadWrite;
+          psraWrite: Item.Access:=psraWriteRead;
+          //psraReadWrite: ;
+          //psraWriteRead: ;
+          //psraTypeInfo: ;
+        end;
+      psraTypeInfo: Item.Access:=psraTypeInfo;
+      else
+        raise EPasResolve.Create(GetObjName(El)+' unknown Access');
+      end;
+      exit(Item);
+      end;
+    Item:=Item.NextSameName;
+    end;
+  // new reference
+  Item:=TPasProcScopeReference.Create;
+  Item.Element:=El;
+  Item.Access:=Access;
+  Index:=References.FindIndexOf(LoName);
+  if Index<0 then
+    begin
+    References.Add(LoName,Item);
+    {$IFDEF VerbosePJUFiler}
+    if TPasProcScopeReference(References.Find(LoName))<>Item then
+      raise EPasResolve.Create('20180219230028');
+    {$ENDIF}
+    end
+  else
+    begin
+    OldItem:=TPasProcScopeReference(References.List^[Index].Data);
+    {$IFDEF VerbosePJUFiler}
+    if lowercase(OldItem.Element.Name)<>LoName then
+      raise EPasResolve.Create('20180219230055');
+    {$ENDIF}
+    Item.NextSameName:=OldItem;
+    References.List^[Index].Data:=Item;
+    end;
+  Result:=Item;
+end;
+
+function TPasProcedureScope.FindReference(const aName: string
+  ): TPasProcScopeReference;
+var
+  LoName: String;
+begin
+  if References=nil then exit(nil);
+  LoName:=lowercase(aName);
+  Result:=TPasProcScopeReference(References.Find(LoName));
+end;
+
 { TPasClassScope }
 
 destructor TPasClassScope.Destroy;
@@ -7390,7 +7583,13 @@ end;
 procedure TPasResolver.AddFunctionResult(El: TPasResultElement);
 begin
   if TopScope.ClassType<>FScopeClass_Proc then exit;
-  if not (El.Parent is TPasProcedure) then exit;
+  if El.Parent is TPasProcedureType then
+    begin
+    if not (El.Parent.Parent is TPasProcedure) then
+      exit;
+    end
+  else if not (El.Parent is TPasProcedure) then
+    exit;
   AddIdentifier(TPasProcedureScope(TopScope),ResolverResultVar,El,pikSimple);
 end;
 
@@ -10827,11 +11026,7 @@ begin
     end;
   SrcY:=ASrcPos.Row;
   if StoreSrcColumns then
-    begin
-    if (ASrcPos.Column<ParserMaxEmbeddedColumn)
-        and (SrcY<ParserMaxEmbeddedRow) then
-      SrcY:=-(SrcY*ParserMaxEmbeddedColumn+integer(ASrcPos.Column));
-    end;
+    SrcY:=MangleSourceLineNumber(SrcY,ASrcPos.Column);
 
   // create element
   El:=AClass.Create(AName,AParent);
@@ -12061,6 +12256,16 @@ begin
   until false;
 end;
 
+class function TPasResolver.MangleSourceLineNumber(Line, Column: integer
+  ): integer;
+begin
+  if (Column<ParserMaxEmbeddedColumn)
+      and (Line<ParserMaxEmbeddedRow) then
+    Result:=-(Line*ParserMaxEmbeddedColumn+integer(Column))
+  else
+    Result:=Line;
+end;
+
 procedure TPasResolver.SetLastMsg(const id: int64; MsgType: TMessageType;
   MsgNumber: integer; const Fmt: String; Args: array of const;
   PosEl: TPasElement);

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -617,6 +617,7 @@ begin
     UseExpr(TPasExpr(El))
   else if C=TPasEnumValue then
     begin
+    UseExpr(TPasEnumValue(El).Value);
     repeat
       MarkElementAsUsed(El);
       El:=El.Parent;
@@ -665,6 +666,8 @@ begin
   else if (C=TPasAliasType) or (C=TPasTypeAliasType) then
     UsePublished(TPasAliasType(El).DestType)
   else if C=TPasEnumType then
+    for i:=0 to TPasEnumType(El).Values.Count-1 do
+      UsePublished(TPasEnumValue(TPasEnumType(El).Values[i]))
   else if C=TPasSetType then
     UsePublished(TPasSetType(El).EnumType)
   else if C=TPasRangeType then
@@ -991,7 +994,7 @@ var
   Params: TPasExprArray;
   i: Integer;
   BuiltInProc: TResElDataBuiltInProc;
-  ParamResolved, ResolvedAbs: TPasResolverResult;
+  ParamResolved: TPasResolverResult;
   Decl: TPasElement;
   ModScope: TPasModuleScope;
 begin
@@ -1006,13 +1009,6 @@ begin
     Decl:=Ref.Declaration;
     UseElement(Decl,Ref.Access,false);
 
-    if (Decl is TPasVariable) and (TPasVariable(Decl).AbsoluteExpr<>nil) then
-      begin
-      Resolver.ComputeElement(TPasVariable(Decl).AbsoluteExpr,ResolvedAbs,[rcNoImplicitProc]);
-      if ResolvedAbs.IdentEl is TPasVariable then
-        UseVariable(TPasVariable(ResolvedAbs.IdentEl),Ref.Access,false);
-      end;
-
     if Resolver.IsNameExpr(El) then
       begin
       if Ref.WithExprScope<>nil then
@@ -1318,6 +1314,8 @@ begin
     else if C=TPasEnumType then
       begin
       if not MarkElementAsUsed(El) then exit;
+      for i:=0 to TPasEnumType(El).Values.Count-1 do
+        UseElement(TPasEnumValue(TPasEnumType(El).Values[i]),rraRead,false);
       end
     else if C=TPasPointerType then
       begin
@@ -1531,18 +1529,15 @@ begin
     UseExpr(El.Expr);
     UseExpr(El.LibraryName);
     UseExpr(El.ExportName);
+    UseExpr(El.AbsoluteExpr);
     if Prop<>nil then
       begin
       for i:=0 to Prop.Args.Count-1 do
         UseType(TPasArgument(Prop.Args[i]).ArgType,paumElement);
       UseExpr(Prop.IndexExpr);
-      // ToDo: Prop.ImplementsFunc
-      // ToDo: Prop.DispIDExpr
+      UseExpr(Prop.ImplementsFunc);
+      // ToDo: UseExpr(Prop.DispIDExpr);
       // see UsePublished: Prop.StoredAccessor, Prop.DefaultExpr
-      end;
-    if El.AbsoluteExpr<>nil then
-      begin
-
       end;
     end
   else

packages/fcl-passrc/src/pparser.pp

@@ -5596,7 +5596,7 @@ begin
       Result.ProcType := TPasProcedureType(CreateElement(TPasProcedureType, '', Result))
     else
       begin
-      Result.ProcType := CreateFunctionType('', 'Result', Result, True, CurTokenPos);
+      Result.ProcType := CreateFunctionType('', 'Result', Result, False, CurTokenPos);
       if (ProcType in [ptOperator, ptClassOperator]) then
         begin
         TPasOperator(Result).TokenBased:=IsTokenBased;

packages/fcl-passrc/tests/tcresolver.pas

@@ -6104,7 +6104,7 @@ begin
         //writeln('TTestResolver.TestProc_FunctionResult_DeclProc ',GetObjName(Ref.Declaration));
         if not (Ref.Declaration is TPasResultElement) then continue;
         ResultEl:=TPasResultElement(Ref.Declaration);
-        Proc:=ResultEl.Parent as TPasProcedure;
+        Proc:=ResultEl.Parent.Parent as TPasProcedure;
         ProcScope:=Proc.CustomData as TPasProcedureScope;
         if ProcScope.DeclarationProc<>nil then
           RaiseErrorAtSrcMarker('expected Result to resolve to declaration at "#'+aMarker^.Identifier+', but was implproc"',aMarker);