unit FrameworkTestsU; interface uses TestFramework, MVCFramework.Router, System.Generics.Collections, MVCFramework, Data.DB; type TTestRouting = class(TTestCase) private Router: TMVCRouter; Controllers: TList; public procedure SetUp; override; procedure TearDown; override; protected procedure SameFishesDataSet(ds, ds2: TDataSet); published procedure TestWithNoParameters; procedure TestWithNoPath; procedure TestPathButNoParameters; procedure TestPathWithParameters; procedure TestWithMethodTypes; procedure TestComplexRoutings; // procedure TestClassNameMethodNameRouting; procedure TestObjectToJSONObject; procedure TestObjectListToJSONArray; // objects mappers procedure TestJSONObjectToObjectAndBack; procedure TestDataSetToJSONObject; procedure TestDataSetToJSONArray; end; implementation { TTestRouting } uses MVCFramework.Commons, TestControllersU, DBClient, Web.HTTPApp, ObjectsMappers, BOs, Data.DBXJSON; procedure TTestRouting.SameFishesDataSet(ds, ds2: TDataSet); begin CheckEquals(ds.FieldByName('Species No').AsInteger, ds2.FieldByName('Species No').AsInteger); CheckEquals(ds.FieldByName('Category').AsString, ds2.FieldByName('Category').AsString); CheckEquals(ds.FieldByName('Common_Name').AsString, ds2.FieldByName('Common_Name').AsString); CheckEquals(ds.FieldByName('Species Name').AsString, ds2.FieldByName('Species Name').AsString); CheckEquals(ds.FieldByName('Length (cm)').AsString, ds2.FieldByName('Length (cm)').AsString); CheckEquals(ds.FieldByName('Length_In').AsInteger, ds2.FieldByName('Length_In').AsInteger); CheckEquals(ds.FieldByName('Notes').AsString, ds2.FieldByName('Notes').AsString); CheckEquals(ds.FieldByName('Graphic').AsString, ds2.FieldByName('Graphic').AsString); end; procedure TTestRouting.SetUp; begin Controllers := TList.Create; Controllers.Add(TSimpleController); Controllers.Add(TNotSoSimpleController); Router := TMVCRouter.Create(nil); end; procedure TTestRouting.TearDown; begin Router.Free; Controllers.Free; end; // procedure TTestRouting.TestClassNameMethodNameRouting; // var // Params: TMVCRequestParamsTable; // ResponseContentType: string; // ResponseContentEncoding: string; // begin // Params := TMVCRequestParamsTable.Create; // try // CheckTrue(Router.ExecuteRouting('/TNotSoSimpleController/Method1', httpGET, 'text/plain', Controllers, // Params, ResponseContentType, ResponseContentEncoding)); // CheckEquals(0, Params.Count); // CheckEquals('TSimpleController', Router.MVCControllerClass.ClassName); // CheckEquals('Index', Router.MethodToCall.Name); // finally // Params.Free; // end; // end; procedure TTestRouting.TestComplexRoutings; begin end; procedure TTestRouting.TestDataSetToJSONArray; var ds: TClientDataSet; JObj: TJSONObject; S: string; ds2: TClientDataSet; JArr: TJSONArray; begin ds := TClientDataSet.Create(nil); ds2 := TClientDataSet.Create(nil); try ds.LoadFromFile('..\..\fishes.xml'); ds.First; JArr := TJSONArray.Create; try JArr := ds.AsJSONArray; // Mapper.DataSetToJSONArray(ds, JArr, false); ds2.LoadFromFile('..\..\fishes.xml'); ds2.EmptyDataSet; ds.First; while not ds.Eof do begin ds2.Insert; JObj := JArr.Get(ds.RecNo - 1) as TJSONObject; ds2.LoadFromJSONObject(JObj); // Mapper.JSONObjectToDataSet(JObj, ds2, false); ds2.Post; SameFishesDataSet(ds, ds2); ds.Next; end; finally JArr.Free; end; finally ds.Free; ds2.Free; end; end; procedure TTestRouting.TestDataSetToJSONObject; var ds: TClientDataSet; JObj: TJSONObject; S: string; ds2: TClientDataSet; begin ds := TClientDataSet.Create(nil); ds2 := TClientDataSet.Create(nil); try ds.LoadFromFile('..\..\fishes.xml'); JObj := TJSONObject.Create; try JObj := ds.AsJSONObject; // Mapper.DataSetToJSONObject(ds, JObj, false); ds2.LoadFromFile('..\..\fishes.xml'); ds2.EmptyDataSet; ds2.Insert; ds2.LoadFromJSONObject(JObj); // Mapper.JSONObjectToDataSet(JObj, ds2, false); ds2.Post; SameFishesDataSet(ds, ds2); finally JObj.Free; end; finally ds.Free; ds2.Free; end; end; procedure TTestRouting.TestJSONObjectToObjectAndBack; var Obj: TMyObject; JObj: TJSONObject; Obj2: TMyObject; begin Obj := GetMyObject; try JObj := Mapper.ObjectToJSONObject(Obj); try Obj2 := Mapper.JSONObjectToObject(JObj); try CheckTrue(Obj.Equals(Obj2)); finally Obj2.Free; end; finally JObj.Free; end; finally Obj.Free; end; end; procedure TTestRouting.TestObjectListToJSONArray; var Obj, Obj2: TMyObject; ObjList, Obj2List: TObjectList; json: TJSONArray; I: Integer; begin ObjList := TObjectList.Create(true); try for I := 1 to 10 do begin Obj := GetMyObject; Obj.PropInteger := I; ObjList.Add(Obj); end; json := Mapper.ObjectListToJSONArray(ObjList); Obj2List := Mapper.JSONArrayToObjectList(json); try CheckEquals(ObjList.Count, Obj2List.Count); for I := 0 to 9 do begin CheckTrue(Obj2List[I].Equals(ObjList[I])); end; finally Obj2List.Free; end; finally ObjList.Free; end; end; procedure TTestRouting.TestObjectToJSONObject; var Obj: TMyObject; json: TJSONObject; Obj2: TMyObject; begin Obj := GetMyObject; try json := Mapper.ObjectToJSONObject(Obj); try Obj2 := Mapper.JSONObjectToObject(json); CheckTrue(Obj.Equals(Obj2)); finally json.Free; end; finally Obj.Free; end; end; procedure TTestRouting.TestPathButNoParameters; var Params: TMVCRequestParamsTable; ResponseContentType: string; ResponseContentEncoding: string; begin Params := TMVCRequestParamsTable.Create; try CheckTrue(Router.ExecuteRouting('/orders', httpGET, 'text/plain', Controllers, Params, ResponseContentType, ResponseContentEncoding)); CheckEquals(0, Params.Count); CheckEquals('TSimpleController', Router.MVCControllerClass.ClassName); CheckEquals('Orders', Router.MethodToCall.Name); CheckEquals('UTF-8', ResponseContentEncoding); finally Params.Free; end; end; procedure TTestRouting.TestPathWithParameters; var Params: TMVCRequestParamsTable; ResponseContentType: string; ResponseContentEncoding: string; begin Params := TMVCRequestParamsTable.Create; try CheckTrue(Router.ExecuteRouting('/orders/789', httpGET, 'text/plain', Controllers, Params, ResponseContentType, ResponseContentEncoding)); CheckEquals(1, Params.Count); CheckEquals('789', Params['ordernumber']); CheckEquals('TSimpleController', Router.MVCControllerClass.ClassName); CheckEquals('OrderNumber', Router.MethodToCall.Name); finally Params.Free; end; end; procedure TTestRouting.TestWithMethodTypes; var Params: TMVCRequestParamsTable; ResponseContentType: string; ResponseContentEncoding: string; begin Params := TMVCRequestParamsTable.Create; try CheckTrue(Router.ExecuteRouting('/orders/789', httpPOST, 'text/plain', Controllers, Params, ResponseContentType, ResponseContentEncoding)); CheckEquals('UpdateOrderNumber', Router.MethodToCall.Name); Params.Clear; CheckTrue(Router.ExecuteRouting('/orders/789', httpPUT, 'text/plain', Controllers, Params, ResponseContentType, ResponseContentEncoding)); CheckEquals('UpdateOrderNumber', Router.MethodToCall.Name); Params.Clear; CheckFalse(Router.ExecuteRouting('/orders/789', httpDELETE, 'text/plain', Controllers, Params, ResponseContentType, ResponseContentEncoding)); CheckNull(Router.MethodToCall); CheckFalse(Assigned(Router.MVCControllerClass)); Params.Clear; CheckFalse(Router.ExecuteRouting('/orders/789', httpHEAD, 'text/plain', Controllers, Params, ResponseContentType, ResponseContentEncoding), 'Resolved as HEAD'); CheckNull(Router.MethodToCall, 'Resolved as HEAD'); CheckFalse(Assigned(Router.MVCControllerClass)); Params.Clear; CheckFalse(Router.ExecuteRouting('/orders/789', httpOPTIONS, 'text/plain', Controllers, Params, ResponseContentType, ResponseContentEncoding), 'Resolved as OPTIONS'); CheckNull(Router.MethodToCall, 'Resolved as OPTIONS'); CheckFalse(Assigned(Router.MVCControllerClass)); Params.Clear; CheckTrue(Router.ExecuteRouting('/orders/789', httpGET, 'text/plain', Controllers, Params, ResponseContentType, ResponseContentEncoding)); CheckEquals('OrderNumber', Router.MethodToCall.Name); Params.Clear; CheckTrue(Router.ExecuteRouting('/orders/789', httpGET, 'text/plain', Controllers, Params, ResponseContentType, ResponseContentEncoding)); CheckEquals('OrderNumber', Router.MethodToCall.Name); finally Params.Free; end; end; procedure TTestRouting.TestWithNoParameters; var Params: TMVCRequestParamsTable; ResponseContentType: string; ResponseContentEncoding: string; begin Params := TMVCRequestParamsTable.Create; try CheckTrue(Router.ExecuteRouting('/', httpGET, 'text/plain', Controllers, Params, ResponseContentType, ResponseContentEncoding)); CheckEquals(0, Params.Count); CheckEquals('TSimpleController', Router.MVCControllerClass.ClassName); CheckEquals('Index', Router.MethodToCall.Name); finally Params.Free; end; end; procedure TTestRouting.TestWithNoPath; var Params: TMVCRequestParamsTable; ResponseContentType: string; ResponseContentEncoding: string; begin Params := TMVCRequestParamsTable.Create; try CheckTrue(Router.ExecuteRouting('', httpGET, 'text/plain', Controllers, Params, ResponseContentType, ResponseContentEncoding)); CheckEquals(0, Params.Count); CheckEquals('TSimpleController', Router.MVCControllerClass.ClassName); CheckEquals('Index', Router.MethodToCall.Name); finally Params.Free; end; end; { TMyObject } initialization RegisterTest(TTestRouting.suite); finalization end.