mirror of
https://github.com/danieleteti/delphimvcframework.git
synced 2024-11-16 00:05:53 +01:00
2166 lines
65 KiB
ObjectPascal
2166 lines
65 KiB
ObjectPascal
// ***************************************************************************
|
||
//
|
||
// Delphi MVC Framework
|
||
//
|
||
// Copyright (c) 2010-2023 Daniele Teti and the DMVCFramework Team
|
||
//
|
||
// https://github.com/danieleteti/delphimvcframework
|
||
//
|
||
// ***************************************************************************
|
||
//
|
||
// Licensed under the Apache License, Version 2.0 (the "License");
|
||
// you may not use this file except in compliance with the License.
|
||
// You may obtain a copy of the License at
|
||
//
|
||
// http://www.apache.org/licenses/LICENSE-2.0
|
||
//
|
||
// Unless required by applicable law or agreed to in writing, software
|
||
// distributed under the License is distributed on an "AS IS" BASIS,
|
||
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||
// See the License for the specific language governing permissions and
|
||
// limitations under the License.
|
||
//
|
||
// *************************************************************************** }
|
||
|
||
unit FrameworkTestsU;
|
||
|
||
interface
|
||
|
||
uses
|
||
DUnitX.TestFramework,
|
||
MVCFramework.Router,
|
||
System.Generics.Collections,
|
||
BOs,
|
||
MVCFramework, Data.DB, System.SysUtils, MVCFramework.JWT,
|
||
MVCFramework.Serializer.Intf, MVCFramework.Serializer.Defaults,
|
||
MVCFramework.MultiMap, MVCFramework.Commons, MVCFramework.Serializer.Commons,
|
||
MVCFramework.Crypt.Utils;
|
||
|
||
type
|
||
|
||
[TestFixture]
|
||
TTestMappers = class(TObject)
|
||
protected
|
||
[Test]
|
||
procedure SameFishesDataSet(ds, ds2: TDataSet);
|
||
|
||
public
|
||
// procedure TestObjectToJSONObject;
|
||
// procedure TestObjectListToJSONArray;
|
||
// procedure TestObjectToJSONObject_Generics;
|
||
// procedure TestWrappedListToJSONArray;
|
||
// procedure TestJSONObjectToObjectAndBack;
|
||
// procedure TestLoadJSONObjectToObjectAndBack;
|
||
// procedure TestSerializeUsingProperties;
|
||
// procedure TestSerializeUsingFields;
|
||
// procedure TestSerializeUsingFieldsComplexObject;
|
||
// procedure TestSerializeUsingFieldsComplexObject2;
|
||
// procedure TestSerializeUsingFieldsWithNotExixtentPropetyInJSONObject;
|
||
// procedure TestComplexObjectToJSONObjectAndBack;
|
||
// procedure TestComplexObjectToJSONObjectAndBackWithNilReference;
|
||
// procedure TestDataSetToJSONObject;
|
||
// procedure TestDataSetToJSONObjectWithNulls;
|
||
// procedure TestDataSetToJSONObjectFieldPolicyLowerCase;
|
||
// procedure TestDataSetToJSONObjectFieldPolicyUpperCase;
|
||
// procedure TestDataSetToJSONObjectFieldPolicyAsIsCase;
|
||
// procedure TestDataSetToJSONArray;
|
||
// procedure TestObjectToJSONObjectAndBackWithStringStreamUTF16;
|
||
// procedure TestObjectToJSONObjectAndBackWithStringStreamUTF8;
|
||
// procedure TestObjectToJSONObjectAndBackWithStream;
|
||
// procedure TestJSONArrayToObjectListNoGenerics;
|
||
// procedure TestJSONArrayToObjectListNoGenericsWrappedList;
|
||
// procedure TestCheckMapperSerializeAsStringIsEmptyStrIfObjIsNil;
|
||
// procedure TestJSONObjectToObjectWithNullInJSONString;
|
||
// procedure TestJSONObjectStringToObject;
|
||
// procedure TestJSONObjectStringToObjectWithWrongJSON;
|
||
end;
|
||
|
||
[TestFixture]
|
||
TTestRouting = class(TObject)
|
||
private
|
||
FRouter: TMVCRouter;
|
||
FControllers: TObjectList<TMVCControllerDelegate>;
|
||
FMVCActionParamsCache: TMVCStringObjectDictionary<TMVCActionParamCacheItem>;
|
||
FConfig: TMVCConfig;
|
||
public
|
||
[SetUp]
|
||
procedure SetUp;
|
||
[TearDown]
|
||
procedure TearDown;
|
||
[Test]
|
||
procedure TestWithNoParameters;
|
||
[Test]
|
||
procedure TestWithNoPath;
|
||
[Test]
|
||
procedure TestPathButNoParameters;
|
||
[Test]
|
||
procedure TestPathWithParameters;
|
||
[Test]
|
||
procedure TestWithMethodTypes;
|
||
[Test]
|
||
procedure TestComplexRoutings;
|
||
[Test]
|
||
[Category('issues')]
|
||
procedure Test_ISSUE_338;
|
||
[Test]
|
||
[Category('issues')]
|
||
procedure Test_ISSUE_513_A;
|
||
[Test]
|
||
[Category('issues')]
|
||
procedure Test_ISSUE_513_B;
|
||
[Test]
|
||
[Category('issues')]
|
||
procedure Test_ISSUE_513_C;
|
||
[Test]
|
||
[Category('issues')]
|
||
procedure Test_ISSUE_492;
|
||
[Test]
|
||
procedure TestProduceRoutings;
|
||
[Test]
|
||
procedure TestProduceRoutingsWithExplicitCharset;
|
||
[Test]
|
||
procedure TestPathPrefix;
|
||
[Test]
|
||
procedure TestReservedIPs;
|
||
// procedure TestRoutingSpeed;
|
||
|
||
// objects mappers
|
||
end;
|
||
|
||
[TestFixture]
|
||
TTestJWT = class(TObject)
|
||
private
|
||
FJWT: TJWT;
|
||
public
|
||
[SetUp]
|
||
procedure SetUp;
|
||
[TearDown]
|
||
procedure TearDown;
|
||
[Test]
|
||
procedure TestHMAC;
|
||
[Test]
|
||
procedure TestStorage;
|
||
[Test]
|
||
procedure TestCreateAndValidateToken;
|
||
[Test]
|
||
procedure TestLoadToken;
|
||
[Test]
|
||
procedure TestNotBefore;
|
||
[Test]
|
||
procedure TestExpirationTime;
|
||
[Test]
|
||
procedure TestIssuedAt;
|
||
[Test]
|
||
procedure TestDefaults;
|
||
end;
|
||
|
||
{ This is the base test case for all the serunser testcases,
|
||
check 'SerializationFrameworkTestU.pas' }
|
||
[TestFixture]
|
||
TMVCSerUnSerTestCase = class abstract(TObject)
|
||
private
|
||
FSerializer: IMVCSerializer;
|
||
protected
|
||
procedure SetSerializer(const ASerializer: IMVCSerializer);
|
||
[SetUp]
|
||
procedure SetUp;
|
||
function GetObjectsList: TObjectList<TMyObject>;
|
||
function GetObjectsWithStreamsList: TObjectList<TMyStreamObject>;
|
||
function GetObjectsWithTValueList: TObjectList<TMyObjectWithTValue>;
|
||
property Serializer: IMVCSerializer read FSerializer;
|
||
[Test]
|
||
procedure TestSerUnSerObject; virtual; abstract;
|
||
[Test]
|
||
procedure TestSerUnSerObjectList; virtual; abstract;
|
||
[Test]
|
||
procedure TestSerUnSerNestedObjects; virtual; abstract;
|
||
[Test]
|
||
procedure TestSerUnSerObjectWithStream; virtual; abstract;
|
||
[Test]
|
||
procedure TestSerUnSerObjectListWithStream; virtual; abstract;
|
||
[Test]
|
||
procedure TestSerUnSerObjectWithTValue; virtual; abstract;
|
||
[Test]
|
||
procedure TestSerUnSerObjectListWithTValue; virtual; abstract;
|
||
[Test]
|
||
procedure TestSerUnSerObjectStrict; virtual; abstract;
|
||
[Test]
|
||
procedure TestSerUnSerObjectBuiltInCustomTypes; virtual; abstract;
|
||
[Test]
|
||
procedure TestSerUnSerObjectBuiltInCustomTypesFullObject; virtual; abstract;
|
||
end;
|
||
|
||
[TestFixture]
|
||
TTestMultiMap = class(TObject)
|
||
protected
|
||
[SetUp]
|
||
procedure SetUp;
|
||
[TearDown]
|
||
procedure TearDown;
|
||
[Test]
|
||
procedure TestObjectMultiMapAdd;
|
||
[Test]
|
||
procedure TestObjectMultiMapRemove;
|
||
[Test]
|
||
procedure TestInterfaceMultiMapAdd;
|
||
[Test]
|
||
procedure TestInterfaceMultiMapRemove;
|
||
end;
|
||
|
||
[TestFixture]
|
||
TTestNameCase = class(TObject)
|
||
private
|
||
fOutDATA: array [1 .. 5] of array [ncAsIs .. ncSnakeCase] of string;
|
||
fOrigDATA: array [1 .. 5] of string;
|
||
public
|
||
[SetupFixture]
|
||
procedure SetupFixture;
|
||
[Test]
|
||
procedure TestNameCase;
|
||
|
||
[Test]
|
||
[TestCase('LowerCase', 'onetwo,onetwo')]
|
||
[TestCase('LowerCaseWithUnderline', 'one_two,one_two')]
|
||
[TestCase('UpperCase', 'ONETWO,onetwo')]
|
||
[TestCase('UpperCaseWithUnderline', 'ONE_TWO,one_two')]
|
||
[TestCase('PascalCase', 'OneTwo,one_two')]
|
||
[TestCase('CamelCase', 'oneTwo,one_two')]
|
||
[TestCase('UPPERLower1', 'ONETwo,one_two')]
|
||
[TestCase('UPPERLower2', 'OneTWOThree,one_two_three')]
|
||
[TestCase('UPPERLower3', 'DATEOf,date_of')]
|
||
[TestCase('UPPERLower4', 'RESTClient,rest_client')]
|
||
[TestCase('UPPERLowerWithNumber1', 'OneTWO01,one_two_01')]
|
||
[TestCase('UPPERLowerWithNumber2', 'ONE02Three,one_02_three')]
|
||
[TestCase('WithSpaces1', 'One two three,one_two_three')]
|
||
[TestCase('WithSpaces2', 'One two three,one_two_three')]
|
||
[TestCase('WithSpaces3', 'One two three,one_two_three')]
|
||
[TestCase('WithDots1', 'One.two.three,one_two_three')]
|
||
[TestCase('WithDots2', 'ONE.TWO.THREE,one_two_three')]
|
||
[TestCase('WithDots3', 'ONE.02.THREE,one_02_three')]
|
||
[TestCase('WithUnderlines', 'One_two_three,one_two_three')]
|
||
[TestCase('MultipleUnderlines', 'One___two______three,one_two_three')]
|
||
[TestCase('WithNumber1', 'OneTwo1,one_two_1')]
|
||
[TestCase('WithNumber02', 'OneTwo02,one_two_02')]
|
||
[TestCase('WithNumberInTheMiddle1', 'OneTwo1Two,one_two_1_two')]
|
||
[TestCase('WithNumberInTheMiddle2', 'OneTwo_2two,one_two_2_two')]
|
||
[TestCase('WithNumberInTheMiddle3', 'OneTwo3_Two3,one_two_3_two_3')]
|
||
[TestCase('WithNumberInTheMiddle4', 'OneTwo_4_Two,one_two_4_two')]
|
||
[TestCase('WithNumberInTheMiddle5', 'OneTwo05Three,one_two_05_three')]
|
||
[TestCase('WithNumberInTheMiddle6', 'OneTwo_06Three,one_two_06_three')]
|
||
[TestCase('WithNumberInTheMiddle7', 'OneTwo07_Three,one_two_07_three')]
|
||
[TestCase('WithNumberInTheMiddle8', 'OneTwo_08_Three,one_two_08_three')]
|
||
procedure TestSnakeCase(const AValue1: string; const AValue2: string);
|
||
|
||
end;
|
||
|
||
[TestFixture]
|
||
TTestCryptUtils = class(TObject)
|
||
public
|
||
[SetupFixture]
|
||
procedure SetupFixture;
|
||
[Test]
|
||
procedure TestPBKDF2_SHA1;
|
||
[Test]
|
||
procedure TestPBKDF2_SHA256;
|
||
end;
|
||
|
||
[TestFixture]
|
||
TTestUTC = class(TObject)
|
||
public
|
||
[Test]
|
||
procedure TestStringToDateTime_Local;
|
||
[Test]
|
||
procedure TestStringToDateTime_in_DST_period;
|
||
[Test]
|
||
procedure TestStringToDateTime_in_no_DST_period;
|
||
[Test]
|
||
procedure TestStringToDateTime_NewYork;
|
||
[Test]
|
||
procedure TestStringToDateTime_Mumbai;
|
||
end;
|
||
|
||
[TestFixture]
|
||
TTestLRUCache = class(TObject)
|
||
public
|
||
[Test]
|
||
[Category('lru')]
|
||
procedure TestPutGet;
|
||
[Test]
|
||
[Category('lru')]
|
||
procedure TestPutGet_Check_No_AV;
|
||
end;
|
||
|
||
implementation
|
||
|
||
{$WARN SYMBOL_DEPRECATED OFF}
|
||
|
||
uses
|
||
System.DateUtils, System.TimeSpan, System.Math,
|
||
TestControllersU, DBClient,
|
||
Web.HTTPApp, Soap.EncdDecd,
|
||
IdHashMessageDigest, idHash,
|
||
System.Threading,
|
||
MVCFramework.HMAC, System.Diagnostics,
|
||
MVCFramework.LRUCache,
|
||
|
||
{$IF CompilerVersion < 27}
|
||
Data.DBXJSON,
|
||
|
||
{$ELSE}
|
||
System.JSON,
|
||
|
||
{$ENDIF}
|
||
TestServerControllerU, System.Classes,
|
||
MVCFramework.DuckTyping, System.IOUtils, MVCFramework.SystemJSONUtils,
|
||
IdGlobal, System.TypInfo, System.Types, Winapi.Windows;
|
||
|
||
var
|
||
JWT_SECRET_KEY_TEST: string = 'myk3y';
|
||
HMAC_ALG_AND_RESULTS: array [0 .. 4] of array [0 .. 1] of string = (
|
||
(
|
||
'md5',
|
||
'5256311089fa9c80f735fb8cc28bf4fe'
|
||
),
|
||
(
|
||
'sha1',
|
||
'323ff5f4e53c43f2d9342952299a9d35f9ee5dc2'
|
||
),
|
||
(
|
||
'sha224',
|
||
'2f42e18342d2d35afc9942364caec009e1ace1d1695c3e9178e65e35'
|
||
),
|
||
(
|
||
'sha256',
|
||
'1f75a969e2b9c43e6d06969dfad2088f9aab68d3aa440904d2ed8710e2f8e38b'
|
||
),
|
||
(
|
||
'sha512',
|
||
'22465b5f4138ab80801ff8eca8dd99a56844dd7dc54f76d38bb02bdd815596fc5859709ba4f7130c299a626864a84a4a79401f529d44c85a894fcd7e6192eee9'
|
||
)
|
||
);
|
||
|
||
function MD5(const aStream: TStream): string;
|
||
var
|
||
idmd5: TIdHashMessageDigest5;
|
||
begin
|
||
aStream.Position := 0;
|
||
idmd5 := TIdHashMessageDigest5.Create;
|
||
try
|
||
Result := idmd5.HashBytesAsHex(idmd5.HashStream(aStream));
|
||
finally
|
||
idmd5.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure TTestMappers.SameFishesDataSet(ds, ds2: TDataSet);
|
||
begin
|
||
Assert.areEqual(ds.FieldByName('Species No').AsInteger, ds2.FieldByName('Species No').AsInteger);
|
||
Assert.areEqual(ds.FieldByName('Category').AsString, ds2.FieldByName('Category').AsString);
|
||
Assert.areEqual(ds.FieldByName('Common_Name').AsString, ds2.FieldByName('Common_Name').AsString);
|
||
Assert.areEqual(ds.FieldByName('Species Name').AsString, ds2.FieldByName('Species Name').AsString);
|
||
Assert.areEqual(ds.FieldByName('Length (cm)').AsString, ds2.FieldByName('Length (cm)').AsString);
|
||
Assert.areEqual(ds.FieldByName('Length_In').AsInteger, ds2.FieldByName('Length_In').AsInteger);
|
||
Assert.areEqual(ds.FieldByName('Notes').AsString, ds2.FieldByName('Notes').AsString);
|
||
Assert.areEqual(ds.FieldByName('Graphic').AsString, ds2.FieldByName('Graphic').AsString);
|
||
end;
|
||
|
||
procedure TTestRouting.SetUp;
|
||
begin
|
||
FControllers := TObjectList<TMVCControllerDelegate>.Create;
|
||
FControllers.Add(TMVCControllerDelegate.Create(TSimpleController, nil));
|
||
FControllers.Add(TMVCControllerDelegate.Create(TNotSoSimpleController, nil));
|
||
FControllers.Add(TMVCControllerDelegate.Create(TTestServerController, nil));
|
||
FMVCActionParamsCache := TMVCStringObjectDictionary<TMVCActionParamCacheItem>.Create;
|
||
FConfig := TMVCConfig.Create;
|
||
FConfig.Value[TMVCConfigKey.PathPrefix] := '';
|
||
FRouter := TMVCRouter.Create(FConfig, FMVCActionParamsCache);
|
||
end;
|
||
|
||
procedure TTestRouting.TearDown;
|
||
begin
|
||
FRouter.Free;
|
||
FControllers.Free;
|
||
FMVCActionParamsCache.Free;
|
||
FConfig.Free;
|
||
end;
|
||
|
||
procedure TTestRouting.TestComplexRoutings;
|
||
var
|
||
Params: TMVCRequestParamsTable;
|
||
ResponseContentType: string;
|
||
ResponseContentEncoding: string;
|
||
begin
|
||
Params := TMVCRequestParamsTable.Create;
|
||
try
|
||
Assert.isTrue(FRouter.ExecuteRouting('/path1/1', httpPOST, 'text/plain', 'text/plain', FControllers, 'text/plain',
|
||
TMVCMediaType.TEXT_PLAIN, '', Params, ResponseContentType, ResponseContentEncoding));
|
||
Assert.areEqual('TestMultiplePaths', FRouter.MethodToCall.Name);
|
||
|
||
Params.Clear;
|
||
Assert.isTrue(FRouter.ExecuteRouting('/path2/1/2/3', httpPOST, 'text/plain', 'text/plain', FControllers,
|
||
'text/plain', TMVCMediaType.TEXT_PLAIN, '', Params, ResponseContentType, ResponseContentEncoding));
|
||
Assert.areEqual('TestMultiplePaths', FRouter.MethodToCall.Name);
|
||
|
||
Params.Clear;
|
||
Assert.isTrue(FRouter.ExecuteRouting('/path3/1/2/tre/3', httpPOST, 'text/plain', 'text/plain', FControllers,
|
||
'text/plain', TMVCMediaType.TEXT_PLAIN, '', Params, ResponseContentType, ResponseContentEncoding));
|
||
Assert.areEqual('TestMultiplePaths', FRouter.MethodToCall.Name);
|
||
|
||
Params.Clear;
|
||
Assert.isTrue(FRouter.ExecuteRouting('/path4/par1/2/par2/3/4', httpPOST, 'text/plain', 'text/plain', FControllers,
|
||
'text/plain', TMVCMediaType.TEXT_PLAIN, '', Params, ResponseContentType, ResponseContentEncoding));
|
||
Assert.areEqual('TestMultiplePaths', FRouter.MethodToCall.Name);
|
||
|
||
Params.Clear;
|
||
Assert.isFalse(FRouter.ExecuteRouting('/path4/par1/par2/3/4/notvalidparameter', httpPOST, 'text/plain',
|
||
'text/plain', FControllers, 'text/plain', TMVCMediaType.TEXT_PLAIN, '', Params, ResponseContentType,
|
||
ResponseContentEncoding));
|
||
Assert.isNull(FRouter.MethodToCall);
|
||
Assert.isFalse(Assigned(FRouter.ControllerClazz));
|
||
|
||
finally
|
||
Params.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure TTestRouting.Test_ISSUE_338;
|
||
var
|
||
Params: TMVCRequestParamsTable;
|
||
ResponseContentType: string;
|
||
ResponseContentEncoding: string;
|
||
begin
|
||
// https://github.com/danieleteti/delphimvcframework/issues/338
|
||
Params := TMVCRequestParamsTable.Create;
|
||
try
|
||
Params.Clear;
|
||
Assert.isTrue(FRouter.ExecuteRouting('/issue338/projectid/pictures/imageuuid', httpGET, 'text/plain', 'text/plain',
|
||
FControllers, 'text/plain', TMVCMediaType.TEXT_PLAIN, '', Params, ResponseContentType, ResponseContentEncoding));
|
||
Assert.areEqual('GetImage', FRouter.MethodToCall.Name);
|
||
Assert.areEqual(2, Params.Count);
|
||
Assert.areEqual('projectid', Params['projectid']);
|
||
Assert.areEqual('imageuuid', Params['imageuuid']);
|
||
|
||
Params.Clear;
|
||
Assert.isTrue(FRouter.ExecuteRouting('/issue338/projectid', httpGET, 'text/plain', 'text/plain', FControllers,
|
||
'text/plain', TMVCMediaType.TEXT_PLAIN, '', Params, ResponseContentType, ResponseContentEncoding));
|
||
Assert.areEqual('GetProject', FRouter.MethodToCall.Name);
|
||
Assert.areEqual(1, Params.Count);
|
||
Assert.areEqual('projectid', Params['projectid']);
|
||
finally
|
||
Params.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure TTestRouting.Test_ISSUE_492;
|
||
var
|
||
Params: TMVCRequestParamsTable;
|
||
ResponseContentType: string;
|
||
ResponseContentEncoding: string;
|
||
begin
|
||
// https://github.com/danieleteti/delphimvcframework/issues/492
|
||
Params := TMVCRequestParamsTable.Create;
|
||
try
|
||
Params.Clear;
|
||
Assert.isTrue(FRouter.ExecuteRouting('/issue492/delphi$mvc$framework', httpGET, 'text/plain', 'text/plain',
|
||
FControllers, 'text/plain', TMVCMediaType.TEXT_PLAIN, '', Params, ResponseContentType, ResponseContentEncoding));
|
||
Assert.areEqual('GetIssue492', FRouter.MethodToCall.Name);
|
||
Assert.areEqual(1, Params.Count);
|
||
Assert.areEqual('delphi$mvc$framework', Params['stringvalue']);
|
||
finally
|
||
Params.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure TTestRouting.Test_ISSUE_513_A;
|
||
var
|
||
Params: TMVCRequestParamsTable;
|
||
ResponseContentType: string;
|
||
ResponseContentEncoding: string;
|
||
begin
|
||
// https://github.com/danieleteti/delphimvcframework/issues/513
|
||
Params := TMVCRequestParamsTable.Create;
|
||
try
|
||
Params.Clear;
|
||
Assert.isTrue(FRouter.ExecuteRouting('/patient/$match', httpGET, 'text/plain', 'text/plain',
|
||
FControllers, 'text/plain', TMVCMediaType.TEXT_PLAIN, '', Params, ResponseContentType, ResponseContentEncoding));
|
||
Assert.areEqual('GetOrderIssue513', FRouter.MethodToCall.Name);
|
||
Assert.areEqual(0, Params.Count);
|
||
finally
|
||
Params.Free;
|
||
end;
|
||
|
||
end;
|
||
|
||
procedure TTestRouting.Test_ISSUE_513_B;
|
||
var
|
||
Params: TMVCRequestParamsTable;
|
||
ResponseContentType: string;
|
||
ResponseContentEncoding: string;
|
||
begin
|
||
// https://github.com/danieleteti/delphimvcframework/issues/513
|
||
Params := TMVCRequestParamsTable.Create;
|
||
try
|
||
Assert.isTrue(FRouter.ExecuteRouting('/patient/$match/daniele/teti', httpGET, 'text/plain', 'text/plain', FControllers,
|
||
'text/plain', TMVCMediaType.TEXT_PLAIN, '', Params, ResponseContentType, ResponseContentEncoding));
|
||
Assert.areEqual('GetOrderIssue513WithPars', FRouter.MethodToCall.Name);
|
||
Assert.areEqual(2, Params.Count);
|
||
Assert.areEqual('daniele', Params['par1']);
|
||
Assert.areEqual('teti', Params['par2']);
|
||
finally
|
||
Params.Free;
|
||
end;
|
||
|
||
end;
|
||
|
||
procedure TTestRouting.Test_ISSUE_513_C;
|
||
var
|
||
Params: TMVCRequestParamsTable;
|
||
ResponseContentType: string;
|
||
ResponseContentEncoding: string;
|
||
begin
|
||
// https://github.com/danieleteti/delphimvcframework/issues/513
|
||
Params := TMVCRequestParamsTable.Create;
|
||
try
|
||
Assert.isTrue(FRouter.ExecuteRouting('/patient/$match/da$niele/te$ti', httpGET, 'text/plain', 'text/plain', FControllers,
|
||
'text/plain', TMVCMediaType.TEXT_PLAIN, '', Params, ResponseContentType, ResponseContentEncoding));
|
||
Assert.areEqual('GetOrderIssue513WithPars', FRouter.MethodToCall.Name);
|
||
Assert.areEqual(2, Params.Count);
|
||
Assert.areEqual('da$niele', Params['par1']);
|
||
Assert.areEqual('te$ti', Params['par2']);
|
||
finally
|
||
Params.Free;
|
||
end;
|
||
|
||
end;
|
||
|
||
|
||
// procedure TTestMappers.TestDataSetToJSONArray;
|
||
// var
|
||
// ds: TClientDataSet;
|
||
// JObj: TJSONObject;
|
||
// ds2: TClientDataSet;
|
||
// JArr: TJSONArray;
|
||
// begin
|
||
// ds := TClientDataSet.Create(nil);
|
||
// ds2 := TClientDataSet.Create(nil);
|
||
// try
|
||
// ds.LoadFromFile('..\..\fishes.xml');
|
||
// ds.First;
|
||
// // JArr := TJSONArray.Create;
|
||
// JArr := ds.AsJSONArray;
|
||
// try
|
||
// // 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 TTestMappers.TestDataSetToJSONObject;
|
||
// var
|
||
// ds: TClientDataSet;
|
||
// JObj: TJSONObject;
|
||
// ds2: TClientDataSet;
|
||
// begin
|
||
// ds := TClientDataSet.Create(nil);
|
||
// ds2 := TClientDataSet.Create(nil);
|
||
// try
|
||
// ds.LoadFromFile('..\..\fishes.xml');
|
||
// JObj := ds.AsJSONObject;
|
||
// try
|
||
// ds2.LoadFromFile('..\..\fishes.xml');
|
||
// ds2.EmptyDataSet;
|
||
// ds2.Insert;
|
||
// ds2.LoadFromJSONObject(JObj);
|
||
// ds2.Post;
|
||
// SameFishesDataSet(ds, ds2);
|
||
// finally
|
||
// JObj.Free;
|
||
// end;
|
||
// finally
|
||
// ds.Free;
|
||
// ds2.Free;
|
||
// end;
|
||
// end;
|
||
|
||
// procedure TTestMappers.TestDataSetToJSONObjectFieldPolicyAsIsCase;
|
||
// var
|
||
// ds: TClientDataSet;
|
||
// JObj: TJSONObject;
|
||
// ds2: TClientDataSet;
|
||
// begin
|
||
// ds := TClientDataSet.Create(nil);
|
||
// ds2 := TClientDataSet.Create(nil);
|
||
// try
|
||
// ds.LoadFromFile('..\..\fishes.xml');
|
||
// JObj := ds.AsJSONObject(false, fpAsIs);
|
||
// try
|
||
// ds2.LoadFromFile('..\..\fishes.xml');
|
||
// ds2.EmptyDataSet;
|
||
// ds2.Insert;
|
||
// ds2.LoadFromJSONObject(JObj, fpAsIs);
|
||
// ds2.Post;
|
||
// SameFishesDataSet(ds, ds2);
|
||
// finally
|
||
// JObj.Free;
|
||
// end;
|
||
// finally
|
||
// ds.Free;
|
||
// ds2.Free;
|
||
// end;
|
||
// end;
|
||
|
||
// procedure TTestMappers.TestDataSetToJSONObjectFieldPolicyLowerCase;
|
||
// var
|
||
// ds: TClientDataSet;
|
||
// JObj: TJSONObject;
|
||
// ds2: TClientDataSet;
|
||
// begin
|
||
// ds := TClientDataSet.Create(nil);
|
||
// ds2 := TClientDataSet.Create(nil);
|
||
// try
|
||
// ds.LoadFromFile('..\..\fishes.xml');
|
||
// JObj := ds.AsJSONObject(false, fpLowerCase);
|
||
// try
|
||
// ds2.LoadFromFile('..\..\fishes.xml');
|
||
// ds2.EmptyDataSet;
|
||
// ds2.Insert;
|
||
// ds2.LoadFromJSONObject(JObj, fpLowerCase);
|
||
// ds2.Post;
|
||
// SameFishesDataSet(ds, ds2);
|
||
// finally
|
||
// JObj.Free;
|
||
// end;
|
||
// finally
|
||
// ds.Free;
|
||
// ds2.Free;
|
||
// end;
|
||
// end;
|
||
//
|
||
// procedure TTestMappers.TestDataSetToJSONObjectFieldPolicyUpperCase;
|
||
// var
|
||
// ds: TClientDataSet;
|
||
// JObj: TJSONObject;
|
||
// ds2: TClientDataSet;
|
||
// begin
|
||
// ds := TClientDataSet.Create(nil);
|
||
// ds2 := TClientDataSet.Create(nil);
|
||
// try
|
||
// ds.LoadFromFile('..\..\fishes.xml');
|
||
// JObj := ds.AsJSONObject(false, fpUpperCase);
|
||
// try
|
||
// ds2.LoadFromFile('..\..\fishes.xml');
|
||
// ds2.EmptyDataSet;
|
||
// ds2.Insert;
|
||
// ds2.LoadFromJSONObject(JObj, fpUpperCase);
|
||
// ds2.Post;
|
||
// SameFishesDataSet(ds, ds2);
|
||
// finally
|
||
// JObj.Free;
|
||
// end;
|
||
// finally
|
||
// ds.Free;
|
||
// ds2.Free;
|
||
// end;
|
||
// end;
|
||
|
||
// procedure TTestMappers.TestDataSetToJSONObjectWithNulls;
|
||
// var
|
||
// ds: TClientDataSet;
|
||
// JObj: TJSONObject;
|
||
// begin
|
||
// ds := TClientDataSet.Create(nil);
|
||
// try
|
||
// ds.FieldDefs.Add('string_value', ftString, 50);
|
||
// ds.FieldDefs.Add('integer_value', ftInteger);
|
||
// ds.FieldDefs.Add('float_value', ftFloat);
|
||
// ds.FieldDefs.Add('null_value', ftString, 50);
|
||
// ds.FieldDefs.Add('boolean_value', ftBoolean);
|
||
// ds.CreateDataSet;
|
||
// ds.Insert;
|
||
// ds.FieldByName('string_value').AsString := 'myStringValue';
|
||
// ds.FieldByName('integer_value').AsInteger := 123;
|
||
// ds.FieldByName('float_value').AsFloat := 123.456;
|
||
// ds.FieldByName('null_value').Clear;
|
||
// ds.FieldByName('boolean_value').AsBoolean := true;
|
||
// ds.Post;
|
||
// JObj := ds.AsJSONObject;
|
||
// try
|
||
// Assert.areEqual('myStringValue', JObj.Values['string_value'].Value);
|
||
// Assert.areEqual(123, JObj.Values['integer_value'].GetValue<TJSONNumber>().AsInt);
|
||
// Assert.areEqual(123.456, JObj.Values['float_value'].GetValue<TJSONNumber>().AsDouble, 0.0009);
|
||
// Assert.isTrue(JObj.Values['null_value'].GetValue<TJSONNull>().Null);
|
||
// Assert.areEqual(true, JObj.Values['boolean_value'].GetValue<TJSONBool>().AsBoolean);
|
||
// Assert.isTrue(JObj.ToJSON.Replace(' ', '').Contains('"null_value":null'));
|
||
// ds.Insert;
|
||
// ds.LoadFromJSONObject(JObj);
|
||
// ds.Post;
|
||
// Assert.isTrue(ds.FieldByName('null_value').IsNull);
|
||
// finally
|
||
// JObj.Free;
|
||
// end;
|
||
// finally
|
||
// ds.Free;
|
||
// end;
|
||
// end;
|
||
|
||
// procedure TTestMappers.TestJSONArrayToObjectListNoGenerics;
|
||
// var
|
||
// ListObj, RetList: TObjectList<TMyObject>;
|
||
// JSONArr: TJSONArray;
|
||
// I: Integer;
|
||
// begin
|
||
// ListObj := TObjectList<TMyObject>.Create;
|
||
// try
|
||
// ListObj.Add(GetMyObject);
|
||
// ListObj.Add(GetMyObject);
|
||
// JSONArr := Mapper.ObjectListToJSONArray<TMyObject>(ListObj);
|
||
// try
|
||
// RetList := TObjectList<TMyObject>(Mapper.JSONArrayToObjectList(TMyObject,
|
||
// JSONArr, false));
|
||
// try
|
||
// Assert.areEqual(2, RetList.Count);
|
||
// for I := 0 to ListObj.Count - 1 do
|
||
// Assert.isTrue(ListObj[I].Equals(RetList[I]));
|
||
// finally
|
||
// RetList.Free;
|
||
// end;
|
||
// finally
|
||
// JSONArr.Free;
|
||
// end;
|
||
// finally
|
||
// ListObj.Free;
|
||
// end;
|
||
// end;
|
||
//
|
||
// procedure TTestMappers.TestJSONArrayToObjectListNoGenericsWrappedList;
|
||
// var
|
||
// ListObj, RetList: TObjectList<TMyObject>;
|
||
// JSONArr: TJSONArray;
|
||
// I: Integer;
|
||
// begin
|
||
// ListObj := TObjectList<TMyObject>.Create;
|
||
// try
|
||
// ListObj.Add(GetMyObject);
|
||
// ListObj.Add(GetMyObject);
|
||
// JSONArr := Mapper.ObjectListToJSONArray<TMyObject>(ListObj);
|
||
// try
|
||
// RetList := TObjectList<TMyObject>.Create;
|
||
// try
|
||
// Mapper.JSONArrayToObjectList(WrapAsList(RetList), TMyObject,
|
||
// JSONArr, false);
|
||
// Assert.areEqual(2, RetList.Count);
|
||
// for I := 0 to ListObj.Count - 1 do
|
||
// Assert.isTrue(ListObj[I].Equals(RetList[I]));
|
||
// finally
|
||
// RetList.Free;
|
||
// end;
|
||
// finally
|
||
// JSONArr.Free;
|
||
// end;
|
||
// finally
|
||
// ListObj.Free;
|
||
// end;
|
||
// end;
|
||
//
|
||
// procedure TTestMappers.TestJSONObjectStringToObject;
|
||
// const
|
||
// MYOBJECTJSON =
|
||
// '{"PropString":"Some text \u00E0\u00E8\u00E9\u00EC\u00F2\u00F9",' +
|
||
// '"PropAnsiString":"This is an ANSI text","PropInteger":-1234,' +
|
||
// '"PropUInt32":1234,"PropInt64":-1234567890,"PropUInt64":1234567890,' +
|
||
// '"PropUInt16":12345,"PropInt16":-12345,"PropBoolean":true,' +
|
||
// '"PropDate":"2010-10-20","PropTime":"10:20:30",' +
|
||
// '"PropDateTime":"2010-10-20 10:20:30",' +
|
||
// '"PropTimeStamp":63423339630040,"PropCurrency":1234.5678}';
|
||
// var
|
||
// lMyObject: TMyObject;
|
||
// lMyObject2: TMyObject;
|
||
// begin
|
||
// lMyObject := Mapper.JSONObjectStringToObject<TMyObject>(MYOBJECTJSON);
|
||
// try
|
||
// lMyObject2 := GetMyObject;
|
||
// try
|
||
// Assert.isTrue(lMyObject.Equals(lMyObject2));
|
||
// finally
|
||
// lMyObject2.Free;
|
||
// end;
|
||
// finally
|
||
// lMyObject.Free;
|
||
// end;
|
||
// end;
|
||
//
|
||
// procedure TTestMappers.TestJSONObjectStringToObjectWithWrongJSON;
|
||
// begin
|
||
// ExpectedException := EMapperException;
|
||
// Mapper.JSONObjectStringToObject<TObject>('{wrongjson}');
|
||
// end;
|
||
//
|
||
// procedure TTestMappers.TestJSONObjectToObjectAndBack;
|
||
// var
|
||
// Obj: TMyObject;
|
||
// JObj: TJSONObject;
|
||
// Obj2: TMyObject;
|
||
// begin
|
||
// Obj := GetMyObject;
|
||
// try
|
||
// JObj := Mapper.ObjectToJSONObject(Obj);
|
||
// try
|
||
// Obj2 := Mapper.JSONObjectToObject<TMyObject>(JObj);
|
||
// try
|
||
// Assert.isTrue(Obj.Equals(Obj2));
|
||
// finally
|
||
// Obj2.Free;
|
||
// end;
|
||
// finally
|
||
// JObj.Free;
|
||
// end;
|
||
// finally
|
||
// Obj.Free;
|
||
// end;
|
||
// end;
|
||
//
|
||
// procedure TTestMappers.TestJSONObjectToObjectWithNullInJSONString;
|
||
// var
|
||
// LJSONObject: string;
|
||
// Obj: TMyStreamObject;
|
||
// begin
|
||
// LJSONObject := '{"ImageStream":null}';
|
||
// Obj := Mapper.JSONObjectStringToObject<TMyStreamObject>(LJSONObject);
|
||
// Assert.isNull(Obj.ImageStream);
|
||
// Obj.Free;
|
||
// end;
|
||
//
|
||
// procedure TTestMappers.TestLoadJSONObjectToObjectAndBack;
|
||
// var
|
||
// Obj: TMyObject;
|
||
// JObj: TJSONObject;
|
||
// Obj2: TMyObject;
|
||
// begin
|
||
// Obj := GetMyObject;
|
||
// try
|
||
// JObj := Mapper.ObjectToJSONObject(Obj);
|
||
// try
|
||
// Obj2 := TMyObject.Create;
|
||
// try
|
||
// Mapper.LoadJSONObjectToObject<TMyObject>(JObj, Obj2);
|
||
// Assert.isTrue(Obj.Equals(Obj2));
|
||
// finally
|
||
// Obj2.Free;
|
||
// end;
|
||
// finally
|
||
// JObj.Free;
|
||
// end;
|
||
// finally
|
||
// Obj.Free;
|
||
// end;
|
||
// end;
|
||
//
|
||
// procedure TTestMappers.TestObjectListToJSONArray;
|
||
// var
|
||
// Obj: TMyObject;
|
||
// ObjList, Obj2List: TObjectList<TMyObject>;
|
||
// JSON: TJSONArray;
|
||
// I: Integer;
|
||
// begin
|
||
// ObjList := TObjectList<TMyObject>.Create(true);
|
||
// try
|
||
// for I := 1 to 10 do
|
||
// begin
|
||
// Obj := GetMyObject;
|
||
// Obj.PropInteger := I;
|
||
// ObjList.Add(Obj);
|
||
// end;
|
||
// JSON := Mapper.ObjectListToJSONArray<TMyObject>(ObjList);
|
||
//
|
||
// Obj2List := Mapper.JSONArrayToObjectList<TMyObject>(JSON);
|
||
// try
|
||
// Assert.areEqual(ObjList.Count, Obj2List.Count);
|
||
// for I := 0 to 9 do
|
||
// begin
|
||
// Assert.isTrue(Obj2List[I].Equals(ObjList[I]));
|
||
// end;
|
||
// finally
|
||
// Obj2List.Free;
|
||
// end;
|
||
// finally
|
||
// ObjList.Free;
|
||
// end;
|
||
// end;
|
||
//
|
||
// procedure TTestMappers.TestWrappedListToJSONArray;
|
||
// var
|
||
// Obj: TMyObject;
|
||
// ObjList: TObjectList<TMyObject>;
|
||
// WrapList: IWrappedList;
|
||
// JSON: TJSONArray;
|
||
// I: Integer;
|
||
// LJSONObj: TJSONObject;
|
||
// LMyItem: TMyObject;
|
||
// begin
|
||
// ObjList := TObjectList<TMyObject>.Create(true);
|
||
// try
|
||
// for I := 1 to 10 do
|
||
// begin
|
||
// Obj := GetMyObject;
|
||
// Obj.PropInteger := I;
|
||
// ObjList.Add(Obj);
|
||
// end;
|
||
// WrapList := WrapAsList(ObjList);
|
||
// JSON := Mapper.ObjectListToJSONArray(WrapList);
|
||
// try
|
||
// Assert.areEqual(WrapList.Count, JSON.Count);
|
||
// for I := 0 to 9 do
|
||
// begin
|
||
// LJSONObj := JSON.Items[I] as TJSONObject;
|
||
// LMyItem := WrapList.GetItem(I) as TMyObject;
|
||
// Assert.areEqual(LMyItem.PropInteger, LJSONObj.GetValue<Integer>('PropInteger'));
|
||
// end;
|
||
// finally
|
||
// JSON.Free;
|
||
// end;
|
||
// finally
|
||
// ObjList.Free;
|
||
// end;
|
||
// end;
|
||
//
|
||
// procedure TTestMappers.TestObjectToJSONObject;
|
||
// var
|
||
// Obj: TMyObject;
|
||
// JSON: TJSONObject;
|
||
// Obj2: TMyObject;
|
||
// begin
|
||
// Obj := GetMyObject;
|
||
// try
|
||
// JSON := Mapper.ObjectToJSONObject(Obj);
|
||
// try
|
||
// Obj2 := Mapper.JSONObjectToObject<TMyObject>(JSON);
|
||
// try
|
||
// Assert.isTrue(Obj.Equals(Obj2));
|
||
// finally
|
||
// Obj2.Free;
|
||
// end;
|
||
// finally
|
||
// JSON.Free;
|
||
// end;
|
||
// finally
|
||
// Obj.Free;
|
||
// end;
|
||
// end;
|
||
//
|
||
// procedure TTestMappers.TestObjectToJSONObjectAndBackWithStream;
|
||
// var
|
||
// SO: TMyStreamObject;
|
||
// JSONObj: TJSONObject;
|
||
// ResultSO: TMyStreamObject;
|
||
// begin
|
||
// // ARRANGE
|
||
// SO := TMyStreamObject.Create;
|
||
// try
|
||
// // ACT
|
||
// TMemoryStream(SO.ImageStream)
|
||
// .LoadFromFile('..\..\..\..\..\samples\_\customer.png');
|
||
// JSONObj := Mapper.ObjectToJSONObject(SO);
|
||
// try
|
||
// ResultSO := Mapper.JSONObjectToObject<TMyStreamObject>(JSONObj);
|
||
// try
|
||
// // ASSERT
|
||
// Assert.areEqual(SO.ImageStream.Size, ResultSO.ImageStream.Size);
|
||
// Assert.areEqual(MD5(SO.ImageStream), MD5(ResultSO.ImageStream));
|
||
// finally
|
||
// ResultSO.Free;
|
||
// end;
|
||
// finally
|
||
// JSONObj.Free;
|
||
// end;
|
||
// finally
|
||
// SO.Free;
|
||
// end;
|
||
// end;
|
||
//
|
||
// procedure TTestMappers.TestObjectToJSONObjectAndBackWithStringStreamUTF16;
|
||
// var
|
||
// SO: TMyStreamObject;
|
||
// JSONObj: TJSONObject;
|
||
// ResultSO: TMyStreamObject;
|
||
// ResultStr, str: UnicodeString;
|
||
// begin
|
||
// // ARRANGE
|
||
// str := 'This is a UTF16 String (什么是)';
|
||
// SO := TMyStreamObject.Create;
|
||
// try
|
||
// // ACT
|
||
// SO.PropStream := TStringStream.Create(str, TEncoding.Unicode);
|
||
// JSONObj := Mapper.ObjectToJSONObject(SO);
|
||
// try
|
||
// ResultSO := Mapper.JSONObjectToObject<TMyStreamObject>(JSONObj);
|
||
// try
|
||
// ResultStr := TStringStream(ResultSO.PropStream).DataString;
|
||
// // ASSERT
|
||
// Assert.areEqual(str, ResultStr);
|
||
// finally
|
||
// ResultSO.Free;
|
||
// end;
|
||
// finally
|
||
// JSONObj.Free;
|
||
// end;
|
||
// finally
|
||
// SO.Free;
|
||
// end;
|
||
// end;
|
||
//
|
||
// procedure TTestMappers.TestObjectToJSONObjectAndBackWithStringStreamUTF8;
|
||
// var
|
||
// SO: TMyStreamObject;
|
||
// JSONObj: TJSONObject;
|
||
// ResultSO: TMyStreamObject;
|
||
// ResultStr, str: UTF8String;
|
||
// begin
|
||
// // ARRANGE
|
||
// str := 'This is a UTF8 String (什么是)';
|
||
// SO := TMyStreamObject.Create;
|
||
// try
|
||
// // ACT
|
||
// SO.Prop8Stream := TStringStream.Create(string(str), TEncoding.UTF8);
|
||
// JSONObj := Mapper.ObjectToJSONObject(SO);
|
||
// try
|
||
// ResultSO := Mapper.JSONObjectToObject<TMyStreamObject>(JSONObj);
|
||
// try
|
||
// ResultStr := UTF8String(TStringStream(ResultSO.Prop8Stream).DataString);
|
||
// // ASSERT
|
||
// Assert.areEqual(str, ResultStr);
|
||
// finally
|
||
// ResultSO.Free;
|
||
// end;
|
||
// finally
|
||
// JSONObj.Free;
|
||
// end;
|
||
// finally
|
||
// SO.Free;
|
||
// end;
|
||
// end;
|
||
//
|
||
// procedure TTestMappers.TestObjectToJSONObject_Generics;
|
||
// var
|
||
// lObjList: TObjectList<TMyClass>;
|
||
// lResponse: TResponseWrapper<TMyClass>;
|
||
// LJSONObj: TJSONObject;
|
||
// begin
|
||
// lObjList := TObjectList<TMyClass>.Create();
|
||
// lObjList.Add(TMyClass.Create(1, 'pippo'));
|
||
// lObjList.Add(TMyClass.Create(2, 'pluto'));
|
||
// lResponse := TResponseWrapper<TMyClass>.Create(lObjList.Count, lObjList);
|
||
// try
|
||
// LJSONObj := Mapper.ObjectToJSONObject(lResponse);
|
||
// try
|
||
// CheckNotNull(LJSONObj.GetValue('Items'));
|
||
// Assert.areEqual(2, TJSONArray(LJSONObj.GetValue('Items')).Count);
|
||
// finally
|
||
// LJSONObj.Free;
|
||
// end;
|
||
// finally
|
||
// lResponse.Free;
|
||
// end;
|
||
// end;
|
||
|
||
procedure TTestRouting.TestPathButNoParameters;
|
||
var
|
||
Params: TMVCRequestParamsTable;
|
||
ResponseContentType: string;
|
||
ResponseContentCharset: string;
|
||
begin
|
||
Params := TMVCRequestParamsTable.Create;
|
||
try
|
||
Assert.isTrue(FRouter.ExecuteRouting('/orders', httpGET, 'text/plain', 'text/plain', FControllers, 'text/plain',
|
||
TMVCConstants.DEFAULT_CONTENT_CHARSET, '', Params, ResponseContentType, ResponseContentCharset));
|
||
Assert.areEqual(0, Params.Count);
|
||
Assert.areEqual('TSimpleController', FRouter.ControllerClazz.ClassName);
|
||
Assert.areEqual('Orders', FRouter.MethodToCall.Name);
|
||
Assert.areEqual(TMVCConstants.DEFAULT_CONTENT_CHARSET, ResponseContentCharset);
|
||
finally
|
||
Params.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure TTestRouting.TestPathPrefix;
|
||
var
|
||
lControllers: TObjectList<TMVCControllerDelegate>;
|
||
lMVCActionParamsCache: TMVCStringObjectDictionary<TMVCActionParamCacheItem>;
|
||
lConfig: TMVCConfig;
|
||
lRouter: TMVCRouter;
|
||
lParams: TMVCRequestParamsTable;
|
||
ResponseContentType: string;
|
||
ResponseContentEncoding: string;
|
||
begin
|
||
lControllers := TObjectList<TMVCControllerDelegate>.Create;
|
||
lControllers.Add(TMVCControllerDelegate.Create(TSimpleController, nil));
|
||
lControllers.Add(TMVCControllerDelegate.Create(TNotSoSimpleController, nil));
|
||
lControllers.Add(TMVCControllerDelegate.Create(TTestServerController, nil));
|
||
lMVCActionParamsCache := TMVCStringObjectDictionary<TMVCActionParamCacheItem>.Create;
|
||
lConfig := TMVCConfig.Create;
|
||
lConfig.Value[TMVCConfigKey.PathPrefix] := '';
|
||
lRouter := TMVCRouter.Create(lConfig, FMVCActionParamsCache);
|
||
try
|
||
lParams := TMVCRequestParamsTable.Create;
|
||
try
|
||
Assert.isFalse(lRouter.ExecuteRouting('/api/orders', httpGET, 'text/plain', 'text/plain', FControllers,
|
||
'text/plain', TMVCConstants.DEFAULT_CONTENT_CHARSET, '', lParams, ResponseContentType,
|
||
ResponseContentEncoding));
|
||
|
||
Assert.isTrue(lRouter.ExecuteRouting('/api/orders', httpGET, 'text/plain', 'text/plain', FControllers,
|
||
'text/plain', TMVCConstants.DEFAULT_CONTENT_CHARSET, '/api', lParams, ResponseContentType,
|
||
ResponseContentEncoding));
|
||
Assert.areEqual(0, lParams.Count);
|
||
Assert.areEqual('TSimpleController', lRouter.ControllerClazz.ClassName);
|
||
Assert.areEqual('Orders', lRouter.MethodToCall.Name);
|
||
Assert.areEqual(TMVCConstants.DEFAULT_CONTENT_CHARSET, ResponseContentEncoding);
|
||
finally
|
||
lParams.Free;
|
||
end;
|
||
|
||
finally
|
||
lRouter.Free;
|
||
lControllers.Free;
|
||
lMVCActionParamsCache.Free;
|
||
lConfig.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure TTestRouting.TestPathWithParameters;
|
||
var
|
||
Params: TMVCRequestParamsTable;
|
||
ResponseContentType: string;
|
||
ResponseContentEncoding: string;
|
||
begin
|
||
Params := TMVCRequestParamsTable.Create;
|
||
try
|
||
Assert.isTrue(FRouter.ExecuteRouting('/orders/789', httpGET, 'text/plain', 'text/plain', FControllers, 'text/plain',
|
||
TMVCMediaType.TEXT_PLAIN, '', Params, ResponseContentType, ResponseContentEncoding));
|
||
Assert.areEqual(1, Params.Count);
|
||
Assert.areEqual('789', Params['ordernumber']);
|
||
Assert.areEqual('TSimpleController', FRouter.ControllerClazz.ClassName);
|
||
Assert.areEqual('OrderNumber', FRouter.MethodToCall.Name);
|
||
finally
|
||
Params.Free;
|
||
end;
|
||
|
||
Params := TMVCRequestParamsTable.Create;
|
||
try
|
||
Assert.isTrue(FRouter.ExecuteRouting('/orders/àèéìòù .-_\', httpGET, 'text/plain', 'text/plain', FControllers,
|
||
'text/plain', TMVCMediaType.TEXT_PLAIN, '', Params, ResponseContentType, ResponseContentEncoding));
|
||
Assert.areEqual(1, Params.Count);
|
||
Assert.areEqual('àèéìòù .-_\', Params['ordernumber']);
|
||
Assert.areEqual('TSimpleController', FRouter.ControllerClazz.ClassName);
|
||
Assert.areEqual('OrderNumber', FRouter.MethodToCall.Name);
|
||
finally
|
||
Params.Free;
|
||
end;
|
||
|
||
end;
|
||
|
||
procedure TTestRouting.TestProduceRoutings;
|
||
var
|
||
Params: TMVCRequestParamsTable;
|
||
ResponseContentType: string;
|
||
ResponseContentCharset: string;
|
||
begin
|
||
Params := TMVCRequestParamsTable.Create;
|
||
try
|
||
// a GET request with a ACCEPT: application/json
|
||
Assert.isTrue(FRouter.ExecuteRouting('/orders', httpGET, '', 'application/json', FControllers,
|
||
TMVCConstants.DEFAULT_CONTENT_TYPE, TMVCConstants.DEFAULT_CONTENT_CHARSET, '', Params, ResponseContentType,
|
||
ResponseContentCharset));
|
||
Assert.areEqual(0, Params.Count);
|
||
Assert.areEqual('TSimpleController', FRouter.ControllerClazz.ClassName);
|
||
Assert.areEqual('OrdersProduceJSON', FRouter.MethodToCall.Name);
|
||
Assert.areEqual(TMVCConstants.DEFAULT_CONTENT_CHARSET, ResponseContentCharset);
|
||
finally
|
||
Params.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure TTestRouting.TestProduceRoutingsWithExplicitCharset;
|
||
var
|
||
Params: TMVCRequestParamsTable;
|
||
ResponseContentType: string;
|
||
ResponseContentCharset: string;
|
||
begin
|
||
Params := TMVCRequestParamsTable.Create;
|
||
try
|
||
// a GET request with a ACCEPT: application/json
|
||
Assert.isTrue(FRouter.ExecuteRouting('/orders', httpGET, '', 'application/json; charset=UTF-8', FControllers,
|
||
TMVCConstants.DEFAULT_CONTENT_TYPE, TMVCConstants.DEFAULT_CONTENT_CHARSET, '', Params, ResponseContentType,
|
||
ResponseContentCharset));
|
||
Assert.areEqual(0, Params.Count);
|
||
Assert.areEqual('TSimpleController', FRouter.ControllerClazz.ClassName);
|
||
Assert.areEqual('OrdersProduceJSON', FRouter.MethodToCall.Name);
|
||
Assert.areEqual(TMVCConstants.DEFAULT_CONTENT_CHARSET, ResponseContentCharset);
|
||
finally
|
||
Params.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure TTestRouting.TestReservedIPs;
|
||
var
|
||
I: Integer;
|
||
begin
|
||
// this test just tests the IP2Long implementation
|
||
for I := low(RESERVED_IPv4) to high(RESERVED_IPv4) do
|
||
begin
|
||
Assert.areEqual(IPv4ToUInt32(RESERVED_IPv4[I][1]), IP2Long(RESERVED_IPv4[I][1]));
|
||
Assert.areEqual(IPv4ToUInt32(RESERVED_IPv4[I][2]), IP2Long(RESERVED_IPv4[I][2]));
|
||
end;
|
||
end;
|
||
|
||
{ Use this test only if you want to test the speed of the router }
|
||
// procedure TTestRouting.TestRoutingSpeed;
|
||
// var
|
||
// Params: TMVCRequestParamsTable;
|
||
// ResponseContentType: string;
|
||
// ResponseContentEncoding: string;
|
||
// I: Integer;
|
||
// lSW: TStopwatch;
|
||
// begin
|
||
// // procedure TestTypedActionBooleans(bool1, bool2, bool3, bool4: Boolean);
|
||
// Params := TMVCRequestParamsTable.Create;
|
||
// try
|
||
// lSW := TStopWatch.Create;
|
||
// lSW.Start;
|
||
// for I := 1 to 1000 do
|
||
// begin
|
||
// Params.Clear;
|
||
// Router.ExecuteRouting(
|
||
// '/typed/booleans/true/false/true/false',
|
||
// httpGET,
|
||
// TMVCMediaType.APPLICATION_JSON,
|
||
// TMVCMediaType.APPLICATION_JSON,
|
||
// Controllers,
|
||
// TMVCMediaType.APPLICATION_JSON,
|
||
// TMVCMediaType.APPLICATION_JSON,
|
||
// Params,
|
||
// ResponseContentType, ResponseContentEncoding);
|
||
// end;
|
||
// Assert.isTrue(false, lSW.ElapsedMilliseconds.ToString);
|
||
// finally
|
||
// Params.Free;
|
||
// end;
|
||
//
|
||
// end;
|
||
|
||
// procedure TTestMappers.TestSerializeUsingFields;
|
||
// var
|
||
// lObj: TMyObjectWithLogic;
|
||
// lJObj: TJSONObject;
|
||
// lObj2: TObject;
|
||
// begin
|
||
// lObj := TMyObjectWithLogic.Create('Daniele', 'Teti', 35);
|
||
// try
|
||
// lJObj := Mapper.ObjectToJSONObjectFields(lObj, []);
|
||
// try
|
||
// Assert.areEqual(4, lJObj.Count); // 3 properties + $dmvc.classname
|
||
// CheckNotNull(lJObj.Get('FFirstName'));
|
||
// CheckNotNull(lJObj.Get('FLastName'));
|
||
// CheckNotNull(lJObj.Get('FAge'));
|
||
// lObj2 := Mapper.JSONObjectFieldsToObject(lJObj);
|
||
// try
|
||
// CheckIs(lObj2, TMyObjectWithLogic,
|
||
// 'wrong classtype for deserialized object');
|
||
// Assert.isTrue(lObj.Equals(lObj2),
|
||
// 'restored object is different from the original');
|
||
// finally
|
||
// lObj2.Free;
|
||
// end;
|
||
// finally
|
||
// lJObj.Free;
|
||
// end;
|
||
// finally
|
||
// lObj.Free;
|
||
// end;
|
||
// end;
|
||
//
|
||
// procedure TTestMappers.TestSerializeUsingFieldsComplexObject;
|
||
// var
|
||
// lJObj: TJSONObject;
|
||
// lObj2: TObject;
|
||
// lObj: TMyComplexObject;
|
||
// begin
|
||
// lObj := GetMyComplexObject;
|
||
// try
|
||
// lJObj := Mapper.ObjectToJSONObjectFields(lObj, []);
|
||
// try
|
||
// Assert.areEqual(5, lJObj.Count); // 4 properties + $dmvc.classname
|
||
// CheckNotNull(lJObj.Get('FProp1'));
|
||
// CheckNotNull(lJObj.Get('FChildObjectList'));
|
||
// CheckNotNull(lJObj.Get('FChildObject'));
|
||
// lObj2 := Mapper.JSONObjectFieldsToObject(lJObj);
|
||
// try
|
||
// CheckIs(lObj2, TMyComplexObject,
|
||
// 'wrong classtype for deserialized object');
|
||
// Assert.isTrue(lObj.Equals(lObj2),
|
||
// 'restored object is different from the original');
|
||
// finally
|
||
// lObj2.Free;
|
||
// end;
|
||
// finally
|
||
// lJObj.Free;
|
||
// end;
|
||
// finally
|
||
// lObj.Free;
|
||
// end;
|
||
// end;
|
||
//
|
||
// procedure TTestMappers.TestSerializeUsingFieldsComplexObject2;
|
||
// var
|
||
// lJObj: TJSONObject;
|
||
// lObj2: TObject;
|
||
// lObj: TMyComplexObject;
|
||
// begin
|
||
// lObj := GetMyComplexObjectWithNotInitializedChilds;
|
||
// try
|
||
// lJObj := Mapper.ObjectToJSONObjectFields(lObj, []);
|
||
// try
|
||
// Assert.areEqual(5, lJObj.Count); // 4 properties + $dmvc.classname
|
||
// CheckNotNull(lJObj.Get('FProp1'));
|
||
// CheckNotNull(lJObj.Get('FChildObjectList'));
|
||
// CheckNotNull(lJObj.Get('FChildObject'));
|
||
// lObj2 := Mapper.JSONObjectFieldsToObject(lJObj);
|
||
// try
|
||
// CheckIs(lObj2, TMyComplexObject,
|
||
// 'wrong classtype for deserialized object');
|
||
// Assert.isTrue(lObj.Equals(lObj2),
|
||
// 'restored object is different from the original');
|
||
// finally
|
||
// lObj2.Free;
|
||
// end;
|
||
// finally
|
||
// lJObj.Free;
|
||
// end;
|
||
// finally
|
||
// lObj.Free;
|
||
// end;
|
||
// end;
|
||
//
|
||
// procedure TTestMappers.
|
||
// TestSerializeUsingFieldsWithNotExixtentPropetyInJSONObject;
|
||
// var
|
||
// lObj: TMyObjectWithLogic;
|
||
// lJObj: TJSONObject;
|
||
// lObj2: TMyObjectWithLogic;
|
||
// begin
|
||
// lObj := TMyObjectWithLogic.Create('Daniele', 'Teti', 35);
|
||
// try
|
||
// lJObj := Mapper.ObjectToJSONObjectFields(lObj, []);
|
||
// try
|
||
// lJObj.RemovePair('FFirstName').Free;
|
||
// lObj2 := Mapper.JSONObjectFieldsToObject(lJObj) as TMyObjectWithLogic;
|
||
// try
|
||
// Assert.areEqual('', lObj2.FirstName);
|
||
// finally
|
||
// lObj2.Free;
|
||
// end;
|
||
// finally
|
||
// lJObj.Free;
|
||
// end;
|
||
// finally
|
||
// lObj.Free;
|
||
// end;
|
||
// end;
|
||
//
|
||
// procedure TTestMappers.TestSerializeUsingProperties;
|
||
// var
|
||
// lObj: TMyObjectWithLogic;
|
||
// lJObj: TJSONObject;
|
||
// lObj2: TMyObjectWithLogic;
|
||
// begin
|
||
// lObj := TMyObjectWithLogic.Create('Daniele', 'Teti', 35);
|
||
// try
|
||
// lJObj := Mapper.ObjectToJSONObject(lObj, []);
|
||
// try
|
||
// Assert.areEqual(5, lJObj.Count); // 5 properties
|
||
// CheckNotNull(lJObj.Get('FirstName'));
|
||
// CheckNotNull(lJObj.Get('LastName'));
|
||
// CheckNotNull(lJObj.Get('Age'));
|
||
// CheckNotNull(lJObj.Get('FullName'));
|
||
// CheckNotNull(lJObj.Get('IsAdult'));
|
||
// lObj2 := Mapper.JSONObjectToObject<TMyObjectWithLogic>(lJObj);
|
||
// try
|
||
// Assert.isTrue(lObj2.Equals(lObj),
|
||
// 'deserialized object is not equals to the original object');
|
||
// finally
|
||
// lObj2.Free;
|
||
// end;
|
||
// finally
|
||
// lJObj.Free;
|
||
// end;
|
||
// finally
|
||
// lObj.Free;
|
||
// end;
|
||
// end;
|
||
|
||
procedure TTestRouting.TestWithMethodTypes;
|
||
var
|
||
Params: TMVCRequestParamsTable;
|
||
ResponseContentType: string;
|
||
ResponseContentEncoding: string;
|
||
begin
|
||
Params := TMVCRequestParamsTable.Create;
|
||
try
|
||
Assert.isTrue(FRouter.ExecuteRouting('/orders/789', httpPOST, 'text/plain', 'text/plain', FControllers,
|
||
'text/plain', TMVCMediaType.TEXT_PLAIN, '', Params, ResponseContentType, ResponseContentEncoding));
|
||
Assert.areEqual('UpdateOrderNumber', FRouter.MethodToCall.Name);
|
||
|
||
Params.Clear;
|
||
Assert.isTrue(FRouter.ExecuteRouting('/orders/789', httpPUT, 'text/plain', 'text/plain', FControllers, 'text/plain',
|
||
TMVCMediaType.TEXT_PLAIN, '', Params, ResponseContentType, ResponseContentEncoding));
|
||
Assert.areEqual('UpdateOrderNumber', FRouter.MethodToCall.Name);
|
||
|
||
Params.Clear;
|
||
Assert.isTrue(FRouter.ExecuteRouting('/orders/789', httpPATCH, 'text/plain', 'text/plain', FControllers,
|
||
'text/plain', TMVCMediaType.TEXT_PLAIN, '', Params, ResponseContentType, ResponseContentEncoding));
|
||
Assert.areEqual('PatchOrder', FRouter.MethodToCall.Name);
|
||
|
||
Params.Clear;
|
||
Assert.isFalse(FRouter.ExecuteRouting('/orders/789', httpDELETE, 'text/plain', 'text/plain', FControllers,
|
||
'text/plain', TMVCMediaType.TEXT_PLAIN, '', Params, ResponseContentType, ResponseContentEncoding));
|
||
Assert.isNull(FRouter.MethodToCall);
|
||
Assert.isFalse(Assigned(FRouter.ControllerClazz));
|
||
|
||
Params.Clear;
|
||
Assert.isFalse(FRouter.ExecuteRouting('/orders/789', httpHEAD, 'text/plain', 'text/plain', FControllers,
|
||
'text/plain', TMVCMediaType.TEXT_PLAIN, '', Params, ResponseContentType, ResponseContentEncoding),
|
||
'Resolved as HEAD');
|
||
Assert.isNull(FRouter.MethodToCall, 'Resolved as HEAD');
|
||
Assert.isFalse(Assigned(FRouter.ControllerClazz));
|
||
|
||
Params.Clear;
|
||
Assert.isFalse(FRouter.ExecuteRouting('/orders/789', httpOPTIONS, 'text/plain', 'text/plain', FControllers,
|
||
'text/plain', TMVCMediaType.TEXT_PLAIN, '', Params, ResponseContentType, ResponseContentEncoding),
|
||
'Resolved as OPTIONS');
|
||
Assert.isNull(FRouter.MethodToCall, 'Resolved as OPTIONS');
|
||
Assert.isFalse(Assigned(FRouter.ControllerClazz));
|
||
|
||
Params.Clear;
|
||
Assert.isTrue(FRouter.ExecuteRouting('/orders/789', httpGET, 'text/plain', 'text/plain', FControllers, 'text/plain',
|
||
TMVCMediaType.TEXT_PLAIN, '', Params, ResponseContentType, ResponseContentEncoding));
|
||
Assert.areEqual('OrderNumber', FRouter.MethodToCall.Name);
|
||
|
||
Params.Clear;
|
||
Assert.isTrue(FRouter.ExecuteRouting('/orders/789', httpGET, 'text/plain', 'text/plain', FControllers, 'text/plain',
|
||
TMVCMediaType.TEXT_PLAIN, '', Params, ResponseContentType, ResponseContentEncoding));
|
||
Assert.areEqual('OrderNumber', FRouter.MethodToCall.Name);
|
||
finally
|
||
Params.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure TTestRouting.TestWithNoParameters;
|
||
var
|
||
Params: TMVCRequestParamsTable;
|
||
ResponseContentType: string;
|
||
ResponseContentEncoding: string;
|
||
begin
|
||
Params := TMVCRequestParamsTable.Create;
|
||
try
|
||
Assert.isTrue(FRouter.ExecuteRouting('/', httpGET, 'text/plain', 'text/plain', FControllers, 'text/plain',
|
||
TMVCMediaType.TEXT_PLAIN, '', Params, ResponseContentType, ResponseContentEncoding));
|
||
Assert.areEqual(0, Params.Count);
|
||
Assert.areEqual('TSimpleController', FRouter.ControllerClazz.ClassName);
|
||
Assert.areEqual('Index', FRouter.MethodToCall.Name);
|
||
finally
|
||
Params.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure TTestRouting.TestWithNoPath;
|
||
var
|
||
Params: TMVCRequestParamsTable;
|
||
ResponseContentType: string;
|
||
ResponseContentEncoding: string;
|
||
begin
|
||
Params := TMVCRequestParamsTable.Create;
|
||
try
|
||
Assert.isTrue(FRouter.ExecuteRouting('', httpGET, 'text/plain', 'text/plain', FControllers, 'text/plain',
|
||
TMVCMediaType.TEXT_PLAIN, '', Params, ResponseContentType, ResponseContentEncoding));
|
||
Assert.areEqual(0, Params.Count);
|
||
Assert.areEqual('TSimpleController', FRouter.ControllerClazz.ClassName);
|
||
Assert.areEqual('Index', FRouter.MethodToCall.Name);
|
||
finally
|
||
Params.Free;
|
||
end;
|
||
end;
|
||
|
||
{ TTestJWT }
|
||
|
||
procedure TTestJWT.SetUp;
|
||
begin
|
||
inherited;
|
||
FJWT := TJWT.Create(JWT_SECRET_KEY_TEST);
|
||
end;
|
||
|
||
procedure TTestJWT.TearDown;
|
||
begin
|
||
FJWT.Free;
|
||
inherited;
|
||
end;
|
||
|
||
procedure TTestJWT.TestCreateAndValidateToken;
|
||
var
|
||
lToken: string;
|
||
lError: string;
|
||
begin
|
||
FJWT.Claims.Issuer := 'bit Time Professionals';
|
||
FJWT.Claims.Subject := 'DelphiMVCFramework';
|
||
FJWT.Claims.JWT_ID := TGUID.NewGuid.ToString;
|
||
FJWT.CustomClaims['username'] := 'dteti';
|
||
FJWT.CustomClaims['userrole'] := 'admin';
|
||
FJWT.Claims.ExpirationTime := Tomorrow;
|
||
FJWT.Claims.IssuedAt := Yesterday;
|
||
FJWT.Claims.NotBefore := Yesterday;
|
||
lToken := FJWT.GetToken;
|
||
// TFile.WriteAllText('jwt_token.dat', lToken);
|
||
|
||
Assert.isTrue(FJWT.LoadToken(lToken, lError), 'Generated token is not valid');
|
||
end;
|
||
|
||
procedure TTestJWT.TestDefaults;
|
||
begin
|
||
Assert.areEqual('HS512', FJWT.HMACAlgorithm, 'Default algorithm should be HS512');
|
||
Assert.areEqual(300, FJWT.LeewaySeconds, 'Default leeway should be 5 minutes');
|
||
if FJWT.RegClaimsToChecks * [TJWTCheckableClaim.ExpirationTime, TJWTCheckableClaim.NotBefore,
|
||
TJWTCheckableClaim.IssuedAt] <> [TJWTCheckableClaim.ExpirationTime, TJWTCheckableClaim.NotBefore,
|
||
TJWTCheckableClaim.IssuedAt] then
|
||
Assert.Fail('Default RegClaimsToCheck not correct');
|
||
end;
|
||
|
||
procedure TTestJWT.TestExpirationTime;
|
||
var
|
||
lToken: string;
|
||
lError: string;
|
||
begin
|
||
FJWT.RegClaimsToChecks := [TJWTCheckableClaim.ExpirationTime];
|
||
FJWT.Claims.ExpirationTime := Tomorrow;
|
||
lToken := FJWT.GetToken;
|
||
Assert.isTrue(FJWT.LoadToken(lToken, lError), 'Valid token is considered expired');
|
||
|
||
FJWT.Claims.ExpirationTime := Yesterday;
|
||
lToken := FJWT.GetToken;
|
||
Assert.isFalse(FJWT.LoadToken(lToken, lError), 'Expired token is considered valid');
|
||
|
||
FJWT.Claims.ExpirationTime := Now;
|
||
lToken := FJWT.GetToken;
|
||
Assert.isTrue(FJWT.LoadToken(lToken, lError), 'Valid token is considered expired');
|
||
|
||
FJWT.Claims.ExpirationTime := Now - (FJWT.LeewaySeconds + 1) * OneSecond;
|
||
lToken := FJWT.GetToken;
|
||
Assert.isFalse(FJWT.LoadToken(lToken, lError), 'Expired token is considered valid');
|
||
end;
|
||
|
||
procedure TTestJWT.TestHMAC;
|
||
var
|
||
lAlg: string;
|
||
lValue: string;
|
||
I: Integer;
|
||
begin
|
||
for I := low(HMAC_ALG_AND_RESULTS) to high(HMAC_ALG_AND_RESULTS) do
|
||
begin
|
||
lAlg := HMAC_ALG_AND_RESULTS[I][0];
|
||
lValue := HMAC_ALG_AND_RESULTS[I][1];
|
||
Assert.areEqual(lValue, BytesToHex(HMAC(lAlg, 'Daniele Teti', 'daniele')), 'HMAC ' + lAlg + ' fails');
|
||
end;
|
||
end;
|
||
|
||
procedure TTestJWT.TestIssuedAt;
|
||
var
|
||
lToken: string;
|
||
lError: string;
|
||
begin
|
||
FJWT.RegClaimsToChecks := [TJWTCheckableClaim.IssuedAt];
|
||
FJWT.Claims.IssuedAt := Yesterday;
|
||
lToken := FJWT.GetToken;
|
||
Assert.isTrue(FJWT.LoadToken(lToken, lError), 'Valid token is considered not valid');
|
||
|
||
FJWT.Claims.IssuedAt := Tomorrow;
|
||
lToken := FJWT.GetToken;
|
||
Assert.isFalse(FJWT.LoadToken(lToken, lError), 'Still-not-valid token is considered valid');
|
||
|
||
FJWT.Claims.IssuedAt := Now;
|
||
lToken := FJWT.GetToken;
|
||
Assert.isTrue(FJWT.LoadToken(lToken, lError), 'Valid token is considered not valid');
|
||
|
||
FJWT.Claims.IssuedAt := Now + (FJWT.LeewaySeconds + 1) * OneSecond;
|
||
lToken := FJWT.GetToken;
|
||
Assert.isFalse(FJWT.LoadToken(lToken, lError), 'Still-not-valid token is considered valid');
|
||
end;
|
||
|
||
procedure TTestJWT.TestLoadToken;
|
||
var
|
||
lToken: string;
|
||
lJWT: TJWT;
|
||
lError: string;
|
||
lExp: TDateTime;
|
||
begin
|
||
lExp := Now + OneHour * 2;
|
||
FJWT.Claims.Issuer := 'bit Time Professionals';
|
||
FJWT.Claims.Subject := 'DelphiMVCFramework';
|
||
FJWT.Claims.Audience := 'DelphiDevelopers';
|
||
FJWT.Claims.IssuedAt := EncodeDateTime(2011, 11, 17, 17, 30, 0, 0);
|
||
FJWT.Claims.ExpirationTime := lExp;
|
||
FJWT.Claims.NotBefore := EncodeDateTime(2011, 11, 17, 17, 30, 0, 0);
|
||
FJWT.Claims.JWT_ID := '123456';
|
||
FJWT.CustomClaims['username'] := 'dteti';
|
||
FJWT.CustomClaims['userrole'] := 'admin';
|
||
|
||
lToken := FJWT.GetToken;
|
||
// TFile.WriteAllText('jwt_token_full.dat', lToken);
|
||
|
||
lJWT := TJWT.Create(JWT_SECRET_KEY_TEST);
|
||
try
|
||
lJWT.LoadToken(lToken, lError);
|
||
Assert.areEqual('bit Time Professionals', lJWT.Claims.Issuer);
|
||
Assert.areEqual('DelphiMVCFramework', lJWT.Claims.Subject);
|
||
Assert.areEqual('DelphiDevelopers', lJWT.Claims.Audience);
|
||
Assert.areEqual('123456', lJWT.Claims.JWT_ID);
|
||
Assert.areEqual(EncodeDateTime(2011, 11, 17, 17, 30, 0, 0), lJWT.Claims.IssuedAt);
|
||
Assert.areEqual(Roundto(lExp, 4), Roundto(lJWT.Claims.ExpirationTime, 4));
|
||
Assert.areEqual(EncodeDateTime(2011, 11, 17, 17, 30, 0, 0), lJWT.Claims.NotBefore);
|
||
Assert.areEqual('dteti', lJWT.CustomClaims['username']);
|
||
Assert.areEqual('admin', lJWT.CustomClaims['userrole']);
|
||
finally
|
||
lJWT.Free;
|
||
end;
|
||
|
||
end;
|
||
|
||
procedure TTestJWT.TestNotBefore;
|
||
var
|
||
lToken: string;
|
||
lError: string;
|
||
begin
|
||
FJWT.RegClaimsToChecks := [TJWTCheckableClaim.NotBefore];
|
||
FJWT.Claims.NotBefore := Yesterday;
|
||
lToken := FJWT.GetToken;
|
||
Assert.isTrue(FJWT.LoadToken(lToken, lError), 'Valid token is considered not valid');
|
||
|
||
FJWT.Claims.NotBefore := Tomorrow;
|
||
lToken := FJWT.GetToken;
|
||
Assert.isFalse(FJWT.LoadToken(lToken, lError),
|
||
'Still-not-valid token is considered valid (near midnight is ok... fix this test) ');
|
||
|
||
FJWT.Claims.NotBefore := Now;
|
||
lToken := FJWT.GetToken;
|
||
Assert.isTrue(FJWT.LoadToken(lToken, lError), 'Valid token is considered not valid');
|
||
|
||
FJWT.Claims.NotBefore := Now + (FJWT.LeewaySeconds + 1) * OneSecond;
|
||
lToken := FJWT.GetToken;
|
||
Assert.isFalse(FJWT.LoadToken(lToken, lError), 'Still-not-valid token is considered valid');
|
||
end;
|
||
|
||
procedure TTestJWT.TestStorage;
|
||
begin
|
||
FJWT.Claims.Issuer := 'bit Time Professionals';
|
||
FJWT.Claims.Subject := 'DelphiMVCFramework';
|
||
FJWT.Claims.Audience := 'DelphiDevelopers';
|
||
FJWT.Claims.IssuedAt := EncodeDateTime(2011, 11, 17, 17, 30, 0, 0);
|
||
FJWT.Claims.ExpirationTime := FJWT.Claims.IssuedAt + OneHour * 2;
|
||
FJWT.Claims.NotBefore := EncodeDateTime(2011, 11, 17, 17, 30, 0, 0);
|
||
FJWT.Claims.JWT_ID := '123456';
|
||
FJWT.CustomClaims['username'] := 'dteti';
|
||
FJWT.CustomClaims['userrole'] := 'admin';
|
||
|
||
Assert.areEqual('bit Time Professionals', FJWT.Claims.Issuer);
|
||
Assert.areEqual('DelphiMVCFramework', FJWT.Claims.Subject);
|
||
Assert.areEqual('DelphiDevelopers', FJWT.Claims.Audience);
|
||
Assert.areEqual('123456', FJWT.Claims.JWT_ID);
|
||
Assert.areEqual(EncodeDateTime(2011, 11, 17, 17, 30, 0, 0), FJWT.Claims.IssuedAt);
|
||
Assert.areEqual(Roundto(FJWT.Claims.IssuedAt + OneHour * 2, 4), Roundto(FJWT.Claims.ExpirationTime, 4));
|
||
Assert.areEqual(EncodeDateTime(2011, 11, 17, 17, 30, 0, 0), FJWT.Claims.NotBefore);
|
||
|
||
Assert.areEqual('dteti', FJWT.CustomClaims['username']);
|
||
Assert.areEqual('admin', FJWT.CustomClaims['userrole']);
|
||
|
||
end;
|
||
|
||
{ TMVCSerUnSerTestCase }
|
||
|
||
function TMVCSerUnSerTestCase.GetObjectsList: TObjectList<TMyObject>;
|
||
var
|
||
I: Integer;
|
||
begin
|
||
Result := TObjectList<TMyObject>.Create(true);
|
||
for I := 1 to 10 do
|
||
begin
|
||
Result.Add(GetMyObject);
|
||
Result.Last.PropInteger := I;
|
||
end;
|
||
end;
|
||
|
||
function TMVCSerUnSerTestCase.GetObjectsWithTValueList: TObjectList<TMyObjectWithTValue>;
|
||
var
|
||
I: Integer;
|
||
begin
|
||
Result := TObjectList<TMyObjectWithTValue>.Create(true);
|
||
for I := 1 to 10 do
|
||
begin
|
||
Result.Add(GetMyObjectWithTValue);
|
||
end;
|
||
end;
|
||
|
||
function TMVCSerUnSerTestCase.GetObjectsWithStreamsList: TObjectList<TMyStreamObject>;
|
||
var
|
||
I: Integer;
|
||
begin
|
||
Result := TObjectList<TMyStreamObject>.Create(true);
|
||
for I := 1 to 10 do
|
||
begin
|
||
Result.Add(GetMyObjectWithStream);
|
||
end;
|
||
end;
|
||
|
||
procedure TMVCSerUnSerTestCase.SetSerializer(const ASerializer: IMVCSerializer);
|
||
begin
|
||
FSerializer := ASerializer;
|
||
end;
|
||
|
||
procedure TMVCSerUnSerTestCase.SetUp;
|
||
begin
|
||
raise Exception.Create('You should override this to use a specific MVCSerUnSer');
|
||
end;
|
||
|
||
{ TTestMultiMap }
|
||
|
||
procedure TTestMultiMap.SetUp;
|
||
begin
|
||
inherited;
|
||
|
||
end;
|
||
|
||
procedure TTestMultiMap.TearDown;
|
||
begin
|
||
inherited;
|
||
|
||
end;
|
||
|
||
procedure TTestMultiMap.TestInterfaceMultiMapAdd;
|
||
var
|
||
lMultiMap: IMVCInterfaceMultiMap<IMyInterface>;
|
||
begin
|
||
lMultiMap := TMVCInterfaceMultiMap<IMyInterface>.Create;
|
||
Assert.AreEqual<Integer>(0, Length(lMultiMap.Keys));
|
||
lMultiMap.Clear;
|
||
Assert.isFalse(lMultiMap.Contains('key1'));
|
||
lMultiMap.Add('key1', TMyIntfObject.Create(1, 'value1'));
|
||
Assert.isTrue(lMultiMap.Contains('key1'));
|
||
Assert.areEqual(1, lMultiMap.GetItems('key1').Count);
|
||
lMultiMap.Add('key1', TMyIntfObject.Create(2, 'value2'));
|
||
Assert.areEqual(2, lMultiMap.GetItems('key1').Count);
|
||
Assert.areEqual('value1', lMultiMap.GetItems('key1')[0].GetDescription);
|
||
Assert.areEqual('value2', lMultiMap.GetItems('key1')[1].GetDescription);
|
||
lMultiMap.Add('key2', TMyIntfObject.Create(1, 'value3'));
|
||
Assert.areEqual(2, lMultiMap.GetItems('key1').Count);
|
||
Assert.areEqual(1, lMultiMap.GetItems('key2').Count);
|
||
end;
|
||
|
||
procedure TTestMultiMap.TestInterfaceMultiMapRemove;
|
||
var
|
||
lMultiMap: IMVCInterfaceMultiMap<IMyInterface>;
|
||
begin
|
||
lMultiMap := TMVCInterfaceMultiMap<IMyInterface>.Create;
|
||
lMultiMap.Remove('not valid');
|
||
lMultiMap.Add('key1', TMyIntfObject.Create(1, 'value1'));
|
||
lMultiMap.Add('key1', TMyIntfObject.Create(2, 'value2'));
|
||
Assert.areEqual(2, lMultiMap.GetItems('key1').Count);
|
||
Assert.isTrue(lMultiMap.Contains('key1'));
|
||
lMultiMap.Remove('key1');
|
||
Assert.isFalse(lMultiMap.Contains('key1'));
|
||
end;
|
||
|
||
procedure TTestMultiMap.TestObjectMultiMapAdd;
|
||
var
|
||
lMultiMap: IMVCObjectMultiMap<TMyClass>;
|
||
begin
|
||
lMultiMap := TMVCObjectMultiMap<TMyClass>.Create;
|
||
Assert.AreEqual<Integer>(0, Length(lMultiMap.Keys));
|
||
lMultiMap.Clear;
|
||
Assert.isFalse(lMultiMap.Contains('key1'));
|
||
lMultiMap.Add('key1', TMyClass.Create(1, 'value1'));
|
||
Assert.isTrue(lMultiMap.Contains('key1'));
|
||
Assert.areEqual(1, lMultiMap.GetItems('key1').Count);
|
||
lMultiMap.Add('key1', TMyClass.Create(2, 'value2'));
|
||
Assert.areEqual(2, lMultiMap.GetItems('key1').Count);
|
||
Assert.areEqual('value1', lMultiMap.GetItems('key1')[0].Description);
|
||
Assert.areEqual('value2', lMultiMap.GetItems('key1')[1].Description);
|
||
lMultiMap.Add('key2', TMyClass.Create(1, 'value3'));
|
||
Assert.areEqual(2, lMultiMap.GetItems('key1').Count);
|
||
Assert.areEqual(1, lMultiMap.GetItems('key2').Count);
|
||
end;
|
||
|
||
procedure TTestMultiMap.TestObjectMultiMapRemove;
|
||
var
|
||
lMultiMap: IMVCObjectMultiMap<TMyClass>;
|
||
begin
|
||
lMultiMap := TMVCObjectMultiMap<TMyClass>.Create;
|
||
lMultiMap.Remove('not valid');
|
||
lMultiMap.Add('key1', TMyClass.Create(1, 'value1'));
|
||
lMultiMap.Add('key1', TMyClass.Create(2, 'value2'));
|
||
Assert.areEqual(2, lMultiMap.GetItems('key1').Count);
|
||
Assert.isTrue(lMultiMap.Contains('key1'));
|
||
lMultiMap.Remove('key1');
|
||
Assert.isFalse(lMultiMap.Contains('key1'));
|
||
end;
|
||
|
||
{ TTestNameCase }
|
||
|
||
procedure TTestNameCase.SetupFixture;
|
||
begin
|
||
fOrigDATA[1] := 'one_two_3or4';
|
||
fOrigDATA[2] := 'ONE_TWO_THREE';
|
||
fOrigDATA[3] := 'JustOne';
|
||
fOrigDATA[4] := '_with__underscores_';
|
||
fOrigDATA[5] := 'oneTwo___three04';
|
||
|
||
fOutDATA[1][ncAsIs] := fOrigDATA[1];
|
||
fOutDATA[2][ncAsIs] := fOrigDATA[2];
|
||
fOutDATA[3][ncAsIs] := fOrigDATA[3];
|
||
fOutDATA[4][ncAsIs] := fOrigDATA[4];
|
||
fOutDATA[5][ncAsIs] := fOrigDATA[5];
|
||
|
||
fOutDATA[1][ncUpperCase] := 'ONE_TWO_3OR4';
|
||
fOutDATA[2][ncUpperCase] := 'ONE_TWO_THREE';
|
||
fOutDATA[3][ncUpperCase] := 'JUSTONE';
|
||
fOutDATA[4][ncUpperCase] := '_WITH__UNDERSCORES_';
|
||
fOutDATA[5][ncUpperCase] := 'ONETWO___THREE04';
|
||
|
||
fOutDATA[1][ncLowerCase] := 'one_two_3or4';
|
||
fOutDATA[2][ncLowerCase] := 'one_two_three';
|
||
fOutDATA[3][ncLowerCase] := 'justone';
|
||
fOutDATA[4][ncLowerCase] := '_with__underscores_';
|
||
fOutDATA[5][ncLowerCase] := 'onetwo___three04';
|
||
|
||
fOutDATA[1][ncCamelCase] := 'oneTwo3Or4';
|
||
fOutDATA[2][ncCamelCase] := 'oneTwoThree';
|
||
fOutDATA[3][ncCamelCase] := 'justOne';
|
||
fOutDATA[4][ncCamelCase] := 'WithUnderscores';
|
||
fOutDATA[5][ncCamelCase] := 'oneTwoThree04';
|
||
|
||
fOutDATA[1][ncPascalCase] := 'OneTwo3Or4';
|
||
fOutDATA[2][ncPascalCase] := 'OneTwoThree';
|
||
fOutDATA[3][ncPascalCase] := 'JustOne';
|
||
fOutDATA[4][ncPascalCase] := 'WithUnderscores';
|
||
fOutDATA[5][ncPascalCase] := 'OneTwoThree04';
|
||
|
||
fOutDATA[1][ncSnakeCase] := 'one_two_3_or_4';
|
||
fOutDATA[2][ncSnakeCase] := 'one_two_three';
|
||
fOutDATA[3][ncSnakeCase] := 'just_one';
|
||
fOutDATA[4][ncSnakeCase] := '_with_underscores_';
|
||
fOutDATA[5][ncSnakeCase] := 'one_two_three_04';
|
||
|
||
end;
|
||
|
||
procedure TTestNameCase.TestNameCase;
|
||
var
|
||
I: Integer;
|
||
lNameCaseIdx: TMVCNameCase;
|
||
lOrig: string;
|
||
lOutData: string;
|
||
lActualOutData: string;
|
||
begin
|
||
for lNameCaseIdx := ncAsIs to ncSnakeCase do
|
||
begin
|
||
for I := 1 to 5 do
|
||
begin
|
||
lOrig := fOrigDATA[I];
|
||
lOutData := fOutDATA[I][lNameCaseIdx];
|
||
lActualOutData := TMVCSerializerHelper.ApplyNameCase(lNameCaseIdx, lOrig);
|
||
Assert.areEqual(lOutData, lActualOutData, False, lOrig + ' for ' + GetEnumName(TypeInfo(TMVCNameCase),
|
||
Ord(lNameCaseIdx)));
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TTestNameCase.TestSnakeCase(const AValue1, AValue2: string);
|
||
begin
|
||
Assert.areEqual(AValue2, SnakeCase(AValue1));
|
||
end;
|
||
|
||
{ TTestCryptUtils }
|
||
|
||
procedure TTestCryptUtils.SetupFixture;
|
||
begin
|
||
MVCCryptInit;
|
||
end;
|
||
|
||
procedure TTestCryptUtils.TestPBKDF2_SHA1;
|
||
var
|
||
P: TBytes;
|
||
S: TBytes;
|
||
K: TBytes;
|
||
begin
|
||
// https://www.freecodeformat.com/pbkdf2.php
|
||
P := TBytes.Create($70, $61, $73, $73, $77, $6F, $72, $64);
|
||
S := TBytes.Create($78, $57, $8E, $5A, $5D, $63, $CB, $06);
|
||
|
||
K := PBKDF2(P, S, 2048, 24);
|
||
Assert.areEqual('BFDE6BE94DF7E11DD409BCE20A0255EC327CB936FFE93643', BytesToHexString(K));
|
||
|
||
P := TBytes.Create($70, $61, $73, $73, $77, $6F, $72, $64);
|
||
S := TBytes.Create($73, $61, $6C, $74);
|
||
|
||
K := PBKDF2(P, S, 1, 20);
|
||
Assert.areEqual('0C60C80F961F0E71F3A9B524AF6012062FE037A6', BytesToHexString(K));
|
||
K := PBKDF2(P, S, 2, 20);
|
||
Assert.areEqual('EA6C014DC72D6F8CCD1ED92ACE1D41F0D8DE8957', BytesToHexString(K));
|
||
K := PBKDF2(P, S, 4096, 20);
|
||
Assert.areEqual('4B007901B765489ABEAD49D926F721D065A429C1', BytesToHexString(K));
|
||
// K := PBKDF2(P, S, 16777216, 20);
|
||
// Assert.AreEqual('EEFE3D61CD4DA4E4E9945B3D6BA2158C2634E984', BytesToHexString(K));
|
||
|
||
P := TBytes.Create($70, $61, $73, $73, $77, $6F, $72, $64, $50, $41, $53, $53, $57, $4F, $52, $44, $70, $61, $73, $73,
|
||
$77, $6F, $72, $64);
|
||
S := TBytes.Create($73, $61, $6C, $74, $53, $41, $4C, $54, $73, $61, $6C, $74, $53, $41, $4C, $54, $73, $61, $6C, $74,
|
||
$53, $41, $4C, $54, $73, $61, $6C, $74, $53, $41, $4C, $54, $73, $61, $6C, $74);
|
||
|
||
K := PBKDF2(P, S, 4096, 25);
|
||
Assert.areEqual('3D2EEC4FE41C849B80C8D83662C0E44A8B291A964CF2F07038', BytesToHexString(K));
|
||
end;
|
||
|
||
procedure TTestCryptUtils.TestPBKDF2_SHA256;
|
||
var
|
||
lPassword: string;
|
||
lSalt: string;
|
||
lOut: TBytes;
|
||
begin
|
||
lPassword := 'daniele.teti';
|
||
lSalt := 'thisissomesalt';
|
||
lOut := PBKDF2(TEncoding.ASCII.GetBytes(lPassword), TEncoding.ASCII.GetBytes(lSalt), 50, 512 div 8);
|
||
// https://www.freecodeformat.com/pbkdf2.php
|
||
Assert.areEqual
|
||
('caca227458fe66cf8c19f2d943190feca54fd403b966189d6c7befc3bc856e2d5218d825e91912058fdbdb488dbe4ae3e7be5f59318b03d805857440017ee440',
|
||
BytesToHexString(lOut));
|
||
end;
|
||
|
||
{ TTestUTC }
|
||
|
||
procedure TTestUTC.TestStringToDateTime_Local;
|
||
var
|
||
lDate, lDateToCompare: TDateTime;
|
||
s1,s2: string;
|
||
begin
|
||
// Local time
|
||
lDate := ISOTimeStampToDateTime('2020-11-04T12:12:12');
|
||
Assert.areEqual<TDateTime>(EncodeDateTime(2020, 11, 4, 12, 12, 12, 0), lDate);
|
||
|
||
// UTC with no time zone (in a DST period)
|
||
lDate := ISOTimeStampToDateTime('2020-08-15T12:12:12Z');
|
||
lDateToCompare := TTimeZone.Local.ToLocalTime(EncodeDateTime(2020, 8, 15, 12, 12, 12, 0));
|
||
s1 := DateTimeToStr(lDate);
|
||
s2 := DateTimeToStr(lDateToCompare);
|
||
Assert.areEqual(s1,s2, 'UTC with no time zone (in DST period)');
|
||
|
||
|
||
// UTC with no time zone (in no DST period)
|
||
lDate := ISOTimeStampToDateTime('2020-11-04T12:12:12Z');
|
||
lDateToCompare := TTimeZone.Local.ToLocalTime(EncodeDateTime(2020, 11, 04, 12, 12, 12, 0));
|
||
s1 := DateTimeToStr(lDate);
|
||
s2 := DateTimeToStr(lDateToCompare);
|
||
Assert.areEqual(s1,s2, 'UTC with no time zone (in no DST period)');
|
||
end;
|
||
|
||
procedure TTestUTC.TestStringToDateTime_in_DST_period;
|
||
var
|
||
lDate, lDateToCompare: TDateTime;
|
||
s1,s2: string;
|
||
begin
|
||
// UTC with no time zone (in a DST period)
|
||
lDate := ISOTimeStampToDateTime('2020-08-15T12:12:12Z');
|
||
lDateToCompare := TTimeZone.Local.ToLocalTime(EncodeDateTime(2020, 8, 15, 12, 12, 12, 0));
|
||
s1 := DateTimeToStr(lDate);
|
||
s2 := DateTimeToStr(lDateToCompare);
|
||
Assert.areEqual(s1,s2, 'UTC with no time zone (in DST period)');
|
||
end;
|
||
|
||
procedure TTestUTC.TestStringToDateTime_in_no_DST_period;
|
||
var
|
||
lDate, lDateToCompare: TDateTime;
|
||
s1,s2: string;
|
||
begin
|
||
// UTC with no time zone (in no DST period)
|
||
lDate := ISOTimeStampToDateTime('2020-11-04T12:12:12Z');
|
||
lDateToCompare := TTimeZone.Local.ToLocalTime(EncodeDateTime(2020, 11, 04, 12, 12, 12, 0));
|
||
s1 := DateTimeToStr(lDate);
|
||
s2 := DateTimeToStr(lDateToCompare);
|
||
Assert.areEqual(s1,s2, 'UTC with no time zone (in no DST period)');
|
||
end;
|
||
|
||
|
||
procedure TTestUTC.TestStringToDateTime_Mumbai;
|
||
var
|
||
lDate: TDateTime;
|
||
begin
|
||
// UTC "+05:30" for Mumbai (UTC+05:30)
|
||
lDate := ISOTimeStampToDateTime('2020-11-04T12:12:12+05:30');
|
||
Assert.areEqual(DateTimeToStr(EncodeDateTime(2020, 11, 4, 7, 42, 12, 0)), DateTimeToStr(lDate));
|
||
end;
|
||
|
||
procedure TTestUTC.TestStringToDateTime_NewYork;
|
||
var
|
||
lDate: TDateTime;
|
||
begin
|
||
// UTC "−05:00" for New York on standard time (UTC-05:00)
|
||
lDate := ISOTimeStampToDateTime('2020-11-04T12:12:12-05:00');
|
||
Assert.areEqual(DateTimeToStr(EncodeDateTime(2020, 11, 4, 18, 12, 12, 0)), DateTimeToStr(lDate));
|
||
end;
|
||
|
||
{ TTestLRUCache }
|
||
|
||
procedure TTestLRUCache.TestPutGet;
|
||
var
|
||
lCache: TMVCLRUCache<TMyObject>;
|
||
I: Integer;
|
||
lMyObj: TMyObject;
|
||
lItemIndex: UInt64;
|
||
begin
|
||
lCache := TMVCLRUCache<TMyObject>.Create(5);
|
||
try
|
||
lCache.Lock;
|
||
try
|
||
for I := 1 to 100 do
|
||
begin
|
||
Assert.isFalse(lCache.Contains(I.ToString, lItemIndex));
|
||
end;
|
||
|
||
for I := 1 to 100 do
|
||
begin
|
||
lMyObj := TMyObject.Create;
|
||
lMyObj.PropString := I.ToString;
|
||
lCache.Put(I.ToString, lMyObj);
|
||
Assert.isTrue(lCache.Contains(I.ToString, lItemIndex));
|
||
Assert.isTrue(lCache.TryGet(I.ToString, lMyObj));
|
||
Assert.AreEqual(I.ToString, lMyObj.PropString);
|
||
end;
|
||
Assert.areEqual(5, lCache.Size);
|
||
finally
|
||
lCache.UnLock;
|
||
end;
|
||
lCache.Lock;
|
||
try
|
||
Assert.isTrue(lCache.Contains('100', lItemIndex));
|
||
Assert.isTrue(lCache.Contains('99', lItemIndex));
|
||
Assert.isTrue(lCache.Contains('98', lItemIndex));
|
||
Assert.isTrue(lCache.Contains('97', lItemIndex));
|
||
Assert.isTrue(lCache.Contains('96', lItemIndex));
|
||
for I := 95 downto -10 do
|
||
begin
|
||
Assert.isFalse(lCache.Contains(I.ToString, lItemIndex));
|
||
end;
|
||
for I := 101 to 105 do
|
||
begin
|
||
Assert.isFalse(lCache.Contains(I.ToString, lItemIndex));
|
||
end;
|
||
finally
|
||
lCache.UnLock;
|
||
end;
|
||
finally
|
||
lCache.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure TTestLRUCache.TestPutGet_Check_No_AV;
|
||
var
|
||
lCache: TMVCLRUCache<TMyObject>;
|
||
lMyObj: TMyObject;
|
||
lProducer1, lProducer2, lProducer3, lProducer4: ITask;
|
||
lProcProducer, lProcConsumer: TProc;
|
||
lConsumer1, lConsumer2, lConsumer3, lConsumer4: ITask;
|
||
begin
|
||
lCache := TMVCLRUCache<TMyObject>.Create(10);
|
||
try
|
||
lProcProducer := procedure
|
||
var
|
||
T, J: Integer;
|
||
lKey: string;
|
||
begin
|
||
for T := 1 to 50 do
|
||
begin
|
||
Sleep(T * 5);
|
||
lCache.Lock;
|
||
try
|
||
for J := 1 to 100 do
|
||
begin
|
||
lMyObj := TMyObject.Create;
|
||
lKey := T.ToString + '|' + J.ToString;
|
||
lMyObj.PropString := lKey;
|
||
lCache.Put(lKey, lMyObj);
|
||
end;
|
||
finally
|
||
lCache.UnLock;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
lProcConsumer := procedure
|
||
var
|
||
T, J: Integer;
|
||
lKey: string;
|
||
begin
|
||
for T := 1 to 20 do
|
||
begin
|
||
Sleep(T * 10);
|
||
lCache.Lock;
|
||
try
|
||
for J := T to T + 100 do
|
||
begin
|
||
lKey := T.ToString + '|' + J.ToString;
|
||
lCache.TryGet(lKey, lMyObj);
|
||
end;
|
||
finally
|
||
lCache.UnLock;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
lProducer1 := TTask.Run(lProcProducer).Start; // Thread
|
||
lProducer2 := TTask.Run(lProcProducer).Start; // Thread
|
||
lProducer3 := TTask.Run(lProcProducer).Start; // Thread
|
||
lProducer4 := TTask.Run(lProcProducer).Start; // Thread
|
||
|
||
lConsumer1 := TTask.Run(lProcConsumer).Start; // Thread
|
||
lConsumer2 := TTask.Run(lProcConsumer).Start; // Thread
|
||
lConsumer3 := TTask.Run(lProcConsumer).Start; // Thread
|
||
lConsumer4 := TTask.Run(lProcConsumer).Start; // Thread
|
||
TTask.WaitForAll([lProducer1, lProducer2, lProducer3, lProducer4, lConsumer1, lConsumer2, lConsumer3, lConsumer4]);
|
||
Assert.Pass('No Exception raised');
|
||
finally
|
||
lCache.Free;
|
||
end;
|
||
end;
|
||
|
||
initialization
|
||
|
||
TDUnitX.RegisterTestFixture(TTestRouting);
|
||
// TDUnitX.RegisterTestFixture(TTestMappers);
|
||
TDUnitX.RegisterTestFixture(TTestJWT);
|
||
TDUnitX.RegisterTestFixture(TTestMultiMap);
|
||
TDUnitX.RegisterTestFixture(TTestNameCase);
|
||
TDUnitX.RegisterTestFixture(TTestCryptUtils);
|
||
TDUnitX.RegisterTestFixture(TTestLRUCache);
|
||
|
||
finalization
|
||
|
||
end.
|