Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement