mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 18:29:27 +02:00
fcl-passrc: resolver: fixed dotted runit reference
git-svn-id: trunk@36117 -
This commit is contained in:
Mattias Gaertner
parent
c552b2957a
commit
96f88184ef
@ -618,6 +618,7 @@ type
|
||||
|
||||
TPasModuleScope = class(TPasScope)
|
||||
public
|
||||
FirstName: string;
|
||||
procedure IterateElements(const aName: string; StartScope: TPasScope;
|
||||
const OnIterateElement: TIterateScopeElement; Data: Pointer;
|
||||
var Abort: boolean); override;
|
||||
@ -1528,6 +1529,7 @@ procedure SetResolverValueExpr(out ResolvedType: TPasResolverResult;
|
||||
|
||||
function ProcNeedsImplProc(Proc: TPasProcedure): boolean;
|
||||
function ChompDottedIdentifier(const Identifier: string): string;
|
||||
function FirstDottedIdentifier(const Identifier: string): string;
|
||||
function IsDottedIdentifierPrefix(const Prefix, Identifier: string): boolean;
|
||||
|
||||
function dbgs(const Flags: TPasResolverComputeFlags): string; overload;
|
||||
@ -1815,6 +1817,17 @@ begin
|
||||
Result:=LeftStr(Identifier,p-1);
|
||||
end;
|
||||
|
||||
function FirstDottedIdentifier(const Identifier: string): string;
|
||||
var
|
||||
p: SizeInt;
|
||||
begin
|
||||
p:=Pos('.',Identifier);
|
||||
if p<1 then
|
||||
Result:=Identifier
|
||||
else
|
||||
Result:=LeftStr(Identifier,p-1);
|
||||
end;
|
||||
|
||||
function IsDottedIdentifierPrefix(const Prefix, Identifier: string): boolean;
|
||||
var
|
||||
l: Integer;
|
||||
@ -2287,7 +2300,7 @@ procedure TPasModuleScope.IterateElements(const aName: string;
|
||||
StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
|
||||
Data: Pointer; var Abort: boolean);
|
||||
begin
|
||||
if CompareText(aName,Element.Name)<>0 then exit;
|
||||
if CompareText(aName,FirstName)<>0 then exit;
|
||||
OnIterateElement(Element,Self,StartScope,Data,Abort);
|
||||
end;
|
||||
|
||||
@ -4985,6 +4998,7 @@ var
|
||||
BuiltInProc: TResElDataBuiltInProc;
|
||||
p: SizeInt;
|
||||
DottedName: String;
|
||||
Bin: TBinaryExpr;
|
||||
begin
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TPasResolver.ResolveNameExpr El=',GetObjName(El),' Name="',aName,'" ',Access);
|
||||
@ -5041,14 +5055,18 @@ begin
|
||||
if El=nil then
|
||||
RaiseInternalError(20170503002012);
|
||||
CreateReference(DeclEl,El,Access);
|
||||
if (El.Parent is TBinaryExpr) and (TBinaryExpr(El.Parent).right=El) then
|
||||
begin
|
||||
Bin:=TBinaryExpr(El.Parent);
|
||||
while Bin.OpCode=eopSubIdent do
|
||||
begin
|
||||
CreateReference(DeclEl,Bin,Access);
|
||||
if not (Bin.Parent is TBinaryExpr) then break;
|
||||
if (TBinaryExpr(Bin.Parent).right<>Bin) then break;
|
||||
Bin:=TBinaryExpr(Bin.Parent);
|
||||
end;
|
||||
end;
|
||||
until false;
|
||||
// and add references to the binary expressions
|
||||
while (El.Parent is TBinaryExpr) and (TBinaryExpr(El.Parent).right=El) do
|
||||
begin
|
||||
El:=TBinaryExpr(El.Parent);
|
||||
if TBinaryExpr(El).OpCode<>eopSubIdent then break;
|
||||
CreateReference(DeclEl,El,Access);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -5847,11 +5865,13 @@ end;
|
||||
procedure TPasResolver.AddModule(El: TPasModule);
|
||||
var
|
||||
C: TClass;
|
||||
ModScope: TPasModuleScope;
|
||||
begin
|
||||
if TopScope<>DefaultScope then
|
||||
RaiseInvalidScopeForElement(20160922163504,El);
|
||||
PushScope(El,TPasModuleScope);
|
||||
TPasModuleScope(TopScope).VisibilityContext:=El;
|
||||
ModScope:=TPasModuleScope(PushScope(El,TPasModuleScope));
|
||||
ModScope.VisibilityContext:=El;
|
||||
ModScope.FirstName:=FirstDottedIdentifier(El.Name);
|
||||
C:=El.ClassType;
|
||||
if (C=TPasProgram) or (C=TPasLibrary) or (C=TPasPackage) then
|
||||
FDefaultNameSpace:=ChompDottedIdentifier(El.Name)
|
||||
|
||||
@ -280,6 +280,9 @@ type
|
||||
Procedure TestUnitUseDotted;
|
||||
Procedure TestUnit_ProgramDefaultNamespace;
|
||||
Procedure TestUnit_DottedIdentifier;
|
||||
Procedure TestUnit_DottedPrg;
|
||||
Procedure TestUnit_DottedUnit;
|
||||
Procedure TestUnit_DottedExpr;
|
||||
Procedure TestUnit_DuplicateDottedUsesFail;
|
||||
Procedure TestUnit_DuplicateUsesDiffNameFail;
|
||||
Procedure TestUnit_Unit1DotUnit2Fail;
|
||||
@ -1260,14 +1263,14 @@ begin
|
||||
Ref:=TResolvedReference(El.CustomData);
|
||||
if ActualAccess<>rraNone then
|
||||
begin
|
||||
writeln('TTestResolver.CheckAccessMarkers multiple references at "#'+aMarker^.Identifier+'":');
|
||||
//writeln('TTestResolver.CheckAccessMarkers multiple references at "#'+aMarker^.Identifier+'":');
|
||||
for j:=0 to Elements.Count-1 do
|
||||
begin
|
||||
El2:=TPasElement(Elements[i]);
|
||||
if not (El2.CustomData is TResolvedReference) then continue;
|
||||
//writeln('TTestResolver.CheckAccessMarkers ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
|
||||
Ref:=TResolvedReference(El.CustomData);
|
||||
writeln(' ',j,'/',Elements.Count,' Element=',GetObjName(El2),' ',AccessNames[Ref.Access],' Declaration="',El2.GetDeclaration(true),'"');
|
||||
//writeln(' ',j,'/',Elements.Count,' Element=',GetObjName(El2),' ',AccessNames[Ref.Access],' Declaration="',El2.GetDeclaration(true),'"');
|
||||
end;
|
||||
RaiseErrorAtSrcMarker('multiple references at "#'+aMarker^.Identifier+'"',aMarker);
|
||||
end;
|
||||
@ -3795,13 +3798,13 @@ begin
|
||||
'begin',
|
||||
' if j1=0 then ;',
|
||||
'']);
|
||||
writeln('TTestResolver.TestUnit_ProgramDefaultNamespace ');
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestUnit_DottedIdentifier;
|
||||
begin
|
||||
MainFilename:='unitdots.main1.pas';
|
||||
|
||||
AddModuleWithIntfImplSrc('unitdots.unit1.pp',
|
||||
LinesToStr([
|
||||
'type TColor = longint;',
|
||||
@ -3829,7 +3832,74 @@ begin
|
||||
' if unitdots.j1=0 then ;',
|
||||
' if unitdots.unit1.i1=0 then ;',
|
||||
'']);
|
||||
writeln('TTestResolver.TestUnit_DottedIdentifier ');
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestUnit_DottedPrg;
|
||||
begin
|
||||
MainFilename:='unitdots.main1.pas';
|
||||
|
||||
AddModuleWithIntfImplSrc('unitdots.unit1.pp',
|
||||
LinesToStr([
|
||||
'type TColor = longint;',
|
||||
'var i1: longint;']),
|
||||
LinesToStr([
|
||||
'']));
|
||||
|
||||
StartProgram(true);
|
||||
Add([
|
||||
'uses UnIt1;',
|
||||
'type',
|
||||
' TPrgColor = UNIT1.tcolor;',
|
||||
' TStrange = UnitDots.Main1.tprgcolor;',
|
||||
'var k1: longint;',
|
||||
'begin',
|
||||
' if unitdots.main1.k1=0 then ;',
|
||||
' if unit1.i1=0 then ;',
|
||||
'']);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestUnit_DottedUnit;
|
||||
begin
|
||||
MainFilename:='unitdots.unit1.pas';
|
||||
StartUnit(false);
|
||||
Add([
|
||||
'interface',
|
||||
'var k1: longint;',
|
||||
'implementation',
|
||||
'initialization',
|
||||
' if unitDots.Unit1.k1=0 then ;',
|
||||
'']);
|
||||
ParseUnit;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestUnit_DottedExpr;
|
||||
begin
|
||||
MainFilename:='unitdots1.sub1.main1.pas';
|
||||
|
||||
AddModuleWithIntfImplSrc('unitdots2.sub2.unit2.pp',
|
||||
LinesToStr([
|
||||
'procedure DoIt; external name ''$DoIt'';']),
|
||||
LinesToStr([
|
||||
'']));
|
||||
|
||||
AddModuleWithIntfImplSrc('unitdots3.sub3.unit3.pp',
|
||||
LinesToStr([
|
||||
'procedure DoSome;']),
|
||||
LinesToStr([
|
||||
'uses unitdots2.sub2.unit2;',
|
||||
'procedure DoSome;',
|
||||
'begin',
|
||||
' unitdots2.sub2.unit2.doit;',
|
||||
'end;']));
|
||||
|
||||
StartProgram(true);
|
||||
Add([
|
||||
'uses unitdots3.sub3.unit3;',
|
||||
'begin',
|
||||
' unitdots3.sub3.unit3.dosome;',
|
||||
'']);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
@ -4648,16 +4718,16 @@ begin
|
||||
aMarker:=FirstSrcMarker;
|
||||
while aMarker<>nil do
|
||||
begin
|
||||
writeln('TTestResolver.TestProc_FunctionResult_DeclProc ',aMarker^.Identifier,' ',aMarker^.StartCol,' ',aMarker^.EndCol);
|
||||
//writeln('TTestResolver.TestProc_FunctionResult_DeclProc ',aMarker^.Identifier,' ',aMarker^.StartCol,' ',aMarker^.EndCol);
|
||||
Elements:=FindElementsAt(aMarker);
|
||||
try
|
||||
for i:=0 to Elements.Count-1 do
|
||||
begin
|
||||
El:=TPasElement(Elements[i]);
|
||||
writeln('TTestResolver.TestProc_FunctionResult_DeclProc ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
|
||||
//writeln('TTestResolver.TestProc_FunctionResult_DeclProc ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
|
||||
if not (El.CustomData is TResolvedReference) then continue;
|
||||
Ref:=TResolvedReference(El.CustomData);
|
||||
writeln('TTestResolver.TestProc_FunctionResult_DeclProc ',GetObjName(Ref.Declaration));
|
||||
//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;
|
||||
@ -6203,17 +6273,17 @@ begin
|
||||
aMarker:=FirstSrcMarker;
|
||||
while aMarker<>nil do
|
||||
begin
|
||||
writeln('TTestResolver.TestClass_ConDestructor_Inherited ',aMarker^.Identifier,' ',aMarker^.StartCol,' ',aMarker^.EndCol);
|
||||
//writeln('TTestResolver.TestClass_ConDestructor_Inherited ',aMarker^.Identifier,' ',aMarker^.StartCol,' ',aMarker^.EndCol);
|
||||
Elements:=FindElementsAt(aMarker);
|
||||
try
|
||||
for i:=0 to Elements.Count-1 do
|
||||
begin
|
||||
El:=TPasElement(Elements[i]);
|
||||
writeln('TTestResolver.TestClass_ConDestructor_Inherited ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
|
||||
//writeln('TTestResolver.TestClass_ConDestructor_Inherited ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
|
||||
if not (El.CustomData is TResolvedReference) then continue;
|
||||
Ref:=TResolvedReference(El.CustomData);
|
||||
if not (Ref.Declaration is TPasProcedure) then continue;
|
||||
writeln('TTestResolver.TestClass_ConDestructor_Inherited ',GetObjName(Ref.Declaration),' rrfNewInstance=',rrfNewInstance in Ref.Flags);
|
||||
//writeln('TTestResolver.TestClass_ConDestructor_Inherited ',GetObjName(Ref.Declaration),' rrfNewInstance=',rrfNewInstance in Ref.Flags);
|
||||
if rrfNewInstance in Ref.Flags then
|
||||
RaiseErrorAtSrcMarker('expected normal call at "#'+aMarker^.Identifier+', but got newinstance"',aMarker);
|
||||
if rrfFreeInstance in Ref.Flags then
|
||||
|
||||
Loading…
Reference in New Issue
Block a user