ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/testsuite/testApp/TestApplication.pas
(Generate patch)

Comparing ibx/trunk/fbintf/testsuite/testApp/TestApplication.pas (file contents):
Revision 351 by tony, Wed Oct 20 15:04:35 2021 UTC vs.
Revision 369 by tony, Wed Dec 8 13:12:10 2021 UTC

# Line 81 | Line 81 | type
81      FCursorSeq: integer;
82      function GetFirebirdAPI: IFirebirdAPI;
83      procedure SetOwner(AOwner: TTestApplication);
84 +    {$if declared(TJnlEntry) }
85 +    procedure HandleOnJnlEntry(JnlEntry: TJnlEntry);
86 +    {$endif}
87    protected
88      FHexStrings: boolean;
89      FShowBinaryBlob: boolean;
# Line 96 | Line 99 | type
99      procedure PrintSPB(SPB: ISPB);
100      procedure PrintMetaData(meta: IMetaData);
101      procedure ParamInfo(SQLParams: ISQLParams);
102 +    {$if declared(TJnlEntry) }
103 +    procedure PrintJournalFile(aFileName: AnsiString);
104 +    procedure PrintJournalTable(Attachment: IAttachment);
105 +    {$ifend}
106      function ReportResults(Statement: IStatement; ShowCursorName: boolean=false): IResultSet;
107      procedure ReportResult(aValue: IResults);
108      function StringToHex(octetString: string; MaxLineLength: integer=0): string;
109 +    procedure WriteAttachmentInfo(Attachment: IAttachment);
110      procedure WriteArray(ar: IArray);
111      procedure WriteAffectedRows(Statement: IStatement);
112      procedure WriteDBInfo(DBInfo: IDBInformation);
113 +    procedure WriteTRInfo(TrInfo: ITrInformation);
114      procedure WriteBytes(Bytes: TByteArray);
115      procedure WriteOperationCounts(Category: AnsiString; ops: TDBOperationCounts);
116      procedure WritePerfStats(stats: TPerfCounters);
# Line 381 | Line 390 | begin
390    FOwner := AOwner;
391   end;
392  
393 + {$if declared(TJnlEntry)}
394 + procedure TTestBase.HandleOnJnlEntry(JnlEntry: TJnlEntry);
395 + begin
396 + with JnlEntry do
397 + begin
398 +   {$IFNDEF FPC}
399 +   writeln(OutFile,'Journal Entry = ',ord(JnlEntryType),'(', TJournalProcessor.JnlEntryText(JnlEntryType),')');
400 +   {$ELSE}
401 +   writeln(OutFile,'Journal Entry = ',JnlEntryType,'(', TJournalProcessor.JnlEntryText(JnlEntryType),')');
402 +   {$ENDIF}
403 +   writeln(OutFIle,'Timestamp = ',FBFormatDateTime('yyyy/mm/dd hh:nn:ss.zzzz',Timestamp));
404 +   writeln(OutFile,'Session ID = ',SessionID);
405 +   writeln(OutFile,'Transaction ID = ',TransactionID);
406 +   case JnlEntry.JnlEntryType of
407 +   jeTransStart:
408 +     begin
409 +       writeln(OutFile,'Transaction Name = "',TransactionName,'"');
410 +       PrintTPB(TPB);
411 +       {$IFNDEF FPC}
412 +       writeln(OutFile,'Default Completion = ',ord(DefaultCompletion));
413 +       {$ELSE}
414 +       writeln(OutFile,'Default Completion = ',DefaultCompletion);
415 +       {$ENDIF}
416 +     end;
417 +
418 +   jeQuery:
419 +     begin
420 +       writeln(OutFile,'Query = ',QueryText);
421 +     end;
422 +
423 +   jeTransCommitRet,
424 +   jeTransRollbackRet:
425 +     writeln(Outfile,'Old TransactionID = ',OldTransactionID);
426 +   end;
427 + end;
428 + writeln(OutFile);
429 + end;
430 + {$ifend}
431 +
432   procedure TTestBase.DumpBCD(bcd: tBCD);
433   var i,l: integer;
434   begin
# Line 560 | Line 608 | begin
608    end;
609   end;
610  
611 + {$if declared(TJnlEntry) }
612 + procedure TTestBase.PrintJournalFile(aFileName: AnsiString);
613 + begin
614 + writeln(OutFile,'Journal Entries');
615 + with TJournalProcessor.Create do
616 + try
617 +    Execute(aFileName,FirebirdAPI,HandleOnJnlEntry);
618 + finally
619 +   Free
620 + end;
621 + end;
622 +
623 + procedure TTestBase.PrintJournalTable(Attachment: IAttachment);
624 + var Results: IResultSet;
625 + begin
626 +  writeln(OutFile,'Journal Table');
627 +  Results := Attachment.OpenCursorAtStart('Select * From IBX$JOURNALS');
628 +  while not Results.IsEof do
629 +  begin
630 +    ReportResult(Results);
631 +    Results.Fetchnext;
632 +  end;
633 + end;
634 + {$ifend}
635 +
636   function TTestBase.ReportResults(Statement: IStatement; ShowCursorName: boolean): IResultSet;
637   begin
638    Result := Statement.OpenCursor;
# Line 617 | Line 690 | begin
690    end;
691   end;
692  
693 + procedure TTestBase.WriteAttachmentInfo(Attachment: IAttachment);
694 + begin
695 + writeln(outfile,'DB Connect String = ',Attachment.GetConnectString);
696 + writeln(outfile,'DB Charset ID = ',Attachment.GetDefaultCharSetID);
697 + writeln(outfile,'DB SQL Dialect = ',Attachment.GetSQLDialect);
698 + writeln(outfile,'DB Remote Protocol = ', Attachment.GetRemoteProtocol);
699 + writeln(outfile,'DB ODS Major Version = ',Attachment.GetODSMajorVersion);
700 + writeln(outfile,'DB ODS Minor Version = ',Attachment.GetODSMinorVersion);
701 + writeln(outfile,'User Authentication Method = ',Attachment.GetAuthenticationMethod);
702 + writeln(outfile,'Firebird Library Path = ',Attachment.getFirebirdAPI.GetFBLibrary.GetLibraryFilePath);
703 + writeln(outfile,'DB Client Implementation Version = ',Attachment.getFirebirdAPI.GetImplementationVersion);
704 + end;
705 +
706   procedure TTestBase.WriteArray(ar: IArray);
707   var Bounds: TArrayBounds;
708      i,j: integer;
# Line 770 | Line 856 | begin
856    end;
857   end;
858  
859 + procedure TTestBase.WriteTRInfo(TrInfo: ITrInformation);
860 + var IsolationType, RecVersion: byte;
861 +    i: integer;
862 +    access: integer;
863 + begin
864 + for i := 0 to TrInfo.GetCount - 1 do
865 + with TrInfo[i] do
866 + case getItemType of
867 +   isc_info_tra_id:
868 +     writeln(OutFile,'Transaction ID = ',getAsInteger);
869 +   isc_info_tra_oldest_interesting:
870 +     writeln(OutFile,'Oldest Interesting = ',getAsInteger);
871 +   isc_info_tra_oldest_active:
872 +     writeln(OutFile,'Oldest Action = ',getAsInteger);
873 +   isc_info_tra_oldest_snapshot:
874 +     writeln(OutFile,'Oldest Snapshot = ',getAsInteger);
875 +   fb_info_tra_snapshot_number:
876 +     writeln(OutFile,'Oldest Snapshot Number = ',getAsInteger);
877 +   isc_info_tra_lock_timeout:
878 +     writeln(OutFile,'Lock Timeout = ',getAsInteger);
879 +   isc_info_tra_isolation:
880 +     begin
881 +       DecodeTraIsolation(IsolationType, RecVersion);
882 +       write(OutFile,'Isolation Type = ');
883 +       case IsolationType of
884 +       isc_info_tra_consistency:
885 +         write(OutFile,'isc_info_tra_consistency');
886 +       isc_info_tra_concurrency:
887 +         write(OutFile,'isc_info_tra_concurrency');
888 +       isc_info_tra_read_committed:
889 +         begin
890 +          write(OutFile,'isc_info_tra_read_committed, Options =');
891 +          case RecVersion of
892 +          isc_info_tra_no_rec_version:
893 +            write(OutFile,'isc_info_tra_no_rec_version');
894 +          isc_info_tra_rec_version:
895 +            write(OutFile,'isc_info_tra_rec_version');
896 +          isc_info_tra_read_consistency:
897 +            write(OutFile,'isc_info_tra_read_consistency');
898 +          end;
899 +         end;
900 +       end;
901 +       writeln(OutFile);
902 +     end;
903 +   isc_info_tra_access:
904 +     begin
905 +       write(OutFile,'Transaction Access = ');
906 +       access :=  getAsInteger;
907 +       case access of
908 +       isc_info_tra_readonly:
909 +         writeln(OutFile,'isc_info_tra_readonly');
910 +       isc_info_tra_readwrite:
911 +         writeln(OutFile,'isc_info_tra_readwrite');
912 +       end;
913 +     end;
914 +   fb_info_tra_dbpath:
915 +     writeln(OutFile,'Transaction Database Path = ',getAsString);
916 + end;
917 +
918 + end;
919 +
920   procedure TTestBase.WriteBytes(Bytes: TByteArray);
921   var i: integer;
922   begin

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines