fcl-passrc: resolver: check library export function overload

git-svn-id: trunk@48118 -

packages/fcl-passrc/src/pasresolver.pp

@@ -9049,7 +9049,7 @@ begin
     CurEl:=nil;
     if not SameText(RightStr(AttrName,length('Attribute')),'Attribute') then
       begin
-      // first search AttrName+'Attibute'
+      // first search AttrName+'Attribute'
       CurEl:=FindFirstEl(AttrName+'Attribute',Data,NameExpr);
       end;
     // then search the name
@@ -9164,12 +9164,14 @@ var
   FindData: TPRFindData;
   Ref: TResolvedReference;
   ResolvedEl: TPasResolverResult;
+  Section: TPasSection;
+  Scope: TPasIdentifierScope;
+  ScopeIdent: TPasIdentifier;
 begin
   Expr:=El.NameExpr;
   if Expr<>nil then
     begin
     ResolveExpr(Expr,rraRead);
-    //ResolveGlobalSymbol(Expr);
     ComputeElement(Expr,ResolvedEl,[rcConstant]);
     DeclEl:=ResolvedEl.IdentEl;
     if DeclEl=nil then
@@ -9189,6 +9191,18 @@ begin
     CheckFoundElement(FindData,Ref);
     end;
 
+  if DeclEl is TPasProcedure then
+    begin
+    Section:=DeclEl.Parent as TPasSection;
+    Scope:=Section.CustomData as TPasIdentifierScope;
+    ScopeIdent:=Scope.FindLocalIdentifier(DeclEl.Name);
+    if (ScopeIdent=nil) then
+      RaiseNotYetImplemented(20210106103001,El,GetObjPath(DeclEl));
+    if ScopeIdent.NextSameIdentifier<>nil then
+      RaiseMsg(20210106103320,nCantDetermineWhichOverloadedFunctionToCall,
+        sCantDetermineWhichOverloadedFunctionToCall,[],El);
+    end;
+
   // check index and name
   CheckConstExpr(El.ExportIndex,[revkInt,revkUInt],'integer');
   CheckConstExpr(El.ExportName,[revkString,revkUnicodeString],'string');
@@ -21318,7 +21332,7 @@ procedure TPasResolver.CheckFoundElement(
 // Call this method after finding an element by searching the scopes.
 
   function IsFieldInheritingConst(aRef: TResolvedReference): boolean;
-  // returns true of aRef is a TPasVariable that inherits its const from parent.
+  // returns true if aRef is a TPasVariable that inherits its const from parent.
   // For example
   //  type TRecord = record
   //    a: word; // inherits const
@@ -27564,6 +27578,21 @@ procedure TPasResolver.ComputeElement(El: TPasElement; out
       end;
   end;
 
+  procedure ComputeExportSymbol(ExpSymbol: TPasExportSymbol);
+  var
+    Ref: TResolvedReference;
+  begin
+    if ExpSymbol.CustomData is TResolvedReference then
+      begin
+      Ref:=TResolvedReference(El.CustomData);
+      ComputeElement(Ref.Declaration,ResolvedEl,Flags+[rcNoImplicitProc],StartEl);
+      end
+    else if ExpSymbol.NameExpr<>nil then
+      ComputeElement(ExpSymbol.NameExpr,ResolvedEl,Flags,StartEl)
+    else
+      RaiseNotYetImplemented(20210106225512,ExpSymbol);
+  end;
+
 var
   DeclEl: TPasElement;
   ElClass: TClass;
@@ -27946,6 +27975,8 @@ begin
     ComputeSpecializeType(TPasSpecializeType(El))
   else if ElClass=TInlineSpecializeExpr then
     ComputeElement(TInlineSpecializeExpr(El).NameExpr,ResolvedEl,Flags,StartEl)
+  else if ElClass=TPasExportSymbol then
+    ComputeExportSymbol(TPasExportSymbol(El))
   else
     RaiseNotYetImplemented(20160922163705,El);
   {$IF defined(nodejs) and defined(VerbosePasResolver)}

packages/fcl-passrc/tests/tcresolver.pas

@@ -986,8 +986,8 @@ type
     Procedure TestLibrary_ExportFunc_IndexStringFail;
     Procedure TestLibrary_ExportVar; // ToDo
     Procedure TestLibrary_Initialization_Finalization;
-    Procedure TestLibrary_ExportFuncOverloadFail; // ToDo
-    // ToDo Procedure TestLibrary_UnitExports;
+    Procedure TestLibrary_ExportFuncOverloadFail;
+    Procedure TestLibrary_UnitExports;
   end;
 
 function LinesToStr(Args: array of const): string;
@@ -18836,8 +18836,6 @@ end;
 
 procedure TTestResolver.TestLibrary_ExportFuncOverloadFail;
 begin
-  exit;
-
   StartLibrary(false);
   Add([
   'procedure Run(w: word); overload;',
@@ -18850,7 +18848,24 @@ begin
   '  Run,',
   '  afile.run;',
   'begin']);
-  CheckResolverException('The symbol cannot be exported from a library',123);
+  CheckResolverException(sCantDetermineWhichOverloadedFunctionToCall,
+    nCantDetermineWhichOverloadedFunctionToCall);
+end;
+
+procedure TTestResolver.TestLibrary_UnitExports;
+begin
+  StartUnit(false);
+  Add([
+  'interface' ,
+  'procedure Run;',
+  'implementation',
+  'procedure Run;',
+  'begin',
+  'end;',
+  'exports',
+  '  Run;',
+  '']);
+  ParseUnit;
 end;
 
 initialization