Simba: Fix recursive INCLUDE_ONCE.

This commit is contained in:
Merlijn Wajer 2011-07-31 17:36:34 +02:00
parent b301172600
commit cf41d95f53
3 changed files with 33 additions and 24 deletions

View File

@ -184,8 +184,8 @@ type
procedure OnCompile(Sender: TPSScript); procedure OnCompile(Sender: TPSScript);
function RequireFile(Sender: TObject; const OriginFileName: String; function RequireFile(Sender: TObject; const OriginFileName: String;
var FileName, OutPut: string): Boolean; var FileName, OutPut: string): Boolean;
function FileAlreadyIncluded(Sender: TObject; FileName: string): Boolean; function FileAlreadyIncluded(Sender: TObject; OrgFileName, FileName: string): Boolean;
function OnIncludingFile(Sender: TObject; FileName: string): Boolean; function OnIncludingFile(Sender: TObject; OrgFileName, FileName: string): Boolean;
procedure OnCompImport(Sender: TObject; x: TPSPascalCompiler); procedure OnCompImport(Sender: TObject; x: TPSPascalCompiler);
procedure OnExecImport(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter); procedure OnExecImport(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter);
@ -741,20 +741,24 @@ begin
'{$IFDEF __REMOVE_IS_INCLUDE}{$UNDEF IS_INCLUDE}{$ENDIF}'; '{$IFDEF __REMOVE_IS_INCLUDE}{$UNDEF IS_INCLUDE}{$ENDIF}';
end; end;
function TPSThread.FileAlreadyIncluded(Sender: TObject; FileName: string): Boolean; function TPSThread.FileAlreadyIncluded(Sender: TObject; OrgFileName, FileName: string): Boolean;
var var
path: string; path: string;
i: integer; i: integer;
begin begin
{ XXX/TODO: Why not just use path := ExpandFileNameUTF8(FileName); } path := FindFile(filename,[includepath,ScriptPath,IncludeTrailingPathDelimiter(ExtractFileDir(OrgFileName))]);
path := FindFile(Filename,[ScriptPath,IncludePath]); if path = '' then
begin
Result := True;
Exit;
end;
path := ExpandFileNameUTF8(path); path := ExpandFileNameUTF8(path);
if (path <> '') then if (path <> '') then
if Includes.IndexOf(path) <> -1 then if Includes.IndexOf(path) <> -1 then
begin begin
{$IFDEF SIMBA_VERBOSE} {$IFDEF SIMBA_VERBOSE}
psWriteln('Include_Once file already included:' + Path); writeln('Include_Once file already included:' + Path);
{$ENDIF} {$ENDIF}
Result := True; Result := True;
Exit; Exit;
@ -767,11 +771,16 @@ begin
Result := False; Result := False;
end; end;
function TPSThread.OnIncludingFile(Sender: TObject; FileName: string): Boolean; function TPSThread.OnIncludingFile(Sender: TObject; OrgFileName, FileName: string): Boolean;
var var
path: string; path: string;
begin begin
path := FindFile(Filename,[ScriptPath,IncludePath]); path := FindFile(filename,[includepath,ScriptPath,IncludeTrailingPathDelimiter(ExtractFileDir(OrgFileName))]);
if path = '' then
begin
Result := True;
Exit;
end;
path := ExpandFileNameUTF8(path); path := ExpandFileNameUTF8(path);
if Includes.IndexOf(path) = -1 then if Includes.IndexOf(path) = -1 then

View File

@ -94,8 +94,8 @@ type
TPSOnNeedFile = function (Sender: TObject; const OrginFileName: tbtstring; var FileName, Output: tbtstring): Boolean of object; TPSOnNeedFile = function (Sender: TObject; const OrginFileName: tbtstring; var FileName, Output: tbtstring): Boolean of object;
{ Added by Wizzup } { Added by Wizzup }
TPSOnFileAlreadyIncluded = function (Sender: TObject; FileName: tbtstring): Boolean of object; TPSOnFileAlreadyIncluded = function (Sender: TObject; OrgFileName, FileName: tbtstring): Boolean of object;
TPSOnIncludingFile = function (Sender: TObject; FileName: tbtstring): Boolean of object; TPSOnIncludingFile = function (Sender: TObject; OrgFileName, FileName: tbtstring): Boolean of object;
{ Wizzup out } { Wizzup out }
TPSOnProcessDirective = procedure ( TPSOnProcessDirective = procedure (
@ -163,8 +163,8 @@ type
//--jgv new //--jgv new
function DoOnNeedFile (Sender: TObject; const OrginFileName: tbtstring; var FileName, Output: tbtstring): Boolean; virtual; function DoOnNeedFile (Sender: TObject; const OrginFileName: tbtstring; var FileName, Output: tbtstring): Boolean; virtual;
{ Added by Wizzup } { Added by Wizzup }
function DoOnFileAlreadyIncluded (Sender: TObject; FileName: tbtstring): Boolean; virtual; function DoOnFileAlreadyIncluded (Sender: TObject; OrgFileName, FileName: tbtstring): Boolean; virtual;
function DoOnIncludingFile (Sender: TObject; FileName: tbtstring): Boolean; virtual; function DoOnIncludingFile (Sender: TObject; OrgFileName, FileName: tbtstring): Boolean; virtual;
{ Wizzup out } { Wizzup out }
function DoOnUnknowUses (Sender: TPSPascalCompiler; const Name: tbtstring): Boolean; virtual; // return true if processed function DoOnUnknowUses (Sender: TPSPascalCompiler; const Name: tbtstring): Boolean; virtual; // return true if processed
procedure DoOnCompImport; virtual; procedure DoOnCompImport; virtual;
@ -557,14 +557,14 @@ begin
end; end;
{ Added by Wizzup } { Added by Wizzup }
function CEOnFileAlreadyIncluded(Sender: TPSPreProcessor; FileName: tbtstring): Boolean; function CEOnFileAlreadyIncluded(Sender: TPSPreProcessor; OrgFileName, FileName: tbtstring): Boolean;
begin begin
Result := TPSScript (Sender.ID).DoOnFileAlreadyIncluded(Sender.ID, Filename); Result := TPSScript (Sender.ID).DoOnFileAlreadyIncluded(Sender.ID, OrgFileName, Filename);
end; end;
function CEOnIncludingFile(Sender: TPSPreProcessor; FileName: tbtstring): Boolean; function CEOnIncludingFile(Sender: TPSPreProcessor; OrgFileName, FileName: tbtstring): Boolean;
begin begin
Result := TPSScript (Sender.ID).DoOnIncludingFile(Sender.ID, Filename); Result := TPSScript (Sender.ID).DoOnIncludingFile(Sender.ID, OrgFileName, Filename);
end; end;
{ Wizzup out } { Wizzup out }
@ -1091,19 +1091,19 @@ end;
{ Added by Wizzup } { Added by Wizzup }
function TPSScript.DoOnFileAlreadyIncluded(Sender: TObject; function TPSScript.DoOnFileAlreadyIncluded(Sender: TObject;
FileName: tbtstring): Boolean; OrgFileName, FileName: tbtstring): Boolean;
begin begin
If Assigned (OnFileAlreadyIncluded) then If Assigned (OnFileAlreadyIncluded) then
Result := OnFileAlreadyIncluded(Sender, FileName) Result := OnFileAlreadyIncluded(Sender, OrgFileName, FileName)
else else
Result := False; Result := False;
end; end;
function TPSScript.DoOnIncludingFile(Sender: TObject; function TPSScript.DoOnIncludingFile(Sender: TObject;
FileName: tbtstring): Boolean; OrgFileName, FileName: tbtstring): Boolean;
begin begin
If Assigned (OnIncludingFile) then If Assigned (OnIncludingFile) then
Result := OnIncludingFile(Sender, FileName) Result := OnIncludingFile(Sender, OrgFileName, FileName)
else else
Result := False; Result := False;
end; end;

View File

@ -16,8 +16,8 @@ type
TPSOnNeedFile = function (Sender: TPSPreProcessor; const callingfilename: tbtstring; var FileName, Output: tbtstring): Boolean; TPSOnNeedFile = function (Sender: TPSPreProcessor; const callingfilename: tbtstring; var FileName, Output: tbtstring): Boolean;
{ Added by Wizzup } { Added by Wizzup }
TPSOnFileAlreadyIncluded = function (Sender: TPSPreProcessor; FileName: tbtstring): Boolean; TPSOnFileAlreadyIncluded = function (Sender: TPSPreProcessor; OrgFileName, FileName: tbtstring): Boolean;
TPSOnIncludingFile = function (Sender: TPSPreProcessor; FileName: tbtstring): Boolean; TPSOnIncludingFile = function (Sender: TPSPreProcessor; OrgFileName, FileName: tbtstring): Boolean;
{ Wizzup out } { Wizzup out }
TPSOnProcessDirective = procedure ( TPSOnProcessDirective = procedure (
@ -637,7 +637,7 @@ begin
if FDefineState.DoWrite then if FDefineState.DoWrite then
begin begin
if assigned(@OnIncludingFile) then if assigned(@OnIncludingFile) then
OnIncludingFile(self, s); OnIncludingFile(self , Filename, s);
FAddedPosition := 0; FAddedPosition := 0;
IntPreProcess(Level +1, FileName, s, Dest); IntPreProcess(Level +1, FileName, s, Dest);
FCurrentLineInfo.Current := current; FCurrentLineInfo.Current := current;
@ -651,7 +651,7 @@ begin
raise EPSPreProcessor.CreateFmt(RPS_IncludeOnceNotFound, [FileName, OrgFileName]) raise EPSPreProcessor.CreateFmt(RPS_IncludeOnceNotFound, [FileName, OrgFileName])
else else
begin begin
if not OnFileAlreadyIncluded(Self, s) then if not OnFileAlreadyIncluded(Self, FileName, s) then
begin begin
FAddedPosition := 0; FAddedPosition := 0;
IntPreProcess(Level +1, FileName, s, Dest); IntPreProcess(Level +1, FileName, s, Dest);