JSONTestSuite

program Import_JSON_TestSuite;

uses
  Classes,
  IOUtils,
  JSON,
  SysUtils,
  Types,
  TestFramework,
  TestInsight.DUnit;

type
  TJSONParsingTests = class(TTestCase)
  private
    fFileName: string;
    class function Suite(const path: string): ITestSuite; reintroduce;
    constructor Create(const fileName: string); reintroduce;
  published
    procedure Test;
  end;

{ TJSONParsingTests }

constructor TJSONParsingTests.Create(const fileName: string);
begin
  inherited Create('Test');
  fFileName := fileName;
  FTestName := ChangeFileExt(ExtractFileName(fFileName), '');
end;

class function TJSONParsingTests.Suite(const path: string): ITestSuite;
var
  test: TJSONParsingTests;
  s: string;
begin
  Result := TTestSuite.Create('JSON Parsing Tests');

  for s in TDirectory.GetFiles(path, '*.json') do
  begin
    test := TJSONParsingTests.Create(s);
    Result.AddTest(test);
  end;
end;

procedure TJSONParsingTests.Test;
var
  s: TStrings;
  json: TJSONValue;
  f: string;
begin
  s := TStringList.Create;
  json := nil;
  try
    s.LoadFromFile(fFileName);

    json := TJSONObject.ParseJSONValue(s.Text);

    f := ExtractFileName(fFileName);
    if f[1] = 'y' then
      Check(Assigned(json), 'parsing should have succeeded')
    else if f[1] = 'n' then
      Check(not Assigned(json), 'parsing should have failed')
    else if (f[1] = 'i') and Assigned(json) then
      FCheckCalled := True;
    // should raise warning when no check was called which indicates undefined result and failed to parse
  finally
    json.Free;
    s.Free;
  end;
end;

begin
  RegisterTest(TJSONParsingTests.Suite('..\..\Test_Parsing'));
  RegisterTest(TJSONParsingTests.Suite('..\..\parse_fail'));
//  RegisterTest(TJSONParsingTests.Suite('..\..\stack_overflow'));
  RunRegisteredTests;
end.