Changeset 91 for trunk


Ignore:
Timestamp:
Feb 2, 2022, 4:33:25 PM (3 years ago)
Author:
chronos
Message:
  • Added: A windows for showing log output for selected test case.
  • Added: Various load-save tests.
  • Modified: Improved parsing vCard format.
Location:
trunk
Files:
3 added
9 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/UFormTest.lfm

    r90 r91  
    2222      item
    2323        Caption = 'Name'
    24         Width = 200
     24        Width = 300
    2525      end   
    2626      item
    2727        Caption = 'Result'
    28         Width = 869
     28        Width = 769
    2929      end>
    3030    OwnerData = True
     31    PopupMenu = PopupMenuTest
    3132    ReadOnly = True
    3233    RowSelect = True
    … …  
    3435    ViewStyle = vsReport
    3536    OnData = ListViewTestCasesData
     37    OnDblClick = AShowExecute
     38    OnSelectItem = ListViewTestCasesSelectItem
    3639  end
    3740  object ButtonRun: TButton
    … …  
    4548    TabOrder = 1
    4649  end
     50  object ActionList1: TActionList
     51    Left = 537
     52    Top = 115
     53    object AShow: TAction
     54      Caption = 'Show'
     55      OnExecute = AShowExecute
     56    end
     57    object ARun: TAction
     58      Caption = 'Run'
     59      OnExecute = ARunExecute
     60    end
     61  end
     62  object PopupMenuTest: TPopupMenu
     63    Left = 539
     64    Top = 244
     65    object MenuItem1: TMenuItem
     66      Action = AShow
     67    end
     68    object MenuItem2: TMenuItem
     69      Action = ARun
     70    end
     71  end
    4772end

  • trunk/Forms/UFormTest.lrj

    r90 r91  
    33{"hash":346165,"name":"tformtest.listviewtestcases.columns[0].caption","sourcebytes":[78,97,109,101],"value":"Name"},
    44{"hash":93105204,"name":"tformtest.listviewtestcases.columns[1].caption","sourcebytes":[82,101,115,117,108,116],"value":"Result"},
    5 {"hash":22974,"name":"tformtest.buttonrun.caption","sourcebytes":[82,117,110],"value":"Run"}
     5{"hash":22974,"name":"tformtest.buttonrun.caption","sourcebytes":[82,117,110],"value":"Run"},
     6{"hash":368487,"name":"tformtest.ashow.caption","sourcebytes":[83,104,111,119],"value":"Show"},
     7{"hash":22974,"name":"tformtest.arun.caption","sourcebytes":[82,117,110],"value":"Run"}
    68]}

  • trunk/Forms/UFormTest.pas

    r90 r91  
    77uses
    88  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, StdCtrls,
    9   UTest;
     9  ActnList, Menus, UTest;
    1010
    1111type
    … …  
    1414
    1515  TFormTest = class(TForm)
     16    ARun: TAction;
     17    AShow: TAction;
     18    ActionList1: TActionList;
    1619    ButtonRun: TButton;
    1720    ListViewTestCases: TListView;
     21    MenuItem1: TMenuItem;
     22    MenuItem2: TMenuItem;
     23    PopupMenuTest: TPopupMenu;
     24    procedure ARunExecute(Sender: TObject);
     25    procedure AShowExecute(Sender: TObject);
    1826    procedure ButtonRunClick(Sender: TObject);
    1927    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    … …  
    2230    procedure FormShow(Sender: TObject);
    2331    procedure ListViewTestCasesData(Sender: TObject; Item: TListItem);
     32    procedure ListViewTestCasesSelectItem(Sender: TObject; Item: TListItem;
     33      Selected: Boolean);
    2434  private
    2535    procedure ReloadList;
     36    procedure UpdateInterface;
    2637  public
    2738    TestCases: TTestCases;
    … …  
    3748
    3849uses
    39   UCore;
     50  UCore, UFormTestCase;
    4051
    4152{ TFormTest }
    … …  
    4657  with TestCases[Item.Index] do begin
    4758    Item.Caption := Name;
     59    Item.Data := TestCases[Item.Index];
     60    Item.SubItems.Add(ResultText[Result]);
    4861  end;
     62end;
     63
     64procedure TFormTest.ListViewTestCasesSelectItem(Sender: TObject;
     65  Item: TListItem; Selected: Boolean);
     66begin
     67  UpdateInterface;
    4968end;
    5069
    … …  
    5372  ListViewTestCases.Items.Count := TestCases.Count;
    5473  ListViewTestCases.Refresh;
     74end;
     75
     76procedure TFormTest.UpdateInterface;
     77begin
     78  ARun.Enabled := Assigned(ListViewTestCases.Selected);
     79  AShow.Enabled := Assigned(ListViewTestCases.Selected);
    5580end;
    5681
    … …  
    6691  for I := 0 to TestCases.Count - 1 do
    6792    TestCases[I].Run;
     93  ReloadList;
     94end;
     95
     96procedure TFormTest.AShowExecute(Sender: TObject);
     97begin
     98  if Assigned(ListViewTestCases.Selected) then
     99  with TFormTestCase.Create(nil) do
     100  try
     101    MemoLog.Text := TTestCase(ListViewTestCases.Selected.Data).Log;
     102    ShowModal;
     103  finally
     104    Free;
     105  end;
     106end;
     107
     108procedure TFormTest.ARunExecute(Sender: TObject);
     109begin
     110  if Assigned(ListViewTestCases.Selected) then begin
     111    TTestCase(ListViewTestCases.Selected.Data).Run;
     112    ReloadList;
     113  end;
    68114end;
    69115
    … …  
    72118  TestCases := TTestCases.Create;
    73119  with TestCases do begin
    74     AddNew('Load and save');
    75     AddNew('Multi-line');
    76     AddNew('Encoding base64');
    77     AddNew('Encoding quoted-printable');
    78     AddNew('Image format');
     120    with TTestCaseLoadSave(AddNew('Load and save', TTestCaseLoadSave)) do begin
     121      Input := 'BEGIN:VCARD' + LineEnding +
     122        'VERSION:2.1' + LineEnding +
     123        'N:Surname;Name' + LineEnding +
     124        'FN:Name Surname' + LineEnding +
     125        'END:VCARD' + LineEnding;
     126      Output := Input;
     127    end;
     128    with TTestCaseLoadSave(AddNew('Multi-line', TTestCaseLoadSave)) do begin
     129      Input := 'BEGIN:VCARD' + LineEnding +
     130        'VERSION:2.1' + LineEnding +
     131        'NOTE:This is some long test which is really multi-lined\neach line\nis on' + LineEnding +
     132        ' different\nline so it is on multiple\nlines.'  + LineEnding +
     133        'END:VCARD' + LineEnding;
     134      Output := Input;
     135    end;
     136    AddNew('Encoding base64', TTestCaseLoadSave);
     137    AddNew('Encoding quoted-printable', TTestCaseLoadSave);
     138    AddNew('Image format', TTestCaseLoadSave);
     139    with TTestCaseLoadSave(AddNew('Empty', TTestCaseLoadSave)) do begin
     140      Input := '';
     141      Output := '';
     142    end;
     143    with TTestCaseLoadSave(AddNew('Begin only', TTestCaseLoadSave)) do begin
     144      Input := 'BEGIN:VCARD';
     145      Output := '';
     146    end;
     147    with TTestCaseLoadSave(AddNew('Missing end', TTestCaseLoadSave)) do begin
     148      Input := 'BEGIN:VCARD' + LineEnding +
     149        'VERSION:2.1' + LineEnding +
     150        'N:Surname;Name' + LineEnding +
     151        'FN:Name Surname' + LineEnding;
     152      Output := '';
     153    end;
    79154  end;
    80155end;
    … …  
    89164  Core.PersistentForm1.Load(Self);
    90165  ReloadList;
     166  UpdateInterface;
    91167end;
    92168

  • trunk/Languages/vCardStudio.cs.po

    r90 r91  
    8383msgctxt "tcore.atest.caption"
    8484msgid "Test"
    85 msgstr ""
     85msgstr "Testování"
    8686
    8787#: tformcontact.aphotoclear.caption
    … …  
    792792msgstr "DPI:"
    793793
     794#: tformtest.arun.caption
     795msgctxt "tformtest.arun.caption"
     796msgid "Run"
     797msgstr "Spustit"
     798
     799#: tformtest.ashow.caption
     800msgctxt "tformtest.ashow.caption"
     801msgid "Show"
     802msgstr "Ukázat"
     803
    794804#: tformtest.buttonrun.caption
     805msgctxt "tformtest.buttonrun.caption"
    795806msgid "Run"
    796 msgstr ""
     807msgstr "Spustit"
    797808
    798809#: tformtest.caption
    799810msgctxt "tformtest.caption"
    800811msgid "Test"
    801 msgstr ""
     812msgstr "Testování"
    802813
    803814#: tformtest.listviewtestcases.columns[0].caption
    … …  
    809820#: tformtest.listviewtestcases.columns[1].caption
    810821msgid "Result"
    811 msgstr ""
     822msgstr "Výsledek"
     823
     824#: tformtestcase.caption
     825msgid "Test case"
     826msgstr "Testový případ"
    812827
    813828#: ucontact.saim
    … …  
    12811296msgid "Invalid line length for encoded text"
    12821297msgstr "Neplatná délka řádky kódovaného textu"
    1283 

  • trunk/Languages/vCardStudio.pot

    r90 r91  
    764764msgstr ""
    765765
     766#: tformtest.arun.caption
     767msgctxt "tformtest.arun.caption"
     768msgid "Run"
     769msgstr ""
     770
     771#: tformtest.ashow.caption
     772msgctxt "tformtest.ashow.caption"
     773msgid "Show"
     774msgstr ""
     775
    766776#: tformtest.buttonrun.caption
     777msgctxt "tformtest.buttonrun.caption"
    767778msgid "Run"
    768779msgstr ""
    … …  
    782793msgstr ""
    783794
     795#: tformtestcase.caption
     796msgid "Test case"
     797msgstr ""
     798
    784799#: ucontact.saim
    785800msgid "AIM"

  • trunk/UContact.pas

    r90 r91  
    141141    class destructor Destroy2;
    142142    procedure SaveToStrings(Output: TStrings);
    143     function LoadFromStrings(Lines: TStrings; StartLine: Integer = 0): Integer;
     143    function LoadFromStrings(Lines: TStrings; var StartLine: Integer): Boolean;
    144144    procedure SaveToFile(FileName: string);
    145145    procedure LoadFromFile(FileName: string);
    … …  
    11341134            end;
    11351135          end;
    1136           if LinePrefix <> '' then Add('');
    11371136        end;
    11381137      end;
    … …  
    11411140end;
    11421141
    1143 function TContact.LoadFromStrings(Lines: TStrings; StartLine: Integer = 0): Integer;
     1142function TContact.LoadFromStrings(Lines: TStrings; var StartLine: Integer): Boolean;
    11441143type
    11451144  TParseState = (psNone, psInside, psFinished);
    … …  
    11541153  Names: string;
    11551154begin
     1155  Result := False;
    11561156  ParseState := psNone;
    11571157  I := StartLine;
    … …  
    11661166      end else begin
    11671167        ContactsFile.Error(SExpectedVCardBegin, I + 1);
    1168         I := -1;
    11691168        Break;
    11701169      end;
    … …  
    11741173        ParseState := psFinished;
    11751174        Inc(I);
     1175        Result := True;
    11761176        Break;
    11771177      end else
    … …  
    11821182        while True do begin
    11831183          Inc(I);
     1184          if I >= Lines.Count then Break;
    11841185          Line2 := Lines[I];
    1185           if (Length(Lines[I]) > 0) and (Line2[1] = ' ') then begin
    1186             Value := Value + Trim(Lines[I]);
     1186          if (Length(Line2) > 0) and (Line2[1] = ' ') then begin
     1187            Value := Value + Trim(Line2);
    11871188          end else
    1188           if (Length(Lines[I]) > 0) and (Length(Value) > 0) and (Value[Length(Value)] = '=') and
    1189             (Lines[I][1] = '=') then begin
    1190             Value := Value + Copy(Trim(Lines[I]), 2, MaxInt);
     1189          if (Length(Line2) > 0) and (Length(Value) > 0) and (Value[Length(Value)] = '=') and
     1190            (Line2[1] = '=') then begin
     1191            Value := Value + Copy(Trim(Line2), 2, MaxInt);
    11911192          end else begin
    11921193            Dec(I);
    … …  
    12081209      end else begin
    12091210        ContactsFile.Error(SExpectedProperty, I + 1);
    1210         I := -1;
    12111211        Break;
    12121212      end;
    … …  
    12141214    Inc(I);
    12151215  end;
    1216   Result := I;
     1216  if Result then StartLine := I;
    12171217end;
    12181218
    … …  
    12331233var
    12341234  Lines: TStringList;
     1235  StartLine: Integer;
    12351236begin
    12361237  Lines := TStringList.Create;
    … …  
    12451246    end;
    12461247    {$ENDIF}
    1247     LoadFromStrings(Lines);
     1248    StartLine := 0;
     1249    LoadFromStrings(Lines, StartLine);
    12481250  finally
    12491251    Lines.Free;
    … …  
    12851287  Contact: TContact;
    12861288  I: Integer;
    1287   NewI: Integer;
    12881289begin
    12891290  Contacts.Clear;
    … …  
    12931294    Contact := TContact.Create;
    12941295    Contact.ContactsFile := Self;
    1295     NewI := Contact.LoadFromStrings(Lines, I);
    1296     if NewI <= Lines.Count then begin
    1297       if NewI <> -1 then begin
    1298         Contacts.Add(Contact);
    1299         I := NewI;
    1300       end else begin
    1301         FreeAndNil(Contact);
    1302         Inc(I);
    1303       end;
     1296    if Contact.LoadFromStrings(Lines, I) then begin
     1297      Contacts.Add(Contact);
    13041298    end else begin
    13051299      FreeAndNil(Contact);
    1306       Break;
     1300      Inc(I);
    13071301    end;
    13081302  end;

  • trunk/UTest.pas

    r90 r91  
    1414
    1515  TTestCase = class
     16  public
    1617    Name: string;
    1718    Result: TTestResult;
    18     procedure Run;
     19    Log: string;
     20    procedure Run; virtual;
    1921  end;
     22
     23  TTestCaseClass = class of TTestCase;
    2024
    2125  { TTestCases }
    2226
    2327  TTestCases = class(TFPGObjectList<TTestCase>)
    24     function AddNew(Name: string): TTestCase;
     28    function AddNew(Name: string; TestClass: TTestCaseClass): TTestCase;
    2529  end;
    2630
     31  { TTestCaseLoadSave }
     32
     33  TTestCaseLoadSave = class(TTestCase)
     34    Input: string;
     35    Output: string;
     36    procedure Run; override;
     37    procedure Evaluate(Passed: Boolean);
     38  end;
     39
     40const
     41  ResultText: array[TTestResult] of string = ('None', 'Passed', 'Failed');
     42
     43
    2744implementation
     45
     46uses
     47  UContact;
     48
     49{ TTestCaseLoadSave }
     50
     51procedure TTestCaseLoadSave.Run;
     52var
     53  Lines: TStringList;
     54begin
     55  Lines := TStringList.Create;
     56  try
     57    with TContactsFile.Create do
     58    try
     59      Lines.Text := Input;
     60      LoadFromStrings(Lines);
     61      Lines.Text := '';
     62      SaveToStrings(Lines);
     63      Evaluate(Lines.Text = Output);
     64      if Result <> trPassed then begin
     65        Log := 'Expected:' + LineEnding +
     66          '"' + Output + '"' + LineEnding + LineEnding +
     67          'Output:' + LineEnding +
     68          '"' + Lines.Text + '"';
     69      end;
     70    finally
     71      Free;
     72    end;
     73  finally
     74    Lines.Free;
     75  end;
     76end;
     77
     78procedure TTestCaseLoadSave.Evaluate(Passed: Boolean);
     79begin
     80  if Passed then Result := trPassed
     81    else Result := trFailed;
     82end;
    2883
    2984{ TTestCase }
    … …  
    3691{ TTestCases }
    3792
    38 function TTestCases.AddNew(Name: string): TTestCase;
     93function TTestCases.AddNew(Name: string; TestClass: TTestCaseClass): TTestCase;
    3994begin
    40   Result := TTestCase.Create;
     95  Result := TestClass.Create;
    4196  Result.Name := Name;
    4297  Add(Result);

  • trunk/vCardStudio.lpi

    r90 r91  
    104104      </Item2>
    105105    </RequiredPackages>
    106     <Units Count="17">
     106    <Units Count="18">
    107107      <Unit0>
    108108        <Filename Value="vCardStudio.lpr"/>
    … …  
    208208        <IsPartOfProject Value="True"/>
    209209      </Unit16>
     210      <Unit17>
     211        <Filename Value="Forms\UFormTestCase.pas"/>
     212        <IsPartOfProject Value="True"/>
     213        <ComponentName Value="FormTestCase"/>
     214        <ResourceBaseClass Value="Form"/>
     215      </Unit17>
    210216    </Units>
    211217  </ProjectOptions>

  • trunk/vCardStudio.lpr

    r90 r91  
    88  {$ENDIF}
    99  Interfaces, // this includes the LCL widgetset
    10   Forms, UFormMain, UCore, Common, UDataFile, SysUtils, UFormTest, UTest;
     10  Forms, UFormMain, UCore, Common, UDataFile, SysUtils, UFormTest, UTest,
     11UFormTestCase;
    1112
    1213{$R *.res}
Note: See TracChangeset for help on using the changeset viewer.