-
-
Notifications
You must be signed in to change notification settings - Fork 324
/
SynSelfTests.pas
20857 lines (20184 loc) · 761 KB
/
SynSelfTests.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
/// automated tests for common units of the Synopse mORMot Framework
// - this unit is a part of the freeware Synopse mORMot framework,
// licensed under a MPL/GPL/LGPL tri-license; version 1.18
unit SynSelfTests;
{
This file is part of Synopse mORMot framework.
Synopse framework. Copyright (c) Arnaud Bouchez
Synopse Informatique - https://synopse.info
*** BEGIN LICENSE BLOCK *****
Version: MPL 1.1/GPL 2.0/LGPL 2.1
The contents of this file are subject to the Mozilla Public License Version
1.1 (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.mozilla.org/MPL
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
for the specific language governing rights and limitations under the License.
The Original Code is Synopse framework.
The Initial Developer of the Original Code is Arnaud Bouchez.
Portions created by the Initial Developer are Copyright (c)
the Initial Developer. All Rights Reserved.
Contributor(s):
Alternatively, the contents of this file may be used under the terms of
either the GNU General Public License Version 2 or later (the "GPL"), or
the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
in which case the provisions of the GPL or the LGPL are applicable instead
of those above. If you wish to allow use of your version of this file only
under the terms of either the GPL or the LGPL, and not to allow others to
use your version of this file under the terms of the MPL, indicate your
decision by deleting the provisions above and replace them with the notice
and other provisions required by the GPL or the LGPL. If you do not delete
the provisions above, a recipient may use your version of this file under
the terms of any one of the MPL, the GPL or the LGPL.
***** END LICENSE BLOCK *****
}
interface
{$I Synopse.inc} // define HASINLINE CPU32 CPU64
{$ifdef ISDELPHIXE}
// since Delphi XE, we have unit System.RegularExpressionsAPI available
{$define TEST_REGEXP}
{$else}
// define only if you have unit PCRE.pas installed (not set by default)
{.$define TEST_REGEXP}
{$endif}
uses
{$ifdef MSWINDOWS}
Windows,
{$else}
{$ifdef KYLIX3}
Types,
LibC,
SynKylix,
{$endif}
{$ifdef FPC}
SynFPCLinux,
BaseUnix,
{$endif}
{$endif}
Classes,
SynCrtSock,
SynTable, // for TSynTableStatement
{$ifndef NOVARIANTS}
SynMongoDB,
SynMustache,
Variants,
{$endif}
{$ifdef UNICODE}
Generics.Collections,
{$endif}
SysUtils,
{$ifndef LVCL}
Contnrs,
{$ifdef MSWINDOWS}
SynOleDB,
{$ifndef FPC}
SynGdiPlus,
SynPdf,
{$endif}
{$endif}
{$endif LVCL}
SynEcc,
SynDB,
SynSQLite3,
SynSQLite3Static,
SynDBSQLite3,
SynDBRemote,
SynDBODBC,
{$ifndef DELPHI5OROLDER}
mORMot,
mORMotDB,
mORMotSQLite3,
mORMotHttpServer,
mORMotHttpClient,
{$ifndef NOVARIANTS}
mORMotMongoDB,
mORMotMVC,
{$endif}
SynBidirSock,
mORMotDDD,
dddDomCountry,
dddDomUserTypes,
dddDomUserInterfaces,
dddDomAuthInterfaces,
dddInfraEmail,
dddInfraEmailer,
dddInfraAuthRest,
dddInfraRepoUser,
ECCProcess {$ifdef FPC} in '.\SQLite3\Samples\33 - ECC\ECCProcess.pas' {$endif},
{$endif DELPHI5OROLDER}
mORMotService,
SynProtoRTSPHTTP,
SynProtoRelay,
{$ifdef TEST_REGEXP}
SynSQLite3RegEx,
{$endif TEST_REGEXP}
{$ifdef MSWINDOWS}
{$ifdef USEZEOS}
SynDBZeos,
{$endif}
{$endif}
SynCommons,
SynLog,
SynTests;
{ ************ Unit-Testing classes and functions }
{$ifndef DELPHI5OROLDER}
const
{$ifdef MSWINDOWS}
HTTP_DEFAULTPORT = '888';
// if this library file is available and USEZEOS conditional is set, will run
// TTestExternalDatabase.FirebirdEmbeddedViaODBC
// !! download driver from http://www.firebirdsql.org/en/odbc-driver
FIREBIRDEMBEDDEDDLL = 'd:\Dev\Lib\SQLite3\Samples\15 - External DB performance\Firebird'+
{$ifdef CPU64}'64'+{$endif=}'\fbembed.dll';
{$else}
HTTP_DEFAULTPORT = '8888'; // under Linux, port<1024 needs root user
{$endif MSWINDOWS}
type
// a record mapping used in the test classes of the framework
// - this class can be used for debugging purposes, with the database
// created by TTestFileBased in mORMotSQLite3.pas
// - this class will use 'People' as a table name
TSQLRecordPeople = class(TSQLRecord)
private
fData: TSQLRawBlob;
fFirstName: RawUTF8;
fLastName: RawUTF8;
fYearOfBirth: integer;
fYearOfDeath: word;
published
property FirstName: RawUTF8 read fFirstName write fFirstName;
property LastName: RawUTF8 read fLastName write fLastName;
property Data: TSQLRawBlob read fData write fData;
property YearOfBirth: integer read fYearOfBirth write fYearOfBirth;
property YearOfDeath: word read fYearOfDeath write fYearOfDeath;
public
/// method used to test the Client-Side
// ModelRoot/TableName/ID/MethodName RESTful request, i.e.
// ModelRoot/People/ID/DataAsHex in this case
// - this method calls the supplied TSQLRestClient to retrieve its results,
// with the ID taken from the current TSQLRecordPeole instance ID field
// - parameters and result types depends on the purpose of the function
// - TSQLRestServerTest.DataAsHex published method implements the result
// calculation on the Server-Side
function DataAsHex(aClient: TSQLRestClientURI): RawUTF8;
/// method used to test the Client-Side
// ModelRoot/MethodName RESTful request, i.e. ModelRoot/Sum in this case
// - this method calls the supplied TSQLRestClient to retrieve its results
// - parameters and result types depends on the purpose of the function
// - TSQLRestServerTest.Sum published method implements the result calculation
// on the Server-Side
// - this method doesn't expect any ID to be supplied, therefore will be
// called as class function - normally, it should be implement in a
// TSQLRestClient descendant, and not as a TSQLRecord, since it does't depend
// on TSQLRecordPeople at all
// - you could also call the same servce from the ModelRoot/People/ID/Sum URL,
// but it won't make any difference)
class function Sum(aClient: TSQLRestClientURI; a, b: double; Method2: boolean): double;
end;
TSQLRecordTest = class(TSQLRecord)
private
fTest: RawUTF8;
fValfloat: double;
fValWord: word;
fNext: TSQLRecordTest;
fInt: int64;
fValDate: TDateTime;
fData: TSQLRawBlob;
fAnsi: WinAnsiString;
fUnicode: RawUnicode;
{$ifndef NOVARIANTS}
fVariant: variant;
{$endif}
procedure SetInt(const Value: int64);
public
procedure FillWith(i: Integer);
procedure CheckWith(test: TSynTestCase; i: Integer; offset: integer=0;
checkblob: boolean=true);
published
property Int: int64 read fInt write SetInt default 12;
property Test: RawUTF8 read fTest write fTest;
property Unicode: RawUnicode read fUnicode write fUnicode;
property Ansi: WinAnsiString read fAnsi write fAnsi;
property ValFloat: double read fValfloat write fValFloat;
property ValWord: word read fValWord write fValWord;
property ValDate: tdatetime read fValDate write fValDate;
property Next: TSQLRecordTest read fNext write fNext;
property Data: TSQLRawBlob read fData write fData;
{$ifndef NOVARIANTS}
property ValVariant: variant read fVariant write fVariant;
{$endif}
end;
{$endif}
type
/// this test case will test most functions, classes and types defined and
// implemented in the SynCommons unit
TTestLowLevelCommon = class(TSynTestCase)
protected
{$ifndef DELPHI5OROLDER}
a: array of TSQLRecordPeople;
{$endif}
fAdd,fDel: RawUTF8;
fQuickSelectValues: TIntegerDynArray;
function QuickSelectGT(IndexA,IndexB: PtrInt): boolean;
procedure intadd(const Sender; Value: integer);
procedure intdel(const Sender; Value: integer);
published
/// the faster CopyRecord function, enhancing the system.pas unit
procedure SystemCopyRecord;
/// test the TRawUTF8List class
procedure _TRawUTF8List;
/// test the TDynArray object and methods
procedure _TDynArray;
/// test the TDynArrayHashed object and methods (dictionary features)
// - this test will create an array of 200,000 items to test speed
procedure _TDynArrayHashed;
/// test the TSynDictionary class
procedure _TSynDictionary;
/// validate the TSynQueue class
procedure _TSynQueue;
/// test TObjectListHashed class
procedure _TObjectListHashed;
/// test TObjectListSorted class
procedure _TObjectListSorted;
/// test TSynNameValue class
procedure _TSynNameValue;
/// test TRawUTF8Interning process
procedure _TRawUTF8Interning;
{$ifndef DELPHI5OROLDER}
/// test TObjectDynArrayWrapper class
procedure _TObjectDynArrayWrapper;
/// test T*ObjArray types and the ObjArray*() wrappers
procedure _TObjArray;
{$endif DELPHI5OROLDER}
{$ifdef CPUINTEL}
/// validate our optimized MoveFast/FillCharFast functions
procedure CustomRTL;
{$endif CPUINTEL}
/// test StrIComp() and AnsiIComp() functions
procedure FastStringCompare;
/// test IdemPropName() and IdemPropNameU() functions
procedure _IdemPropName;
/// test UrlEncode() and UrlDecode() functions
procedure UrlEncoding;
/// test our internal fast TGUID process functions
procedure _GUID;
/// test ParseCommandArguments() function
procedure _ParseCommandArguments;
/// test IsMatch() function
procedure _IsMatch;
/// test TExprParserMatch class
procedure _TExprParserMatch;
/// the Soundex search feature (i.e. TSynSoundex and all related
// functions)
procedure Soundex;
/// low level fast Integer or Floating-Point to/from string conversion
// - especially the RawUTF8 or PUTF8Char relative versions
procedure NumericalConversions;
/// test low-level integer/Int64 functions
procedure Integers;
/// test crc32c in both software and hardware (SSE4.2) implementations
procedure _crc32c;
/// test RDRAND Intel x86/x64 opcode if available, or fast gsl_rng_taus2
procedure _Random32;
/// test TSynBloomFilter class
procedure BloomFilters;
/// test DeltaCompress/DeltaExtract functions
procedure _DeltaCompress;
/// the new fast Currency to/from string conversion
procedure Curr64;
/// the camel-case / camel-uncase features, used for i18n from Delphi RTII
procedure _CamelCase;
/// the low-level bit management functions
procedure Bits;
/// the fast .ini file content direct access
procedure IniFiles;
/// test UTF-8 and Win-Ansi conversion (from or to, through RawUnicode)
procedure _UTF8;
/// test UrlEncode() and UrlDecode() functions
// - this method use some ISO-8601 encoded dates and times for the testing
procedure UrlDecoding;
/// test ASCII Baudot encoding
procedure BaudotCode;
/// the ISO-8601 date and time encoding
// - test especially the conversion to/from text
procedure Iso8601DateAndTime;
/// test the TSynTimeZone class and its cross-platform local time process
procedure TimeZones;
/// test mime types recognition
procedure MimeTypes;
/// validates the median computation using the "Quick Select" algorithm
procedure QuickSelect;
/// test TSynTable class and TSynTableVariantType new variant type
procedure _TSynTable;
/// test the TSynCache class
procedure _TSynCache;
/// low-level TSynFilter classes
procedure _TSynFilter;
/// low-level TSynValidate classes
procedure _TSynValidate;
/// low-level TSynLogFile class
procedure _TSynLogFile;
/// client side geniune 64 bit identifiers generation
procedure _TSynUniqueIdentifier;
end;
/// this test case will test most low-level functions, classes and types
// defined and implemented in the mORMot.pas unit
TTestLowLevelTypes = class(TSynTestCase)
{$ifndef NOVARIANTS}
protected
procedure MustacheTranslate(var English: string);
procedure MustacheHelper(const Value: variant; out result: variant);
{$endif}
published
{$ifndef DELPHI5OROLDER}
/// some low-level RTTI access
// - especially the field type retrieval from published properties
procedure RTTI;
{$endif}
/// some low-level Url encoding from parameters
procedure UrlEncoding;
/// some low-level JSON encoding/decoding
procedure EncodeDecodeJSON;
/// some performance numbers about JSON parsing and generating
procedure JSONBenchmark;
/// HTML generation from Wiki Or Markdown syntax
procedure WikiMarkdownToHtml;
{$ifndef NOVARIANTS}
/// some low-level variant process
procedure Variants;
/// test the Mustache template rendering unit
procedure MustacheRenderer;
{$ifndef DELPHI5OROLDER}
{$ifndef LVCL}
/// variant-based JSON/BSON document process
procedure _TDocVariant;
/// low-level TDecimal128 decimal value process (as used in BSON)
procedure _TDecimal128;
/// BSON process (using TDocVariant)
procedure _BSON;
{$endif LVCL}
/// test SELECT statement parsing
procedure _TSynTableStatement;
/// test advanced statistics monitoring
procedure _TSynMonitorUsage;
{$endif DELPHI5OROLDER}
{$endif NOVARIANTS}
end;
{$ifndef DELPHI5OROLDER}
/// this test case will test some generic classes
// defined and implemented in the mORMot.pas unit
TTestBasicClasses = class(TSynTestCase)
published
/// test the TSQLRecord class
// - especially SQL auto generation, or JSON export/import
procedure _TSQLRecord;
/// test the digital signature of records
procedure _TSQLRecordSigned;
/// test the TSQLModel class
procedure _TSQLModel;
/// test a full in-memory server over Windows Messages
// - Under Linux, URIDll will be used instead due to lack of message loop
// - without any SQLite3 engine linked
procedure _TSQLRestServerFullMemory;
end;
{$endif DELPHI5OROLDER}
/// this test case will test most functions, classes and types defined and
// implemented in the SynZip unit
TTestCompression = class(TSynTestCase)
protected
Data: RawByteString;
M: THeapMemoryStream;
crc0,crc1: cardinal;
public
procedure Setup; override;
procedure CleanUp; override;
published
/// direct deflate/inflate functions
procedure InMemoryCompression;
/// .gzip archive handling
procedure GZIPFormat;
/// .zip archive handling
procedure ZIPFormat;
/// SynLZO internal format
procedure _SynLZO;
/// SynLZ internal format
procedure _SynLZ;
/// TAlgoCompress classes
procedure _TAlgoCompress;
end;
/// this test case will test most functions, classes and types defined and
// implemented in the SynCrypto unit
TTestCryptographicRoutines = class(TSynTestCase)
public
procedure CryptData(dpapi: boolean);
published
/// Adler32 hashing functions
procedure _Adler32;
/// MD5 hashing functions
procedure _MD5;
/// SHA-1 hashing functions
procedure _SHA1;
/// SHA-256 hashing functions
procedure _SHA256;
/// SHA-512 hashing functions
procedure _SHA512;
/// SHA-3 / Keccak hashing functions
procedure _SHA3;
/// AES encryption/decryption functions
procedure _AES256;
/// AES-GCM encryption/decryption with authentication
procedure _AES_GCM;
/// RC4 encryption function
procedure _RC4;
/// Base-64 encoding/decoding functions
procedure _Base64;
/// CompressShaAes() using SHA-256 / AES-256-CTR algorithm over SynLZ
procedure _CompressShaAes;
/// AES-based pseudorandom number generator
procedure _TAESPNRG;
/// CryptDataForCurrentUser() function
procedure _CryptDataForCurrentUser;
{$ifdef MSWINDOWS}
/// CryptDataForCurrentUserAPI() function
procedure _CryptDataForCurrentUserAPI;
{$endif MSWINDOWS}
{$ifndef NOVARIANTS}
/// JWT classes
procedure _JWT;
{$endif NOVARIANTS}
/// compute some performance numbers, mostly against regression
procedure Benchmark;
end;
/// this test case will test ECDH and ECDSA cryptography as implemented
// in the SynECC unit
TTestECCCryptography = class(TSynTestCase)
protected
pub: array of TECCPublicKey;
priv: array of TECCPrivateKey;
sign: array of TECCSignature;
hash: TECCHash;
published
/// avoid regression among platforms and compilers
procedure ReferenceVectors;
/// ECC private/public keys generation
procedure _ecc_make_key;
/// ECDSA signature computation
procedure _ecdsa_sign;
/// ECDSA signature verification
procedure _ecdsa_verify;
/// ECDH key derivation
procedure _ecdh_shared_secret;
/// ECDSA certificates chains and digital signatures
procedure CertificatesAndSignatures;
{$ifndef DELPHI5OROLDER}
/// run most commands of the ECC tool
procedure ECCCommandLineTool;
{$endif}
/// ECDHE stream protocol
procedure ECDHEStreamProtocol;
end;
/// this test case will validate several low-level protocols
TTestProtocols = class(TSynTestCase)
published
/// RTSP over HTTP, as implemented in SynProtoRTSPHTTP unit
procedure RTSPOverHTTP;
end;
{$ifdef MSWINDOWS}
{$ifndef LVCL}
{$ifndef FPC}
/// this test case will test most functions, classes and types defined and
// implemented in the SynPDF unit
TTestSynopsePDF = class(TSynTestCase)
published
/// create a PDF document, using the PDF Canvas property
// - test font handling, especially standard font substitution
procedure _TPdfDocument;
/// create a PDF document, using a EMF content
// - validates the EMF/TMetaFile enumeration, and its conversion into the
// PDF content, including PDF-1.5 and page orientation
// - this method will produce a .pdf file in the executable directory,
// if you want to check out the result (it's simply a curve drawing, with
// data from NIST)
procedure _TPdfDocumentGDI;
end;
{$endif}
{$endif}
{$endif}
{$ifndef DELPHI5OROLDER}
{$ifndef LVCL}
type
TCollTest = class(TCollectionItem)
private
FLength: Integer;
FColor: Integer;
FName: RawUTF8;
published
property Color: Integer read FColor write FColor;
property Length: Integer read FLength write FLength;
property Name: RawUTF8 read FName write FName;
end;
TCollTestsI = class(TInterfacedCollection)
protected
class function GetClass: TCollectionItemClass; override;
end;
{$endif LVCL}
type
/// a parent test case which will test most functions, classes and types defined
// and implemented in the mORMotSQLite3 unit, i.e. the SQLite3 engine itself
// - it should not be called directly, but through TTestFileBased,
// TTestMemoryBased and TTestMemoryBased children
TTestSQLite3Engine = class(TSynTestCase)
protected
{ these values are used internaly by the published methods below }
BackupProgressStep: TSQLDatabaseBackupEventStep; // should be the first
TempFileName: TFileName;
EncryptedFile: boolean;
Demo: TSQLDataBase;
Req: RawUTF8;
JS: RawUTF8;
BackupTimer: TPrecisionTimer;
function OnBackupProgress(Sender: TSQLDatabaseBackupThread): Boolean;
published
/// test direct access to the SQLite3 engine
// - i.e. via TSQLDataBase and TSQLRequest classes
procedure DatabaseDirectAccess;
/// test direct access to the Virtual Table features of SQLite3
procedure VirtualTableDirectAccess;
/// test the TSQLTableJSON table
// - the JSON content generated must match the original data
// - a VACCUM is performed, for testing some low-level SQLite3 engine
// implementation
// - the SortField feature is also tested
procedure _TSQLTableJSON;
/// test the TSQLRestClientDB, i.e. a local Client/Server driven usage
// of the framework
// - validates TSQLModel, TSQLRestServer and TSQLRestStorage by checking
// the coherency of the data between client and server instances, after
// update from both sides
// - use all RESTful commands (GET/UDPATE/POST/DELETE...)
// - test the 'many to many' features (i.e. TSQLRecordMany) and dynamic
// arrays published properties handling
// - test dynamic tables
procedure _TSQLRestClientDB;
{$ifdef TEST_REGEXP}
/// check the PCRE-based REGEX function
procedure RegexpFunction;
{$endif TEST_REGEXP}
/// test Master/Slave replication using TRecordVersion field
procedure _TRecordVersion;
end;
/// this test case will test most functions, classes and types defined and
// implemented in the mORMotSQLite3 unit, i.e. the SQLite3 engine itself,
// with a file-based approach
TTestFileBased = class(TTestSQLite3Engine);
/// this test case will test most functions, classes and types defined and
// implemented in the mORMotSQLite3 unit, i.e. the SQLite3 engine itself,
// with a memory-based approach
// - this class will also test the TSQLRestStorage class, and its
// 100% Delphi simple database engine
TTestMemoryBased = class(TTestSQLite3Engine)
protected
function CreateShardDB(maxshard: Integer): TSQLRestServer;
published
/// test the TSQLTableWritable table
procedure _TSQLTableWritable;
/// validate RTREE virtual tables
procedure _RTree;
/// validate TSQLRestStorageShardDB add operation, with or without batch
procedure ShardWrite;
/// validate TSQLRestStorageShardDB reading among all sharded databases
procedure ShardRead;
/// validate TSQLRestStorageShardDB reading after deletion of several shards
procedure ShardReadAfterPurge;
/// validate TSQLRestStorageShardDB.MaxShardCount implementation
procedure _MaxShardCount;
end;
/// this test case will test most functions, classes and types defined and
// implemented in the mORMotSQLite3 unit, i.e. the SQLite3 engine itself,
// with a file-based approach
// - purpose of this class is to test Write-Ahead Logging for the database
TTestFileBasedWAL = class(TTestFileBased);
/// this test case will test most functions, classes and types defined and
// implemented in the mORMotSQLite3 unit, i.e. the SQLite3 engine itself,
// with a file-based approach
// - purpose of this class is to test Memory-Mapped I/O for the database
TTestFileBasedMemoryMap = class(TTestFileBased);
/// this test case will test most functions, classes and types defined and
// implemented in the mORMotSQLite3 unit, i.e. the SQLite3 engine itself,
// used as a HTTP/1.1 server and client
// - test a HTTP/1.1 server and client on the port 888 of the local machine
// - require the 'test.db3' SQLite3 database file, as created by TTestFileBased
TTestClientServerAccess = class(TSynTestCase)
protected
{ these values are used internaly by the published methods below }
Model: TSQLModel;
DataBase: TSQLRestServerDB;
Server: TSQLHttpServer;
Client: TSQLRestClientURI;
/// perform the tests of the current Client instance
procedure ClientTest;
/// release used instances (e.g. http server) and memory
procedure CleanUp; override;
public
/// this could be called as administrator for THttpApiServer to work
{$ifdef MSWINDOWS}
class function RegisterAddUrl(OnlyDelete: boolean): string;
{$endif}
published
/// initialize a TSQLHttpServer instance
// - uses the 'test.db3' SQLite3 database file generated by TTestSQLite3Engine
// - creates and validates a HTTP/1.1 server on the port 888 of the local
// machine, using the THttpApiServer (using kernel mode http.sys) class
// if available
procedure _TSQLHttpServer;
/// validate the HTTP/1.1 client implementation
// - by using a request of all records data
procedure _TSQLHttpClient;
/// validate the HTTP/1.1 client multi-query implementation with one
// connection for the all queries
// - this method keep alive the HTTP connection, so is somewhat faster
// - it runs 1000 remote SQL queries, and check the JSON data retrieved
// - the time elapsed for this step is computed, and displayed on the report
procedure HTTPClientKeepAlive;
/// validate the HTTP/1.1 client multi-query implementation with one
// connection initialized per query
// - this method don't keep alive the HTTP connection, so is somewhat slower:
// a new HTTP connection is created for every query
// - it runs 1000 remote SQL queries, and check the JSON data retrieved
// - the time elapsed for this step is computed, and displayed on the report
procedure HTTPClientMultiConnect;
/// validate the HTTP/1.1 client multi-query implementation with one
// connection for the all queries and our proprietary SHA-256 / AES-256-CTR
// encryption encoding
// - it runs 1000 remote SQL queries, and check the JSON data retrieved
// - the time elapsed for this step is computed, and displayed on the report
procedure HTTPClientEncrypted;
/// validates TSQLRest.SetCustomEncryption process with AES+SHA
procedure HTTPClientCustomEncryptionAesSha;
/// validates TSQLRest.SetCustomEncryption process with only AES
procedure HTTPClientCustomEncryptionAes;
/// validates TSQLRest.SetCustomEncryption process with only SHA
procedure HTTPClientCustomEncryptionSha;
{
/// validate the HTTP/1.1 client multi-query implementation with one
// connection for all queries, and the THttpServer class instead
// of the THttpApiServer kernel mode server
procedure HTTPClientKeepAliveDelphi;
/// validate the HTTP/1.1 client multi-query implementation with one
// connection initialized per query, and the THttpServer class instead
// of the THttpApiServer kernel mode server
// - this method don't keep alive the HTTP connection, so is somewhat slower:
// a new HTTP connection is created for every query
procedure HTTPClientMultiConnectDelphi;
}
{$ifdef MSWINDOWS}
/// validate the Named-Pipe client implementation
// - it first launch the Server as Named-Pipe
// - it then runs 1000 remote SQL queries, and check the JSON data retrieved
// - the time elapsed for this step is computed, and displayed on the report
procedure NamedPipeAccess;
/// validate the Windows Windows Messages based client implementation
// - it first launch the Server to handle Windows Messages
// - it then runs 1000 remote SQL queries, and check the JSON data retrieved
// - the time elapsed for this step is computed, and displayed on the report
procedure LocalWindowMessages;
/// validate the client implementation, using direct access to the server
// - it connects directly the client to the server, therefore use the same
// process and memory during the run: it's the fastest possible way of
// communicating
// - it then runs 1000 remote SQL queries, and check the JSON data retrieved
// - the time elapsed for this step is computed, and displayed on the report
{$endif}
procedure DirectInProcessAccess;
/// validate HTTP/1.1 client-server with multiple TSQLRestServer instances
procedure HTTPSeveralDBServers;
end;
/// this class defined two published methods of type TSQLRestServerCallBack in
// order to test the Server-Side ModelRoot/TableName/ID/MethodName RESTful model
TSQLRestServerTest = class(TSQLRestServerDB)
published
/// test ModelRoot/People/ID/DataAsHex
// - this method is called by TSQLRestServer.URI when a
// ModelRoot/People/ID/DataAsHex GET request is provided
// - Parameters values are not used here: this service only need aRecord.ID
// - SentData is set with incoming data from a PUT method
// - if called from ModelRoot/People/ID/DataAsHex with GET or PUT methods,
// TSQLRestServer.URI will create a TSQLRecord instance and set its ID
// (but won't retrieve its other field values automaticaly)
// - if called from ModelRoot/People/DataAsHex with GET or PUT methods,
// TSQLRestServer.URI will leave aRecord.ID=0 before launching it
// - if called from ModelRoot/DataAsHex with GET or PUT methods,
// TSQLRestServer.URI will leave aRecord=nil before launching it
// - implementation must return the HTTP error code (e.g. 200 as success)
// - Table is overloaded as TSQLRecordPeople here, and still match the
// TSQLRestServerCallBack prototype: but you have to check the class
// at runtime: it can be called by another similar but invalid URL, like
// ModelRoot/OtherTableName/ID/DataAsHex
procedure DataAsHex(Ctxt: TSQLRestServerURIContext);
/// method used to test the Server-Side ModelRoot/Sum or
// ModelRoot/People/Sum Requests with JSON process
// - implementation of this method returns the sum of two floating-points,
// named A and B, as in the public TSQLRecordPeople.Sum() method,
// which implements the Client-Side of this service
// - Table nor ID are never used here
procedure Sum(Ctxt: TSQLRestServerURIContext);
/// method used to test the Server-Side ModelRoot/Sum or
// ModelRoot/People/Sum Requests with variant process
procedure Sum2(Ctxt: TSQLRestServerURIContext);
end;
/// a test case which will test most external DB functions of the mORMotDB unit
// - the external DB will be in fact a SynDBSQLite3 instance, expecting a
// test.db3 SQlite3 file available in the current directory, populated with
// some TSQLRecordPeople rows
// - note that SQL statement caching at SQLite3 engine level makes those test
// 2 times faster: nice proof of performance improvement
TTestExternalDatabase = class(TSynTestCase)
protected
fExternalModel: TSQLModel;
fPeopleData: TSQLTable;
/// called by ExternalViaREST/ExternalViaVirtualTable and
// ExternalViaRESTWithChangeTracking tests method
procedure Test(StaticVirtualTableDirect, TrackChanges: boolean);
public
/// release used instances (e.g. server) and memory
procedure CleanUp; override;
published
{$ifndef LVCL}
/// test TQuery emulation class
procedure _TQuery;
{$endif}
/// test SynDB connection remote access via HTTP
procedure _SynDBRemote;
/// test TSQLDBConnectionProperties persistent as JSON
procedure DBPropertiesPersistence;
/// initialize needed RESTful client (and server) instances
// - i.e. a RESTful direct access to an external DB
procedure ExternalRecords;
/// check the SQL auto-adaptation features
procedure AutoAdaptSQL;
/// check the per-db encryption
// - the testpass.db3-wal file is not encrypted, but the main
// testpass.db3 file will
procedure CryptedDatabase;
/// test external DB implementation via faster REST calls
// - will mostly call directly the TSQLRestStorageExternal instance,
// bypassing the Virtual Table mechanism of SQLite3
procedure ExternalViaREST;
/// test external DB implementation via slower Virtual Table calls
// - using the Virtual Table mechanism of SQLite3 is more than 2 times
// slower than direct REST access
procedure ExternalViaVirtualTable;
/// test external DB implementation via faster REST calls and change tracking
// - a TSQLRecordHistory table will be used to store record history
procedure ExternalViaRESTWithChangeTracking;
{$ifndef CPU64}
{$ifndef LVCL}
{$ifdef MSWINDOWS}
/// test external DB using the JET engine
procedure JETDatabase;
{$endif MSWINDOWS}
{$endif LVCL}
{$endif CPU64}
{$ifdef MSWINDOWS}
{$ifdef USEZEOS}
/// test external Firebird embedded engine via Zeos/ZDBC (if available)
procedure FirebirdEmbeddedViaZDBCOverHTTP;
{$endif USEZEOS}
{$endif MSWINDOWS}
end;
/// a test case for multi-threading abilities of the framework
// - will test all direct or remote access protocols with a growing number
// of concurrent clients (1,2,5,10,30,50 concurent threads), to ensure
// stability, scalibility and safety of the framework
TTestMultiThreadProcess = class(TSynTestCase)
protected
fModel: TSQLModel;
fDatabase: TSQLRestServerDB;
fTestClass: TSQLRestClass;
fThreads: TSynObjectList;
fRunningThreadCount: integer;
fHttpServer: TSQLHttpServer;
fMinThreads: integer;
fMaxThreads: integer;
fOperationCount: integer;
fClientPerThread: integer;
fClientOnlyServerIP: RawByteString;
fTimer: TPrecisionTimer;
procedure DatabaseClose;
procedure Test(aClass: TSQLRestClass; aHttp: TSQLHttpServerOptions=HTTP_DEFAULT_MODE;
aWriteMode: TSQLRestServerAcquireMode=amLocked);
function CreateClient: TSQLRest;
public
/// create the test case instance
constructor Create(Owner: TSynTests; const Ident: string = ''); override;
/// release used instances (e.g. server) and memory
procedure CleanUp; override;
/// if not '', forces the test not to initiate any server and connnect to
// the specified server IP address
property ClientOnlyServerIP: RawByteString read fClientOnlyServerIP write fClientOnlyServerIP;
/// the minimum number of threads used for this test
// - is 1 by default
property MinThreads: integer read fMinThreads write fMinThreads;
/// the maximum number of threads used for this test
// - is 50 by default
property MaxThreads: integer read fMaxThreads write fMaxThreads;
/// how many Add() + Retrieve() operations are performed during each test
// - is 200 by default, i.e. 200 Add() plus 200 Retrieve() globally
property OperationCount: integer read fOperationCount write fOperationCount;
/// how many TSQLRest instance is initialized per thread
// - is 1 by default
property ClientPerThread: Integer read fClientPerThread write fClientPerThread;
published
/// initialize fDatabase and create MaxThreads threads for clients
procedure CreateThreadPool;
/// direct test of its RESTful methods
procedure _TSQLRestServerDB;
/// test via TSQLRestClientDB instances
procedure _TSQLRestClientDB;
{$ifdef MSWINDOWS}
/// test via TSQLRestClientURINamedPipe instances
procedure _TSQLRestClientURINamedPipe;
/// test via TSQLRestClientURIMessage instances
procedure _TSQLRestClientURIMessage;
{$endif}
{$ifndef ONLYUSEHTTPSOCKET}
/// test via TSQLHttpClientWinHTTP instances over http.sys (HTTP API) server
procedure WindowsAPI;
{$endif}
/// test via TSQLHttpClientWinSock instances over OS's socket API server
// - this test won't work within the Delphi IDE debugger
procedure SocketAPI;
//// test via TSQLHttpClientWebsockets instances
procedure Websockets;
{$ifdef USELIBCURL}
/// test via TSQLHttpClientCurl using libcurl library
procedure _libcurl;
{$endif}
/// test via TSQLRestClientDB instances with AcquireWriteMode=amLocked
procedure Locked;
/// test via TSQLRestClientDB instances with AcquireWriteMode=amUnlocked
procedure Unlocked;
{$ifndef LVCL}
/// test via TSQLRestClientDB instances with AcquireWriteMode=amMainThread
procedure MainThread;
{$endif}
/// test via TSQLRestClientDB instances with AcquireWriteMode=amBackgroundThread
procedure BackgroundThread;
end;
/// SOA callback definition as expected by TTestBidirectionalRemoteConnection
IBidirCallback = interface(IInvokable)
['{5C5818CC-FFBA-445C-82C1-39F45B84520C}']
procedure AsynchEvent(a: integer);
function Value: Integer;
end;
/// SOA service definition as expected by TTestBidirectionalRemoteConnection
IBidirService = interface(IInvokable)
['{0984A2DA-FD1F-49D6-ACFE-4D45CF08CA1B}']
function TestRest(a,b: integer; out c: RawUTF8): variant;
function TestRestCustom(a: integer): TServiceCustomAnswer;
function TestCallback(d: Integer; const callback: IBidirCallback): boolean;
procedure LaunchAsynchCallback(a: integer);
procedure RemoveCallback;
end;
TBidirServer = class(TInterfacedObject,IBidirService)
protected
fCallback: IBidirCallback;
// IBidirService implementation methods
function TestRest(a,b: integer; out c: RawUTF8): variant;
function TestRestCustom(a: integer): TServiceCustomAnswer;
function TestCallback(d: Integer; const callback: IBidirCallback): boolean;
procedure LaunchAsynchCallback(a: integer);
procedure RemoveCallback;
public
function LaunchSynchCallback: integer;
end;
/// a test case for all bidirectional remote access, e.g. WebSockets
TTestBidirectionalRemoteConnection = class(TSynTestCase)
protected
fHttpServer: TSQLHttpServer;
fServer: TSQLRestServerFullMemory;
fBidirServer: TBidirServer;
fPublicRelayClientsPort, fPublicRelayPort: SockString;
fPublicRelay: TPublicRelay;
fPrivateRelay: TPrivateRelay;
procedure CleanUp; override;
function NewClient(const port: SockString): TSQLHttpClientWebsockets;
procedure WebsocketsLowLevel(protocol: TWebSocketProtocol; opcode: TWebSocketFrameOpCode);
procedure TestRest(Rest: TSQLRest);
procedure TestCallback(Rest: TSQLRest);
procedure SOACallbackViaWebsockets(Ajax, Relay: boolean);
published
/// low-level test of our 'synopsejson' WebSockets JSON protocol
procedure WebsocketsJSONProtocol;
/// low-level test of our 'synopsebinary' WebSockets binary protocol
procedure WebsocketsBinaryProtocol;
procedure WebsocketsBinaryProtocolEncrypted;
procedure WebsocketsBinaryProtocolCompressed;
procedure WebsocketsBinaryProtocolCompressEncrypted;
/// launch the WebSockets-ready HTTP server
procedure RunHttpServer;
/// test the callback mechanism via interface-based services on server side
procedure SOACallbackOnServerSide;
/// test callbacks via interface-based services over JSON WebSockets
procedure SOACallbackViaJSONWebsockets;
/// test callbacks via interface-based services over binary WebSockets
procedure SOACallbackViaBinaryWebsockets;
/// initialize SynProtoRelay tunnelling
procedure RelayStart;
/// test SynProtoRelay tunnelling over JSON WebSockets
procedure RelaySOACallbackViaJSONWebsockets;
/// verify ability to reconect from Private Relay to Public Relay
procedure RelayConnectionRecreate;
/// test SynProtoRelay tunnelling over binary WebSockets
procedure RelaySOACallbackViaBinaryWebsockets;
/// finalize SynProtoRelay tunnelling
procedure RelayShutdown;
/// test Master/Slave replication using TRecordVersion field over WebSockets
procedure _TRecordVersion;
end;
type
// This is our simple Test data class. Will be mapped to TSQLRecordDDDTest.
TDDDTest = class(TSynPersistent)
private