From cf41d95f534712d145bbfe2f22fcac9748fb3eab Mon Sep 17 00:00:00 2001 From: Merlijn Wajer Date: Sun, 31 Jul 2011 17:36:34 +0200 Subject: [PATCH] Simba: Fix recursive INCLUDE_ONCE. --- Units/MMLAddon/mmlpsthread.pas | 25 +++++++++++++++++-------- Units/PascalScript/uPSComponent.pas | 24 ++++++++++++------------ Units/PascalScript/uPSPreProcessor.pas | 8 ++++---- 3 files changed, 33 insertions(+), 24 deletions(-) diff --git a/Units/MMLAddon/mmlpsthread.pas b/Units/MMLAddon/mmlpsthread.pas index 08be9ce..6f194f7 100644 --- a/Units/MMLAddon/mmlpsthread.pas +++ b/Units/MMLAddon/mmlpsthread.pas @@ -184,8 +184,8 @@ type procedure OnCompile(Sender: TPSScript); function RequireFile(Sender: TObject; const OriginFileName: String; var FileName, OutPut: string): Boolean; - function FileAlreadyIncluded(Sender: TObject; FileName: string): Boolean; - function OnIncludingFile(Sender: TObject; FileName: string): Boolean; + function FileAlreadyIncluded(Sender: TObject; OrgFileName, FileName: string): Boolean; + function OnIncludingFile(Sender: TObject; OrgFileName, FileName: string): Boolean; procedure OnCompImport(Sender: TObject; x: TPSPascalCompiler); procedure OnExecImport(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter); @@ -741,20 +741,24 @@ begin '{$IFDEF __REMOVE_IS_INCLUDE}{$UNDEF IS_INCLUDE}{$ENDIF}'; end; -function TPSThread.FileAlreadyIncluded(Sender: TObject; FileName: string): Boolean; +function TPSThread.FileAlreadyIncluded(Sender: TObject; OrgFileName, FileName: string): Boolean; var path: string; i: integer; begin - { XXX/TODO: Why not just use path := ExpandFileNameUTF8(FileName); } - path := FindFile(Filename,[ScriptPath,IncludePath]); + path := FindFile(filename,[includepath,ScriptPath,IncludeTrailingPathDelimiter(ExtractFileDir(OrgFileName))]); + if path = '' then + begin + Result := True; + Exit; + end; path := ExpandFileNameUTF8(path); if (path <> '') then if Includes.IndexOf(path) <> -1 then begin {$IFDEF SIMBA_VERBOSE} - psWriteln('Include_Once file already included:' + Path); + writeln('Include_Once file already included:' + Path); {$ENDIF} Result := True; Exit; @@ -767,11 +771,16 @@ begin Result := False; end; -function TPSThread.OnIncludingFile(Sender: TObject; FileName: string): Boolean; +function TPSThread.OnIncludingFile(Sender: TObject; OrgFileName, FileName: string): Boolean; var path: string; 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); if Includes.IndexOf(path) = -1 then diff --git a/Units/PascalScript/uPSComponent.pas b/Units/PascalScript/uPSComponent.pas index 232a68a..9aad121 100644 --- a/Units/PascalScript/uPSComponent.pas +++ b/Units/PascalScript/uPSComponent.pas @@ -94,8 +94,8 @@ type TPSOnNeedFile = function (Sender: TObject; const OrginFileName: tbtstring; var FileName, Output: tbtstring): Boolean of object; { Added by Wizzup } - TPSOnFileAlreadyIncluded = function (Sender: TObject; FileName: tbtstring): Boolean of object; - TPSOnIncludingFile = function (Sender: TObject; FileName: tbtstring): Boolean of object; + TPSOnFileAlreadyIncluded = function (Sender: TObject; OrgFileName, FileName: tbtstring): Boolean of object; + TPSOnIncludingFile = function (Sender: TObject; OrgFileName, FileName: tbtstring): Boolean of object; { Wizzup out } TPSOnProcessDirective = procedure ( @@ -163,8 +163,8 @@ type //--jgv new function DoOnNeedFile (Sender: TObject; const OrginFileName: tbtstring; var FileName, Output: tbtstring): Boolean; virtual; { Added by Wizzup } - function DoOnFileAlreadyIncluded (Sender: TObject; FileName: tbtstring): Boolean; virtual; - function DoOnIncludingFile (Sender: TObject; FileName: tbtstring): Boolean; virtual; + function DoOnFileAlreadyIncluded (Sender: TObject; OrgFileName, FileName: tbtstring): Boolean; virtual; + function DoOnIncludingFile (Sender: TObject; OrgFileName, FileName: tbtstring): Boolean; virtual; { Wizzup out } function DoOnUnknowUses (Sender: TPSPascalCompiler; const Name: tbtstring): Boolean; virtual; // return true if processed procedure DoOnCompImport; virtual; @@ -557,14 +557,14 @@ begin end; { Added by Wizzup } -function CEOnFileAlreadyIncluded(Sender: TPSPreProcessor; FileName: tbtstring): Boolean; +function CEOnFileAlreadyIncluded(Sender: TPSPreProcessor; OrgFileName, FileName: tbtstring): Boolean; begin - Result := TPSScript (Sender.ID).DoOnFileAlreadyIncluded(Sender.ID, Filename); + Result := TPSScript (Sender.ID).DoOnFileAlreadyIncluded(Sender.ID, OrgFileName, Filename); end; -function CEOnIncludingFile(Sender: TPSPreProcessor; FileName: tbtstring): Boolean; +function CEOnIncludingFile(Sender: TPSPreProcessor; OrgFileName, FileName: tbtstring): Boolean; begin - Result := TPSScript (Sender.ID).DoOnIncludingFile(Sender.ID, Filename); + Result := TPSScript (Sender.ID).DoOnIncludingFile(Sender.ID, OrgFileName, Filename); end; { Wizzup out } @@ -1091,19 +1091,19 @@ end; { Added by Wizzup } function TPSScript.DoOnFileAlreadyIncluded(Sender: TObject; - FileName: tbtstring): Boolean; + OrgFileName, FileName: tbtstring): Boolean; begin If Assigned (OnFileAlreadyIncluded) then - Result := OnFileAlreadyIncluded(Sender, FileName) + Result := OnFileAlreadyIncluded(Sender, OrgFileName, FileName) else Result := False; end; function TPSScript.DoOnIncludingFile(Sender: TObject; - FileName: tbtstring): Boolean; + OrgFileName, FileName: tbtstring): Boolean; begin If Assigned (OnIncludingFile) then - Result := OnIncludingFile(Sender, FileName) + Result := OnIncludingFile(Sender, OrgFileName, FileName) else Result := False; end; diff --git a/Units/PascalScript/uPSPreProcessor.pas b/Units/PascalScript/uPSPreProcessor.pas index 0867db1..0dc4438 100644 --- a/Units/PascalScript/uPSPreProcessor.pas +++ b/Units/PascalScript/uPSPreProcessor.pas @@ -16,8 +16,8 @@ type TPSOnNeedFile = function (Sender: TPSPreProcessor; const callingfilename: tbtstring; var FileName, Output: tbtstring): Boolean; { Added by Wizzup } - TPSOnFileAlreadyIncluded = function (Sender: TPSPreProcessor; FileName: tbtstring): Boolean; - TPSOnIncludingFile = function (Sender: TPSPreProcessor; FileName: tbtstring): Boolean; + TPSOnFileAlreadyIncluded = function (Sender: TPSPreProcessor; OrgFileName, FileName: tbtstring): Boolean; + TPSOnIncludingFile = function (Sender: TPSPreProcessor; OrgFileName, FileName: tbtstring): Boolean; { Wizzup out } TPSOnProcessDirective = procedure ( @@ -637,7 +637,7 @@ begin if FDefineState.DoWrite then begin if assigned(@OnIncludingFile) then - OnIncludingFile(self, s); + OnIncludingFile(self , Filename, s); FAddedPosition := 0; IntPreProcess(Level +1, FileName, s, Dest); FCurrentLineInfo.Current := current; @@ -651,7 +651,7 @@ begin raise EPSPreProcessor.CreateFmt(RPS_IncludeOnceNotFound, [FileName, OrgFileName]) else begin - if not OnFileAlreadyIncluded(Self, s) then + if not OnFileAlreadyIncluded(Self, FileName, s) then begin FAddedPosition := 0; IntPreProcess(Level +1, FileName, s, Dest);