fcl-passrc: optional parse units queued instead of recursively

git-svn-id: trunk@38414 -
This commit is contained in:
Mattias Gaertner 2018-03-05 20:58:04 +00:00
parent 77b97abe61
commit d34e9b79bf
5 changed files with 263 additions and 69 deletions

View File

@ -665,6 +665,7 @@ type
Data: Pointer; var Abort: boolean); Data: Pointer; var Abort: boolean);
public public
UsesScopes: TFPList; // list of TPasSectionScope UsesScopes: TFPList; // list of TPasSectionScope
UsesFinished: boolean;
Finished: boolean; Finished: boolean;
constructor Create; override; constructor Create; override;
destructor Destroy; override; destructor Destroy; override;
@ -1434,8 +1435,9 @@ type
function GetVisibilityContext: TPasElement; function GetVisibilityContext: TPasElement;
procedure FinishScope(ScopeType: TPasScopeType; El: TPasElement); override; procedure FinishScope(ScopeType: TPasScopeType; El: TPasElement); override;
function IsUnitIntfFinished(AModule: TPasModule): boolean; function IsUnitIntfFinished(AModule: TPasModule): boolean;
procedure NotifyPendingUsedInterfaces; virtual;
function GetPendingUsedInterface(Section: TPasSection): TPasUsesUnit; function GetPendingUsedInterface(Section: TPasSection): TPasUsesUnit;
procedure CheckPendingUsedInterface(Section: TPasSection); override; function CheckPendingUsedInterface(Section: TPasSection): boolean; override;
procedure ContinueParsing; virtual; procedure ContinueParsing; virtual;
function NeedArrayValues(El: TPasElement): boolean; override; function NeedArrayValues(El: TPasElement): boolean; override;
function GetDefaultClassVisibility(AClass: TPasClassType function GetDefaultClassVisibility(AClass: TPasClassType
@ -4045,6 +4047,10 @@ begin
{$IFDEF VerbosePasResolver} {$IFDEF VerbosePasResolver}
writeln('TPasResolver.FinishUsesClause Section=',Section.ClassName,' Section.UsesList.Count=',Section.UsesList.Count); writeln('TPasResolver.FinishUsesClause Section=',Section.ClassName,' Section.UsesList.Count=',Section.UsesList.Count);
{$ENDIF} {$ENDIF}
if Scope.UsesFinished then
RaiseInternalError(20180305145220);
Scope.UsesFinished:=true;
for i:=0 to Section.UsesList.Count-1 do for i:=0 to Section.UsesList.Count-1 do
begin begin
UseUnit:=Section.UsesClause[i]; UseUnit:=Section.UsesClause[i];
@ -4055,8 +4061,8 @@ begin
// check used unit // check used unit
PublicEl:=nil; PublicEl:=nil;
if (UseModule.ClassType=TLibrarySection) then if (UseModule.ClassType=TPasLibrary) then
PublicEl:=UseModule PublicEl:=TPasLibrary(UseModule).LibrarySection
else if (UseModule.ClassType=TPasModule) then else if (UseModule.ClassType=TPasModule) then
PublicEl:=TPasModule(UseModule).InterfaceSection PublicEl:=TPasModule(UseModule).InterfaceSection
else else
@ -4131,29 +4137,12 @@ begin
end; end;
procedure TPasResolver.FinishInterfaceSection(Section: TPasSection); procedure TPasResolver.FinishInterfaceSection(Section: TPasSection);
var
ModuleScope: TPasModuleScope;
PendingResolver: TPasResolver;
PendingParser: TPasParser;
PendingModule: TPasModule;
PendingImpl: TImplementationSection;
begin begin
{$IFDEF VerbosePasResolver} {$IFDEF VerbosePasResolver}
if not IsUnitIntfFinished(Section.GetModule) then if not IsUnitIntfFinished(Section.GetModule) then
RaiseInternalError(20171214004323,'TPasResolver.FinishInterfaceSection "'+CurrentParser.CurModule.Name+'" "'+Section.GetModule.Name+'" IsUnitIntfFinished=false'); RaiseInternalError(20171214004323,'TPasResolver.FinishInterfaceSection "'+CurrentParser.CurModule.Name+'" "'+Section.GetModule.Name+'" IsUnitIntfFinished=false');
{$ENDIF} {$ENDIF}
ModuleScope:=CurrentParser.CurModule.CustomData as TPasModuleScope; NotifyPendingUsedInterfaces;
while ModuleScope.PendingResolvers.Count>0 do
begin
PendingResolver:=TObject(ModuleScope.PendingResolvers[0]) as TPasResolver;
PendingParser:=PendingResolver.CurrentParser;
PendingModule:=PendingParser.CurModule;
PendingImpl:=PendingModule.ImplementationSection;
{$IFDEF VerbosePasResolver}
writeln('TPasResolver.FinishInterfaceSection "',ModuleScope.Element.Name,'" Pending="',PendingModule.Name,'"');
{$ENDIF}
PendingResolver.CheckPendingUsedInterface(PendingImpl);
end;
if Section=nil then ; if Section=nil then ;
end; end;
@ -11835,6 +11824,45 @@ begin
and TPasSectionScope(CurIntf.CustomData).Finished; and TPasSectionScope(CurIntf.CustomData).Finished;
end; end;
procedure TPasResolver.NotifyPendingUsedInterfaces;
// called after unit interface is ready to be used by other modules
var
ModuleScope: TPasModuleScope;
i: Integer;
PendingResolver: TPasResolver;
PendingParser: TPasParser;
PendingSection: TPasSection;
Changed: Boolean;
begin
// call all PendingResolvers
// Note that a waiting resolver might continue parsing, so this
// recursively solves all unit cycles
ModuleScope:=RootElement.CustomData as TPasModuleScope;
i:=ModuleScope.PendingResolvers.Count-1;
while i>=0 do
begin
PendingResolver:=TObject(ModuleScope.PendingResolvers[i]) as TPasResolver;
PendingParser:=PendingResolver.CurrentParser;
PendingSection:=PendingParser.GetLastSection;
{$IFDEF VerbosePasResolver}
writeln('TPasResolver.FinishInterfaceSection "',ModuleScope.Element.Name,'" Pending="',PendingResolver.RootElement.Name,'"');
{$ENDIF}
if PendingSection=nil then
RaiseInternalError(20180305141421);
Changed:=PendingResolver.CheckPendingUsedInterface(PendingSection); // beware: this might alter the ModuleScope.PendingResolvers
if Changed and (PendingSection.PendingUsedIntf=nil) then
begin
{$IFDEF VerbosePasResolver}
writeln('TPasResolver.FinishInterfaceSection "',ModuleScope.Element.Name,'" Continue="',PendingResolver.RootElement.Name,'"');
{$ENDIF}
PendingParser.ParseContinue;
end;
dec(i);
if i>=ModuleScope.PendingResolvers.Count then
i:=ModuleScope.PendingResolvers.Count-1;
end;
end;
function TPasResolver.GetPendingUsedInterface(Section: TPasSection function TPasResolver.GetPendingUsedInterface(Section: TPasSection
): TPasUsesUnit; ): TPasUsesUnit;
var var
@ -11842,7 +11870,6 @@ var
UseUnit: TPasUsesUnit; UseUnit: TPasUsesUnit;
begin begin
Result:=nil; Result:=nil;
if not (Section is TImplementationSection) then exit;
for i:=0 to length(Section.UsesClause)-1 do for i:=0 to length(Section.UsesClause)-1 do
begin begin
UseUnit:=Section.UsesClause[i]; UseUnit:=Section.UsesClause[i];
@ -11852,7 +11879,7 @@ begin
end; end;
end; end;
procedure TPasResolver.CheckPendingUsedInterface(Section: TPasSection); function TPasResolver.CheckPendingUsedInterface(Section: TPasSection): boolean;
var var
PendingModule: TPasModule; PendingModule: TPasModule;
PendingModuleScope: TPasModuleScope; PendingModuleScope: TPasModuleScope;
@ -11860,7 +11887,7 @@ var
WasPending: Boolean; WasPending: Boolean;
begin begin
{$IFDEF VerbosePasResolver} {$IFDEF VerbosePasResolver}
//writeln('TPasResolver.CheckPendingUsedInterface START "',CurrentParser.CurModule.Name,'"'); //writeln('TPasResolver.CheckPendingUsedInterface START "',CurrentParser.CurModule.Name,'" Section.PendingUsedIntf=',Section.PendingUsedIntf<>nil);
{$ENDIF} {$ENDIF}
WasPending:=Section.PendingUsedIntf<>nil; WasPending:=Section.PendingUsedIntf<>nil;
if WasPending then if WasPending then
@ -11869,6 +11896,9 @@ begin
if not IsUnitIntfFinished(PendingModule) then if not IsUnitIntfFinished(PendingModule) then
exit; // still pending exit; // still pending
// other unit interface is finished // other unit interface is finished
{$IFDEF VerbosePasResolver}
writeln('TPasResolver.CheckPendingUsedInterface "',CurrentParser.CurModule.Name,'" UnitIntf finished of "',PendingModule.Name,'"');
{$ENDIF}
PendingModuleScope:=NoNil(PendingModule.CustomData) as TPasModuleScope; PendingModuleScope:=NoNil(PendingModule.CustomData) as TPasModuleScope;
PendingModuleScope.PendingResolvers.Remove(Self); PendingModuleScope.PendingResolvers.Remove(Self);
Section.PendingUsedIntf:=nil; Section.PendingUsedIntf:=nil;
@ -11877,7 +11907,7 @@ begin
Section.PendingUsedIntf:=GetPendingUsedInterface(Section); Section.PendingUsedIntf:=GetPendingUsedInterface(Section);
if Section.PendingUsedIntf<>nil then if Section.PendingUsedIntf<>nil then
begin begin
// unit not yet finished due to pending used interfaces // module not yet finished due to pending used interfaces
PendingModule:=Section.PendingUsedIntf.Module as TPasModule; PendingModule:=Section.PendingUsedIntf.Module as TPasModule;
PendingModuleScope:=NoNil(PendingModule.CustomData) as TPasModuleScope; PendingModuleScope:=NoNil(PendingModule.CustomData) as TPasModuleScope;
{$IFDEF VerbosePasResolver} {$IFDEF VerbosePasResolver}
@ -11886,12 +11916,16 @@ begin
List:=PendingModuleScope.PendingResolvers; List:=PendingModuleScope.PendingResolvers;
if List.IndexOf(Self)<0 then if List.IndexOf(Self)<0 then
List.Add(Self); List.Add(Self);
Result:=not WasPending;
end end
else else
begin begin
{$IFDEF VerbosePasResolver}
if WasPending then if WasPending then
// can now continue parsing writeln('TPasResolver.CheckPendingUsedInterface "',CurrentParser.CurModule.Name,'" uses section complete: ',Section.ClassName);
ContinueParsing; {$ENDIF}
Result:=WasPending;
end; end;
end; end;
@ -11902,7 +11936,7 @@ begin
{$IFDEF VerbosePasResolver} {$IFDEF VerbosePasResolver}
writeln('TPasResolver.ContinueParsing "',CurrentParser.CurModule.Name,'"...'); writeln('TPasResolver.ContinueParsing "',CurrentParser.CurModule.Name,'"...');
{$ENDIF} {$ENDIF}
CurrentParser.ParseContinueImplementation; CurrentParser.ParseContinue;
end; end;
function TPasResolver.NeedArrayValues(El: TPasElement): boolean; function TPasResolver.NeedArrayValues(El: TPasElement): boolean;

View File

@ -192,7 +192,7 @@ type
procedure FinishScope(ScopeType: TPasScopeType; El: TPasElement); virtual; procedure FinishScope(ScopeType: TPasScopeType; El: TPasElement); virtual;
function FindModule(const AName: String): TPasModule; virtual; function FindModule(const AName: String): TPasModule; virtual;
function FindModule(const AName: String; NameExpr, InFileExpr: TPasExpr): TPasModule; virtual; function FindModule(const AName: String; NameExpr, InFileExpr: TPasExpr): TPasModule; virtual;
procedure CheckPendingUsedInterface(Section: TPasSection); virtual; function CheckPendingUsedInterface(Section: TPasSection): boolean; virtual; // true if changed
function NeedArrayValues(El: TPasElement): boolean; virtual; function NeedArrayValues(El: TPasElement): boolean; virtual;
function GetDefaultClassVisibility(AClass: TPasClassType): TPasMemberVisibility; virtual; function GetDefaultClassVisibility(AClass: TPasClassType): TPasMemberVisibility; virtual;
property Package: TPasPackage read FPackage; property Package: TPasPackage read FPackage;
@ -401,7 +401,9 @@ type
// Main scope parsing // Main scope parsing
procedure ParseMain(var Module: TPasModule); procedure ParseMain(var Module: TPasModule);
procedure ParseUnit(var Module: TPasModule); procedure ParseUnit(var Module: TPasModule);
procedure ParseContinueImplementation; function GetLastSection: TPasSection; virtual;
function CanParseContinue(out Section: TPasSection): boolean; virtual;
procedure ParseContinue; virtual;
procedure ParseProgram(var Module: TPasModule; SkipHeader : Boolean = False); procedure ParseProgram(var Module: TPasModule; SkipHeader : Boolean = False);
procedure ParseLibrary(var Module: TPasModule); procedure ParseLibrary(var Module: TPasModule);
procedure ParseOptionalUsesList(ASection: TPasSection); procedure ParseOptionalUsesList(ASection: TPasSection);
@ -778,9 +780,11 @@ begin
if InFileExpr=nil then ; if InFileExpr=nil then ;
end; end;
procedure TPasTreeContainer.CheckPendingUsedInterface(Section: TPasSection); function TPasTreeContainer.CheckPendingUsedInterface(Section: TPasSection
): boolean;
begin begin
if Section=nil then ; // avoid compiler warning if Section=nil then ; // avoid compiler warning
Result:=false;
end; end;
function TPasTreeContainer.NeedArrayValues(El: TPasElement): boolean; function TPasTreeContainer.NeedArrayValues(El: TPasElement): boolean;
@ -2727,39 +2731,137 @@ begin
end; end;
CheckHint(Module,True); CheckHint(Module,True);
ExpectToken(tkInterface); ExpectToken(tkInterface);
If LogEvent(pleInterface) then if po_StopOnUnitInterface in Options then
DoLog(mtInfo,nLogStartInterface,SLogStartInterface); begin
HasFinished:=false;
{$IFDEF VerbosePasResolver}
writeln('TPasParser.ParseUnit pause parsing after unit name ',CurModule.Name);
{$ENDIF}
exit;
end;
ParseInterface; ParseInterface;
if (Module.InterfaceSection<>nil)
and (Module.InterfaceSection.PendingUsedIntf<>nil) then
begin
HasFinished:=false;
{$IFDEF VerbosePasResolver}
writeln('TPasParser.ParseUnit pause parsing after interface uses list ',CurModule.Name);
{$ENDIF}
end;
if (Module.ImplementationSection<>nil) if (Module.ImplementationSection<>nil)
and (Module.ImplementationSection.PendingUsedIntf<>nil) then and (Module.ImplementationSection.PendingUsedIntf<>nil) then
begin
HasFinished:=false; HasFinished:=false;
{$IFDEF VerbosePasResolver}
writeln('TPasParser.ParseUnit pause parsing after implementation uses list ',CurModule.Name);
{$ENDIF}
end;
if HasFinished then if HasFinished then
Engine.FinishScope(stModule,Module); Engine.FinishScope(stModule,Module);
finally finally
if HasFinished then if HasFinished then
FCurModule:=nil; FCurModule:=nil; // clear module if there is an error or finished parsing
end; end;
end; end;
procedure TPasParser.ParseContinueImplementation; function TPasParser.GetLastSection: TPasSection;
begin begin
Result:=nil;
if FCurModule=nil then
exit; // parse completed
if CurModule is TPasProgram then
Result:=TPasProgram(CurModule).ProgramSection
else if CurModule is TPasLibrary then
Result:=TPasLibrary(CurModule).LibrarySection
else if (CurModule.ClassType=TPasModule) or (CurModule is TPasUnitModule) then
begin
if CurModule.ImplementationSection<>nil then
Result:=CurModule.ImplementationSection
else
Result:=CurModule.InterfaceSection; // might be nil
end;
end;
function TPasParser.CanParseContinue(out Section: TPasSection): boolean;
begin
Result:=false;
Section:=nil;
if FCurModule=nil then
exit; // parse completed
if (LastMsg<>'') and (LastMsgType<=mtError) then
begin
{$IFDEF VerbosePasResolver}
writeln('TPasParser.CanParseContinue ',CurModule.Name,' LastMsg="',LastMsgType,':',LastMsg,'"');
{$ENDIF}
exit;
end;
if (Scanner.LastMsg<>'') and (Scanner.LastMsgType<=mtError) then
begin
{$IFDEF VerbosePasResolver}
writeln('TPasParser.CanParseContinue ',CurModule.Name,' Scanner.LastMsg="',Scanner.LastMsgType,':',Scanner.LastMsg,'"');
{$ENDIF}
exit;
end;
Section:=GetLastSection;
if Section=nil then
if (po_StopOnUnitInterface in Options)
and ((CurModule is TPasUnitModule) or (CurModule.ClassType=TPasModule))
and (CurModule.InterfaceSection=nil) then
exit(true)
else
exit(false);
Result:=Section.PendingUsedIntf=nil;
end;
procedure TPasParser.ParseContinue;
// continue parsing after stopped due to pending uses
var
Section: TPasSection;
HasFinished: Boolean;
begin
if CurModule=nil then
ParseExcTokenError('TPasParser.ParseContinue missing module');
{$IFDEF VerbosePasParser}
writeln('TPasParser.ParseContinue ',CurModule.Name);
{$ENDIF}
if not CanParseContinue(Section) then
ParseExcTokenError('TPasParser.ParseContinue missing section');
HasFinished:=true;
try try
ParseDeclarations(CurModule.ImplementationSection); if Section=nil then
Engine.FinishScope(stModule,CurModule); begin
// continue after unit name
ParseInterface;
end
else
begin
// continue after uses clause
Engine.FinishScope(stUsesClause,Section);
ParseDeclarations(Section);
end;
Section:=GetLastSection;
if (Section<>nil) and (Section.PendingUsedIntf<>nil) then
HasFinished:=false;
if HasFinished then
Engine.FinishScope(stModule,CurModule);
finally finally
FCurModule:=nil; if HasFinished then
FCurModule:=nil; // clear module if there is an error or finished parsing
end; end;
end; end;
// Starts after the "program" token // Starts after the "program" token
procedure TPasParser.ParseProgram(var Module: TPasModule; SkipHeader : Boolean = False); procedure TPasParser.ParseProgram(var Module: TPasModule; SkipHeader : Boolean = False);
Var Var
PP : TPasProgram; PP : TPasProgram;
Section : TProgramSection; Section : TProgramSection;
N : String; N : String;
StartPos: TPasSourcePos; StartPos: TPasSourcePos;
HasFinished: Boolean;
{$IFDEF VerbosePasResolver}
aSection: TPasSection;
{$ENDIF}
begin begin
StartPos:=CurTokenPos; StartPos:=CurTokenPos;
if SkipHeader then if SkipHeader then
@ -2779,6 +2881,7 @@ begin
Module := nil; Module := nil;
PP:=TPasProgram(CreateElement(TPasProgram, N, Engine.Package, StartPos)); PP:=TPasProgram(CreateElement(TPasProgram, N, Engine.Package, StartPos));
Module :=PP; Module :=PP;
HasFinished:=true;
FCurModule:=Module; FCurModule:=Module;
try try
if Assigned(Engine.Package) then if Assigned(Engine.Package) then
@ -2806,10 +2909,26 @@ begin
Section := TProgramSection(CreateElement(TProgramSection, '', CurModule)); Section := TProgramSection(CreateElement(TProgramSection, '', CurModule));
PP.ProgramSection := Section; PP.ProgramSection := Section;
ParseOptionalUsesList(Section); ParseOptionalUsesList(Section);
HasFinished:=Section.PendingUsedIntf=nil;
if not HasFinished then
begin
{$IFDEF VerbosePasResolver}
writeln('TPasParser.ParseProgram pause parsing after uses list of "',CurModule.Name,'"');
if CanParseContinue(aSection) then
begin
writeln('TPasParser.ParseProgram Section=',Section.ClassName,' Section.PendingUsedIntf=',Section.PendingUsedIntf<>nil);
if aSection<>nil then
writeln('TPasParser.ParseProgram aSection=',aSection.ClassName,' ',Section=aSection);
ParseExc(nErrNoSourceGiven,'[20180305172432] ');
end;
{$ENDIF}
exit;
end;
ParseDeclarations(Section); ParseDeclarations(Section);
Engine.FinishScope(stModule,Module); Engine.FinishScope(stModule,Module);
finally finally
FCurModule:=nil; if HasFinished then
FCurModule:=nil; // clear module if there is an error or finished parsing
end; end;
end; end;
@ -2820,6 +2939,7 @@ Var
Section : TLibrarySection; Section : TLibrarySection;
N: String; N: String;
StartPos: TPasSourcePos; StartPos: TPasSourcePos;
HasFinished: Boolean;
begin begin
StartPos:=CurTokenPos; StartPos:=CurTokenPos;
@ -2835,6 +2955,7 @@ begin
Module := nil; Module := nil;
PP:=TPasLibrary(CreateElement(TPasLibrary, N, Engine.Package, StartPos)); PP:=TPasLibrary(CreateElement(TPasLibrary, N, Engine.Package, StartPos));
Module :=PP; Module :=PP;
HasFinished:=true;
FCurModule:=Module; FCurModule:=Module;
try try
if Assigned(Engine.Package) then if Assigned(Engine.Package) then
@ -2848,10 +2969,14 @@ begin
Section := TLibrarySection(CreateElement(TLibrarySection, '', CurModule)); Section := TLibrarySection(CreateElement(TLibrarySection, '', CurModule));
PP.LibrarySection := Section; PP.LibrarySection := Section;
ParseOptionalUsesList(Section); ParseOptionalUsesList(Section);
HasFinished:=Section.PendingUsedIntf=nil;
if not HasFinished then
exit;
ParseDeclarations(Section); ParseDeclarations(Section);
Engine.FinishScope(stModule,Module); Engine.FinishScope(stModule,Module);
finally finally
FCurModule:=nil; if HasFinished then
FCurModule:=nil; // clear module if there is an error or finished parsing
end; end;
end; end;
@ -2859,13 +2984,15 @@ procedure TPasParser.ParseOptionalUsesList(ASection: TPasSection);
// checks if next token is Uses keyword and reads the uses list // checks if next token is Uses keyword and reads the uses list
begin begin
NextToken; NextToken;
CheckImplicitUsedUnits(ASection);
if CurToken=tkuses then if CurToken=tkuses then
ParseUsesList(ASection) ParseUsesList(ASection)
else begin else
CheckImplicitUsedUnits(ASection);
Engine.FinishScope(stUsesClause,ASection);
UngetToken; UngetToken;
end; Engine.CheckPendingUsedInterface(ASection);
if ASection.PendingUsedIntf<>nil then
exit;
Engine.FinishScope(stUsesClause,ASection);
end; end;
// Starts after the "interface" token // Starts after the "interface" token
@ -2873,9 +3000,13 @@ procedure TPasParser.ParseInterface;
var var
Section: TInterfaceSection; Section: TInterfaceSection;
begin begin
If LogEvent(pleInterface) then
DoLog(mtInfo,nLogStartInterface,SLogStartInterface);
Section := TInterfaceSection(CreateElement(TInterfaceSection, '', CurModule)); Section := TInterfaceSection(CreateElement(TInterfaceSection, '', CurModule));
CurModule.InterfaceSection := Section; CurModule.InterfaceSection := Section;
ParseOptionalUsesList(Section); ParseOptionalUsesList(Section);
if Section.PendingUsedIntf<>nil then
exit;
ParseDeclarations(Section); // this also parses the Implementation section ParseDeclarations(Section); // this also parses the Implementation section
end; end;
@ -2887,7 +3018,6 @@ begin
Section := TImplementationSection(CreateElement(TImplementationSection, '', CurModule)); Section := TImplementationSection(CreateElement(TImplementationSection, '', CurModule));
CurModule.ImplementationSection := Section; CurModule.ImplementationSection := Section;
ParseOptionalUsesList(Section); ParseOptionalUsesList(Section);
Engine.CheckPendingUsedInterface(Section);
if Section.PendingUsedIntf<>nil then if Section.PendingUsedIntf<>nil then
exit; exit;
ParseDeclarations(Section); ParseDeclarations(Section);
@ -3412,8 +3542,6 @@ var
NamePos, SrcPos: TPasSourcePos; NamePos, SrcPos: TPasSourcePos;
aModule: TPasModule; aModule: TPasModule;
begin begin
CheckImplicitUsedUnits(ASection);
NameExpr:=nil; NameExpr:=nil;
InFileExpr:=nil; InFileExpr:=nil;
FreeExpr:=true; FreeExpr:=true;
@ -3439,8 +3567,9 @@ begin
if (msDelphi in CurrentModeswitches) then if (msDelphi in CurrentModeswitches) then
begin begin
aModule:=ASection.GetModule; aModule:=ASection.GetModule;
if (aModule<>nil) and ((aModule.ClassType=TPasModule) or (aModule is TPasUnitModule)) then if (aModule<>nil)
CheckToken(tkSemicolon); // delphi does not allow it in units and ((aModule.ClassType=TPasModule) or (aModule is TPasUnitModule)) then
CheckToken(tkSemicolon); // delphi does not allow in-filename in units
end; end;
ExpectToken(tkString); ExpectToken(tkString);
InFileExpr:=CreatePrimitiveExpr(ASection,pekString,CurTokenString); InFileExpr:=CreatePrimitiveExpr(ASection,pekString,CurTokenString);
@ -3461,8 +3590,6 @@ begin
ReleaseAndNil(TPasElement(InFileExpr)); ReleaseAndNil(TPasElement(InFileExpr));
end; end;
end; end;
Engine.FinishScope(stUsesClause,ASection);
end; end;
// Starts after the variable name // Starts after the variable name

View File

@ -558,10 +558,11 @@ type
po_KeepClassForward, // disabled: delete class fowards when there is a class declaration po_KeepClassForward, // disabled: delete class fowards when there is a class declaration
po_ArrayRangeExpr, // enable: create TPasArrayType.IndexRange, disable: create TPasArrayType.Ranges po_ArrayRangeExpr, // enable: create TPasArrayType.IndexRange, disable: create TPasArrayType.Ranges
po_SelfToken, // Self is a token. For backward compatibility. po_SelfToken, // Self is a token. For backward compatibility.
po_CheckModeSwitches, // stop on unknown modeswitch with an error po_CheckModeSwitches, // error on unknown modeswitch with an error
po_CheckCondFunction, // stop on unknown function in conditional expression, default: return '0' po_CheckCondFunction, // error on unknown function in conditional expression, default: return '0'
po_StopOnErrorDirective, // stop on user $Error, $message error|fatal po_StopOnErrorDirective, // error on user $Error, $message error|fatal
po_ExtClassConstWithoutExpr // allow const without expression in external class po_ExtClassConstWithoutExpr, // allow const without expression in external class
po_StopOnUnitInterface // parse only a unit name and stop at interface keyword
); );
TPOptions = set of TPOption; TPOptions = set of TPOption;

View File

@ -62,7 +62,7 @@ Type
Procedure Add(Const Lines : array of String); Procedure Add(Const Lines : array of String);
Procedure StartParsing; Procedure StartParsing;
Procedure ParseDeclarations; Procedure ParseDeclarations;
Procedure ParseModule; Procedure ParseModule; virtual;
procedure ResetParser; procedure ResetParser;
Procedure CheckHint(AHint : TPasMemberHint); Procedure CheckHint(AHint : TPasMemberHint);
Function AssertExpression(Const Msg: String; AExpr : TPasExpr; aKind : TPasExprKind; AClass : TClass) : TPasExpr; Function AssertExpression(Const Msg: String; AExpr : TPasExpr; aKind : TPasExprKind; AClass : TClass) : TPasExpr;

View File

@ -56,7 +56,6 @@ type
private private
FFilename: string; FFilename: string;
FModule: TPasModule; FModule: TPasModule;
FOnContinueParsing: TOnContinueParsing;
FOnFindUnit: TOnFindUnit; FOnFindUnit: TOnFindUnit;
FParser: TPasParser; FParser: TPasParser;
FStreamResolver: TStreamResolver; FStreamResolver: TStreamResolver;
@ -72,8 +71,6 @@ type
overload; override; overload; override;
function FindUnit(const AName, InFilename: String; NameExpr, function FindUnit(const AName, InFilename: String; NameExpr,
InFileExpr: TPasExpr): TPasModule; override; InFileExpr: TPasExpr): TPasModule; override;
procedure ContinueParsing; override;
property OnContinueParsing: TOnContinueParsing read FOnContinueParsing write FOnContinueParsing;
property OnFindUnit: TOnFindUnit read FOnFindUnit write FOnFindUnit; property OnFindUnit: TOnFindUnit read FOnFindUnit write FOnFindUnit;
property Filename: string read FFilename write FFilename; property Filename: string read FFilename write FFilename;
property StreamResolver: TStreamResolver read FStreamResolver write FStreamResolver; property StreamResolver: TStreamResolver read FStreamResolver write FStreamResolver;
@ -135,6 +132,7 @@ type
Procedure SetUp; override; Procedure SetUp; override;
Procedure TearDown; override; Procedure TearDown; override;
procedure CreateEngine(var TheEngine: TPasTreeContainer); override; procedure CreateEngine(var TheEngine: TPasTreeContainer); override;
procedure ParseModule; override;
procedure ParseProgram; virtual; procedure ParseProgram; virtual;
procedure ParseUnit; virtual; procedure ParseUnit; virtual;
procedure CheckReferenceDirectives; virtual; procedure CheckReferenceDirectives; virtual;
@ -777,11 +775,6 @@ begin
Result:=OnFindUnit(Self,AName,InFilename,NameExpr,InFileExpr); Result:=OnFindUnit(Self,AName,InFilename,NameExpr,InFileExpr);
end; end;
procedure TTestEnginePasResolver.ContinueParsing;
begin
OnContinueParsing(Self);
end;
{ TCustomTestResolver } { TCustomTestResolver }
procedure TCustomTestResolver.SetUp; procedure TCustomTestResolver.SetUp;
@ -830,6 +823,45 @@ begin
TheEngine:=ResolverEngine; TheEngine:=ResolverEngine;
end; end;
procedure TCustomTestResolver.ParseModule;
var
Section: TPasSection;
i: Integer;
CurResolver: TTestEnginePasResolver;
Found: Boolean;
begin
inherited ParseModule;
repeat
Found:=false;
for i:=0 to ModuleCount-1 do
begin
CurResolver:=Modules[i];
if CurResolver.Parser=nil then continue;
if CurResolver.Parser.CanParseContinue(Section) then
begin
{$IFDEF VerbosePasResolver}
writeln('TCustomTestResolver.ParseModule continue parsing section=',GetObjName(Section),' of ',CurResolver.Filename);
{$ENDIF}
Found:=true;
CurResolver.Parser.ParseContinue;
break;
end;
end;
until not Found;
for i:=0 to ModuleCount-1 do
begin
CurResolver:=Modules[i];
if CurResolver.CurrentParser.CurModule<>nil then
begin
{$IFDEF VerbosePasResolver}
writeln('TCustomTestResolver.ParseModule module not finished "',CurResolver.RootElement.Name,'"');
{$ENDIF}
Fail('module not finished "'+CurResolver.RootElement.Name+'"');
end;
end;
end;
procedure TCustomTestResolver.ParseProgram; procedure TCustomTestResolver.ParseProgram;
var var
aFilename: String; aFilename: String;
@ -1592,7 +1624,7 @@ begin
ErrFilename:=CurEngine.Scanner.CurFilename; ErrFilename:=CurEngine.Scanner.CurFilename;
ErrRow:=CurEngine.Scanner.CurRow; ErrRow:=CurEngine.Scanner.CurRow;
ErrCol:=CurEngine.Scanner.CurColumn; ErrCol:=CurEngine.Scanner.CurColumn;
writeln('ERROR: TTestResolver.OnPasResolverFindUnit during parsing: '+E.ClassName+':'+E.Message writeln('ERROR: TCustomTestResolver.HandleError during parsing: '+E.ClassName+':'+E.Message
+' File='+ErrFilename +' File='+ErrFilename
+' LineNo='+IntToStr(ErrRow) +' LineNo='+IntToStr(ErrRow)
+' Col='+IntToStr(ErrCol) +' Col='+IntToStr(ErrCol)
@ -1636,7 +1668,6 @@ begin
Result.Filename:=aFilename; Result.Filename:=aFilename;
Result.AddObjFPCBuiltInIdentifiers; Result.AddObjFPCBuiltInIdentifiers;
Result.OnFindUnit:=@OnPasResolverFindUnit; Result.OnFindUnit:=@OnPasResolverFindUnit;
Result.OnContinueParsing:=@OnPasResolverContinueParsing;
Result.OnLog:=@OnPasResolverLog; Result.OnLog:=@OnPasResolverLog;
FModules.Add(Result); FModules.Add(Result);
end; end;
@ -1787,6 +1818,7 @@ function TCustomTestResolver.OnPasResolverFindUnit(SrcResolver: TPasResolver;
CurEngine.Scanner.CurrentBoolSwitches:=[bsHints,bsNotes,bsWarnings]; CurEngine.Scanner.CurrentBoolSwitches:=[bsHints,bsNotes,bsWarnings];
CurEngine.Parser:=TPasParser.Create(CurEngine.Scanner, CurEngine.Parser:=TPasParser.Create(CurEngine.Scanner,
CurEngine.StreamResolver,CurEngine); CurEngine.StreamResolver,CurEngine);
CurEngine.Parser.Options:=CurEngine.Parser.Options+[po_StopOnUnitInterface];
if CompareText(ExtractFileUnitName(CurEngine.Filename),'System')=0 then if CompareText(ExtractFileUnitName(CurEngine.Filename),'System')=0 then
CurEngine.Parser.ImplicitUses.Clear; CurEngine.Parser.ImplicitUses.Clear;
CurEngine.Scanner.OpenFile(CurEngine.Filename); CurEngine.Scanner.OpenFile(CurEngine.Filename);
@ -2056,7 +2088,7 @@ begin
writeln('TCustomTestResolver.OnPasResolverContinueParsing "',CurEngine.Module.Name,'"...'); writeln('TCustomTestResolver.OnPasResolverContinueParsing "',CurEngine.Module.Name,'"...');
{$ENDIF} {$ENDIF}
try try
CurEngine.Parser.ParseContinueImplementation; CurEngine.Parser.ParseContinue;
except except
on E: Exception do on E: Exception do
HandleError(CurEngine,E); HandleError(CurEngine,E);