From aac852c18ccdeb9cdd064ccc6bde2d108c92a836 Mon Sep 17 00:00:00 2001 From: Merlijn Wajer Date: Sat, 19 Feb 2011 15:19:08 +0100 Subject: [PATCH] Simba/PS: Add/Fix include_once support. --- Units/MMLAddon/mmlpsthread.pas | 23 ++++++++++++++-- Units/PascalScript/uPSComponent.pas | 36 ++++++++++++++++++++++++++ Units/PascalScript/uPSPreProcessor.pas | 34 +++++++++++++++++++++++- 3 files changed, 90 insertions(+), 3 deletions(-) diff --git a/Units/MMLAddon/mmlpsthread.pas b/Units/MMLAddon/mmlpsthread.pas index bc56167..3dc94f0 100644 --- a/Units/MMLAddon/mmlpsthread.pas +++ b/Units/MMLAddon/mmlpsthread.pas @@ -180,6 +180,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; + procedure OnCompImport(Sender: TObject; x: TPSPascalCompiler); procedure OnExecImport(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter); procedure OutputMessages; @@ -464,9 +466,9 @@ begin if (path <> '') then if Includes.Find(path,i) then begin - psWriteln('Include_Once file already included'); + Writeln('include_once: File already included.'); // debug message Result := False; - end; + end end; end else Result := True; @@ -576,6 +578,7 @@ begin PSScript.UsePreProcessor:= True; PSScript.CompilerOptions := PSScript.CompilerOptions + [icBooleanShortCircuit]; PSScript.OnNeedFile := @RequireFile; + PSScript.OnFileAlreadyIncluded := @FileAlreadyIncluded; PSScript.OnProcessDirective:=@OnProcessDirective; PSScript.OnProcessUnknowDirective:=@PSScriptProcessUnknowDirective; PSScript.OnCompile:= @OnCompile; @@ -692,6 +695,22 @@ begin '{$IFDEF __REMOVE_IS_INCLUDE}{$UNDEF IS_INCLUDE}{$ENDIF}'; end; +function TPSThread.FileAlreadyIncluded(Sender: TObject; FileName: string): Boolean; +var + path: string; + i: integer; +begin + path := FindFile(Filename,[ScriptPath,IncludePath]); + if (path <> '') then + if Includes.Find(path,i) then + begin + psWriteln('Include_Once file already included'); + Result := False; + end; + Includes.Add(path); + Result := True; +end; + procedure SIRegister_Mufasa(cl: TPSPascalCompiler); begin SIRegister_MML(cl); diff --git a/Units/PascalScript/uPSComponent.pas b/Units/PascalScript/uPSComponent.pas index 5971e9e..57c69ce 100644 --- a/Units/PascalScript/uPSComponent.pas +++ b/Units/PascalScript/uPSComponent.pas @@ -93,6 +93,10 @@ type {Script engine event function} 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; + { Wizzup out } + TPSOnProcessDirective = procedure ( Sender: TPSPreProcessor; Parser: TPSPascalPreProcessorParser; @@ -120,6 +124,9 @@ type FPP: TPSPreProcessor; FMainFileName: tbtstring; FOnNeedFile: TPSOnNeedFile; + { Added by Wizzup } + FOnFileAlreadyIncluded: TPSOnFileAlreadyIncluded; + { Wizzup out } FUsePreProcessor: Boolean; FDefines: TStrings; FOnVerifyProc: TPSVerifyProc; @@ -152,6 +159,9 @@ 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; + { Wizzup out } function DoOnUnknowUses (Sender: TPSPascalCompiler; const Name: tbtstring): Boolean; virtual; // return true if processed procedure DoOnCompImport; virtual; procedure DoOnCompile; virtual; @@ -285,6 +295,10 @@ type property OnNeedFile: TPSOnNeedFile read FOnNeedFile write FOnNeedFile; + { Added by Wizzup } + property OnFileAlreadyIncluded: TPSOnFileAlreadyIncluded read FOnFileAlreadyIncluded write FOnFileAlreadyIncluded; + { Wizzup out } + property Defines: TStrings read FDefines write SetDefines; property OnVerifyProc: TPSVerifyProc read FOnVerifyProc write FOnVerifyProc; @@ -535,6 +549,13 @@ begin Result := TPSScript (Sender.ID).DoOnNeedFile(Sender.ID, CallingFileName, FileName, Output); end; +{ Added by Wizzup } +function CEOnFileAlreadyIncluded(Sender: TPSPreProcessor; FileName: tbtstring): Boolean; +begin + Result := TPSScript (Sender.ID).DoOnFileAlreadyIncluded(Sender.ID, Filename); +end; +{ Wizzup out } + procedure CompTranslateLineInfo(Sender: TPSPascalCompiler; var Pos, Row, Col: Cardinal; var Name: tbtstring); var res: TPSLineInfoResults; @@ -649,6 +670,10 @@ begin FPP.Id := Self; FPP.OnNeedFile := CENeedFile; + { Added by Wizzup } + FPP.OnFileAlreadyIncluded:= CEOnFileAlreadyIncluded; + { Wizzup out } + FDefines := TStringList.Create; end; @@ -1049,6 +1074,17 @@ begin Result := False; end; +{ Added by Wizzup } +function TPSScript.DoOnFileAlreadyIncluded(Sender: TObject; + FileName: tbtstring): Boolean; +begin + If Assigned (OnFileAlreadyIncluded) then + Result := OnFileAlreadyIncluded(Sender, FileName) + else + Result := False; +end; +{ Wizzup out } + function TPSScript.DoOnUnknowUses(Sender: TPSPascalCompiler; const Name: tbtstring): Boolean; var diff --git a/Units/PascalScript/uPSPreProcessor.pas b/Units/PascalScript/uPSPreProcessor.pas index 15e5007..e8490bb 100644 --- a/Units/PascalScript/uPSPreProcessor.pas +++ b/Units/PascalScript/uPSPreProcessor.pas @@ -14,6 +14,11 @@ type TPSPascalPreProcessorParser = class; TPSOnNeedFile = function (Sender: TPSPreProcessor; const callingfilename: tbtstring; var FileName, Output: tbtstring): Boolean; + + { Added by Wizzup } + TPSOnFileAlreadyIncluded = function (Sender: TPSPreProcessor; FileName: tbtstring): Boolean; + { Wizzup out } + TPSOnProcessDirective = procedure ( Sender: TPSPreProcessor; Parser: TPSPascalPreProcessorParser; @@ -91,6 +96,9 @@ type FCurrentDefines, FDefines: TStringList; FCurrentLineInfo: TPSLineInfoList; FOnNeedFile: TPSOnNeedFile; + { Added by Wizzup } + FOnFileAlreadyIncluded: TPSOnFileAlreadyIncluded; + { Wizzup out } FAddedPosition: Cardinal; FDefineState: TPSDefineStates; FMaxLevel: Longint; @@ -109,6 +117,10 @@ type property OnNeedFile: TPSOnNeedFile read FOnNeedFile write FOnNeedFile; + { Added by Wizzup } + property OnFileAlreadyIncluded: TPSOnFileAlreadyIncluded read FOnFileAlreadyIncluded write FOnFileAlreadyIncluded; + { Wizzup out } + property Defines: TStringList read FDefines write FDefines; property MainFile: tbtstring read FMainFile write FMainFile; @@ -213,6 +225,9 @@ const RPS_TooManyNestedInclude = 'Too many nested include files while processing ''%s'' from ''%s'''; RPS_IncludeNotFound = 'Unable to find file ''%s'' used from ''%s'''; + { Added by Wizzup } + RPS_IncludeOnceNotFound = 'Unable to check if file ''%s'' is already included, used from ''%s'''; + { Wizzup out } RPS_DefineTooManyParameters = 'Too many parameters at %d:%d'; RPS_NoIfdefForEndif = 'No IFDEF for ENDIF at %d:%d'; RPS_NoIfdefForElse = 'No IFDEF for ELSE at %d:%d'; @@ -614,7 +629,7 @@ begin If AppContinue then //-- end jgv - if (Name = 'I') or (Name = 'INCLUDE') or (Name = 'INCLUDE_ONCE') then + if (Name = 'I') or (Name = 'INCLUDE') then begin if FDefineState.DoWrite then begin @@ -623,6 +638,23 @@ begin FCurrentLineInfo.Current := current; FAddedPosition := Cardinal(Dest.Position) - Item.StartPos - Parser.Pos; end; + { Added by Wizzup } + end else if (Name = 'INCLUDE_ONCE') then + begin + if FDefineState.DoWrite then + if (@OnFileAlreadyIncluded = nil) then + raise EPSPreProcessor.CreateFmt(RPS_IncludeOnceNotFound, [FileName, OrgFileName]) + else + begin + if not OnFileAlreadyIncluded(Self, FileName) then + begin + FAddedPosition := 0; + IntPreProcess(Level +1, FileName, s, Dest); + FCurrentLineInfo.Current := current; + FAddedPosition := Cardinal(Dest.Position) - Item.StartPos - Parser.Pos; + end; + end; + { Wizzup out } end else if (Name = 'DEFINE') then begin if FDefineState.DoWrite then