FAQ DelphiConsultez toutes les FAQ

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
unit ToolsDUnit; 
interface 
  
uses TestFramework, 
     GUITestRunner, 
     SysUtils, 
     Classes, 
     Dialogs; 
type 
  // Il existe 2 types d'erreur qui nous intéressent 
 TypeErreur=(Echec,Exception); 
  
const 
 TabTypeErreur: Array[TypeErreur] Of String[9]=('Echec','Exception'); 
  
type 
  // La solution nécessite d'utiliser l'interface ITestListener 
 TGUIMyTestRunner = class(TGUITestRunner,ITestListener) 
   Procedure TestingEnds(TestResult :TTestResult); Virtual; 
   Function TestResultToCSV(TestResult :TTestResult;Delimiteur:String): TStringList; Virtual;   
 end; 
  
 procedure RunRegisteredTestsAndSave; // Suis le principe de la classe de base 
  
implementation 
  
Function TGUIMyTestRunner.TestResultToCSV(TestResult :TTestResult;Delimiteur:String): TStringList; 
 Var I:Integer;  procedure AddLine(TypeTest:String;ATest:TTestFailure); 
 begin 
  With ATest do 
   // Type :Echec,Exception;Nom de test;Nom de l'exception;Message de l'exception;Adresse de l'exception; 
   // Localisation de l'erreur; pile d'appel 
  Result.Add(TypeTest+Delimiteur+ 
             FailedTest.Name+Delimiteur+ 
             ThrownExceptionName+Delimiteur+ 
             ThrownExceptionMessage+Delimiteur+ 
             AddressInfo+Delimiteur+ 
             LocationInfo+Delimiteur+ 
             StackTrace); 
 end; 
  
begin 
 Result:=TStringList.Create; 
 With TestResult do 
  begin 
   If ErrorCount>0 then 
      // Errors contient la liste des exceptions 
     For I:=0 to ErrorCount-1 do 
      AddLine(TabTypeErreur[Echec],Errors[I]); 
  
   If FailureCount>0 then 
     // Failures contient la liste des cas de test en erreur 
     For I:=0 to FailureCount-1 do 
       With Failures[I] do 
        AddLine(TabTypeErreur[Exception],Failures[I]); 
 end; 
end; 
  
procedure TGUIMyTestRunner.TestingEnds(TestResult :TTestResult); Var Resultat : TStringList; begin  Try 
   if Assigned(TestResult) then 
     if (TestResult.ErrorCount>0) or (TestResult.FailureCount>0) then 
      begin 
        Resultat:=TestResultToCSV(TestResult,';'); 
        Resultat.SaveToFile(IncludeTrailingBackSlash(ExtractFilePath(ParamStr(0)))+ 'DUnit_Resultat.txt'); 
      end; 
 Finally 
  If Assigned(Resultat) 
   then Resultat.Free; 
 end; 
end; 
  
procedure RunRegisteredTestsAndSave; 
Var TestRunner : TGUIMyTestRunner; 
begin 
  TestRunner:=TGUIMyTestRunner.Create(nil); 
  With TestRunner do 
  begin 
    try 
      Suite := RegisteredTests; 
      ShowModal; 
    finally 
      Free; 
    end; 
  end; 
end; 
  
end.

1
2
3
4
5
6
7
8
9
begin 
  Application.Initialize; 
  if IsConsole then 
    TextTestRunner.RunRegisteredTests 
  else 
    //Code d'origine remplacé : 
    // GUITestRunner.RunRegisteredTests; 
   RunRegisteredTestsAndSave; 
end.