SHARE
TWEET

JSONTestSuite

sglienke Nov 2nd, 2016 126 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. program Import_JSON_TestSuite;
  2.  
  3. uses
  4.   Classes,
  5.   IOUtils,
  6.   JSON,
  7.   SysUtils,
  8.   Types,
  9.   TestFramework,
  10.   TestInsight.DUnit;
  11.  
  12. type
  13.   TJSONParsingTests = class(TTestCase)
  14.   private
  15.     fFileName: string;
  16.     class function Suite(const path: string): ITestSuite; reintroduce;
  17.     constructor Create(const fileName: string); reintroduce;
  18.   published
  19.     procedure Test;
  20.   end;
  21.  
  22. { TJSONParsingTests }
  23.  
  24. constructor TJSONParsingTests.Create(const fileName: string);
  25. begin
  26.   inherited Create('Test');
  27.   fFileName := fileName;
  28.   FTestName := ChangeFileExt(ExtractFileName(fFileName), '');
  29. end;
  30.  
  31. class function TJSONParsingTests.Suite(const path: string): ITestSuite;
  32. var
  33.   test: TJSONParsingTests;
  34.   s: string;
  35. begin
  36.   Result := TTestSuite.Create('JSON Parsing Tests');
  37.  
  38.   for s in TDirectory.GetFiles(path, '*.json') do
  39.   begin
  40.     test := TJSONParsingTests.Create(s);
  41.     Result.AddTest(test);
  42.   end;
  43. end;
  44.  
  45. procedure TJSONParsingTests.Test;
  46. var
  47.   s: TStrings;
  48.   json: TJSONValue;
  49.   f: string;
  50. begin
  51.   s := TStringList.Create;
  52.   json := nil;
  53.   try
  54.     s.LoadFromFile(fFileName);
  55.  
  56.     json := TJSONObject.ParseJSONValue(s.Text);
  57.  
  58.     f := ExtractFileName(fFileName);
  59.     if f[1] = 'y' then
  60.       Check(Assigned(json), 'parsing should have succeeded')
  61.     else if f[1] = 'n' then
  62.       Check(not Assigned(json), 'parsing should have failed')
  63.     else if (f[1] = 'i') and Assigned(json) then
  64.       FCheckCalled := True;
  65.     // should raise warning when no check was called which indicates undefined result and failed to parse
  66.   finally
  67.     json.Free;
  68.     s.Free;
  69.   end;
  70. end;
  71.  
  72. begin
  73.   RegisterTest(TJSONParsingTests.Suite('..\..\Test_Parsing'));
  74.   RegisterTest(TJSONParsingTests.Suite('..\..\parse_fail'));
  75. //  RegisterTest(TJSONParsingTests.Suite('..\..\stack_overflow'));
  76.   RunRegisteredTests;
  77. end.
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top