Why Gemfury? Push, build, and install  RubyGems npm packages Python packages Maven artifacts PHP packages Go Modules Debian packages RPM packages NuGet packages

Repository URL to install this package:

Details    
fpc-src / usr / share / fpcsrc / 3.2.0 / packages / fcl-web / tests / tchttproute.pp
Size: Mime:
unit tchttproute;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, fpcunit, testutils, tcwebmodule, testregistry, httpdefs, httproute, fphttp, fpweb, custweb;

Type

  { TMyModule }

  TMyModule = Class(TCustomHTTPModule)
  Private
    class Var
      FCallCount : Integer;
      FCallRequest : TRequest;
      FCallResponse : TResponse;
  Public
    Procedure HandleRequest(ARequest: TRequest; AResponse: TResponse); override;
  end;

  { TTestHTTPRoute }
  TMyHTTPRouter = Class(THTTPRouter);

  { TMyInterfacedHandler }

  TMyInterfacedHandler = class(TObject,IRouteInterface)
  private
    FCallCount: Integer;
  public
    procedure HandleRequest(ARequest: TRequest; AResponse: TResponse);
    Property CallCount : Integer Read FCallCount;
  end;

  { TMyObjectHandler }

  TMyObjectHandler = Class(TRouteObject)
    class Var
      FCallCount : Integer;
      FCallRequest : TRequest;
      FCallResponse : TResponse;
  Public
    Procedure HandleRequest(ARequest: TRequest; AResponse: TResponse); override;
  end;

  TTestHTTPRoute = class(TTestCase)
  private
    FInterfacedHandler: TMyInterfacedHandler;
    FEventCalled : Integer;
    FRequest: TFakeRequest;
    FResponse: TFakeResponse;
    FRouteParams: TStrings;
    FGetRouteMethod: TRouteMethod;
    FGetRoutePath: string;
    FBeforeCalledCount:integer;
    FAfterCalledCount:integer;
    FDoException : Boolean;
    FModuleItem: TModuleItem;
    FModuleCallCount : Integer;
    FWebhandler : TWebhandler;
    procedure DoGetRoute;
    procedure DoRouteRequest;
    function GetWebHandler: TWebhandler;
  protected
    Procedure MyRouteEvent(ARequest : TRequest; AResponse : TResponse);
    Procedure MyRouteEvent2(ARequest : TRequest; AResponse : TResponse);
    Procedure MyRouteEvent3(ARequest : TRequest; AResponse : TResponse);
    procedure SetUp; override;
    procedure TearDown; override;
    Property InterfacedHandler : TMyInterfacedHandler Read FInterfacedHandler;
    Property RouteParams : TStrings Read FRouteParams;
    Property FakeRequest : TFakeRequest Read FRequest;
    Property FakeResponse : TFakeResponse Read FResponse;
    Property WebHandler : TWebhandler Read GetWebHandler;
  public
    procedure DoAfterRequest(Sender: TObject; ARequest: TRequest; AResponse: TResponse);
    procedure DoBeforeRequest(Sender: TObject; ARequest: TRequest; AResponse: TResponse);
    procedure DoModuleRoute(Sender: TModuleItem; ARequest: TRequest; AResponse: TResponse);
  published
    procedure TestHookUp;
    Procedure TestAddEvent;
    Procedure TestAddEventMethod;
    Procedure TestAddEventDefault;
    Procedure TestAddInterface;
    Procedure TestAddInterfaceMethod;
    Procedure TestAddInterfaceDefault;
    Procedure TestAddCallBackex;
    Procedure TestAddCallBackMethodEx;
    Procedure TestAddCallBackDefaultEx;
    Procedure TestAddCallBack;
    Procedure TestAddCallBackMethod;
    Procedure TestAddCallBackDefault;
    Procedure TestAddRouteObject;
    Procedure TestAddRouteObjectMethod;
    Procedure TestAddRouteObjectDefault;
    Procedure TestFindRouteStatic;
    Procedure TestFindRouteStaticNoMatch;
    Procedure TestGetRouteStatic;
    Procedure TestGetRouteStaticNoMatch;
    Procedure TestGetRouteStaticNoMethodMatch;
    Procedure TestFindRouteStatic2Paths;
    Procedure TestFindRouteStatic2PathsNoMatch;
    Procedure TestFindRouteStaticMethodMismatch;
    Procedure TestFindRouteWildCard;
    Procedure TestFindRouteNamedWildCard;
    Procedure TestFindRouteNamedWildCard2;
    Procedure TestFindRouteWildCard3;
    Procedure TestFindRouteWildCard3Named;
    Procedure TestFindRouteParam;
    Procedure TestFindRouteParam2;
    Procedure TestFindRouteWildcardParam;
    Procedure TestFindRouteWildcardParamNoMatch;
    Procedure TestSetServiceClass;
    Procedure TestRouteRequestEvent;
    Procedure TestRouteRequestCallback;
    Procedure TestRouteRequestInterface;
    Procedure TestRouteRequestObject;
    Procedure TestRouteRequestException;
    Procedure TestRouteModule;
    procedure TestRouteModuleAfterRoute;
    procedure TestRouteModuleAfterRoute2;
    Procedure TestWebModuleHandlerLegacy;
    Procedure TestWebModuleHandlerNew;
  end;

implementation


Var
  CallBackCalled : Integer;
  CallBackData : Pointer;

Procedure MyRouteCallBackEx(Data : Pointer;ARequest : TRequest; AResponse : TResponse);

begin
  CallBackCalled:=1;
  CallBackData:=Data;
end;

Procedure MyRouteCallBack2Ex(Data : Pointer;ARequest : TRequest; AResponse : TResponse);

begin
  CallBackCalled:=2;
  CallBackData:=Data;
end;

Procedure MyRouteCallBack3Ex(Data : Pointer;ARequest : TRequest; AResponse : TResponse);

begin
  CallBackCalled:=3;
  CallBackData:=Data;
end;

Procedure MyRouteCallBack(ARequest : TRequest; AResponse : TResponse);

begin
  CallBackCalled:=1;
  CallBackData:=Nil;
end;

Procedure MyRouteCallBack2(ARequest : TRequest; AResponse : TResponse);

begin
  CallBackCalled:=2;
  CallBackData:=Nil;
end;

Procedure MyRouteCallBack3(ARequest : TRequest; AResponse : TResponse);

begin
  CallBackCalled:=3;
  CallBackData:=Nil;
end;

{ TMyObjectHandler }

procedure TMyObjectHandler.HandleRequest(ARequest: TRequest; AResponse: TResponse);
begin
  Inc(FCallCount);
  FCallRequest:=ARequest;
  FCallResponse:=AResponse;
end;

{ TMyModule }

procedure TMyModule.HandleRequest(ARequest: TRequest; AResponse: TResponse);
begin
  Inc(FCallCount);
  FCallRequest:=ARequest;
  FCallResponse:=AResponse;
end;


{ TMyInterfacedHandler }

procedure TMyInterfacedHandler.HandleRequest(ARequest: TRequest;
  AResponse: TResponse);
begin
  Inc(FCallCount);
end;

procedure TTestHTTPRoute.TestHookUp;
begin
  AssertEquals('No routes registered.',0,HTTPRouter.RouteCount);
  AssertEquals('Routeclass.',THTTPRouter,THTTPRouter.ServiceClass);
  AssertNotNull('Have interfaced handler',InterfacedHandler);
  AssertEquals('interfaced handler not called',0,InterfacedHandler.CallCount);
  AssertEquals('No callbacks',0,CallBackCalled);
  AssertEquals('No events',0,FEventCalled);
  AssertEquals('No module calls',0,TMyModule.FCallCount);
  AssertNull('No module request',TMyModule.FCallRequest);
  AssertNull('No module response',TMyModule.FCallResponse);
end;

procedure TTestHTTPRoute.TestAddEvent;

Var
  E : THTTPRouteEvent;

begin
  HTTPRouter.RegisterRoute('*path',@MyRouteEvent);
  AssertEquals('1 route registered.',1,HTTPRouter.RouteCount);
  AssertEquals('Route class correct',THTTPRouteEvent,HTTPRouter[0].ClassType);
  E:=THTTPRouteEvent(HTTPRouter[0]);
  AssertTrue('Route event correct',E.Event=@MyRouteEvent);
  AssertEquals('Route class not default',False,E.Default);
  AssertEquals('Route URL pattern','*path/',E.URLPattern);
  AssertTrue('Correct method',rmAll=E.Method);
end;

procedure TTestHTTPRoute.TestAddEventMethod;

Var
  E : THTTPRouteEvent;

begin
  HTTPRouter.RegisterRoute('*path',rmPOST, @MyRouteEvent);
  AssertEquals('1 route registered.',1,HTTPRouter.RouteCount);
  AssertEquals('Route class correct',THTTPRouteEvent,HTTPRouter[0].ClassType);
  E:=THTTPRouteEvent(HTTPRouter[0]);
  AssertTrue('Route event correct',E.Event=@MyRouteEvent);
  AssertEquals('Route class not default',False,E.Default);
  AssertEquals('Route URL pattern','*path/',E.URLPattern);
  AssertTrue('Correct method',rmPOST=E.Method);
end;

procedure TTestHTTPRoute.TestAddEventDefault;
Var
  E : THTTPRouteEvent;

begin
  HTTPRouter.RegisterRoute('*path',rmPOST, @MyRouteEvent,True);
  AssertEquals('1 route registered.',1,HTTPRouter.RouteCount);
  AssertEquals('Route class correct',THTTPRouteEvent,HTTPRouter[0].ClassType);
  E:=THTTPRouteEvent(HTTPRouter[0]);
  AssertTrue('Route event correct',E.Event=@MyRouteEvent);
  AssertEquals('Route class not default',True,E.Default);
  AssertEquals('Route URL pattern','*path/',E.URLPattern);
  AssertTrue('Correct method',rmPOST=E.Method);
end;

procedure TTestHTTPRoute.TestAddInterface;

Var
  E : THTTPRouteInterface;

begin
  HTTPRouter.RegisterRoute('*path',InterfacedHandler);
  AssertEquals('1 route registered.',1,HTTPRouter.RouteCount);
  AssertEquals('Route class correct',THTTPRouteInterface,HTTPRouter[0].ClassType);
  E:=THTTPRouteInterface(HTTPRouter[0]);
  AssertTrue('Route interface correct',Pointer(E.Intf)=Pointer(InterfacedHandler as IRouteInterface));
  AssertEquals('Route class not default',False,E.Default);
  AssertEquals('Route URLPattern','*path/',E.URLPattern);
  AssertTrue('Correct method',rmAll=E.Method);
end;

procedure TTestHTTPRoute.TestAddInterfaceMethod;

Var
  E : THTTPRouteInterface;

begin
  HTTPRouter.RegisterRoute('*path',rmPost,InterfacedHandler);
  AssertEquals('1 route registered.',1,HTTPRouter.RouteCount);
  AssertEquals('Route class correct',THTTPRouteInterface,HTTPRouter[0].ClassType);
  E:=THTTPRouteInterface(HTTPRouter[0]);
  AssertTrue('Route interface correct',Pointer(E.Intf)=Pointer(InterfacedHandler as IRouteInterface));
  AssertEquals('Route class not default',False,E.Default);
  AssertEquals('Route URLPattern','*path/',E.URLPattern);
  AssertTrue('Correct method',rmPost=E.Method);
end;

procedure TTestHTTPRoute.TestAddInterfaceDefault;
Var
  E : THTTPRouteInterface;

begin
  HTTPRouter.RegisterRoute('*path',rmPost,InterfacedHandler,True);
  AssertEquals('1 route registered.',1,HTTPRouter.RouteCount);
  AssertEquals('Route class correct',THTTPRouteInterface,HTTPRouter[0].ClassType);
  E:=THTTPRouteInterface(HTTPRouter[0]);
  AssertTrue('Route interface correct',Pointer(E.Intf)=Pointer(InterfacedHandler as IRouteInterface));
  AssertEquals('Route class not default',True,E.Default);
  AssertEquals('Route URLPattern','*path/',E.URLPattern);
  AssertTrue('Correct method',rmPost=E.Method);
end;

procedure TTestHTTPRoute.TestAddCallBackex;

Var
  E : THTTPRouteCallBackex;

begin
  HTTPRouter.RegisterRoute('*path',@E,@MyRouteCallBackex);
  AssertEquals('1 route registered.',1,HTTPRouter.RouteCount);
  AssertEquals('Route class correct',THTTPRouteCallBackex,HTTPRouter[0].ClassType);
  E:=THTTPRouteCallBackex(HTTPRouter[0]);
  AssertTrue('Route event correct',Pointer(E.CallBack)=Pointer(@MyRouteCallBackex));
  AssertTrue('Data pointer correct',E.Data=@E);
  AssertEquals('Route class not default',False,E.Default);
  AssertEquals('Route URL pattern','*path/',E.URLPattern);
  AssertTrue('Correct method',rmAll=E.Method);
end;

procedure TTestHTTPRoute.TestAddCallBackMethodEx;

Var
  E : THTTPRouteCallBackex;

begin
  HTTPRouter.RegisterRoute('*path',@E,rmPOST,@MyRouteCallBackex);
  AssertEquals('1 route registered.',1,HTTPRouter.RouteCount);
  AssertEquals('Route class correct',THTTPRouteCallBackex,HTTPRouter[0].ClassType);
  E:=THTTPRouteCallBackex(HTTPRouter[0]);
  AssertTrue('Route event correct',Pointer(E.CallBack)=Pointer(@MyRouteCallBackex));
  AssertTrue('Data pointer correct',E.Data=@E);
  AssertEquals('Route class not default',False,E.Default);
  AssertEquals('Route URL pattern','*path/',E.URLPattern);
  AssertTrue('Correct method',rmPost=E.Method);
end;

procedure TTestHTTPRoute.TestAddCallBackDefaultEx;
Var
  E : THTTPRouteCallBackex;

begin
  HTTPRouter.RegisterRoute('*path',@E,rmPOST,@MyRouteCallBackex,true);
  AssertEquals('1 route registered.',1,HTTPRouter.RouteCount);
  AssertEquals('Route class correct',THTTPRouteCallBackex,HTTPRouter[0].ClassType);
  E:=THTTPRouteCallBackex(HTTPRouter[0]);
  AssertTrue('Route event correct',Pointer(E.CallBack)=Pointer(@MyRouteCallBackex));
  AssertTrue('Data pointer correct',E.Data=@E);
  AssertEquals('Route class not default',true,E.Default);
  AssertEquals('Route URL pattern','*path/',E.URLPattern);
  AssertTrue('Correct method',rmPost=E.Method);
end;

procedure TTestHTTPRoute.TestAddCallBack;

Var
  E : THTTPRouteCallBack;

begin
  HTTPRouter.RegisterRoute('*path',@MyRouteCallBack);
  AssertEquals('1 route registered.',1,HTTPRouter.RouteCount);
  AssertEquals('Route class correct',THTTPRouteCallBack,HTTPRouter[0].ClassType);
  E:=THTTPRouteCallBack(HTTPRouter[0]);
  AssertTrue('Route event correct',Pointer(E.CallBack)=Pointer(@MyRouteCallBack));
  AssertEquals('Route class not default',False,E.Default);
  AssertEquals('Route URL pattern','*path/',E.URLPattern);
  AssertTrue('Correct method',rmAll=E.Method);
end;

procedure TTestHTTPRoute.TestAddCallBackMethod;

Var
  E : THTTPRouteCallBack;

begin
  HTTPRouter.RegisterRoute('*path',rmPOST,@MyRouteCallBack);
  AssertEquals('1 route registered.',1,HTTPRouter.RouteCount);
  AssertEquals('Route class correct',THTTPRouteCallBack,HTTPRouter[0].ClassType);
  E:=THTTPRouteCallBack(HTTPRouter[0]);
  AssertTrue('Route event correct',Pointer(E.CallBack)=Pointer(@MyRouteCallBack));
  AssertEquals('Route class not default',False,E.Default);
  AssertEquals('Route URL pattern','*path/',E.URLPattern);
  AssertTrue('Correct method',rmPost=E.Method);
end;

procedure TTestHTTPRoute.TestAddCallBackDefault;
Var
  E : THTTPRouteCallBack;

begin
  HTTPRouter.RegisterRoute('*path',rmPOST,@MyRouteCallBack,true);
  AssertEquals('1 route registered.',1,HTTPRouter.RouteCount);
  AssertEquals('Route class correct',THTTPRouteCallBack,HTTPRouter[0].ClassType);
  E:=THTTPRouteCallBack(HTTPRouter[0]);
  AssertTrue('Route event correct',Pointer(E.CallBack)=Pointer(@MyRouteCallBack));
  AssertEquals('Route class not default',true,E.Default);
  AssertEquals('Route URL pattern','*path/',E.URLPattern);
  AssertTrue('Correct method',rmPost=E.Method);
end;

procedure TTestHTTPRoute.TestAddRouteObject;

Var
  E : THTTPRouteObject;

begin
  HTTPRouter.RegisterRoute('*path',TMyObjectHandler);
  AssertEquals('1 route registered.',1,HTTPRouter.RouteCount);
  AssertEquals('Route class correct',THTTPRouteObject,HTTPRouter[0].ClassType);
  E:=THTTPRouteObject(HTTPRouter[0]);
  AssertEquals('Route event correct',TMyObjectHandler,E.ObjectCLass);
  AssertEquals('Route class not default',False,E.Default);
  AssertEquals('Route URL pattern','*path/',E.URLPattern);
  AssertTrue('Correct method',rmAll=E.Method);
end;

procedure TTestHTTPRoute.TestAddRouteObjectMethod;

Var
  E : THTTPRouteObject;

begin
  HTTPRouter.RegisterRoute('*path',rmPost,TMyObjectHandler);
  AssertEquals('1 route registered.',1,HTTPRouter.RouteCount);
  AssertEquals('Route class correct',THTTPRouteObject,HTTPRouter[0].ClassType);
  E:=THTTPRouteObject(HTTPRouter[0]);
  AssertEquals('Route event correct',TMyObjectHandler,E.ObjectCLass);
  AssertEquals('Route class not default',False,E.Default);
  AssertEquals('Route URL pattern','*path/',E.URLPattern);
  AssertTrue('Correct method',rmPost=E.Method);
end;

procedure TTestHTTPRoute.TestAddRouteObjectDefault;
Var
  E : THTTPRouteObject;

begin
  HTTPRouter.RegisterRoute('*path',rmPost,TMyObjectHandler,True);
  AssertEquals('1 route registered.',1,HTTPRouter.RouteCount);
  AssertEquals('Route class correct',THTTPRouteObject,HTTPRouter[0].ClassType);
  E:=THTTPRouteObject(HTTPRouter[0]);
  AssertEquals('Route event correct',TMyObjectHandler,E.ObjectCLass);
  AssertEquals('Route class not default',True,E.Default);
  AssertEquals('Route URL pattern','*path/',E.URLPattern);
  AssertTrue('Correct method',rmPost=E.Method);
end;

procedure TTestHTTPRoute.TestFindRouteStatic;

Var
  R,F : THTTPRoute;
  MM : Boolean;

begin
  HTTPRouter.RegisterRoute('/path1',rmAll,@MyRouteCallBack,False);
  R:=HTTPRouter.RegisterRoute('/path2',rmAll,@MyRouteCallBack,False);
  HTTPRouter.RegisterRoute('/path3',rmAll,@MyRouteCallBack,False);
  F:=HTTPRouter.FindHTTPRoute('/path2',rmPOST,RouteParams,MM);
  AssertNotNull('Found route',F);
  AssertSame('Correct route found',R,F);
  AssertEquals('No route mismatch',False,MM);
end;

procedure TTestHTTPRoute.TestFindRouteStaticNoMatch;

Var
  F : THTTPRoute;
  MM : Boolean;

begin
  HTTPRouter.RegisterRoute('/path1',rmAll,@MyRouteCallBack,False);
  HTTPRouter.RegisterRoute('/path2',rmAll,@MyRouteCallBack,False);
  HTTPRouter.RegisterRoute('/path3',rmAll,@MyRouteCallBack,False);
  F:=HTTPRouter.FindHTTPRoute('/path4',rmPOST,RouteParams,MM);
  AssertNull('Found no route',F);
  AssertEquals('No route mismatch',False,MM);
end;

procedure TTestHTTPRoute.TestGetRouteStatic;

Var
  R,F : THTTPRoute;

begin
  HTTPRouter.RegisterRoute('/path1',rmAll,@MyRouteCallBack,False);
  R:=HTTPRouter.RegisterRoute('/path2',rmAll,@MyRouteCallBack,False);
  HTTPRouter.RegisterRoute('/path3',rmAll,@MyRouteCallBack,False);
  F:=HTTPRouter.GetHTTPRoute('/path2',rmPOST,RouteParams);
  AssertNotNull('Found route',F);
  AssertSame('Correct route found',R,F);
end;

procedure TTestHTTPRoute.DoGetRoute;

begin
  HTTPRouter.GetHTTPRoute(FGetRoutePath,FGetRouteMethod,RouteParams);
end;

procedure TTestHTTPRoute.TestGetRouteStaticNoMatch;

begin
  HTTPRouter.RegisterRoute('/path1',rmAll,@MyRouteCallBack,False);
  HTTPRouter.RegisterRoute('/path2',rmAll,@MyRouteCallBack,False);
  HTTPRouter.RegisterRoute('/path3',rmAll,@MyRouteCallBack,False);
  FGetRoutePath:='/pathNNNN';
  FGetRouteMethod:=rmPost;
  AssertException('No route found raises exception',EHTTPRoute,@DoGetRoute,'Not found')
end;

procedure TTestHTTPRoute.TestGetRouteStaticNoMethodMatch;

begin
  HTTPRouter.RegisterRoute('/path1',rmGet,@MyRouteCallBack,False);
  HTTPRouter.RegisterRoute('/path2',rmGet,@MyRouteCallBack,False);
  HTTPRouter.RegisterRoute('/path3',rmGet,@MyRouteCallBack,False);
  FGetRoutePath:='/path1';
  FGetRouteMethod:=rmPost;
  AssertException('No route found raises exception',EHTTPRoute,@DoGetRoute,'Method not allowed')
end;

procedure TTestHTTPRoute.TestFindRouteStatic2Paths;

Var
  R,F : THTTPRoute;
  MM : Boolean;

begin
  HTTPRouter.RegisterRoute('/path1/b',rmAll,@MyRouteCallBack,False);
  R:=HTTPRouter.RegisterRoute('/path2/b',rmAll,@MyRouteCallBack,False);
  HTTPRouter.RegisterRoute('/path2/c',rmAll,@MyRouteCallBack,False);
  F:=HTTPRouter.FindHTTPRoute('/path2/b',rmPOST,RouteParams,MM);
  AssertNotNull('Found route',F);
  AssertSame('Correct route found',R,F);
  AssertEquals('No route mismatch',False,MM);
end;

procedure TTestHTTPRoute.TestFindRouteStatic2PathsNoMatch;

Var
  F : THTTPRoute;
  MM : Boolean;

begin
  HTTPRouter.RegisterRoute('/path1/b',rmAll,@MyRouteCallBack,False);
  HTTPRouter.RegisterRoute('/path2/b',rmAll,@MyRouteCallBack,False);
  HTTPRouter.RegisterRoute('/path2',rmAll,@MyRouteCallBack,False);
  F:=HTTPRouter.FindHTTPRoute('/path2/c',rmPOST,RouteParams,MM);
  AssertNull('No route',F);
  AssertEquals('No route mismatch',False,MM);
end;

procedure TTestHTTPRoute.TestFindRouteStaticMethodMismatch;
Var
  F : THTTPRoute;
  MM : Boolean;

begin
  HTTPRouter.RegisterRoute('/path1/b',rmAll,@MyRouteCallBack,False);
  HTTPRouter.RegisterRoute('/path2/b',rmGet,@MyRouteCallBack,False);
  HTTPRouter.RegisterRoute('/path2',rmAll,@MyRouteCallBack,False);
  F:=HTTPRouter.FindHTTPRoute('/path2/b',rmPOST,RouteParams,MM);
  AssertNull('No route',F);
  AssertEquals('No route mismatch',True,MM);
end;

procedure TTestHTTPRoute.TestFindRouteWildCard;

Var
  F,R : THTTPRoute;
  MM : Boolean;

begin
  HTTPRouter.RegisterRoute('/path1/b',rmAll,@MyRouteCallBack,False);
  HTTPRouter.RegisterRoute('/path2',rmAll,@MyRouteCallBack,False);
  R:=HTTPRouter.RegisterRoute('/*',rmAll,@MyRouteCallBack,False);
  F:=HTTPRouter.FindHTTPRoute('/path2/b',rmPOST,RouteParams,MM);
  AssertNotNull('Found route',F);
  AssertSame('Correct route found',R,F);
  AssertEquals('No route mismatch',False,MM);
  AssertEquals('No route params',0,RouteParams.Count);
end;

procedure TTestHTTPRoute.TestFindRouteNamedWildCard;

Var
  F,R : THTTPRoute;
  MM : Boolean;

begin
  HTTPRouter.RegisterRoute('/path1/b',rmAll,@MyRouteCallBack,False);
  HTTPRouter.RegisterRoute('/path2',rmAll,@MyRouteCallBack,False);
  R:=HTTPRouter.RegisterRoute('/*thepath',rmAll,@MyRouteCallBack,False);
  F:=HTTPRouter.FindHTTPRoute('/path2/b',rmPOST,RouteParams,MM);
  AssertNotNull('Found route',F);
  AssertSame('Correct route found',R,F);
  AssertEquals('No route mismatch',False,MM);
  AssertEquals('Route params',1,RouteParams.Count);
  AssertEquals('Wildcard path correctly registered','path2/b',RouteParams.Values['thepath']);
end;

procedure TTestHTTPRoute.TestFindRouteNamedWildCard2;

Var
  F,R : THTTPRoute;
  MM : Boolean;

begin
  HTTPRouter.RegisterRoute('/path1/b',rmAll,@MyRouteCallBack,False);
  HTTPRouter.RegisterRoute('/path2',rmAll,@MyRouteCallBack,False);
  R:=HTTPRouter.RegisterRoute('/path2/*thepath',rmAll,@MyRouteCallBack,False);
  F:=HTTPRouter.FindHTTPRoute('/path2/b',rmPOST,RouteParams,MM);
  AssertNotNull('Found route',F);
  AssertSame('Correct route found',R,F);
  AssertEquals('No route mismatch',False,MM);
  AssertEquals('Route params',1,RouteParams.Count);
  AssertEquals('Wildcard path correctly registered','b',RouteParams.Values['thepath']);
end;

procedure TTestHTTPRoute.TestFindRouteWildCard3;

Var
  F,R : THTTPRoute;
  MM : Boolean;

begin
  HTTPRouter.RegisterRoute('/path1/b',rmAll,@MyRouteCallBack,False);
  HTTPRouter.RegisterRoute('/path2',rmAll,@MyRouteCallBack,False);
  R:=HTTPRouter.RegisterRoute('*/c',rmAll,@MyRouteCallBack,False);
  F:=HTTPRouter.FindHTTPRoute('/path2/c',rmPOST,RouteParams,MM);
  AssertNotNull('Found route',F);
  AssertSame('Correct route found',R,F);
  AssertEquals('No route mismatch',False,MM);
  AssertEquals('No route params',0,RouteParams.Count);
end;

procedure TTestHTTPRoute.TestFindRouteWildCard3Named;
Var
  F,R : THTTPRoute;
  MM : Boolean;

begin
  HTTPRouter.RegisterRoute('/path1/b',rmAll,@MyRouteCallBack,False);
  HTTPRouter.RegisterRoute('/path2',rmAll,@MyRouteCallBack,False);
  R:=HTTPRouter.RegisterRoute('*start/c',rmAll,@MyRouteCallBack,False);
  F:=HTTPRouter.FindHTTPRoute('/path2/c',rmPOST,RouteParams,MM);
  AssertNotNull('Found route',F);
  AssertSame('Correct route found',R,F);
  AssertEquals('No route mismatch',False,MM);
  AssertEquals('route params',1,RouteParams.Count);
  AssertEquals('Wildcard path correctly registered','path2',RouteParams.Values['start']);
end;

procedure TTestHTTPRoute.TestFindRouteParam;

Var
  F,R : THTTPRoute;
  MM : Boolean;

begin
  HTTPRouter.RegisterRoute('/path1/b',rmAll,@MyRouteCallBack,False);
  HTTPRouter.RegisterRoute('/path2',rmAll,@MyRouteCallBack,False);
  R:=HTTPRouter.RegisterRoute(':start/c',rmAll,@MyRouteCallBack,False);
  F:=HTTPRouter.FindHTTPRoute('/path2/c',rmPOST,RouteParams,MM);
  AssertNotNull('Found route',F);
  AssertSame('Correct route found',R,F);
  AssertEquals('No route mismatch',False,MM);
  AssertEquals('route params',1,RouteParams.Count);
  AssertEquals('Param path correctly registered','path2',RouteParams.Values['start']);
end;

procedure TTestHTTPRoute.TestFindRouteParam2;

Var
  F,R : THTTPRoute;
  MM : Boolean;

begin
  HTTPRouter.RegisterRoute('/path1/b',rmAll,@MyRouteCallBack,False);
  HTTPRouter.RegisterRoute('/path2',rmAll,@MyRouteCallBack,False);
  R:=HTTPRouter.RegisterRoute(':start/:end',rmAll,@MyRouteCallBack,False);
  F:=HTTPRouter.FindHTTPRoute('/path2/c',rmPOST,RouteParams,MM);
  AssertNotNull('Found route',F);
  AssertSame('Correct route found',R,F);
  AssertEquals('No route mismatch',False,MM);
  AssertEquals('route params',2,RouteParams.Count);
  AssertEquals('Param 1 correctly registered','path2',RouteParams.Values['start']);
  AssertEquals('Param 2 correctly registered','c',RouteParams.Values['end']);
end;

procedure TTestHTTPRoute.TestFindRouteWildcardParam;

Var
  F,R : THTTPRoute;
  MM : Boolean;

begin
  HTTPRouter.RegisterRoute('/path1/b',rmAll,@MyRouteCallBack,False);
  HTTPRouter.RegisterRoute('/path2',rmAll,@MyRouteCallBack,False);
  R:=HTTPRouter.RegisterRoute('*start/:end',rmAll,@MyRouteCallBack,False);
  F:=HTTPRouter.FindHTTPRoute('/path1/path2/c',rmPOST,RouteParams,MM);
  AssertNotNull('Found route',F);
  AssertSame('Correct route found',R,F);
  AssertEquals('No route mismatch',False,MM);
  AssertEquals('route params',2,RouteParams.Count);
  AssertEquals('Param 1 correctly registered','path1/path2',RouteParams.Values['start']);
  AssertEquals('Param 2 correctly registered','c',RouteParams.Values['end']);
end;

procedure TTestHTTPRoute.TestFindRouteWildcardParamNoMatch;
Var
  F,R : THTTPRoute;
  MM : Boolean;

begin
  HTTPRouter.RegisterRoute('/path1/b',rmAll,@MyRouteCallBack,False);
  HTTPRouter.RegisterRoute('/path2',rmAll,@MyRouteCallBack,False);
  R:=HTTPRouter.RegisterRoute('*start/:end',rmAll,@MyRouteCallBack,False);
  F:=HTTPRouter.FindHTTPRoute('/path1',rmPOST,RouteParams,MM);
  AssertNull('Found route',F);
end;

procedure TTestHTTPRoute.TestSetServiceClass;
begin
  THTTPRouter.SetServiceClass(TMyHTTPRouter);
  AssertEquals('Correct service class',TMyHTTPRouter,THTTPRouter.ServiceClass);
  AssertEquals('Correct service class used for singleton',TMyHTTPRouter,HTTPRouter.ClassType);
end;

procedure TTestHTTPRoute.DoRouteRequest;

begin
  HTTPRouter.RouteRequest(FakeRequest,FakeResponse);
end;

function TTestHTTPRoute.GetWebHandler: TWebhandler;

Var
  F: TFakeWebhandler;
begin
  if FWebhandler=Nil then
    begin
    F:=TFakeWebhandler.Create(Nil);
    F.FakeRequest:=Self.FakeRequest;
    F.FakeResponse:=Self.FakeResponse;
    FWebhandler:=F;
    end;
  Result:=FWebhandler;
end;

procedure TTestHTTPRoute.TestRouteRequestEvent;

begin
  HTTPRouter.RegisterRoute('*path',@MyRouteEvent);
  FakeRequest.PathInfo:='me';
  RouteParams.Values['path']:='me';
  HTTPRouter.BeforeRequest:=@DoBeforeRequest;
  HTTPRouter.AfterRequest:=@DoAfterRequest;
  DoRouteRequest;
  AssertEquals('MyRouteEvent called',1,FEventCalled);
  AssertEquals('Before request called once',1,FBeforeCalledCount);
  AssertEquals('After request called once',1,FAfterCalledCount);
end;

procedure TTestHTTPRoute.TestRouteRequestCallback;
begin
  HTTPRouter.RegisterRoute('*path',@MyRouteCallBack);
  FakeRequest.PathInfo:='me';
  HTTPRouter.BeforeRequest:=@DoBeforeRequest;
  HTTPRouter.AfterRequest:=@DoAfterRequest;
  DoRouteRequest;
  AssertEquals('MyRouteEvent called',1,CallBackCalled);
  AssertEquals('Before request called once',1,FBeforeCalledCount);
  AssertEquals('After request called once',1,FAfterCalledCount);
end;

procedure TTestHTTPRoute.TestRouteRequestInterface;
begin
  HTTPRouter.RegisterRoute('*path',InterfacedHandler);
  FakeRequest.PathInfo:='me';
  HTTPRouter.BeforeRequest:=@DoBeforeRequest;
  HTTPRouter.AfterRequest:=@DoAfterRequest;
  DoRouteRequest;
  AssertEquals('MyRouteEvent called',1,InterfacedHandler.CallCount);
  AssertEquals('Before request called once',1,FBeforeCalledCount);
  AssertEquals('After request called once',1,FAfterCalledCount);
end;

procedure TTestHTTPRoute.TestRouteRequestObject;
begin
  HTTPRouter.RegisterRoute('*path',TMyObjectHandler);
  FakeRequest.PathInfo:='me';
  HTTPRouter.BeforeRequest:=@DoBeforeRequest;
  HTTPRouter.AfterRequest:=@DoAfterRequest;
  DoRouteRequest;
  AssertEquals('TMyObjectHandler.handleRequest called',1,TMyObjectHandler.FCallCount);
  AssertEquals('Before request called once',1,FBeforeCalledCount);
  AssertEquals('After request called once',1,FAfterCalledCount);
end;

procedure TTestHTTPRoute.TestRouteRequestException;
begin
  FDoException:=true;
  HTTPRouter.RegisterRoute('*path',@MyRouteEvent);
  FakeRequest.PathInfo:='me';
  HTTPRouter.BeforeRequest:=@DoBeforeRequest;
  HTTPRouter.AfterRequest:=@DoAfterRequest;
  AssertException('Raise exception',EXception,@DoRouteRequest);
  AssertEquals('MyRouteEvent called',1,FEventCalled);
  AssertEquals('Before request called once',1,FBeforeCalledCount);
  AssertEquals('After request not called',0,FAfterCalledCount);
end;

procedure TTestHTTPRoute.TestRouteModule;
begin
  RegisterHTTPModule('my',TMyModule,True);
  // Should not be called, as the module registration takes precedence.
  HTTPRouter.RegisterRoute('/my/no',@MyRouteEvent);
  ModuleFactory.OnModuleRequest:=@DoModuleRoute;
  FakeRequest.PathInfo:='/my/no/';
  DoRouteRequest;
  AssertEquals('MyRouteEvent not called',0,FEventCalled);
  AssertEquals('Module route event called',1,FModuleCallCount);
  AssertSame('Module route event called with correct module',ModuleFactory.Modules[0],FModuleItem);
end;

procedure TTestHTTPRoute.TestRouteModuleAfterRoute;

begin
  HTTPRouter.RegisterRoute('/my/no',@MyRouteEvent);
  // Should not be called, as the event registration takes precedence.
  RegisterHTTPModule('my',TMyModule,True);
  ModuleFactory.OnModuleRequest:=@DoModuleRoute;
  FakeRequest.PathInfo:='/my/no/';
  DoRouteRequest;
  AssertEquals('MyRouteEvent not called',1,FEventCalled);
  AssertEquals('Module route event called',0,FModuleCallCount);
end;

procedure TTestHTTPRoute.TestRouteModuleAfterRoute2;
begin
  HTTPRouter.RegisterRoute('/my/no',@MyRouteEvent);
  RegisterHTTPModule('my',TMyModule,True);
  ModuleFactory.OnModuleRequest:=@DoModuleRoute;
  FakeRequest.PathInfo:='/my/ap/';
  DoRouteRequest;
  AssertEquals('MyRouteEvent not called',0,FEventCalled);
  AssertEquals('Module route event called',1,FModuleCallCount);
  AssertSame('Module route event called with correct module',ModuleFactory.Modules[0],FModuleItem);
end;

procedure TTestHTTPRoute.TestWebModuleHandlerLegacy;
begin
  WebHandler.LegacyRouting:=True;
  // will not be called because of legacy routing
  HTTPRouter.RegisterRoute('/my/no',@MyRouteEvent);
  RegisterHTTPModule('my',TMyModule,True);
  ModuleFactory.OnModuleRequest:=@DoModuleRoute;
  FakeRequest.PathInfo:='/my/no/';
  WebHandler.Run;
  AssertEquals('MyRouteEvent not called',0,FEventCalled);
  AssertEquals('Module handler called',1,TMyModule.FCallCount);
  AssertSame('Module handler request correct',FakeRequest,TMyModule.FCallRequest);
  AssertSame('Module handler response correct',FakeResponse,TMyModule.FCallResponse);
end;

procedure TTestHTTPRoute.TestWebModuleHandlerNew;

begin
  WebHandler.LegacyRouting:=False;
  // will not be called because of legacy routing
  HTTPRouter.RegisterRoute('/my/no',@MyRouteEvent);
  RegisterHTTPModule('my',TMyModule,True);
  ModuleFactory.OnModuleRequest:=@DoModuleRoute;
  FakeRequest.PathInfo:='/my/no/';
  WebHandler.Run;
  AssertEquals('MyRouteEvent not called',1,FEventCalled);
  AssertEquals('Module handler not called',0,TMyModule.FCallCount);
  AssertSame('Module handler request correct',Nil,TMyModule.FCallRequest);
  AssertSame('Module handler response correct',Nil,TMyModule.FCallResponse);
end;

procedure TTestHTTPRoute.MyRouteEvent(ARequest: TRequest; AResponse: TResponse);

Var
  I : integer;
  N,V : string;

begin
  FEventCalled:=1;
  for I:=0 to RouteParams.Count-1 do
    begin
    RouteParams.GetNameValue(I,N,V);
    AssertEquals('Have route parameter '+N,V,ARequest.RouteParams[N]);
    end;
  if FDoException then
    Raise Exception.Create('An error');
end;

procedure TTestHTTPRoute.MyRouteEvent2(ARequest: TRequest; AResponse: TResponse);
begin
  FEventCalled:=2;
end;

procedure TTestHTTPRoute.MyRouteEvent3(ARequest: TRequest; AResponse: TResponse);
begin
  FEventCalled:=3;
end;

procedure TTestHTTPRoute.SetUp;

begin
  // Resets all.
  THTTPRouter.SetServiceClass(THTTPRouter);
  FInterfacedHandler:=TMyInterfacedHandler.Create;
  FRouteParams:=TStringList.Create;
  FRequest:=TFakeRequest.Create;
  FResponse:=TFakeResponse.Create(FRequest);
  ModuleFactory.Clear;
  CallBackCalled:=0;
  FEventCalled:=0;
  TMyModule.FCallCount:=0;
  TMyModule.FCallRequest:=Nil;
  TMyModule.FCallResponse:=Nil;
end;

procedure TTestHTTPRoute.TearDown;

begin
  CallBackCalled:=0;
  FEventCalled:=0;
  FreeAndNil(FRouteParams);
  FreeAndNil(FInterfacedHandler);
  FreeAndNil(FRequest);
  FreeAndNil(FResponse);
  THTTPRouter.SetServiceClass(Nil);
end;

procedure TTestHTTPRoute.DoAfterRequest(Sender: TObject; ARequest: TRequest; AResponse: TResponse);
begin
  AssertSame('Sender is router',HTTPRouter,Sender);
  AssertSame('Request is original request',FakeRequest,ARequest);
  AssertSame('Response is original response',FakeResponse,AResponse);
  Inc(FAfterCalledCount);
end;

procedure TTestHTTPRoute.DoBeforeRequest(Sender: TObject; ARequest: TRequest; AResponse: TResponse);
begin
  AssertSame('Sender is router',HTTPRouter,Sender);
  AssertSame('Request is original request',FakeRequest,ARequest);
  AssertSame('Response is original response',FakeResponse,AResponse);
  Inc(FBeforeCalledCount);
end;

procedure TTestHTTPRoute.DoModuleRoute(Sender: TModuleItem; ARequest: TRequest; AResponse: TResponse);
begin
  FModuleItem:=Sender;
  Inc(FModuleCallCount);
end;

initialization

  RegisterTest(TTestHTTPRoute);
end.