FServer.Active := False - not working

[dogriz]

Here's a very basic WebServerThread example (in GUI app):

Code: Pascal  [Select][+][-]

1. unit unitMain;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, fphttpserver;
9.  
10. type
11.   { TWebServerThread }
12.   TWebServerThread = class(TThread)
13.   private
14.     FServer: TFPHTTPServer;
15.     msg: String;
16.     procedure LogMessage;
17.   public
18.     constructor Create(APort: String);
19.     destructor Destroy; override;
20.     procedure Execute; override;
21.     procedure DoTerminate; override;
22.     procedure DoHandleRequest(Sender: TObject; var ARequest: TFPHTTPConnectionRequest; var AResponse: TFPHTTPConnectionResponse);
23.     property Server: TFPHTTPServer Read FServer;
24.   end;
25.  
26. type
27.  
28.   { TForm1 }
29.  
30.   TForm1 = class(TForm)
31.     CheckBox1: TCheckBox;
32.     MemoLog: TMemo;
33.     procedure CheckBox1Click(Sender: TObject);
34.   private
35.     FServerThread: TWebServerThread;
36.   public
37.  
38.   end;
39.  
40. var
41.   Form1: TForm1;
42.  
43. implementation
44.  
45. {$R *.lfm}
46.  
47. { TForm1 }
48.  
49. procedure TForm1.CheckBox1Click(Sender: TObject);
50. begin
51.   if not(Assigned(FServerThread)) then
52.     FServerThread := TWebServerThread.Create('8080')
53.   else
54.     FServerThread.Terminate;
55. end;
56.  
57. { TWebServerThread }
58.  
59. procedure TWebServerThread.LogMessage;
60. begin
61.   Form1.MemoLog.Append(msg);
62. end;
63.  
64. constructor TWebServerThread.Create(APort: String);
65. begin
66.   inherited Create(False);
67.   FServer := TFPHTTPServer.Create(nil);
68.   FServer.Port := StrToInt(APort);
69.   FServer.OnRequest := @DoHandleRequest;
70.   Self.FreeOnTerminate := True;
71. end;
72.  
73. destructor TWebServerThread.Destroy;
74. begin
75.   FServer.Free;
76.   inherited Destroy;
77. end;
78.  
79. procedure TWebServerThread.Execute;
80. begin
81.   FServer.Active := True;
82. end;
83.  
84. procedure TWebServerThread.DoTerminate;
85. begin
86.   FServer.Active := False; // <== this is not working...
87.   inherited DoTerminate;
88. end;
89.  
90. procedure TWebServerThread.DoHandleRequest(Sender: TObject; var ARequest: TFPHTTPConnectionRequest; var AResponse: TFPHTTPConnectionResponse);
91. var
92.   s: String;
93. begin
94.   s := ARequest.Content;
95.   AResponse.Content := 'OK';
96.   AResponse.Code := 200;
97.   AResponse.ContentType := 'text/plain';
98.   AResponse.ContentLength := Length(AResponse.Content);
99.   AResponse.SendContent;
100.   msg := s;
101.   Synchronize(@LogMessage);
102. end;
103.  
104. end.
105.  

For some reason, FServer.Active := False (procedure TWebServerThread.DoTerminate) does not work and FServer can't be deactivated. Has anyone idea, why?
Btw, tested on Linux (compiled with -dUseCThreads).

[Leledumbo]

Your thread is already terminated as soon as Execute reaches the end of the method. Add a blocking code such as:

Code: Pascal  [Select][+][-]

1. while not Terminated do Sleep(1);
2.  

before the method's end.

[dogriz]

Hm, but the thing is that Execute method never ends...

Code: Pascal  [Select][+][-]

1. procedure TWebServerThread.Execute;
2. begin
3.   FServer.Active := True;
4.   WriteLn('This line never executes');
5. end;
6.  

And, also, looking at the number of app threads in Linux OS, webServer thread is definately not terminated.