Skip to content

Commit d2d7643

Browse files
committed
Merge branch 'release/1.3.0'
2 parents 194a1bb + c26f0e2 commit d2d7643

File tree

5 files changed

+249
-29
lines changed

5 files changed

+249
-29
lines changed

CHANGELOG.md

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,17 @@
11
# Changelog
22

3+
## [1.3.0](https://github.com/appercept/Delphi-WebMocks/tree/1.3.0) (2020-10-07)
4+
5+
[Full Changelog](https://github.com/appercept/Delphi-WebMocks/compare/1.2.2...1.3.0)
6+
7+
**Implemented enhancements:**
8+
9+
- Add auto-port allocation [\#31](https://github.com/appercept/Delphi-WebMocks/pull/31) ([rhatherall](https://github.com/rhatherall))
10+
11+
**Closed issues:**
12+
13+
- In large projects you can frequently hit port clashes [\#30](https://github.com/appercept/Delphi-WebMocks/issues/30)
14+
315
## [1.2.2](https://github.com/appercept/Delphi-WebMocks/tree/1.2.2) (2020-07-25)
416

517
[Full Changelog](https://github.com/appercept/Delphi-WebMocks/compare/1.2.1...1.2.2)

README.md

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -27,7 +27,7 @@ WebMocks should now be listed in
2727

2828
## Installation: Manual
2929
1. Download and extract the latest version
30-
[1.2.2](https://github.com/appercept/Delphi-WebMocks/archive/1.2.2.zip).
30+
[1.3.0](https://github.com/appercept/Delphi-WebMocks/archive/1.3.0.zip).
3131
2. Open the package appropriate for your Delphi version in the `Packages`
3232
folder.
3333
3. Build and install the package.
@@ -97,15 +97,15 @@ initialization
9797
end.
9898
```
9999

100-
By default `TWebMock` will bind to port `8080`. The port can be specified at
101-
creation.
100+
By default `TWebMock` will bind to a port dynamically assigned start at `8080`.
101+
This behaviour can be overriden by sepcifying a port at creation.
102102
```Delphi
103103
WebMock := TWebMock.Create(8088);
104104
```
105105

106106
The use of `WebMock.URLFor` function within your tests is to simplify
107-
constructing a valid URL. The `BaseURL` property contains a valid URL for the
108-
server root.
107+
constructing a valid URL. The `Port` property containes the current bound port
108+
and `BaseURL` property contains a valid URL for the server root.
109109

110110
## Examples
111111
### Stubbing

Source/Delphi.WebMock.pas

Lines changed: 69 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -33,18 +33,24 @@ interface
3333
Delphi.WebMock.Dynamic.RequestStub, Delphi.WebMock.Response,
3434
Delphi.WebMock.ResponseBodySource, Delphi.WebMock.ResponseStatus,
3535
IdContext, IdCustomHTTPServer, IdGlobal, IdHTTPServer,
36-
System.Classes, System.Generics.Collections, System.RegularExpressions;
36+
System.Classes, System.Generics.Collections, System.RegularExpressions,
37+
System.SysUtils;
3738

3839
type
40+
EWebMockError = class(Exception);
41+
EWebMockExceededBindAttempts = class(EWebMockError);
42+
3943
TWebWockPort = TIdPort;
4044

4145
TWebMock = class(TObject)
46+
class var NextPort: Integer;
4247
private
4348
FServer: TIdHTTPServer;
4449
FBaseURL: string;
4550
FStubRegistry: TList<IWebMockRequestStub>;
4651
FHistory: TList<IWebMockHTTPRequest>;
4752
procedure InitializeServer(const APort: TWebWockPort);
53+
procedure StartServer(const APort: TWebWockPort);
4854
procedure OnServerRequest(AContext: TIdContext;
4955
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
5056
function GetRequestStub(ARequestInfo: IWebMockHTTPRequest) : IWebMockRequestStub;
@@ -56,9 +62,11 @@ TWebMock = class(TObject)
5662
const AResponseHeaders: TStrings);
5763
procedure SetResponseStatus(AResponseInfo: TIdHTTPResponseInfo;
5864
const AResponseStatus: TWebMockResponseStatus);
65+
function GetNextPort: Integer;
66+
function GetPort: Integer;
5967
property Server: TIdHTTPServer read FServer write FServer;
6068
public
61-
constructor Create(const APort: TWebWockPort = 8080);
69+
constructor Create(const APort: TWebWockPort = 0);
6270
destructor Destroy; override;
6371
function Assert: TWebMockAssertion;
6472
procedure PrintStubRegistry;
@@ -75,16 +83,18 @@ TWebMock = class(TObject)
7583
property BaseURL: string read FBaseURL;
7684
property History: TList<IWebMockHTTPRequest> read FHistory;
7785
property StubRegistry: TList<IWebMockRequestStub> read FStubRegistry;
86+
property Port: Integer read GetPort;
7887
end;
7988

8089
implementation
8190

8291
uses
8392
Delphi.WebMock.HTTP.Request,
8493
Delphi.WebMock.HTTP.RequestMatcher,
94+
IdException,
8595
IdHTTP,
8696
IdSocketHandle,
87-
System.SysUtils;
97+
IdStack;
8898

8999
{ TWebMock }
90100

@@ -93,7 +103,7 @@ function TWebMock.Assert: TWebMockAssertion;
93103
Result := TWebMockAssertion.Create(History);
94104
end;
95105

96-
constructor TWebMock.Create(const APort: TWebWockPort = 8080);
106+
constructor TWebMock.Create(const APort: TWebWockPort = 0);
97107
begin
98108
inherited Create;
99109
FStubRegistry := TList<IWebMockRequestStub>.Create;
@@ -109,6 +119,22 @@ destructor TWebMock.Destroy;
109119
inherited;
110120
end;
111121

122+
function TWebMock.GetNextPort: Integer;
123+
var
124+
FIsInitial: Boolean;
125+
begin
126+
AtomicCmpExchange(NextPort, 8080, 0, FIsInitial);
127+
if FIsInitial then
128+
Exit(NextPort);
129+
130+
Result := AtomicIncrement(NextPort);
131+
end;
132+
133+
function TWebMock.GetPort: Integer;
134+
begin
135+
Result := Server.Bindings.Items[0].Port;
136+
end;
137+
112138
function TWebMock.GetRequestStub(ARequestInfo: IWebMockHTTPRequest) : IWebMockRequestStub;
113139
var
114140
LRequestStub: IWebMockRequestStub;
@@ -131,11 +157,9 @@ procedure TWebMock.InitializeServer(const APort: TWebWockPort);
131157

132158
FServer := TIdHTTPServer.Create;
133159
Server.ServerSoftware := 'Delphi WebMocks';
134-
Server.DefaultPort := APort;
135160
Server.OnCommandGet := OnServerRequest;
136161
Server.OnCommandOther := OnServerRequest;
137-
Server.Active := True;
138-
FBaseURL := Format('http://127.0.0.1:%d/', [Server.DefaultPort]);
162+
StartServer(APort);
139163
end;
140164

141165
procedure TWebMock.OnServerRequest(AContext: TIdContext;
@@ -209,6 +233,44 @@ procedure TWebMock.SetResponseStatus(AResponseInfo: TIdHTTPResponseInfo;
209233
AResponseInfo.ResponseText := AResponseStatus.Text;
210234
end;
211235

236+
procedure TWebMock.StartServer(const APort: TWebWockPort);
237+
var
238+
LAttempt, LMaxAttempts: Integer;
239+
LPort: Integer;
240+
LSocketHandle: TIdSocketHandle;
241+
begin
242+
LAttempt := 0;
243+
LMaxAttempts := 3;
244+
while not Server.Active do
245+
begin
246+
Inc(LAttempt);
247+
if LAttempt >= LMaxAttempts then
248+
raise EWebMockExceededBindAttempts.Create('Exceeded attempts to bind port.');
249+
if APort > 0 then
250+
LPort := APort
251+
else
252+
LPort := GetNextPort;
253+
Server.Bindings.Clear;
254+
LSocketHandle := Server.Bindings.Add;
255+
LSocketHandle.Port := LPort;
256+
try
257+
Server.Active := True;
258+
FBaseURL := Format('http://127.0.0.1:%d/', [LSocketHandle.Port]);
259+
except
260+
on E: EIdCouldNotBindSocket do
261+
begin
262+
Server.Active := False;
263+
StartServer(APort);
264+
end;
265+
on E: EIdSocketError do
266+
begin
267+
Server.Active := False;
268+
StartServer(APort);
269+
end;
270+
end;
271+
end;
272+
end;
273+
212274
function TWebMock.StubRequest(
213275
const AMatcher: TWebMockDynamicRequestMatcher): TWebMockDynamicRequestStub;
214276
var

Tests/Delphi.WebMock.Tests.pas

Lines changed: 25 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -45,13 +45,15 @@ TWebMockTests = class(TObject)
4545
[TearDown]
4646
procedure TearDown;
4747
[Test]
48-
procedure Create_WithNoArguments_StartsListeningOnPort8080;
48+
procedure Create_WithNoArguments_StartsListeningOnPortGreaterThan8080;
49+
[Test]
50+
procedure Create_WithNoArgumentsWhenRepeated_StartsListeningOnDifferentPorts;
4951
[Test]
5052
procedure Create_WithPort_StartsListeningOnPortPort;
5153
[Test]
52-
procedure BaseURL_ByDefault_ReturnsLocalHostURLWithDefaultPort;
54+
procedure BaseURL_ByDefault_ReturnsLocalHostURLWithPort;
5355
[Test]
54-
procedure BaseURL_WhenPortIsNotDefault_ReturnsLocalHostURLWithPort;
56+
procedure Port_Always_ReturnsTheListeningPort;
5557
[Test]
5658
procedure Reset_Always_ClearsHistory;
5759
[Test]
@@ -96,34 +98,36 @@ procedure TWebMockTests.URLFor_GivenEmptyString_ReturnsBaseURL;
9698

9799
procedure TWebMockTests.URLFor_GivenStringWithLeadingSlash_ReturnsCorrectlyJoinedURL;
98100
begin
99-
Assert.AreEqual('http://127.0.0.1:8080/file', WebMock.URLFor('/file'));
101+
Assert.AreEqual(Format('http://127.0.0.1:%d/file', [WebMock.Port]), WebMock.URLFor('/file'));
100102
end;
101103

102104
procedure TWebMockTests.URLFor_GivenStringWithoutLeadingSlash_ReturnsCorrectlyJoinedURL;
103105
begin
104-
Assert.AreEqual('http://127.0.0.1:8080/file', WebMock.URLFor('file'));
106+
Assert.AreEqual(Format('http://127.0.0.1:%d/file', [WebMock.Port]), WebMock.URLFor('file'));
105107
end;
106108

107-
procedure TWebMockTests.BaseURL_ByDefault_ReturnsLocalHostURLWithDefaultPort;
109+
procedure TWebMockTests.BaseURL_ByDefault_ReturnsLocalHostURLWithPort;
108110
begin
109-
Assert.AreEqual('http://127.0.0.1:8080/', WebMock.BaseURL);
111+
Assert.AreEqual(Format('http://127.0.0.1:%d/', [WebMock.Port]), WebMock.BaseURL);
110112
end;
111113

112-
procedure TWebMockTests.BaseURL_WhenPortIsNotDefault_ReturnsLocalHostURLWithPort;
114+
procedure TWebMockTests.Create_WithNoArgumentsWhenRepeated_StartsListeningOnDifferentPorts;
115+
var
116+
LWebMock1, LWebMock2: TWebMock;
113117
begin
114-
WebMock.Free;
115-
WebMock := TWebMock.Create(8088);
118+
LWebMock1 := TWebMock.Create;
119+
LWebMock2 := TWebMock.Create;
116120

117-
Assert.AreEqual('http://127.0.0.1:8088/', WebMock.BaseURL);
121+
Assert.IsTrue(LWebMock2.Port > LWebMock1.Port);
118122
end;
119123

120-
procedure TWebMockTests.Create_WithNoArguments_StartsListeningOnPort8080;
124+
procedure TWebMockTests.Create_WithNoArguments_StartsListeningOnPortGreaterThan8080;
121125
var
122126
LResponse: IHTTPResponse;
123127
begin
124-
LResponse := WebClient.Get('http://localhost:8080/');
128+
LResponse := WebClient.Get(WebMock.URLFor('/'));
125129

126-
Assert.AreEqual('Delphi WebMocks', LResponse.HeaderValue['Server']);
130+
Assert.IsTrue(WebMock.Port > 8080);
127131
end;
128132

129133
procedure TWebMockTests.Create_WithPort_StartsListeningOnPortPort;
@@ -132,12 +136,17 @@ procedure TWebMockTests.Create_WithPort_StartsListeningOnPortPort;
132136
begin
133137
WebMock.Free;
134138

135-
WebMock := TWebMock.Create(8088);
136-
LResponse := WebClient.Get('http://localhost:8088/');
139+
WebMock := TWebMock.Create(8079);
140+
LResponse := WebClient.Get('http://localhost:8079/');
137141

138142
Assert.AreEqual('Delphi WebMocks', LResponse.HeaderValue['Server']);
139143
end;
140144

145+
procedure TWebMockTests.Port_Always_ReturnsTheListeningPort;
146+
begin
147+
Assert.IsTrue(WebMock.Port > 0);
148+
end;
149+
141150
procedure TWebMockTests.ResetHistory_Always_ClearsHistory;
142151
begin
143152
WebClient.Get(WebMock.URLFor('history'));

0 commit comments

Comments
 (0)