bufdatasettoolsunit.pas 5.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194
  1. unit BufDatasetToolsUnit;
  2. { Sets up bufdataset for testing.
  3. Tests expect Get*Dataset to return a dataset with structure and test data, but closed.
  4. A closed BufDataset normally has no data, so these tests won't work.
  5. To circumvent this, this unit saves the dataset contents to file and reloads them on opening
  6. using the BufDataset persistence mechanism.
  7. }
  8. {$mode objfpc}{$H+}
  9. interface
  10. uses
  11. Classes, SysUtils, toolsunit,
  12. db,
  13. BufDataset;
  14. type
  15. { TbufdatasetConnector }
  16. { TbufdatasetDBConnector }
  17. TbufdatasetDBConnector = class(TDBConnector)
  18. private
  19. FUniDirectional: boolean;
  20. protected
  21. procedure CreateNDatasets; override;
  22. procedure CreateFieldDataset; override;
  23. procedure DropNDatasets; override;
  24. procedure DropFieldDataset; override;
  25. Function InternalGetNDataset(n : integer) : TDataset; override;
  26. Function InternalGetFieldDataset : TDataSet; override;
  27. procedure SetTestUniDirectional(const AValue: boolean); override;
  28. function GetTestUniDirectional: boolean; override;
  29. end;
  30. implementation
  31. uses
  32. StrUtils, FmtBCD;
  33. type
  34. { TPersistentBufDataSet }
  35. TPersistentBufDataSet=class(TBufDataset)
  36. private
  37. TempFileName:string;
  38. public
  39. destructor Destroy; override;
  40. end;
  41. { TPersistentBufDataSet }
  42. destructor TPersistentBufDataSet.Destroy;
  43. begin
  44. Close; // no locks on TempFileName
  45. DeleteFile(TempFileName);
  46. inherited Destroy;
  47. end;
  48. { TbufdatasetDBConnector }
  49. procedure TbufdatasetDBConnector.CreateNDatasets;
  50. begin
  51. // All datasets are created in InternalGet*Dataset
  52. end;
  53. procedure TbufdatasetDBConnector.CreateFieldDataset;
  54. begin
  55. // All datasets are created in InternalGet*Dataset
  56. end;
  57. procedure TbufdatasetDBConnector.DropNDatasets;
  58. begin
  59. // All datasets are created in InternalGet*Dataset and cleaned up when destroyed
  60. end;
  61. procedure TbufdatasetDBConnector.DropFieldDataset;
  62. begin
  63. // All datasets are created in InternalGet*Dataset and cleaned up when destroyed
  64. end;
  65. function TbufdatasetDBConnector.InternalGetNDataset(n: integer): TDataset;
  66. var BufDataset : TPersistentBufDataSet;
  67. i : integer;
  68. begin
  69. BufDataset := TPersistentBufDataSet.Create(nil);
  70. with BufDataset do
  71. begin
  72. Name := 'NDataset';
  73. FieldDefs.Add('ID',ftInteger);
  74. FieldDefs.Add('NAME',ftString,50);
  75. CreateDataset;
  76. Open;
  77. for i := 1 to n do
  78. begin
  79. Append;
  80. FieldByName('ID').AsInteger := i;
  81. FieldByName('NAME').AsString := 'TestName' + inttostr(i);
  82. Post;
  83. end;
  84. MergeChangeLog;
  85. TempFileName:=GetTempFileName;
  86. FileName:=TempFileName;
  87. Close; // Save data into file
  88. end;
  89. Result := BufDataset;
  90. end;
  91. function TbufdatasetDBConnector.InternalGetFieldDataset : TDataSet;
  92. var BufDataset : TPersistentBufDataSet;
  93. i : integer;
  94. begin
  95. // Values >= 24:00:00.000 can't be handled by StrToTime function
  96. testTimeValues[2] := '23:59:59.000';
  97. testTimeValues[3] := '23:59:59.003';
  98. BufDataset := TPersistentBufDataSet.Create(nil);
  99. with BufDataset do
  100. begin
  101. Name := 'FieldDataset';
  102. FieldDefs.Add('ID',ftInteger);
  103. FieldDefs.Add('FSTRING',ftString,10);
  104. FieldDefs.Add('FSMALLINT',ftSmallint);
  105. FieldDefs.Add('FINTEGER',ftInteger);
  106. FieldDefs.Add('FWORD',ftWord);
  107. FieldDefs.Add('FBOOLEAN',ftBoolean);
  108. FieldDefs.Add('FFLOAT',ftFloat);
  109. FieldDefs.Add('FCURRENCY',ftCurrency);
  110. FieldDefs.Add('FBCD',ftBCD);
  111. FieldDefs.Add('FDATE',ftDate);
  112. FieldDefs.Add('FTIME',ftTime);
  113. FieldDefs.Add('FDATETIME',ftDateTime);
  114. FieldDefs.Add('FBLOB',ftBlob);
  115. FieldDefs.Add('FMEMO',ftMemo);
  116. FieldDefs.Add('FLARGEINT',ftLargeint);
  117. FieldDefs.Add('FFIXEDCHAR',ftFixedChar,10);
  118. FieldDefs.Add('FFMTBCD',ftFmtBCD);
  119. CreateDataset;
  120. Open;
  121. for i := 0 to testValuesCount-1 do
  122. begin
  123. Append;
  124. FieldByName('ID').AsInteger := i;
  125. FieldByName('FSTRING').AsString := testStringValues[i];
  126. FieldByName('FSMALLINT').AsInteger := testSmallIntValues[i];
  127. FieldByName('FINTEGER').AsInteger := testIntValues[i];
  128. FieldByName('FWORD').AsInteger := testWordValues[i];
  129. FieldByName('FBOOLEAN').AsBoolean := testBooleanValues[i];
  130. FieldByName('FFLOAT').AsFloat := testFloatValues[i];
  131. FieldByName('FCURRENCY').AsCurrency := testCurrencyValues[i];
  132. FieldByName('FBCD').AsCurrency := testCurrencyValues[i];
  133. FieldByName('FDATE').AsDateTime := StrToDateTime(testDateValues[i], Self.FormatSettings);
  134. FieldByName('FTIME').AsDateTime := StrToTime(testTimeValues[i], Self.FormatSettings);
  135. FieldByName('FDATETIME').AsDateTime := StrToDateTime(testValues[ftDateTime,i], Self.FormatSettings);
  136. FieldByName('FBLOB').AsString := testStringValues[i];
  137. FieldByName('FMEMO').AsString := testStringValues[i];
  138. FieldByName('FLARGEINT').AsLargeInt := testLargeIntValues[i];
  139. FieldByName('FFIXEDCHAR').AsString := PadRight(testStringValues[i], 10);
  140. FieldByName('FFMTBCD').AsBCD := StrToBCD(testFmtBCDValues[i], Self.FormatSettings);
  141. Post;
  142. end;
  143. MergeChangeLog;
  144. TempFileName:=GetTempFileName;
  145. FileName:=TempFileName;
  146. Close; // Save data into file
  147. // When data are loaded from file, bidirectional is checked
  148. // so unidirectional bufdataset can't be tested here
  149. UniDirectional := TestUniDirectional;
  150. end;
  151. Result := BufDataset;
  152. end;
  153. procedure TbufdatasetDBConnector.SetTestUniDirectional(const AValue: boolean);
  154. begin
  155. FUniDirectional := AValue;
  156. end;
  157. function TbufdatasetDBConnector.GetTestUniDirectional: boolean;
  158. begin
  159. Result := FUniDirectional;
  160. end;
  161. initialization
  162. RegisterClass(TbufdatasetDBConnector);
  163. end.