--- ibx/trunk/fbintf/testsuite/testApp/TestApplication.pas	2021/02/26 16:43:23	334
+++ ibx/trunk/fbintf/testsuite/testApp/TestApplication.pas	2021/10/20 15:04:35	351
@@ -77,10 +77,13 @@ type
   TTestBase = class
   private
     FOwner: TTestApplication;
+    FFloatTpl: AnsiString;
+    FCursorSeq: integer;
     function GetFirebirdAPI: IFirebirdAPI;
     procedure SetOwner(AOwner: TTestApplication);
   protected
     FHexStrings: boolean;
+    FShowBinaryBlob: boolean;
     procedure DumpBCD(bcd: tBCD);
     procedure ClientLibraryPathChanged; virtual;
     procedure CreateObjects(Application: TTestApplication); virtual;
@@ -93,7 +96,7 @@ type
     procedure PrintSPB(SPB: ISPB);
     procedure PrintMetaData(meta: IMetaData);
     procedure ParamInfo(SQLParams: ISQLParams);
-    function ReportResults(Statement: IStatement): IResultSet;
+    function ReportResults(Statement: IStatement; ShowCursorName: boolean=false): IResultSet;
     procedure ReportResult(aValue: IResults);
     function StringToHex(octetString: string; MaxLineLength: integer=0): string;
     procedure WriteArray(ar: IArray);
@@ -108,6 +111,7 @@ type
     procedure InitTest; virtual;
     function SkipTest: boolean; virtual;
     procedure ProcessResults; virtual;
+    procedure SetFloatTemplate(tpl: Ansistring);
   public
     constructor Create(aOwner: TTestApplication);  virtual;
     function ChildProcess: boolean; virtual;
@@ -173,6 +177,7 @@ type
     function GetPassword: AnsiString;
     function GetEmployeeDatabaseName: AnsiString;
     function GetNewDatabaseName: AnsiString;
+    function GetTempDatabaseName: AnsiString;
     function GetSecondNewDatabaseName: AnsiString;
     function GetBackupFileName: AnsiString;
     procedure RunAll;
@@ -186,6 +191,22 @@ type
     property Quiet: boolean read FQuiet;
   end;
 
+  { TMsgHash }
+
+  TMsgHash = class
+  private
+    FFinalised: boolean;
+  protected
+    procedure CheckNotFinalised;
+  public
+    procedure AddText(aText: AnsiString); virtual; abstract;
+    procedure Finalise; virtual;
+    function SameHash(otherHash: TMsgHash): boolean;
+    function Digest: AnsiString; virtual; abstract;
+    class function CreateMsgHash: TMsgHash;
+    property Finalised: boolean read FFinalised;
+  end;
+
   ESkipException = class(Exception);
 
 var
@@ -197,8 +218,12 @@ procedure RegisterTest(aTest: TTest);
 
 implementation
 
+{$IFNDEF MSWINDOWS}
+uses MD5;
+{$ENDIF}
+
 {$IFDEF MSWINDOWS}
-uses windows;
+uses {$IFDEF FPC}MD5,{$ENDIF} windows;
 
 function GetTempDir: AnsiString;
 var
@@ -219,12 +244,121 @@ begin
 //    test.CreateObjects(TestApp);
 end;
 
+{$IFDEF FPC}
+type
+
+  { TMD5MsgHash }
+
+  TMD5MsgHash = class(TMsgHash)
+  private
+    FMD5Context: TMDContext;
+    FDigest: TMDDigest;
+  public
+    constructor Create;
+    procedure AddText(aText: AnsiString); override;
+    procedure Finalise; override;
+    function Digest: AnsiString; override;
+  end;
+
+{$DEFINE MSG_HASH_AVAILABLE}
+
+{ TMD5MsgHash }
+
+constructor TMD5MsgHash.Create;
+begin
+  inherited Create;
+  MDInit(FMD5Context,MD_VERSION_5);
+end;
+
+procedure TMD5MsgHash.AddText(aText: AnsiString);
+begin
+  CheckNotFinalised;
+  MDUpdate(FMD5Context,PAnsiChar(aText)^,Length(aText));
+end;
+
+procedure TMD5MsgHash.Finalise;
+begin
+  CheckNotFinalised;
+  MDFinal(FMD5Context,FDigest);
+  inherited Finalise;
+end;
+
+function TMD5MsgHash.Digest: AnsiString;
+begin
+  if not FFinalised then
+    Finalise;
+  Result :=  MD5Print(FDigest);
+end;
+
+class function TMsgHash.CreateMsgHash: TMsgHash;
+begin
+  Result := TMD5MsgHash.Create;
+end;
+{$ENDIF}
+
+{$IFNDEF MSG_HASH_AVAILABLE}
+type
+
+  { TSimpleMsgHash }
+
+  TSimpleMsgHash = class(TMsgHash)
+  private
+    FDigest: Int64;
+    Finalised: boolean;
+  public
+    procedure AddText(aText: AnsiString); override;
+    function Digest: AnsiString; override;
+  end;
+
+{ TSimpleMsgHash }
+
+procedure TSimpleMsgHash.AddText(aText: AnsiString);
+const
+  modulus = high(Int64) div 100;
+var i: integer;
+begin
+  CheckNotFinalised;
+  for i := 1 to length(aText) do
+    FDigest := (FDigest * 7 + ord(aText[i])) mod modulus;
+end;
+
+function TSimpleMsgHash.Digest: AnsiString;
+begin
+  if not Finalised then
+    Finalise;
+  Result := IntToStr(FDigest);
+end;
+
+class function TMsgHash.CreateMsgHash: TMsgHash;
+begin
+  Result := TSimpleMsgHash.Create;
+end;
+
+{$ENDIF}
+
+procedure TMsgHash.CheckNotFinalised;
+begin
+  if FFinalised then
+    raise Exception.Create('Digest has been finalised');
+end;
+
+procedure TMsgHash.Finalise;
+begin
+  FFinalised := true;
+end;
+
+function TMsgHash.SameHash(otherHash: TMsgHash): boolean;
+begin
+  Result := Digest = OtherHash.Digest;
+end;
+
 { TTestBase }
 
 constructor TTestBase.Create(aOwner: TTestApplication);
 begin
   inherited Create;
   FOwner := aOwner;
+  FFloatTpl := '#,###.00';
 end;
 
 function TTestBase.ChildProcess: boolean;
@@ -420,14 +554,18 @@ begin
     writeln(OutFile,'Charset id = ',getCharSetID);
     if getIsNullable then writeln(OutFile,'Nullable') else writeln(OutFile,'Not Null');
     writeln(OutFile,'Size = ',GetSize);
+    if not IsNull then
+      writeln(Outfile,'Value = ',getAsString);
     writeln(OutFile);
   end;
 end;
 
-function TTestBase.ReportResults(Statement: IStatement): IResultSet;
+function TTestBase.ReportResults(Statement: IStatement; ShowCursorName: boolean): IResultSet;
 begin
   Result := Statement.OpenCursor;
   try
+   if ShowCursorName then
+      writeln(Outfile,'Results for Cursor: ',Result.GetCursorName);
     while Result.FetchNext do
       ReportResult(Result);
   finally
@@ -699,11 +837,11 @@ begin
     end;
   SQL_FLOAT,SQL_DOUBLE,
   SQL_D_FLOAT:
-    writeln(OutFile, aValue.Name,' = ',FormatFloat('#,##0.00',aValue.AsFloat));
+    writeln(OutFile, aValue.Name,' = ',FormatFloat(FFloatTpl,aValue.AsDouble));
 
   SQL_INT64:
     if aValue.Scale <> 0 then
-      writeln(OutFile, aValue.Name,' = ',FormatFloat('#,##0.00',aValue.AsFloat))
+      writeln(OutFile, aValue.Name,' = ',FormatFloat(FFloatTpl,aValue.AsDouble))
     else
       writeln(OutFile,aValue.Name,' = ',aValue.AsString);
 
@@ -728,7 +866,11 @@ begin
       end
     end
     else
+    begin
       writeln(OutFile,aValue.Name,' = (blob), Length = ',aValue.AsBlob.GetBlobSize);
+      if FShowBinaryBlob then
+        PrintHexString(aValue.AsString);
+    end;
 
   SQL_TEXT,SQL_VARYING:
   begin
@@ -810,6 +952,11 @@ begin
   //Do nothing
 end;
 
+procedure TTestBase.SetFloatTemplate(tpl: Ansistring);
+begin
+  FFloatTpl := tpl;
+end;
+
 { TTestApplication }
 
 class procedure TTestApplication.CreateTestList;
@@ -858,7 +1005,10 @@ end;
 function TTestApplication.GetFirebirdAPI: IFirebirdAPI;
 begin
   if FFirebirdAPI = nil then
+  begin
     FFirebirdAPI := IB.FirebirdAPI;
+    FFirebirdAPI.GetStatus.SetIBDataBaseErrorMessages([ShowIBMessage]);;
+  end;
   Result := FFirebirdAPI;
 end;
 
@@ -926,6 +1076,11 @@ begin
     Result := MakeConnectString(FServer,  FNewDatabaseName, inet,FPortNo);
 end;
 
+function TTestApplication.GetTempDatabaseName: AnsiString;
+begin
+  Result := GetTempDir + 'fbtest.fbd';
+end;
+
 function TTestApplication.GetSecondNewDatabaseName: AnsiString;
 begin
   if FirebirdAPI.GetClientMajor < 3 then
@@ -948,6 +1103,7 @@ begin
     DoTest(i);
     if not Quiet then
       writeln(Outfile,'------------------------------------------------------');
+    Sleep(500);
   end;
 end;
 
@@ -1219,6 +1375,7 @@ begin
       RunAll
     else
       RunTest(TestID);
+    CleanUp;
   except on E: Exception do
     begin
       writeln('Exception: ',E.Message);