paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-19 04:09:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: resolver: check library export function overload

Browse Source 
git-svn-id: trunk@48118 -
This commit is contained in:
Mattias Gaertner 2021-01-09 13:56:28 +00:00
parent f42f62565b
commit 3b0df17bd1
2 changed files with 54 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
packages/fcl-passrc/src/pasresolver.pp
View File

@ -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)}

25
packages/fcl-passrc/tests/tcresolver.pas
View File

@ -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