utSchemaWriter.pp 5.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220
  1. {
  2. This file is part of the Free Component Library
  3. Testsuite for JSONSchema writer
  4. Copyright (c) 2024 by Michael Van Canneyt [email protected]
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. unit utSchemaWriter;
  12. {$mode ObjFPC}{$H+}
  13. interface
  14. uses
  15. Classes, SysUtils, fpcunit, testregistry, fpjson,fpjson.schema.types, fpjson.schema.schema, fpjson.schema.writer;
  16. Type
  17. { TTestSchemaWriter }
  18. TTestSchemaWriter = Class(TTestCase)
  19. Private
  20. FSchema : TJSONSchema;
  21. FStream: TStringStream;
  22. Public
  23. Procedure Setup; override;
  24. Procedure TearDown; override;
  25. Procedure CheckStream(aJSON : String); virtual; abstract;
  26. Property Schema : TJSONSchema Read FSchema;
  27. Property Stream : TStringStream Read FStream;
  28. Published
  29. Procedure TestHookup;
  30. Procedure TestAny;
  31. Procedure TestNone;
  32. Procedure TestEmpty;
  33. Procedure TestMetaDataSchema;
  34. Procedure TestRequired;
  35. procedure TestJSONValue;
  36. procedure TestDefaultValueObject;
  37. procedure TestDefaultValueSimpleValue;
  38. procedure TestDefaultValueArray;
  39. procedure TestVocabulary;
  40. procedure TestDependentRequired;
  41. procedure TestTypes;
  42. end;
  43. TTestStreamWriter = Class(TTestSchemaWriter)
  44. Public
  45. Procedure CheckStream(aJSON : String); override;
  46. end;
  47. { TTestJSONWriter }
  48. TTestJSONWriter = Class(TTestSchemaWriter)
  49. Public
  50. Procedure CheckStream(aJSON : String); override;
  51. end;
  52. implementation
  53. { TTestSchemaWriter }
  54. procedure TTestSchemaWriter.Setup;
  55. begin
  56. inherited Setup;
  57. FSchema:=TJSONSchema.Create;
  58. FStream:=TStringStream.Create('');
  59. end;
  60. procedure TTestSchemaWriter.TearDown;
  61. begin
  62. FreeAndNil(FStream);
  63. FreeAndNil(FSchema);
  64. inherited TearDown;
  65. end;
  66. procedure TTestSchemaWriter.TestHookup;
  67. begin
  68. AssertNotNull('Have schema',Schema);
  69. AssertNotNull('Have stream',Stream);
  70. end;
  71. procedure TTestSchemaWriter.TestAny;
  72. begin
  73. Schema.MatchType:=smAny;
  74. CheckStream('true');
  75. end;
  76. procedure TTestSchemaWriter.TestNone;
  77. begin
  78. Schema.MatchType:=smNone;
  79. CheckStream('false');
  80. end;
  81. procedure TTestSchemaWriter.TestEmpty;
  82. begin
  83. Schema.MatchType:=smConstrained;
  84. CheckStream('{}');
  85. end;
  86. procedure TTestSchemaWriter.TestMetaDataSchema;
  87. begin
  88. Schema.MetaData.Title:='soso';
  89. Schema.MetaData.Description:='many';
  90. CheckStream('{"title":"soso","description":"many"}');
  91. end;
  92. procedure TTestSchemaWriter.TestRequired;
  93. begin
  94. Schema.Validations.Required.Add('one');
  95. Schema.Validations.Required.Add('two');
  96. Schema.Validations.Required.Add('three');
  97. CheckStream('{"required":["one","two","three"]}');
  98. end;
  99. procedure TTestSchemaWriter.TestDefaultValueObject;
  100. begin
  101. Schema.MetaData.DefaultValue:=TJSONObject.Create(['one',1]);
  102. CheckStream('{"default":{"one":1}}');
  103. end;
  104. procedure TTestSchemaWriter.TestDefaultValueSimpleValue;
  105. begin
  106. Schema.MetaData.DefaultValue:=TJSONString.Create('self');
  107. CheckStream('{"default":"self"}');
  108. end;
  109. procedure TTestSchemaWriter.TestDefaultValueArray;
  110. begin
  111. Schema.MetaData.DefaultValue:=TJSONArray.Create(['self']);
  112. CheckStream('{"default":["self"]}');
  113. end;
  114. procedure TTestSchemaWriter.TestVocabulary;
  115. begin
  116. Schema.Vocabulary.AddVocabulary('http://www.freepascal.org/voc').Enabled:=true;
  117. Schema.Vocabulary.AddVocabulary('http://www.freepascal.org/voc2').Enabled:=true;
  118. CheckStream('{"$vocabulary":{"http://www.freepascal.org/voc":true,"http://www.freepascal.org/voc2":true}}');
  119. end;
  120. procedure TTestSchemaWriter.TestDependentRequired;
  121. begin
  122. With Schema.Validations.DependentRequired.AddDependent('license') do
  123. begin
  124. Required.Add('one');
  125. Required.Add('two');
  126. Required.Add('three');
  127. end;
  128. CheckStream('{"dependentRequired":{"license":["one","two","three"]}}');
  129. end;
  130. procedure TTestSchemaWriter.TestTypes;
  131. begin
  132. Schema.Validations.Types:=[sstString,sstNull,sstNumber];
  133. CheckStream('{"type":["null","number","string"]}');
  134. end;
  135. procedure TTestSchemaWriter.TestJSONValue;
  136. begin
  137. Schema.Validations.constValue:=TJSONString.Create('self');
  138. CheckStream('{"const":"self"}');
  139. end;
  140. { TTestStreamWriter }
  141. procedure TTestStreamWriter.CheckStream(aJSON: String);
  142. begin
  143. With TJSONSchemaWriterStream.Create(Nil) do
  144. try
  145. WriteSchema(Schema,Stream);
  146. finally
  147. Free;
  148. end;
  149. AssertEquals('Streamed content',aJSON,Stream.DataString);
  150. end;
  151. { TTestJSONWriter }
  152. procedure TTestJSONWriter.CheckStream(aJSON: String);
  153. var
  154. D : TJSONData;
  155. begin
  156. D:=Nil;
  157. try
  158. With TJSONSchemaWriterJSON.Create(Nil) do
  159. try
  160. D:=WriteSchema(Schema);
  161. finally
  162. Free;
  163. end;
  164. AssertEquals('Streamed content',aJSON,D.FormatJSON([foSingleLineObject,foSingleLineArray,foSkipWhiteSpace],0));
  165. {
  166. foSingleLineArray, // Array without CR/LF : all on one line
  167. foSingleLineObject, // Object without CR/LF : all on one line
  168. foDoNotQuoteMembers, // Do not quote object member names.
  169. foUseTabchar, // Use tab characters instead of spaces.
  170. foSkipWhiteSpace, // Do not use whitespace at all
  171. }
  172. finally
  173. D.Free;
  174. end;
  175. end;
  176. initialization
  177. RegisterTests([TTestStreamWriter,TTestJSONWriter])
  178. end.