Changeset 94 for trunk

Timestamp:

Feb 3, 2022, 10:53:30 PM (3 years ago)

Author:

chronos

Message:

• Added: Validation tests for contact properties.

Location:

trunk

Files:

• Forms/UFormTest.pas (modified) (6 diffs)
• UTest.pas (modified) (7 diffs)

trunk/Forms/UFormTest.pas

@@ -115 +115 @@
 
 procedure TFormTest.FormCreate(Sender: TObject);
+const
+  VCardVersion = 'VERSION:2.1';
 begin
   TestCases := TTestCases.Create;
@@ -120 +122 @@
     with TTestCaseLoadSave(AddNew('Load and save', TTestCaseLoadSave)) do begin
       Input := VCardBegin + LineEnding +
-        'VERSION:2.1' + LineEnding +
+        VCardVersion + LineEnding +
         'N:Surname;Name' + LineEnding +
         'FN:Name Surname' + LineEnding +
@@ -128 +130 @@
     with TTestCaseLoadSave(AddNew('Long text', TTestCaseLoadSave)) do begin
       Input := VCardBegin + LineEnding +
-        'VERSION:2.1' + LineEnding +
+        VCardVersion + LineEnding +
         'NOTE:This is some long test which is really multi-lined each line is on d' + LineEnding +
         ' ifferent line so it is on multiple lines.' + LineEnding +
@@ -136 +138 @@
     with TTestCaseLoadSave(AddNew('Multi-line', TTestCaseLoadSave)) do begin
       Input := VCardBegin + LineEnding +
-        'VERSION:2.1' + LineEnding +
+        VCardVersion + LineEnding +
         'NOTE:First line\nsecond line\nempty line\n\nlast line' + LineEnding +
         VCardEnd + LineEnding;
       Output := Input;
     end;
-    AddNew('Encoding base64', TTestCaseLoadSave);
-    AddNew('Encoding quoted-printable', TTestCaseLoadSave);
-    AddNew('Image format', TTestCaseLoadSave);
+    //AddNew('Encoding base64', TTestCaseLoadSave);
+    //AddNew('Encoding quoted-printable', TTestCaseLoadSave);
+    //AddNew('Image format', TTestCaseLoadSave);
     with TTestCaseLoadSave(AddNew('Empty', TTestCaseLoadSave)) do begin
       Input := '';
@@ -154 +156 @@
     with TTestCaseLoadSave(AddNew('Missing end', TTestCaseLoadSave)) do begin
       Input := VCardBegin + LineEnding +
-        'VERSION:2.1' + LineEnding +
+        VCardVersion + LineEnding +
         'N:Surname;Name' + LineEnding +
         'FN:Name Surname' + LineEnding;
@@ -160 +162 @@
     end;
     with TTestCaseLoadSave(AddNew('Missing start', TTestCaseLoadSave)) do begin
-      Input := 'VERSION:2.1' + LineEnding +
+      Input := VCardVersion + LineEnding +
         'N:Surname;Name' + LineEnding +
         'FN:Name Surname' + LineEnding +
         VCardEnd + LineEnding;
       Output := '';
+    end;
+    with TTestCaseCheckProperty(AddNew('Propery FN', TTestCaseCheckProperty)) do begin
+      Index := cfFullName;
+      Value := 'Name Surname';
+      Input := VCardBegin + LineEnding +
+        VCardVersion + LineEnding +
+        'FN:' + Value + LineEnding +
+        VCardEnd + LineEnding;
+    end;
+    with TTestCaseCheckProperty(AddNew('Escaped new lines in text', TTestCaseCheckProperty)) do begin
+      Index := cfNote;
+      Value := 'Line' + #13#10 + 'Line';
+      Input := VCardBegin + LineEnding +
+        VCardVersion + LineEnding +
+        'NOTE:Line\nLine' + LineEnding +
+        VCardEnd + LineEnding;
+    end;
+    with TTestCaseCheckProperty(AddNew('Compound value', TTestCaseCheckProperty)) do begin
+      Index := cfFirstName;
+      Value := 'FirstName';
+      Input := VCardBegin + LineEnding +
+        VCardVersion + LineEnding +
+        'N:Surname;FirstName;;;' + LineEnding +
+        VCardEnd + LineEnding;
     end;
   end;

trunk/UTest.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, fgl;
+  Classes, SysUtils, fgl, UContact;
 
 type
@@ -19 +19 @@
     Log: string;
     procedure Run; virtual;
+    procedure Evaluate(Passed: Boolean);
+    procedure Pass;
+    procedure Fail;
   end;
 
@@ -35 +38 @@
     Output: string;
     procedure Run; override;
-    procedure Evaluate(Passed: Boolean);
+  end;
+
+  { TTestCaseCheckProperty }
+
+  TTestCaseCheckProperty = class(TTestCase)
+    Input: string;
+    ContactIndex: Integer;
+    Index: TContactFieldIndex;
+    Value: string;
+    procedure Run; override;
   end;
 
@@ -44 +56 @@
 implementation
 
-uses
-  UContact;
+{ TTestCaseCheckProperty }
+
+procedure TTestCaseCheckProperty.Run;
+var
+  Lines: TStringList;
+  PropertyValue: string;
+begin
+  Lines := TStringList.Create;
+  try
+    with TContactsFile.Create do
+    try
+      Lines.Text := Input;
+      LoadFromStrings(Lines);
+      if ContactIndex < Contacts.Count then begin
+        PropertyValue := Contacts[ContactIndex].Fields[Index];
+        Evaluate(PropertyValue = Value);
+      end else Fail;
+      Log := 'Expected:' + LineEnding +
+        '"' + Value + '"' + LineEnding + LineEnding +
+        'Output:' + LineEnding +
+        '"' + PropertyValue + '"';
+    finally
+      Free;
+    end;
+  finally
+    Lines.Free;
+  end;
+end;
 
 { TTestCaseLoadSave }
@@ -62 +100 @@
       SaveToStrings(Lines);
       Evaluate(Lines.Text = Output);
-      if Result <> trPassed then begin
-        Log := 'Expected:' + LineEnding +
-          '"' + Output + '"' + LineEnding + LineEnding +
-          'Output:' + LineEnding +
-          '"' + Lines.Text + '"';
-      end;
+      Log := 'Expected:' + LineEnding +
+        '"' + Output + '"' + LineEnding + LineEnding +
+        'Output:' + LineEnding +
+        '"' + Lines.Text + '"';
     finally
       Free;
@@ -76 +112 @@
 end;
 
-procedure TTestCaseLoadSave.Evaluate(Passed: Boolean);
+{ TTestCase }
+
+procedure TTestCase.Run;
+begin
+end;
+
+procedure TTestCase.Evaluate(Passed: Boolean);
 begin
   if Passed then Result := trPassed
@@ -82 +124 @@
 end;
 
-{ TTestCase }
+procedure TTestCase.Pass;
+begin
+  Result := trPassed;
+end;
 
-procedure TTestCase.Run;
+procedure TTestCase.Fail;
 begin
-
+  Result := trFailed;
 end;