TestCodeType.pas

The module describes the interfaces of the test TestCode

Constants

MAX_POS_TESTMETHOD

  const  
   MAX_POS_TESTMETHOD = $FFFFFFF;

Use when registering a method in IRegisterMethod.

Replace the parameter iSortPrioritet with MAX_POS_TESTMETHOD if you need to delete an object under test Object.Free
Example:

// Free class
   IRegisterMethod(tmFree  ,'tmFree'  ,'Test Free component'
   ,pAddOneEmptyParam    // Auto add test parameter
   ,MAX_POS_TESTMETHOD); // Last index test position
 

Type

TTestResultParam - Test return code

type
 TTestResultParam=(
    // Выполнения теста
              trNone      = 0  //  there was no test
             ,trOk        = 3  // Test passed
             ,trBreakTest = 10 // Interrupt test on command
             ,trError     = 13 // Error, test failed
             ,trException = 16 // During operation there was an exception
 
    // Registration errors
             ,trErrParamCount = 30 // Error in number of parameters
             ,trErrParamType  = 31 // Error in parameter type (number, string)
             ,trErrRegister   = 32 // Error check test
 
            ,trUnknowResult = 63   // Use as stub for not created test
             );

TTypeDataStore - Saved data type

type
 TTypeDataStore = (
  tdsInteger     = 0   ,
  tdsBoolean     = 1   ,
  tdsAnsiChar    = 2   ,
  tdsExtended    = 3   ,
  tdsShortString = 4   , // conversion to tdsAnsiString
  tdsPointer     = 5   ,
  tdsPAnsiChar   = 6   ,
  tdsObject      = 7   ,
  tdsClass       = 8   ,
  tdsWideChar    = 9   ,
  tdsPWideChar   = 10  ,
  tdsAnsiString  = 11  ,
  tdsCurrency    = 12  , // conversion to tdsExtended
  tdsVariant     = 13  , // disabled, conversion to tdsNone
  tdsInterface   = 14  ,
  tdsWideString  = 15  ,
  tdsInt64       = 16  ,
  tdsUnicodeString = 17,
  tdsNone        = 99 // unknown type 
  );

TDisableInit - defining a function that disables the test

   type
    TPIndexValue=  PInteger;
    TDisableInit=function(var wsErr:WideString):Boolean  of object;

Test registration methods

  type
   TTestRegisterMethod = procedure of object;
   TTestMethodsRun     = function( IMethod:IRunMethodParam):TTestResultParam  of object;

Example:

  L_pIndexTCalculate   := IRegisterClass(TCalc._RegisterMethod,TCalc._TestMethods,'TCalc','Class Calculater');

TTestType - type of testing method

 TTestType=(tEmptyParam=0 // not use
  ,tTestCodeOnly=1 // code testing (default)        
 );

TMethodAddParam - parameter type

 TMethodAddParam = ( pAddManualOnly = 0 // manually adding
                    ,pAddOneEmptyParam =1 // automatic addition of one parameter
                   );

Example:

 // Create class for test
   IRegisterMethod(tmCreate,'tmCreate','Test Create component'
   ,pAddOneEmptyParam    // Auto add test parameter
    ,1);                 // First index test position
 
// Test methods  - pAddManualOnly - default
   IRegisterMethod(tmPlus  ,'tmPlus'  ,'Test Plus operation');
    IRegisterMethodParams([2,2],[4],'2+2=4');
 
 

TParamCheckOption - checked parameters before the test

   TParamCheckOption = (poCountParam // check the number of parameters
                  ,poHardTypeParam   // check for parameter type
                  );
   TParamCheckOptions = set of TParamCheckOption;
 

Example:

 // Create class for test
   IRegisterMethod(tmCreate,'tmCreate','Test Create component'
   ,pAddOneEmptyParam    // Auto add test parameter
    ,1);                 // First index test position
 
// Test methods  - default [poCountParam]
   IRegisterMethod(tmPlus  ,'tmPlus'  ,'Test Plus operation');
    IRegisterMethodParams([2,2],[4],'2+2=4');
 
   IRegisterMethod(tmTestStringChar ,'tmTestStringChar'  ,'Test String operation',pAddManualOnly,100,[poCountParam,poHardTypeParam]);
    IRegisterMethodParams(['aaa','bbb'],['aaabbb'],'aaa+bbb=aaabbb');
    IRegisterMethodParams(['a','bbb'],['abbb'],'a+bbb=abbb');// Error poHardTypeParam     
 

Interfaces

IResultValue - Parameter return value interface

    IResultValue=interface
      ['{999297E2-97B4-4CA8-9FD1-8358C184D84E}']
      Function AsInteger:Integer;
      Function AsBoolean:boolean;
      Function AsObject:TObject;
      Function AsClass:TClass;
      Function AsExtended:Extended; // saves a value without an infinite fraction
      Function AsExtended_RecurrDecimal:Extended;  // with infinite fraction
      Function AsCurrency:currency; // convert to tdsExtended 
      Function AsVariant:Variant;
      Function AsInterface:IInterface;//Pointer;
      Function AsInt64:int64;
 
      Function AsDateTime:TDateTime;
 
      Function AsAnsiChar:AnsiChar;
      Function AsPAnsiChar:PAnsiChar;
 
      Function AsWideChar:WideChar;
      Function AsPWideChar:PWideChar;
 
      // use all strings
      Function AsPointer:Pointer;
      //      AsAnsiString:AnsiString;
      Function AsAnsiString_GetSize:integer;
      Function AsAnsiString_GetDataAll(var Dest):integer;
      Function AsAnsiString_GetData(var Dest;iCount:integer;iOffset:Integer=0):integer;
 
//      Function AsWideString:WideString;
      Function  AsWideString_GetSize:integer;
      Function AsWideString_GetDataAll(var Dest):integer;
      Function AsWideString_GetData(var Dest;iCount:integer;iOffset:Integer=0):integer;
 
//      Function AsUnicodeString:UnicodeString;
      Function  AsUnicodeString_GetSize:integer;
      Function AsUnicodeString_GetDataAll(var Dest):integer;
      Function AsUnicodeString_GetData(var Dest;iCount:integer;iOffset:Integer=0):integer;
 
 
      Function AsType:TTypeDataStore; //Type stores
      Function IsCompareType(tOut:TTypeDataStore):boolean; //Type compatibility check
 
    end;

IResultBuff - Buffer interface for testing

   type
    IResultBuff=interface
    ['{0B0B12B5-7369-4D7D-A07E-A4CE215643E5}']
      Function IsExists:boolean;
      Function AsBuff_Size:integer;
      Function AsBuff_Data(var Dest;iCount:integer;iOffset:Integer=0):integer;
    end;

IRunMethodParam - parameters interface for code testing

type
    IRunMethodParam=interface
     ['{2FF6D5C8-F137-46F0-8A88-FD4BD2C2F93A}']
 
      function GetAutoConvertParam: Boolean;
      procedure SetAutoConvertParam(const Value: Boolean);
 
     function IGetNumParamUser:integer; // number of parameters recorded in the call to be checked in the test function
      function IReg_CodeResult_Ok:TTestResultParam; // what type of return that test passed
 
     // public parameter values for tests
     function IGetArrParamCount:integer;
     function IGetArrParam(iIndexValue:integer):IResultValue;
      function IGetArrParamBuff:IResultBuff;
     function IGetArrResultForTestMethodCount:integer;
     function IGetArrResultForTestMethod(iIndexValue:integer):IResultValue;
      function IGetArrReultBuff:IResultBuff;
      Function IsCompareTypes(tStore,tOut:TTypeDataStore):boolean;
 
     // Count  runs
     function IGetCountRunStep:Integer;
     function IGetCountRun:Integer;
 
    // пget max timeout, after it will be considered that the test is not passed
     function IGetMaxTimeOut:Integer;
 
     // returns whether to abort the test 
       function INeedBreakTest:boolean;
       function INeedBreakTestPointer:PBoolean;
     // autoconvert paramterd in code
       property IAutoConvertParam:Boolean read GetAutoConvertParam write SetAutoConvertParam  ;
 
    end;

IRegisterTestCode - Interface for registration of models, classes, methods for testing

    IRegisterTestCode=interface
    ['{F74FEF67-4EBA-4182-9C42-3580B19BDF61}']
      //  USE ONLY -> LevelTestUnit.pas
      // Samples:    TestCodeLevelUnits.IRegisterLevelUnit(ltApplication,'ltApplication','Applications');
    Procedure IRegisterLevelUnit(vLevelUnit:variant;const wsName,wsDescription:WideString);
 
    // Register the name of the group in which the application will be
    Procedure  IRegisterGroupApplications(const wsGroupName:WideString='';wsGroupDescription:WideString='');
 
    // application registration is required if you are testing both the application and the DLL
    Function   IRegisterApplication(hInstanceApp:NativeUInt;const wsDescription:WideString='';procNeedDisableInit:TDisableInit=nil;iSortPrioritet:integer=100):TPIndexValue;
 
 
    // unit registration
    Function IRegisterUnit(vLevelTest:variant // TLevelTestRun -> TestCodeLevelUnits.pas
              ;const sNameUnit:WideString;sDescription:WideString=''
              ;procNeedDisableInit:TDisableInit=nil // Check when loading a test to disable it
              ;iSortPrioritet:integer=100           // position in the list of units 
              ;pIndexApp_NilDefault:TPIndexValue=nil  // pointer to application number
              ):TPIndexValue; // Id Unit
 
      // class registration
      Function IRegisterClass(RegMethod:TTestRegisterMethod;TestMethodRun:TTestMethodsRun
                            ;const wsClassName:WideString
                             ;wsDescription:WideString=''
              ;procNeedDisableInit:TDisableInit=nil  // Check when loading a test to disable it
                        ;iSortPrioritet:integer=100  // position in class list
                            ;pIndexUnit_NilDefault:TPIndexValue=nil // pointer to application and unit number
                            ;pIndexApp_NilDefault:TPIndexValue=nil
                             )
            :TPIndexValue; // Id Class
 
    Function IRegisterMethodList(const ArrNames :array of Variant// [vENumMethodName,vENumMethodName] array methods list with empty params
         ;wsNames:WideString=''  // method names separated by a separator 'Meth1,Meth2'
         ;wsDescription:WideString=''
         ;chSeparator:WideChar=','  // separator text
         ;iSortPrioritet:integer=100  // create positions default
         ):boolean;// True or False Registrations
 
 
    Function IRegisterMethod(vENumMethodName
                             :variant  //custom types
                             ;const wsNamesMethod:WideString
                             ;wsDesc:WideString=''
                             ;tAddParam:TMethodAddParam=pAddManualOnly
                             ;iSortPrioritet:integer=100
                             ;tParamCheckOptions:TParamCheckOptions=[poCountParam{,poHardTypeParam}]
                             ;ttTestType:TTestType=tTestCodeOnly
                             ;pIndexClass_NilDefault:TPIndexValue=nil
                             ;pIndexUnit_NilDefault:TPIndexValue=nil
                            ;pIndexApp_NilDefault:TPIndexValue=nil
           ):boolean;
 
    Function IRegisterMethodParams(
                      arrParams        // test in params
                       ,arrResultCMP   // test check params
                        :array of const;
                       sName:WideString
                       ;ErrCode_Ok:TTestResultParam=trOk
                        ;bIsAutoConvertParam:boolean=True  // AnsiChar to AnsiString,WideChar,WideString;  integer to int64,extended
                        ;iTimeOutMS:Integer=5000 // wait normal work test 5sec
                        ;iCountRun:Integer=1     // count run test
                       ;ttTestType:TTestType=tTestCodeOnly // test code
 
                       ;sReserveStrParam:WideString=''
                       ;pIndMethod:TPIndexValue=nil
                       ):boolean;
    Function IRegisterMethodParamsBuff(
                      arrParams  
                       ,arrResultCMP 
                        :array of const;
                        BuffParam:Pointer;iBuffParamSize:Integer; // Add buff param
                        BuffResultCMP:Pointer;iBuffResultSize:Integer;
                       sName:WideString
                       ;ErrCode_Ok:TTestResultParam=trOk
                        ;bIsAutoConvertParam:boolean=True
                        ;iTimeOutMS:Integer=5000  
                        ;iCountRun:Integer=1   
                       ;ttTestType:TTestType=tTestCodeOnly  
 
                       ;sReserveStrParam:WideString=''
                       ;pIndMethod:TPIndexValue=nil
                       ):boolean;
      // Set positions for registrations methods and params
      function ISetDefaultIndClassUnitApp(pIndClass:TPIndexValue;pIndUnit:TPIndexValue=nil;pIndApp:TPIndexValue=nil):boolean;
    end;

Functions

Conversion

Converts the expression Sets in a Int64

  function Conv_Set2int64(const value;iSize:integer): int64;
  Procedure Conv_int642Set(const i64:Int64; var value;iSize:integer);

Example:

 type
  TTypeTest=(ts1,ts2,ts3,ts4);
  TTypeTestSet=set of TTypeTest;
 ...
var 
  SS:TTypeTestSet;
begin
      ...  
         SS:=[ts1,ts3];
 
      GetTestMe.ITestCode.IRegisterMethodParams([
           ,Conv_Set2int64(SS,SizeOf(SS))
        ]
        ,[],'Check Set');
 
     ...   
 
         Conv_int642Set(IMethod.IGetArrParam(5).AsInt64,SS,SizeOf(SS));
             if SS<>SS2 then begin
              Exit;
             end;
         result:=trOk;
 

Retrieval of strings

function IMethod_AsAnsiString(const IResValue:IResultValue):AnsiString;
function IMethod_AsWideString(const IResValue:IResultValue):WideString;
function IMethod_AsUnicodeString(const IResValue:IResultValue):UnicodeString;

Example:

var
 sA:AnsiString;
begin
 ...
     sA:=IMethod_AsAnsiString(IMethod.IGetArrParam(i));

"Sleep" and test interruption

 // Sleep and Break Test
 Procedure  CPUTSleep_1MS_Break(msec:Cardinal;var bIsBreak:boolean);
 Procedure  CPUTSleep_10MS_Break(msec:Cardinal;var bIsBreak:boolean);
 Procedure  CPUTSleep_100MS_Break(msec:Cardinal;var bIsBreak:boolean);

Example:

var
  pB:PBoolean;
begin
 ...
             pB:=IMethod.INeedBreakTestPointer;
              CPUTSleep_100MS_Break(20000,pB^);