mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-01 22:50:18 +02:00
fcl-passrc: pasresolver: resolve dotted unit names and default program namespace
git-svn-id: trunk@36069 -
This commit is contained in:
Mattias Gaertner
parent
1a139b951d
commit
bf9dffbaf8
@ -684,7 +684,7 @@ type
|
||||
|
||||
TPasSectionScope = Class(TPasIdentifierScope)
|
||||
public
|
||||
UsesList: TFPList; // list of TPasSectionScope
|
||||
UsesScopes: TFPList; // list of TPasSectionScope
|
||||
constructor Create; override;
|
||||
destructor Destroy; override;
|
||||
function FindIdentifier(const Identifier: String): TPasIdentifier; override;
|
||||
@ -1025,6 +1025,7 @@ type
|
||||
FBaseTypeLength: TResolverBaseType;
|
||||
FBaseTypes: array[TResolverBaseType] of TPasUnresolvedSymbolRef;
|
||||
FBaseTypeString: TResolverBaseType;
|
||||
FDefaultNameSpace: String;
|
||||
FDefaultScope: TPasDefaultScope;
|
||||
FLastCreatedData: array[TResolveDataListKind] of TResolveData;
|
||||
FLastElement: TPasElement;
|
||||
@ -1303,6 +1304,7 @@ type
|
||||
NoProcsWithArgs: boolean): TPasElement;
|
||||
function FindElementWithoutParams(const AName: String; out Data: TPRFindData;
|
||||
ErrorPosEl: TPasElement; NoProcsWithArgs: boolean): TPasElement;
|
||||
procedure FindLongestUnitName(var El: TPasElement; Expr: TPasExpr);
|
||||
procedure IterateElements(const aName: string;
|
||||
const OnIterateElement: TIterateScopeElement; Data: Pointer;
|
||||
var Abort: boolean); virtual;
|
||||
@ -1444,6 +1446,9 @@ type
|
||||
function ResolveAliasType(aType: TPasType): TPasType;
|
||||
function ExprIsAddrTarget(El: TPasExpr): boolean;
|
||||
function IsNameExpr(El: TPasExpr): boolean; inline; // TSelfExpr or TPrimitiveExpr with Kind=pekIdent
|
||||
function GetNameExprValue(El: TPasExpr): string; // TSelfExpr or TPrimitiveExpr with Kind=pekIdent
|
||||
function GetNextDottedExpr(El: TPasExpr): TPasExpr;
|
||||
function GetPathStart(El: TPasExpr): TPasExpr;
|
||||
function GetLastExprIdentifier(El: TPasExpr): TPasExpr;
|
||||
function ParentNeedsExprResult(El: TPasExpr): boolean;
|
||||
function GetReference_NewInstanceClass(Ref: TResolvedReference): TPasClassType;
|
||||
@ -1469,20 +1474,30 @@ type
|
||||
function GetCombinedChar(const Char1, Char2: TPasResolverResult; ErrorEl: TPasElement): TResolverBaseType; virtual;
|
||||
function GetCombinedString(const Str1, Str2: TPasResolverResult; ErrorEl: TPasElement): TResolverBaseType; virtual;
|
||||
public
|
||||
// options
|
||||
property Options: TPasResolverOptions read FOptions write FOptions;
|
||||
property AnonymousElTypePostfix: String read FAnonymousElTypePostfix
|
||||
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 BaseTypeChar: TResolverBaseType read FBaseTypeChar write FBaseTypeChar;
|
||||
property BaseTypeExtended: TResolverBaseType read FBaseTypeExtended write FBaseTypeExtended;
|
||||
property BaseTypeString: TResolverBaseType read FBaseTypeString write FBaseTypeString;
|
||||
property BaseTypeLength: TResolverBaseType read FBaseTypeLength write FBaseTypeLength;
|
||||
property LastElement: TPasElement read FLastElement;
|
||||
// parsed values
|
||||
property DefaultNameSpace: String read FDefaultNameSpace;
|
||||
property RootElement: TPasElement read FRootElement;
|
||||
// scopes
|
||||
property StoreSrcColumns: boolean read FStoreSrcColumns write FStoreSrcColumns; {
|
||||
If true Line and Column is mangled together in TPasElement.SourceLineNumber.
|
||||
Use method UnmangleSourceLineNumber to extract. }
|
||||
property Scopes[Index: integer]: TPasScope read GetScopes;
|
||||
property ScopeCount: integer read FScopeCount;
|
||||
property TopScope: TPasScope read FTopScope;
|
||||
property RootElement: TPasElement read FRootElement;
|
||||
property DefaultScope: TPasDefaultScope read FDefaultScope write FDefaultScope;
|
||||
property ScopeClass_Class: TPasClassScopeClass read FScopeClass_Class write FScopeClass_Class;
|
||||
property ScopeClass_WithExpr: TPasWithExprScopeClass read FScopeClass_WithExpr write FScopeClass_WithExpr;
|
||||
// last element
|
||||
property LastElement: TPasElement read FLastElement;
|
||||
property LastMsg: string read FLastMsg write FLastMsg;
|
||||
property LastMsgArgs: TMessageArgs read FLastMsgArgs write FLastMsgArgs;
|
||||
property LastMsgElement: TPasElement read FLastMsgElement write FLastMsgElement;
|
||||
@ -1491,11 +1506,6 @@ type
|
||||
property LastMsgPattern: string read FLastMsgPattern write FLastMsgPattern;
|
||||
property LastMsgType: TMessageType read FLastMsgType write FLastMsgType;
|
||||
property LastSourcePos: TPasSourcePos read FLastSourcePos write FLastSourcePos;
|
||||
property Options: TPasResolverOptions read FOptions write FOptions;
|
||||
property ScopeClass_Class: TPasClassScopeClass read FScopeClass_Class write FScopeClass_Class;
|
||||
property ScopeClass_WithExpr: TPasWithExprScopeClass read FScopeClass_WithExpr write FScopeClass_WithExpr;
|
||||
property AnonymousElTypePostfix: String read FAnonymousElTypePostfix
|
||||
write FAnonymousElTypePostfix; // default empty, if set, anonymous element types are named ArrayName+Postfix and added to declarations
|
||||
end;
|
||||
|
||||
function GetObjName(o: TObject): string;
|
||||
@ -1515,6 +1525,7 @@ procedure SetResolverValueExpr(out ResolvedType: TPasResolverResult;
|
||||
Flags: TPasResolverResultFlags); overload;
|
||||
|
||||
function ProcNeedsImplProc(Proc: TPasProcedure): boolean;
|
||||
function ChompDottedIdentifier(const Identifier: string): string;
|
||||
|
||||
function dbgs(const Flags: TPasResolverComputeFlags): string; overload;
|
||||
function dbgs(const a: TResolvedRefAccess): string;
|
||||
@ -1786,6 +1797,20 @@ begin
|
||||
Result:=false;
|
||||
end;
|
||||
|
||||
function ChompDottedIdentifier(const Identifier: string): string;
|
||||
var
|
||||
p: Integer;
|
||||
begin
|
||||
Result:=Identifier;
|
||||
p:=length(Identifier);
|
||||
while (p>0) do
|
||||
begin
|
||||
if Identifier[p]='.' then
|
||||
exit(LeftStr(Identifier,p-1));
|
||||
dec(p);
|
||||
end;
|
||||
end;
|
||||
|
||||
function dbgs(const Flags: TPasResolverComputeFlags): string;
|
||||
var
|
||||
s: string;
|
||||
@ -2100,7 +2125,7 @@ procedure TPasModuleDotScope.OnInternalIterate(El: TPasElement; ElScope,
|
||||
var
|
||||
FilterData: PPasIterateFilterData absolute Data;
|
||||
begin
|
||||
if El.ClassType=TPasModule then
|
||||
if (El.ClassType=TPasModule) or (El.ClassType=TPasUsesUnit) then
|
||||
exit; // skip used units
|
||||
// call the original iterator
|
||||
FilterData^.OnIterate(El,ElScope,StartScope,FilterData^.Data,Abort);
|
||||
@ -2153,11 +2178,11 @@ begin
|
||||
FilterData.Data:=Data;
|
||||
if ImplementationScope<>nil then
|
||||
begin
|
||||
ImplementationScope.IterateElements(aName,StartScope,@OnInternalIterate,@FilterData,Abort);
|
||||
ImplementationScope.IterateLocalElements(aName,StartScope,@OnInternalIterate,@FilterData,Abort);
|
||||
if Abort then exit;
|
||||
end;
|
||||
if InterfaceScope<>nil then
|
||||
InterfaceScope.IterateElements(aName,StartScope,@OnInternalIterate,@FilterData,Abort);
|
||||
InterfaceScope.IterateLocalElements(aName,StartScope,@OnInternalIterate,@FilterData,Abort);
|
||||
end;
|
||||
|
||||
procedure TPasModuleDotScope.WriteIdentifiers(Prefix: string);
|
||||
@ -2173,7 +2198,7 @@ end;
|
||||
constructor TPasSectionScope.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
UsesList:=TFPList.Create;
|
||||
UsesScopes:=TFPList.Create;
|
||||
end;
|
||||
|
||||
destructor TPasSectionScope.Destroy;
|
||||
@ -2181,7 +2206,7 @@ begin
|
||||
{$IFDEF VerbosePasResolverMem}
|
||||
writeln('TPasSectionScope.Destroy START ',ClassName);
|
||||
{$ENDIF}
|
||||
FreeAndNil(UsesList);
|
||||
FreeAndNil(UsesScopes);
|
||||
inherited Destroy;
|
||||
{$IFDEF VerbosePasResolverMem}
|
||||
writeln('TPasSectionScope.Destroy END ',ClassName);
|
||||
@ -2197,9 +2222,9 @@ begin
|
||||
Result:=inherited FindIdentifier(Identifier);
|
||||
if Result<>nil then
|
||||
exit;
|
||||
for i:=0 to UsesList.Count-1 do
|
||||
for i:=0 to UsesScopes.Count-1 do
|
||||
begin
|
||||
UsesScope:=TPasIdentifierScope(UsesList[i]);
|
||||
UsesScope:=TPasIdentifierScope(UsesScopes[i]);
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TPasSectionScope.FindIdentifier "',Identifier,'" in used unit ',GetObjName(UsesScope.Element));
|
||||
{$ENDIF}
|
||||
@ -2217,9 +2242,9 @@ var
|
||||
begin
|
||||
inherited IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
|
||||
if Abort then exit;
|
||||
for i:=0 to UsesList.Count-1 do
|
||||
for i:=0 to UsesScopes.Count-1 do
|
||||
begin
|
||||
UsesScope:=TPasIdentifierScope(UsesList[i]);
|
||||
UsesScope:=TPasIdentifierScope(UsesScopes[i]);
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TPasSectionScope.IterateElements "',aName,'" in used unit ',GetObjName(UsesScope.Element));
|
||||
{$ENDIF}
|
||||
@ -2234,9 +2259,9 @@ var
|
||||
UsesScope: TPasIdentifierScope;
|
||||
begin
|
||||
inherited WriteIdentifiers(Prefix);
|
||||
for i:=0 to UsesList.Count-1 do
|
||||
for i:=0 to UsesScopes.Count-1 do
|
||||
begin
|
||||
UsesScope:=TPasIdentifierScope(UsesList[i]);
|
||||
UsesScope:=TPasIdentifierScope(UsesScopes[i]);
|
||||
writeln(Prefix+'Uses: '+GetObjName(UsesScope.Element));
|
||||
end;
|
||||
end;
|
||||
@ -2557,6 +2582,95 @@ begin
|
||||
or ((El.ClassType=TPrimitiveExpr) and (TPrimitiveExpr(El).Kind=pekIdent));
|
||||
end;
|
||||
|
||||
function TPasResolver.GetNameExprValue(El: TPasExpr): string;
|
||||
begin
|
||||
if El=nil then
|
||||
Result:=''
|
||||
else if El.ClassType=TPrimitiveExpr then
|
||||
begin
|
||||
if TPrimitiveExpr(El).Kind=pekIdent then
|
||||
Result:=TPrimitiveExpr(El).Value
|
||||
else
|
||||
Result:='';
|
||||
end
|
||||
else if El.ClassType=TSelfExpr then
|
||||
Result:='self'
|
||||
else
|
||||
Result:='';
|
||||
end;
|
||||
|
||||
function TPasResolver.GetNextDottedExpr(El: TPasExpr): TPasExpr;
|
||||
// returns TSelfExpr or TPrimitiveExpr (Kind=pekIdent)
|
||||
var
|
||||
Bin: TBinaryExpr;
|
||||
C: TClass;
|
||||
begin
|
||||
Result:=nil;
|
||||
if El=nil then exit;
|
||||
repeat
|
||||
if not (El.Parent is TBinaryExpr) then exit;
|
||||
Bin:=TBinaryExpr(El.Parent);
|
||||
if Bin.OpCode<>eopSubIdent then exit;
|
||||
if El=Bin.right then
|
||||
El:=Bin
|
||||
else
|
||||
begin
|
||||
El:=Bin.right;
|
||||
// find left most
|
||||
repeat
|
||||
C:=El.ClassType;
|
||||
if C=TSelfExpr then
|
||||
exit(El)
|
||||
else if C=TPrimitiveExpr then
|
||||
begin
|
||||
if TPrimitiveExpr(El).Kind<>pekIdent then
|
||||
RaiseNotYetImplemented(20170502163825,El);
|
||||
exit(El);
|
||||
end
|
||||
else if C=TBinaryExpr then
|
||||
begin
|
||||
if TBinaryExpr(El).OpCode<>eopSubIdent then
|
||||
RaiseNotYetImplemented(20170502163718,El);
|
||||
El:=TBinaryExpr(El).left;
|
||||
end
|
||||
else if C=TParamsExpr then
|
||||
begin
|
||||
if not (TParamsExpr(El).Kind in [pekFuncParams,pekArrayParams]) then
|
||||
RaiseNotYetImplemented(20170502163908,El);
|
||||
El:=TParamsExpr(El).Value;
|
||||
end;
|
||||
until El=nil;
|
||||
RaiseNotYetImplemented(20170502163953,Bin);
|
||||
end;
|
||||
until false;
|
||||
end;
|
||||
|
||||
function TPasResolver.GetPathStart(El: TPasExpr): TPasExpr;
|
||||
var
|
||||
C: TClass;
|
||||
begin
|
||||
Result:=nil;
|
||||
while El<>nil do
|
||||
begin
|
||||
C:=El.ClassType;
|
||||
if C=TPrimitiveExpr then
|
||||
exit(El)
|
||||
else if C=TSelfExpr then
|
||||
exit(El)
|
||||
else if C=TBinaryExpr then
|
||||
begin
|
||||
if TBinaryExpr(El).OpCode=eopSubIdent then
|
||||
El:=TBinaryExpr(El).left
|
||||
else
|
||||
exit;
|
||||
end
|
||||
else if C=TParamsExpr then
|
||||
El:=TParamsExpr(El).Value
|
||||
else
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPasResolver.ClearResolveDataList(Kind: TResolveDataListKind);
|
||||
var
|
||||
El: TPasElement;
|
||||
@ -3027,12 +3141,15 @@ end;
|
||||
|
||||
procedure TPasResolver.FinishUsesClause;
|
||||
var
|
||||
Section: TPasSection;
|
||||
i: Integer;
|
||||
Section, CurSection: TPasSection;
|
||||
i, j: Integer;
|
||||
PublicEl, UseModule: TPasElement;
|
||||
Scope: TPasSectionScope;
|
||||
UsesScope: TPasIdentifierScope;
|
||||
UseUnit: TPasUsesUnit;
|
||||
FirstName: String;
|
||||
p: SizeInt;
|
||||
OldIdentifier: TPasIdentifier;
|
||||
begin
|
||||
CheckTopScope(TPasSectionScope);
|
||||
Scope:=TPasSectionScope(TopScope);
|
||||
@ -3047,18 +3164,15 @@ begin
|
||||
writeln('TPasResolver.FinishUsesClause ',GetObjName(UseUnit));
|
||||
{$ENDIF}
|
||||
UseModule:=UseUnit.Module;
|
||||
if (UseModule.ClassType=TProgramSection) then
|
||||
RaiseInternalError(20160922163346,'used unit is a program: '+GetObjName(UseModule));
|
||||
|
||||
// add unitname as identifier
|
||||
AddIdentifier(Scope,UseUnit.Name,UseModule,pikSimple);
|
||||
|
||||
// check used unit
|
||||
PublicEl:=nil;
|
||||
if (UseModule.ClassType=TLibrarySection) then
|
||||
PublicEl:=UseModule
|
||||
else if (UseModule.ClassType=TPasModule) then
|
||||
PublicEl:=TPasModule(UseModule).InterfaceSection;
|
||||
PublicEl:=TPasModule(UseModule).InterfaceSection
|
||||
else
|
||||
RaiseXExpectedButYFound(20170503004803,'unit',UseModule.ElementTypeName,UseUnit);
|
||||
if PublicEl=nil then
|
||||
RaiseInternalError(20160922163352,'uses element has no interface section: '+GetObjName(UseModule));
|
||||
if PublicEl.CustomData=nil then
|
||||
@ -3068,14 +3182,56 @@ begin
|
||||
RaiseInternalError(20160922163403,'uses element has invalid resolver data: '
|
||||
+UseUnit.Name+'->'+GetObjName(PublicEl)+'->'+PublicEl.CustomData.ClassName);
|
||||
|
||||
// check if module was already used by a different name
|
||||
j:=i;
|
||||
CurSection:=Section;
|
||||
repeat
|
||||
dec(j);
|
||||
if j<0 then
|
||||
begin
|
||||
if CurSection.ClassType<>TImplementationSection then
|
||||
break;
|
||||
CurSection:=CurSection.GetModule.InterfaceSection;
|
||||
if CurSection=nil then break;
|
||||
j:=length(CurSection.UsesClause)-1;
|
||||
if j<0 then break;
|
||||
end;
|
||||
if CurSection.UsesClause[j].Module=UseModule then
|
||||
RaiseMsg(20170503004022,nDuplicateIdentifier,sDuplicateIdentifier,
|
||||
[UseModule.Name,GetElementSourcePosStr(CurSection.UsesClause[j])],UseUnit);
|
||||
until false;
|
||||
|
||||
// add full uses name
|
||||
AddIdentifier(Scope,UseUnit.Name,UseUnit,pikSimple);
|
||||
|
||||
// add scope
|
||||
UsesScope:=TPasIdentifierScope(PublicEl.CustomData);
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TPasResolver.FinishUsesClause Add UsesScope=',GetObjName(UsesScope));
|
||||
{$ENDIF}
|
||||
Scope.UsesList.Add(UsesScope);
|
||||
Scope.UsesScopes.Add(UsesScope);
|
||||
|
||||
EmitElementHints(Section,UseUnit);
|
||||
end;
|
||||
|
||||
// Note: a sub identifier (e.g. a class member) hides all unitnames starting
|
||||
// with this identifier
|
||||
// -> add first name of dotted unitname as identifier
|
||||
for i:=0 to Section.UsesList.Count-1 do
|
||||
begin
|
||||
UseUnit:=Section.UsesClause[i];
|
||||
FirstName:=UseUnit.Name;
|
||||
p:=Pos('.',FirstName);
|
||||
if p<1 then continue;
|
||||
FirstName:=LeftStr(FirstName,p-1);
|
||||
OldIdentifier:=Scope.FindLocalIdentifier(FirstName);
|
||||
if OldIdentifier=nil then
|
||||
AddIdentifier(Scope,FirstName,UseUnit.Module,pikSimple)
|
||||
else
|
||||
// a reference in the implementation needs to find a match in the
|
||||
// implementation clause -> replace identfier in the scope
|
||||
OldIdentifier.Element:=UseUnit;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPasResolver.FinishTypeSection(El: TPasDeclarations);
|
||||
@ -4812,13 +4968,23 @@ var
|
||||
Proc: TPasProcedure;
|
||||
Ref: TResolvedReference;
|
||||
BuiltInProc: TResElDataBuiltInProc;
|
||||
p: SizeInt;
|
||||
DottedName: String;
|
||||
begin
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TPasResolver.ResolveNameExpr El=',GetObjName(El),' Name="',aName,'" ',Access);
|
||||
{$ENDIF}
|
||||
DeclEl:=FindElementWithoutParams(aName,FindData,El,false);
|
||||
if DeclEl.ClassType=TPasUsesUnit then
|
||||
begin
|
||||
// the first name of a unit matches -> find unit with longest match
|
||||
FindLongestUnitName(DeclEl,El);
|
||||
FindData.Found:=DeclEl;
|
||||
end;
|
||||
|
||||
Ref:=CreateReference(DeclEl,El,Access,@FindData);
|
||||
CheckFoundElement(FindData,Ref);
|
||||
|
||||
if DeclEl is TPasProcedure then
|
||||
begin
|
||||
// identifier is a proc and args brackets are missing
|
||||
@ -4845,6 +5011,29 @@ begin
|
||||
BuiltInProc:=TResElDataBuiltInProc(DeclEl.CustomData);
|
||||
BuiltInProc.GetCallCompatibility(BuiltInProc,El,true);
|
||||
end;
|
||||
end
|
||||
else if (DeclEl.ClassType=TPasUsesUnit) or (DeclEl is TPasModule) then
|
||||
begin
|
||||
// unit reference
|
||||
// dotted unit names needs a ref for each expression identifier
|
||||
// Note: El is the first TPrimitiveExpr of the dotted unit name reference
|
||||
DottedName:=DeclEl.Name;
|
||||
repeat
|
||||
p:=Pos('.',DottedName);
|
||||
if p<1 then break;
|
||||
Delete(DottedName,1,p);
|
||||
El:=GetNextDottedExpr(El);
|
||||
if El=nil then
|
||||
RaiseInternalError(20170503002012);
|
||||
CreateReference(DeclEl,El,Access);
|
||||
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;
|
||||
|
||||
@ -4998,6 +5187,9 @@ var
|
||||
RecordEl: TPasRecordType;
|
||||
RecordScope: TPasDotRecordScope;
|
||||
begin
|
||||
if El.CustomData is TResolvedReference then
|
||||
exit; // for example, when a.b has a dotted unit name
|
||||
|
||||
Left:=El.left;
|
||||
//writeln('TPasResolver.ResolveSubIdent Left=',GetObjName(Left));
|
||||
ComputeElement(Left,LeftResolved,[rcSetReferenceFlags]);
|
||||
@ -5638,11 +5830,18 @@ begin
|
||||
end;
|
||||
|
||||
procedure TPasResolver.AddModule(El: TPasModule);
|
||||
var
|
||||
C: TClass;
|
||||
begin
|
||||
if TopScope<>DefaultScope then
|
||||
RaiseInvalidScopeForElement(20160922163504,El);
|
||||
PushScope(El,TPasModuleScope);
|
||||
TPasModuleScope(TopScope).VisibilityContext:=El;
|
||||
C:=El.ClassType;
|
||||
if (C=TPasProgram) or (C=TPasLibrary) or (C=TPasPackage) then
|
||||
FDefaultNameSpace:=ChompDottedIdentifier(El.Name)
|
||||
else
|
||||
FDefaultNameSpace:='';
|
||||
end;
|
||||
|
||||
procedure TPasResolver.AddSection(El: TPasSection);
|
||||
@ -8210,6 +8409,7 @@ begin
|
||||
or (AClass=TPasProgram)
|
||||
or (AClass=TPasLibrary) then
|
||||
AddModule(TPasModule(El))
|
||||
else if AClass=TPasUsesUnit then
|
||||
else if AClass.InheritsFrom(TPasExpr) then
|
||||
// resolved when finished
|
||||
else if AClass.InheritsFrom(TPasImplBlock) then
|
||||
@ -8336,6 +8536,88 @@ begin
|
||||
sWrongNumberOfParametersForCallTo,[GetProcTypeDescription(TPasProcedure(Result).ProcType)],ErrorPosEl);
|
||||
end;
|
||||
|
||||
procedure TPasResolver.FindLongestUnitName(var El: TPasElement; Expr: TPasExpr);
|
||||
// Input: El is TPasUsesUnit
|
||||
// Output: El is either a TPasUsesUnit or the root module
|
||||
var
|
||||
CurUsesUnit: TPasUsesUnit;
|
||||
BestEl: TPasElement;
|
||||
aName, CurName: String;
|
||||
Clause: TPasUsesClause;
|
||||
i, CurLen: Integer;
|
||||
Section: TPasSection;
|
||||
begin
|
||||
{$IFDEF VerbosePasResolver}
|
||||
//writeln('TPasResolver.FindLongestUnitName El=',GetObjName(El),' Expr=',GetObjName(Expr));
|
||||
{$ENDIF}
|
||||
if not (El is TPasUsesUnit) then
|
||||
RaiseInternalError(20170503000945);
|
||||
aName:=GetNameExprValue(Expr);
|
||||
if aName='' then
|
||||
RaiseNotYetImplemented(20170503110217,Expr);
|
||||
repeat
|
||||
Expr:=GetNextDottedExpr(Expr);
|
||||
if Expr=nil then break;
|
||||
CurName:=GetNameExprValue(Expr);
|
||||
if CurName='' then
|
||||
RaiseNotYetImplemented(20170502164242,Expr);
|
||||
aName:=aName+'.'+CurName;
|
||||
until false;
|
||||
|
||||
{$IFDEF VerbosePasResolver}
|
||||
//writeln('TPasResolver.FindLongestUnitName Dotted="',aName,'"');
|
||||
{$ENDIF}
|
||||
// search in uses clause
|
||||
BestEl:=nil;
|
||||
Section:=TPasUsesUnit(El).Parent as TPasSection;
|
||||
repeat
|
||||
Clause:=Section.UsesClause;
|
||||
for i:=0 to length(Clause)-1 do
|
||||
begin
|
||||
CurUsesUnit:=Clause[i];
|
||||
CurName:=CurUsesUnit.Name;
|
||||
CurLen:=length(CurName);
|
||||
if (CompareText(CurName,LeftStr(aName,CurLen))=0)
|
||||
and ((CurLen=length(aName)) or (aName[CurLen+1]='.')) then
|
||||
begin
|
||||
// a match
|
||||
if (BestEl=nil) or (CurLen>length(BestEl.Name)) then
|
||||
BestEl:=CurUsesUnit; // a better match
|
||||
end;
|
||||
end;
|
||||
if Section is TImplementationSection then
|
||||
begin
|
||||
// search in interface uses clause too
|
||||
Section:=(Section.Parent as TPasModule).InterfaceSection;
|
||||
end
|
||||
else
|
||||
break;
|
||||
until Section=nil;
|
||||
{$IFDEF VerbosePasResolver}
|
||||
//writeln('TPasResolver.FindLongestUnitName LongestUnit="',GetObjName(BestEl),'"');
|
||||
{$ENDIF}
|
||||
|
||||
// check module name
|
||||
CurName:=El.GetModule.Name;
|
||||
CurLen:=length(CurName);
|
||||
if (CompareText(CurName,LeftStr(aName,CurLen))=0)
|
||||
and ((CurLen=length(aName)) or (aName[CurLen+1]='.')) then
|
||||
begin
|
||||
// a match
|
||||
if (BestEl=nil) or (CurLen>length(BestEl.Name)) then
|
||||
BestEl:=El.GetModule; // a better match
|
||||
end;
|
||||
if BestEl=nil then
|
||||
begin
|
||||
// no dotted module name fits the expression
|
||||
RaiseIdentifierNotFound(20170503140643,GetNameExprValue(Expr),Expr);
|
||||
end;
|
||||
El:=BestEl;
|
||||
{$IFDEF VerbosePasResolver}
|
||||
//writeln('TPasResolver.FindLongestUnitName END Best="',GetObjName(El),'"');
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure TPasResolver.IterateElements(const aName: string;
|
||||
const OnIterateElement: TIterateScopeElement; Data: Pointer;
|
||||
var Abort: boolean);
|
||||
|
||||
@ -310,7 +310,7 @@ type
|
||||
Functions, Variables, Properties, ExportSymbols: TFPList;
|
||||
end;
|
||||
|
||||
{ TPasUsesUnit }
|
||||
{ TPasUsesUnit - Parent is TPasSection }
|
||||
|
||||
TPasUsesUnit = class(TPasElement)
|
||||
public
|
||||
@ -332,7 +332,8 @@ type
|
||||
constructor Create(const AName: string; AParent: TPasElement); override;
|
||||
destructor Destroy; override;
|
||||
function AddUnitToUsesList(const AUnitName: string; aName: TPasExpr = nil;
|
||||
InFilename: TPrimitiveExpr = nil; aModule: TPasElement = nil): TPasUsesUnit;
|
||||
InFilename: TPrimitiveExpr = nil; aModule: TPasElement = nil;
|
||||
UsesUnit: TPasUsesUnit = nil): TPasUsesUnit;
|
||||
function ElementTypeName: string; override;
|
||||
procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
|
||||
const Arg: Pointer); override;
|
||||
@ -4029,8 +4030,8 @@ begin
|
||||
end;
|
||||
|
||||
function TPasSection.AddUnitToUsesList(const AUnitName: string;
|
||||
aName: TPasExpr; InFilename: TPrimitiveExpr; aModule: TPasElement
|
||||
): TPasUsesUnit;
|
||||
aName: TPasExpr; InFilename: TPrimitiveExpr; aModule: TPasElement;
|
||||
UsesUnit: TPasUsesUnit): TPasUsesUnit;
|
||||
var
|
||||
l: Integer;
|
||||
begin
|
||||
@ -4040,11 +4041,20 @@ begin
|
||||
aModule:=TPasUnresolvedUnitRef.Create(AUnitName, Self);
|
||||
l:=length(UsesClause);
|
||||
SetLength(UsesClause,l+1);
|
||||
Result:=TPasUsesUnit.Create(AUnitName,Self);
|
||||
UsesClause[l]:=Result;
|
||||
Result.Expr:=aName;
|
||||
Result.InFilename:=InFilename;
|
||||
Result.Module:=aModule;
|
||||
if UsesUnit=nil then
|
||||
begin
|
||||
UsesUnit:=TPasUsesUnit.Create(AUnitName,Self);
|
||||
if aName<>nil then
|
||||
begin
|
||||
Result.SourceFilename:=aName.SourceFilename;
|
||||
Result.SourceLinenumber:=aName.SourceLinenumber;
|
||||
end;
|
||||
end;
|
||||
UsesClause[l]:=UsesUnit;
|
||||
UsesUnit.Expr:=aName;
|
||||
UsesUnit.InFilename:=InFilename;
|
||||
UsesUnit.Module:=aModule;
|
||||
Result:=UsesUnit;
|
||||
|
||||
UsesList.Add(aModule);
|
||||
aModule.AddRef;
|
||||
|
||||
@ -312,8 +312,8 @@ type
|
||||
function DoParseExpression(AParent: TPaselement;InitExpr: TPasExpr=nil; AllowEqual : Boolean = True): TPasExpr;
|
||||
function DoParseConstValueExpression(AParent: TPasElement): TPasExpr;
|
||||
function CheckPackMode: TPackMode;
|
||||
function AddUseUnit(ASection: TPasSection; AUnitName : string;
|
||||
NameExpr: TPasExpr; InFileExpr: TPrimitiveExpr): TPasElement;
|
||||
function AddUseUnit(ASection: TPasSection; const NamePos: TPasSourcePos;
|
||||
AUnitName : string; NameExpr: TPasExpr; InFileExpr: TPrimitiveExpr): TPasElement;
|
||||
procedure CheckImplicitUsedUnits(ASection: TPasSection);
|
||||
// Overload handling
|
||||
procedure AddProcOrFunction(Decs: TPasDeclarations; AProc: TPasProcedure);
|
||||
@ -2319,21 +2319,21 @@ begin
|
||||
AUnitName := ExpectIdentifier;
|
||||
NextToken;
|
||||
while CurToken = tkDot do
|
||||
begin
|
||||
begin
|
||||
ExpectIdentifier;
|
||||
AUnitName := AUnitName + '.' + CurTokenString;
|
||||
NextToken;
|
||||
end;
|
||||
end;
|
||||
UngetToken;
|
||||
Module := TPasModule(CreateElement(TPasModule, AUnitName,
|
||||
Engine.Package));
|
||||
FCurModule:=Module;
|
||||
try
|
||||
if Assigned(Engine.Package) then
|
||||
begin
|
||||
begin
|
||||
Module.PackageName := Engine.Package.Name;
|
||||
Engine.Package.Modules.Add(Module);
|
||||
end;
|
||||
end;
|
||||
CheckHint(Module,True);
|
||||
// ExpectToken(tkSemicolon);
|
||||
ExpectToken(tkInterface);
|
||||
@ -2358,7 +2358,17 @@ begin
|
||||
if SkipHeader then
|
||||
N:=ChangeFileExt(Scanner.CurFilename,'')
|
||||
else
|
||||
begin
|
||||
N:=ExpectIdentifier;
|
||||
NextToken;
|
||||
while CurToken = tkDot do
|
||||
begin
|
||||
ExpectIdentifier;
|
||||
N := N + '.' + CurTokenString;
|
||||
NextToken;
|
||||
end;
|
||||
UngetToken;
|
||||
end;
|
||||
Module := nil;
|
||||
PP:=TPasProgram(CreateElement(TPasProgram, N, Engine.Package));
|
||||
Module :=PP;
|
||||
@ -2396,14 +2406,25 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
// Starts after the "library" token
|
||||
procedure TPasParser.ParseLibrary(var Module: TPasModule);
|
||||
Var
|
||||
PP : TPasLibrary;
|
||||
Section : TLibrarySection;
|
||||
N: String;
|
||||
|
||||
begin
|
||||
N:=ExpectIdentifier;
|
||||
NextToken;
|
||||
while CurToken = tkDot do
|
||||
begin
|
||||
ExpectIdentifier;
|
||||
N := N + '.' + CurTokenString;
|
||||
NextToken;
|
||||
end;
|
||||
UngetToken;
|
||||
Module := nil;
|
||||
PP:=TPasLibrary(CreateElement(TPasLibrary, ExpectIdentifier, Engine.Package));
|
||||
PP:=TPasLibrary(CreateElement(TPasLibrary, N, Engine.Package));
|
||||
Module :=PP;
|
||||
FCurModule:=Module;
|
||||
try
|
||||
@ -2853,8 +2874,9 @@ begin
|
||||
SetBlock(declNone);
|
||||
end;
|
||||
|
||||
function TPasParser.AddUseUnit(ASection: TPasSection; AUnitName: string;
|
||||
NameExpr: TPasExpr; InFileExpr: TPrimitiveExpr): TPasElement;
|
||||
function TPasParser.AddUseUnit(ASection: TPasSection;
|
||||
const NamePos: TPasSourcePos; AUnitName: string; NameExpr: TPasExpr;
|
||||
InFileExpr: TPrimitiveExpr): TPasElement;
|
||||
|
||||
procedure CheckDuplicateInUsesList(AUnitName : string; UsesClause: TPasUsesClause);
|
||||
var
|
||||
@ -2868,8 +2890,10 @@ function TPasParser.AddUseUnit(ASection: TPasSection; AUnitName: string;
|
||||
|
||||
var
|
||||
UnitRef: TPasElement;
|
||||
UsesUnit: TPasUsesUnit;
|
||||
begin
|
||||
Result:=nil;
|
||||
UsesUnit:=nil;
|
||||
try
|
||||
{$IFDEF VerbosePasParser}
|
||||
writeln('TPasParser.AddUseUnit AUnitName=',AUnitName,' CurModule.Name=',CurModule.Name);
|
||||
@ -2891,7 +2915,8 @@ begin
|
||||
UnitRef := TPasUnresolvedUnitRef(CreateElement(TPasUnresolvedUnitRef,
|
||||
AUnitName, ASection));
|
||||
|
||||
Result:=ASection.AddUnitToUsesList(AUnitName,NameExpr,InFileExpr,UnitRef);
|
||||
UsesUnit:=TPasUsesUnit(CreateElement(TPasUsesUnit,AUnitName,ASection,NamePos));
|
||||
Result:=ASection.AddUnitToUsesList(AUnitName,NameExpr,InFileExpr,UnitRef,UsesUnit);
|
||||
if InFileExpr<>nil then
|
||||
begin
|
||||
if UnitRef is TPasModule then
|
||||
@ -2905,6 +2930,8 @@ begin
|
||||
finally
|
||||
if Result=nil then
|
||||
begin
|
||||
if UsesUnit<>nil then
|
||||
UsesUnit.Release;
|
||||
if NameExpr<>nil then
|
||||
NameExpr.Release;
|
||||
if InFileExpr<>nil then
|
||||
@ -2916,12 +2943,14 @@ end;
|
||||
procedure TPasParser.CheckImplicitUsedUnits(ASection: TPasSection);
|
||||
var
|
||||
i: Integer;
|
||||
NamePos: TPasSourcePos;
|
||||
begin
|
||||
If not (ASection.ClassType=TImplementationSection) Then // interface,program,library,package
|
||||
begin
|
||||
// load implicit units, like 'System'
|
||||
NamePos:=Scanner.CurSourcePos;
|
||||
for i:=0 to ImplicitUses.Count-1 do
|
||||
AddUseUnit(ASection,ImplicitUses[i],nil,nil);
|
||||
AddUseUnit(ASection,NamePos,ImplicitUses[i],nil,nil);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -2932,6 +2961,7 @@ var
|
||||
NameExpr: TPasExpr;
|
||||
InFileExpr: TPrimitiveExpr;
|
||||
FreeExpr: Boolean;
|
||||
NamePos: TPasSourcePos;
|
||||
begin
|
||||
CheckImplicitUsedUnits(ASection);
|
||||
|
||||
@ -2942,6 +2972,7 @@ begin
|
||||
Repeat
|
||||
FreeExpr:=true;
|
||||
AUnitName := ExpectIdentifier;
|
||||
NamePos:=Scanner.CurSourcePos;
|
||||
NameExpr:=CreatePrimitiveExpr(ASection,pekString,AUnitName);
|
||||
NextToken;
|
||||
while CurToken = tkDot do
|
||||
@ -2959,7 +2990,7 @@ begin
|
||||
NextToken;
|
||||
end;
|
||||
FreeExpr:=false;
|
||||
AddUseUnit(ASection,AUnitName,NameExpr,InFileExpr);
|
||||
AddUseUnit(ASection,NamePos,AUnitName,NameExpr,InFileExpr);
|
||||
InFileExpr:=nil;
|
||||
NameExpr:=nil;
|
||||
|
||||
|
||||
@ -8,7 +8,7 @@ uses
|
||||
Classes, SysUtils, fpcunit, pastree, pscanner, pparser, testregistry;
|
||||
|
||||
const
|
||||
MainFilename = 'afile.pp';
|
||||
DefaultMainFilename = 'afile.pp';
|
||||
Type
|
||||
{ TTestEngine }
|
||||
|
||||
@ -32,6 +32,7 @@ Type
|
||||
FDeclarations: TPasDeclarations;
|
||||
FDefinition: TPasElement;
|
||||
FEngine : TPasTreeContainer;
|
||||
FMainFilename: string;
|
||||
FModule: TPasModule;
|
||||
FParseResult: TPasElement;
|
||||
FScanner : TPascalScanner;
|
||||
@ -98,6 +99,7 @@ Type
|
||||
// If set, Will be freed in teardown
|
||||
Property ParseResult : TPasElement Read FParseResult Write FParseResult;
|
||||
Property UseImplementation : Boolean Read FUseImplementation Write FUseImplementation;
|
||||
Property MainFilename: string read FMainFilename write FMainFilename;
|
||||
end;
|
||||
|
||||
function ExtractFileUnitName(aFilename: string): string;
|
||||
@ -517,6 +519,7 @@ end;
|
||||
|
||||
procedure TTestParser.SetUp;
|
||||
begin
|
||||
FMainFilename:=DefaultMainFilename;
|
||||
Inherited;
|
||||
SetupParser;
|
||||
end;
|
||||
|
||||
@ -45,7 +45,7 @@ const
|
||||
'=' // mkDirectReference
|
||||
);
|
||||
type
|
||||
TOnFindUnit = function(const aUnitName: String): TPasModule of object;
|
||||
TOnFindUnit = function(Sender: TPasResolver; const aUnitName: String): TPasModule of object;
|
||||
|
||||
{ TTestEnginePasResolver }
|
||||
|
||||
@ -109,7 +109,8 @@ type
|
||||
function GetModules(Index: integer): TTestEnginePasResolver;
|
||||
function GetMsgCount: integer;
|
||||
function GetMsgs(Index: integer): TTestResolverMessage;
|
||||
function OnPasResolverFindUnit(const aUnitName: String): TPasModule;
|
||||
function OnPasResolverFindUnit(SrcResolver: TPasResolver;
|
||||
const aUnitName: String): TPasModule;
|
||||
procedure OnFindReference(El: TPasElement; FindData: pointer);
|
||||
procedure OnCheckElementParent(El: TPasElement; arg: pointer);
|
||||
procedure FreeSrcMarkers;
|
||||
@ -271,10 +272,18 @@ type
|
||||
|
||||
// units
|
||||
Procedure TestUnitOverloads;
|
||||
Procedure TestUnitIntfInitalization;
|
||||
Procedure TestUnitIntfInitialization;
|
||||
Procedure TestUnitUseIntf;
|
||||
Procedure TestUnitUseImplFail;
|
||||
Procedure TestUnit_DuplicateUsesFail;
|
||||
Procedure TestUnit_NestedFail;
|
||||
Procedure TestUnitUseDotted;
|
||||
Procedure TestUnit_ProgramDefaultNamespace;
|
||||
Procedure TestUnit_DottedIdentifier;
|
||||
Procedure TestUnit_DuplicateDottedUsesFail;
|
||||
Procedure TestUnit_DuplicateUsesDiffNameFail;
|
||||
Procedure TestUnit_Unit1DotUnit2Fail;
|
||||
Procedure TestUnit_InFilename; // ToDo
|
||||
|
||||
// procs
|
||||
Procedure TestProcParam;
|
||||
@ -614,7 +623,7 @@ function TTestEnginePasResolver.FindModule(const AName: String): TPasModule;
|
||||
begin
|
||||
Result:=nil;
|
||||
if Assigned(OnFindUnit) then
|
||||
Result:=OnFindUnit(AName);
|
||||
Result:=OnFindUnit(Self,AName);
|
||||
end;
|
||||
|
||||
{ TCustomTestResolver }
|
||||
@ -1193,6 +1202,8 @@ begin
|
||||
except
|
||||
on E: EParserError do
|
||||
begin
|
||||
if (Parser.LastMsg<>Msg) and (Parser.LastMsgPattern<>Msg) then
|
||||
Fail('Expected msg {'+Msg+'}, but got {'+Parser.LastMsg+'} OR pattern {'+Parser.LastMsgPattern+'}');
|
||||
AssertEquals('Expected {'+Msg+'}, but got msg {'+E.Message+'} number',
|
||||
MsgNumber,Parser.LastMsgNumber);
|
||||
ok:=true;
|
||||
@ -1554,61 +1565,83 @@ begin
|
||||
Add('unit '+ExtractFileUnitName(MainFilename)+';');
|
||||
end;
|
||||
|
||||
function TCustomTestResolver.OnPasResolverFindUnit(const aUnitName: String
|
||||
): TPasModule;
|
||||
var
|
||||
i, ErrRow, ErrCol: Integer;
|
||||
CurEngine: TTestEnginePasResolver;
|
||||
CurUnitName, ErrFilename: String;
|
||||
begin
|
||||
//writeln('TTestResolver.OnPasResolverFindUnit START Unit="',aUnitName,'"');
|
||||
Result:=nil;
|
||||
for i:=0 to ModuleCount-1 do
|
||||
begin
|
||||
CurEngine:=Modules[i];
|
||||
CurUnitName:=ExtractFileUnitName(CurEngine.Filename);
|
||||
//writeln('TTestResolver.OnPasResolverFindUnit Checking ',i,'/',ModuleCount,' ',CurEngine.Filename,' ',CurUnitName);
|
||||
if CompareText(aUnitName,CurUnitName)=0 then
|
||||
begin
|
||||
Result:=CurEngine.Module;
|
||||
if Result<>nil then exit;
|
||||
//writeln('TTestResolver.OnPasResolverFindUnit PARSING unit "',CurEngine.Filename,'"');
|
||||
//Resolver.FindSourceFile(aUnitName);
|
||||
function TCustomTestResolver.OnPasResolverFindUnit(SrcResolver: TPasResolver;
|
||||
const aUnitName: String): TPasModule;
|
||||
|
||||
CurEngine.Resolver:=Resolver;
|
||||
//CurEngine.Resolver:=TStreamResolver.Create;
|
||||
//CurEngine.Resolver.OwnsStreams:=True;
|
||||
//writeln('TTestResolver.OnPasResolverFindUnit SOURCE=',CurEngine.Source);
|
||||
CurEngine.Resolver.AddStream(CurEngine.FileName,TStringStream.Create(CurEngine.Source));
|
||||
CurEngine.Scanner:=TPascalScanner.Create(CurEngine.Resolver);
|
||||
CurEngine.Parser:=TPasParser.Create(CurEngine.Scanner,CurEngine.Resolver,CurEngine);
|
||||
if CompareText(CurUnitName,'System')=0 then
|
||||
CurEngine.Parser.ImplicitUses.Clear;
|
||||
CurEngine.Scanner.OpenFile(CurEngine.Filename);
|
||||
try
|
||||
CurEngine.Parser.NextToken;
|
||||
CurEngine.Parser.ParseUnit(CurEngine.FModule);
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
ErrFilename:=CurEngine.Scanner.CurFilename;
|
||||
ErrRow:=CurEngine.Scanner.CurRow;
|
||||
ErrCol:=CurEngine.Scanner.CurColumn;
|
||||
writeln('ERROR: TTestResolver.OnPasResolverFindUnit during parsing: '+E.ClassName+':'+E.Message
|
||||
+' File='+ErrFilename
|
||||
+' LineNo='+IntToStr(ErrRow)
|
||||
+' Col='+IntToStr(ErrCol)
|
||||
+' Line="'+CurEngine.Scanner.CurLine+'"'
|
||||
);
|
||||
WriteSources(ErrFilename,ErrRow,ErrCol);
|
||||
Fail(E.Message);
|
||||
end;
|
||||
end;
|
||||
//writeln('TTestResolver.OnPasResolverFindUnit END ',CurUnitName);
|
||||
Result:=CurEngine.Module;
|
||||
exit;
|
||||
function FindUnit(const aUnitName: String): TPasModule;
|
||||
var
|
||||
i, ErrRow, ErrCol: Integer;
|
||||
CurEngine: TTestEnginePasResolver;
|
||||
CurUnitName, ErrFilename: String;
|
||||
begin
|
||||
{$IFDEF VerboseUnitSearch}
|
||||
writeln('TTestResolver.OnPasResolverFindUnit START Unit="',aUnitName,'"');
|
||||
{$ENDIF}
|
||||
Result:=nil;
|
||||
for i:=0 to ModuleCount-1 do
|
||||
begin
|
||||
CurEngine:=Modules[i];
|
||||
CurUnitName:=ExtractFileUnitName(CurEngine.Filename);
|
||||
{$IFDEF VerboseUnitSearch}
|
||||
writeln('TTestResolver.OnPasResolverFindUnit Checking ',i,'/',ModuleCount,' ',CurEngine.Filename,' ',CurUnitName);
|
||||
{$ENDIF}
|
||||
if CompareText(aUnitName,CurUnitName)=0 then
|
||||
begin
|
||||
Result:=CurEngine.Module;
|
||||
{$IFDEF VerboseUnitSearch}
|
||||
writeln('TTestResolver.OnPasResolverFindUnit Found unit "',CurEngine.Filename,'" Module=',GetObjName(Result));
|
||||
{$ENDIF}
|
||||
if Result<>nil then exit;
|
||||
{$IFDEF VerboseUnitSearch}
|
||||
writeln('TTestResolver.OnPasResolverFindUnit PARSING unit "',CurEngine.Filename,'"');
|
||||
{$ENDIF}
|
||||
|
||||
CurEngine.Resolver:=Resolver;
|
||||
//writeln('TTestResolver.OnPasResolverFindUnit SOURCE=',CurEngine.Source);
|
||||
CurEngine.Resolver.AddStream(CurEngine.FileName,TStringStream.Create(CurEngine.Source));
|
||||
CurEngine.Scanner:=TPascalScanner.Create(CurEngine.Resolver);
|
||||
CurEngine.Parser:=TPasParser.Create(CurEngine.Scanner,CurEngine.Resolver,CurEngine);
|
||||
if CompareText(CurUnitName,'System')=0 then
|
||||
CurEngine.Parser.ImplicitUses.Clear;
|
||||
CurEngine.Scanner.OpenFile(CurEngine.Filename);
|
||||
try
|
||||
CurEngine.Parser.NextToken;
|
||||
CurEngine.Parser.ParseUnit(CurEngine.FModule);
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
ErrFilename:=CurEngine.Scanner.CurFilename;
|
||||
ErrRow:=CurEngine.Scanner.CurRow;
|
||||
ErrCol:=CurEngine.Scanner.CurColumn;
|
||||
writeln('ERROR: TTestResolver.OnPasResolverFindUnit during parsing: '+E.ClassName+':'+E.Message
|
||||
+' File='+ErrFilename
|
||||
+' LineNo='+IntToStr(ErrRow)
|
||||
+' Col='+IntToStr(ErrCol)
|
||||
+' Line="'+CurEngine.Scanner.CurLine+'"'
|
||||
);
|
||||
WriteSources(ErrFilename,ErrRow,ErrCol);
|
||||
Fail(E.Message);
|
||||
end;
|
||||
end;
|
||||
//writeln('TTestResolver.OnPasResolverFindUnit END ',CurUnitName);
|
||||
Result:=CurEngine.Module;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
begin
|
||||
if SrcResolver=nil then ;
|
||||
if (Pos('.',aUnitName)<1) and (ResolverEngine.DefaultNameSpace<>'') then
|
||||
begin
|
||||
// first search in default program namespace
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TCustomTestResolver.OnPasResolverFindUnit searching "',aUnitName,'" in default program/library namespace "',ResolverEngine.DefaultNameSpace,'"');
|
||||
{$ENDIF}
|
||||
Result:=FindUnit(ResolverEngine.DefaultNameSpace+'.'+aUnitName);
|
||||
if Result<>nil then exit;
|
||||
end;
|
||||
Result:=FindUnit(aUnitName);
|
||||
if Result<>nil then exit;
|
||||
writeln('TTestResolver.OnPasResolverFindUnit missing unit "',aUnitName,'"');
|
||||
Fail('can''t find unit "'+aUnitName+'"');
|
||||
end;
|
||||
@ -2070,7 +2103,7 @@ begin
|
||||
Add(' i: longint');
|
||||
Add('begin');
|
||||
Add(' doit;');
|
||||
CheckParserException('Expected ";" at token "begin" in file afile.pp at line 5 column 5',
|
||||
CheckParserException('Expected ";"',
|
||||
nParserExpectTokenError);
|
||||
end;
|
||||
|
||||
@ -3545,7 +3578,7 @@ begin
|
||||
ParseUnit;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestUnitIntfInitalization;
|
||||
procedure TTestResolver.TestUnitIntfInitialization;
|
||||
var
|
||||
El, DeclEl, OtherUnit: TPasElement;
|
||||
LocalVar: TPasVariable;
|
||||
@ -3622,7 +3655,7 @@ begin
|
||||
AssertEquals('other unit assign unit ref resolved',TResolvedReference,Prim1.CustomData.ClassType);
|
||||
DeclEl:=TResolvedReference(Prim1.CustomData).Declaration;
|
||||
OtherUnit:=DeclEl;
|
||||
AssertEquals('other unit assign unit ref',TPasModule,DeclEl.ClassType);
|
||||
AssertEquals('other unit assign unit ref',TPasUsesUnit,DeclEl.ClassType);
|
||||
AssertEquals('other unit assign unit ref system','system',lowercase(DeclEl.Name));
|
||||
|
||||
AssertEquals('other unit assign dot',eopSubIdent,BinExp.OpCode);
|
||||
@ -3636,7 +3669,7 @@ begin
|
||||
DeclEl:=TResolvedReference(Prim2.CustomData).Declaration;
|
||||
AssertEquals('other unit assign var',TPasVariable,DeclEl.ClassType);
|
||||
AssertEquals('other unit assign var exitcode','exitcode',lowercase(DeclEl.Name));
|
||||
AssertSame('other unit assign var exitcode',OtherUnit,DeclEl.GetModule);
|
||||
AssertSame('other unit assign var exitcode',(OtherUnit as TPasUsesUnit).Module,DeclEl.GetModule);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestUnitUseIntf;
|
||||
@ -3672,6 +3705,22 @@ begin
|
||||
CheckResolverException('identifier not found "DoIt"',nIdentifierNotFound);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestUnit_DuplicateUsesFail;
|
||||
begin
|
||||
AddModuleWithIntfImplSrc('unit2.pp',
|
||||
LinesToStr([
|
||||
'var i: longint;']),
|
||||
LinesToStr([
|
||||
'']));
|
||||
|
||||
StartProgram(true);
|
||||
Add('uses unit2, unit2;');
|
||||
Add('begin');
|
||||
Add(' i:=3;');
|
||||
CheckParserException('Duplicate identifier "unit2"',
|
||||
nParserDuplicateIdentifier);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestUnit_NestedFail;
|
||||
begin
|
||||
AddModuleWithIntfImplSrc('unit2.pp',
|
||||
@ -3688,13 +3737,176 @@ begin
|
||||
'']));
|
||||
|
||||
StartProgram(true);
|
||||
Add('uses unit1;');
|
||||
Add('begin');
|
||||
Add(' if j1=0 then ;');
|
||||
Add(' if i2=0 then ;');
|
||||
Add([
|
||||
'uses unit1;',
|
||||
'begin',
|
||||
' if j1=0 then ;',
|
||||
' if i2=0 then ;',
|
||||
'']);
|
||||
CheckResolverException('identifier not found "i2"',nIdentifierNotFound);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestUnitUseDotted;
|
||||
begin
|
||||
AddModuleWithIntfImplSrc('ns1.unit2.pp',
|
||||
LinesToStr([
|
||||
'var i2: longint;']),
|
||||
LinesToStr([
|
||||
'']));
|
||||
|
||||
AddModuleWithIntfImplSrc('ns2.ns2A.unit1.pp',
|
||||
LinesToStr([
|
||||
'uses ns1.unit2;',
|
||||
'var j1: longint;']),
|
||||
LinesToStr([
|
||||
'']));
|
||||
|
||||
StartProgram(true);
|
||||
Add([
|
||||
'uses ns2.ns2A.unit1;',
|
||||
'begin',
|
||||
' if j1=0 then ;',
|
||||
'']);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestUnit_ProgramDefaultNamespace;
|
||||
begin
|
||||
MainFilename:='ns1.main1.pas';
|
||||
|
||||
AddModuleWithIntfImplSrc('ns1.unit2.pp',
|
||||
LinesToStr([
|
||||
'var i2: longint;']),
|
||||
LinesToStr([
|
||||
'']));
|
||||
|
||||
AddModuleWithIntfImplSrc('ns1.unit1.pp',
|
||||
LinesToStr([
|
||||
'uses unit2;',
|
||||
'var j1: longint;']),
|
||||
LinesToStr([
|
||||
'']));
|
||||
|
||||
StartProgram(true);
|
||||
Add([
|
||||
'uses unit1;',
|
||||
'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([
|
||||
'var i1: longint;']),
|
||||
LinesToStr([
|
||||
'']));
|
||||
|
||||
AddModuleWithIntfImplSrc('unitdots.pp',
|
||||
LinesToStr([
|
||||
'var j1: longint;']),
|
||||
LinesToStr([
|
||||
'']));
|
||||
|
||||
StartProgram(true);
|
||||
Add([
|
||||
'uses unitdots.unit1, unitdots;',
|
||||
'var k1: longint;',
|
||||
'begin',
|
||||
' if unitdots.main1.k1=0 then ;',
|
||||
' if unitdots.j1=0 then ;',
|
||||
' if unitdots.unit1.i1=0 then ;',
|
||||
'']);
|
||||
writeln('TTestResolver.TestUnit_DottedIdentifier ');
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestUnit_DuplicateDottedUsesFail;
|
||||
begin
|
||||
AddModuleWithIntfImplSrc('ns.unit2.pp',
|
||||
LinesToStr([
|
||||
'var i: longint;']),
|
||||
LinesToStr([
|
||||
'']));
|
||||
|
||||
StartProgram(true);
|
||||
Add('uses ns.unit2, ns.unit2;');
|
||||
Add('begin');
|
||||
Add(' i:=3;');
|
||||
CheckParserException('Duplicate identifier "ns.unit2"',
|
||||
nParserDuplicateIdentifier);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestUnit_DuplicateUsesDiffNameFail;
|
||||
begin
|
||||
MainFilename:='unitdots.main1.pas';
|
||||
AddModuleWithIntfImplSrc('unitdots.unit1.pp',
|
||||
LinesToStr([
|
||||
'var j1: longint;']),
|
||||
LinesToStr([
|
||||
'']));
|
||||
|
||||
StartProgram(true);
|
||||
Add([
|
||||
'uses unitdots.unit1, unit1;',
|
||||
'var k1: longint;',
|
||||
'begin',
|
||||
' if unitdots.main1.k1=0 then ;',
|
||||
' if unit1.j1=0 then ;',
|
||||
' if unitdots.unit1.j1=0 then ;',
|
||||
'']);
|
||||
CheckResolverException('Duplicate identifier "unitdots.unit1" at unitdots.main1.pas(2,13)',
|
||||
nDuplicateIdentifier);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestUnit_Unit1DotUnit2Fail;
|
||||
begin
|
||||
AddModuleWithIntfImplSrc('unit1.pp',
|
||||
LinesToStr([
|
||||
'var i1: longint;']),
|
||||
LinesToStr([
|
||||
'']));
|
||||
|
||||
AddModuleWithIntfImplSrc('unit2.pp',
|
||||
LinesToStr([
|
||||
'uses unit1;',
|
||||
'var j1: longint;']),
|
||||
LinesToStr([
|
||||
'']));
|
||||
|
||||
StartProgram(true);
|
||||
Add([
|
||||
'uses unit2;',
|
||||
'begin',
|
||||
' if unit2.unit1.i1=0 then ;',
|
||||
'']);
|
||||
CheckResolverException('identifier not found "unit1"',
|
||||
nIdentifierNotFound);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestUnit_InFilename;
|
||||
begin
|
||||
exit;
|
||||
AddModuleWithIntfImplSrc('unit2.pp',
|
||||
LinesToStr([
|
||||
'uses unit1;',
|
||||
'var j1: longint;']),
|
||||
LinesToStr([
|
||||
'']));
|
||||
|
||||
StartProgram(true);
|
||||
Add([
|
||||
'uses foo in ''unit2.pas'';',
|
||||
'begin',
|
||||
' if foo.i1=0 then ;',
|
||||
'']);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestProcParam;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -3747,7 +3959,7 @@ begin
|
||||
StartProgram(false);
|
||||
Add('procedure A: longint; begin end;');
|
||||
Add('begin');
|
||||
CheckParserException('Expected ";" at token ":" in file afile.pp at line 2 column 12',
|
||||
CheckParserException('Expected ";"',
|
||||
nParserExpectTokenError);
|
||||
end;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user