paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-12 22:19:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Allow to compile with prehistoric FPC 3.2.0

Browse Source
This commit is contained in:
Michaël Van Canneyt 2023-12-26 19:35:36 +01:00
parent 29634d9193
commit 1ef62a70d7
1 changed files with 19 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
components/fpcunit/ide/testinsightserver.pas
View File

@ -7,6 +7,11 @@ interface
uses uses
Classes, SysUtils, types, httpdefs, syncobjs, fphttpserver, fpJSON, testinsightprotocol; Classes, SysUtils, types, httpdefs, syncobjs, fphttpserver, fpJSON, testinsightprotocol;
{$IF DECLARED(TCORSSUPPORT)}
{$DEFINE USECORS}
{$ENDIF}
Type Type
TTestItem = Class; TTestItem = Class;
@ -80,14 +85,18 @@ Type
FThread: TThread; FThread: TThread;
FServerPort : Word; FServerPort : Word;
FServerActive : Boolean; FServerActive : Boolean;
{$IFDEF USECORS}
FCorsSupport : TCORSSupport; FCorsSupport : TCORSSupport;
{$ENDIF}
procedure CreateServer; procedure CreateServer;
function ExtractResults(anArray: TJSONArray): TTestInsightResultArray; function ExtractResults(anArray: TJSONArray): TTestInsightResultArray;
procedure FreeResults(Results: TTestInsightResultArray); procedure FreeResults(Results: TTestInsightResultArray);
function GetPort: Word; function GetPort: Word;
procedure HandleStartThreadTerminate(Sender: TObject); procedure HandleStartThreadTerminate(Sender: TObject);
procedure SetBasePath(AValue: String); procedure SetBasePath(AValue: String);
{$IFDEF USECORS}
procedure SetCorsSupport(AValue: TCORSSupport); procedure SetCorsSupport(AValue: TCORSSupport);
{$ENDIF}
procedure SetPort(AValue: Word); procedure SetPort(AValue: Word);
Protected Protected
Procedure DoLog(const aType : TInsightMessageType; const aMessage : String); Procedure DoLog(const aType : TInsightMessageType; const aMessage : String);
@ -130,7 +139,9 @@ Type
// First part of URL. By default: /tests // First part of URL. By default: /tests
Property BasePath : String Read FBasePath Write SetBasePath; Property BasePath : String Read FBasePath Write SetBasePath;
// CORS Support ? // CORS Support ?
{$IFDEF USECORS}
Property CorsSupport : TCORSSupport Read FCorsSupport Write SetCorsSupport; Property CorsSupport : TCORSSupport Read FCorsSupport Write SetCorsSupport;
{$ENDIF}
// Set the list of tests. Event handler must free JSON object. // Set the list of tests. Event handler must free JSON object.
Property OnSetTestNames : TTestNamesEvent Read FOnSetTestNames Write FOnSetTestNames; Property OnSetTestNames : TTestNamesEvent Read FOnSetTestNames Write FOnSetTestNames;
// Get the list of selected tests. The server will free the received object. // Get the list of selected tests. The server will free the received object.
@ -556,8 +567,10 @@ begin
Send404(aResponse) Send404(aResponse)
else else
begin begin
{$IFDEF USECORS}
if FCorsSupport.HandleRequest(aRequest,aResponse,[hcDetect, hcsend]) then if FCorsSupport.HandleRequest(aRequest,aResponse,[hcDetect, hcsend]) then
exit; exit;
{$ENDIF}
Delete(aPath,1,Length(BasePath)); Delete(aPath,1,Length(BasePath));
if (aPath='') then // '/tests' if (aPath='') then // '/tests'
begin begin
@ -646,11 +659,13 @@ begin
FBasePath:=AValue; FBasePath:=AValue;
end; end;
{$IFDEF USECORS}
procedure TTestInsightServer.SetCorsSupport(AValue: TCORSSupport); procedure TTestInsightServer.SetCorsSupport(AValue: TCORSSupport);
begin begin
if FCorsSupport=AValue then Exit; if FCorsSupport=AValue then Exit;
FCorsSupport.Assign(AValue); FCorsSupport.Assign(AValue);
end; end;
{$ENDIF}
procedure TTestInsightServer.SetPort(AValue: Word); procedure TTestInsightServer.SetPort(AValue: Word);
begin begin
@ -715,8 +730,10 @@ begin
BasePath:=pathTests; BasePath:=pathTests;
FTestInsightResultClass:=TTestInsightResult; FTestInsightResultClass:=TTestInsightResult;
FInsightOptions:=CreateTestInsightOptions; FInsightOptions:=CreateTestInsightOptions;
{$IFDEF USECORS}
FCorsSupport:=TCORSSupport.Create; FCorsSupport:=TCORSSupport.Create;
FCorsSupport.Enabled:=True; FCorsSupport.Enabled:=True;
{$ENDIF}
end; end;
@ -725,7 +742,9 @@ begin
StopServer; StopServer;
FreeAndNil(FServer); FreeAndNil(FServer);
FreeAndNil(FInsightOptions); FreeAndNil(FInsightOptions);
{$IFDEF USECORS}
FreeAndNil(FCorsSupport); FreeAndNil(FCorsSupport);
{$ENDIF}
inherited destroy; inherited destroy;
end; end;