1 unit TestBase;
2
3 {$mode objfpc}{$H+}
4
5 interface
6
7 uses
8 Classes, SysUtils, LazFileUtils, LazLogger, DbgIntfDebuggerBase,
9 TestDbgConfig, TTestDbgExecuteables, TestDbgTestSuites, TestDbgControl,
10 FpDebugDebugger, Dialogs, Forms,
11 FpDbgDwarfFreePascal;
12
13 implementation
14
15 type
16
17 { TTestFpDebugDebugger }
18
19 TTestFpDebugDebugger = class(TTestDbgDebugger)
20 protected
21 procedure DoBetweenWaitForFinish; override;
22 public
StartDebuggernull23 function StartDebugger(AppDir, TestExeName: String): Boolean;
24 override;
25 procedure CleanAfterTestDone; override;
26 end;
27
28
29 procedure BuildTestSuites;
30 var
31 FpcList, GdbList: TBaseList;
32 DbgInfo: TExternalExeInfo;
33 begin
34 FpcList := TBaseList(LoadConfig(ConfDir + 'fpclist.txt'));
35
36 DbgInfo.Name := 'FpDebug';
37 DbgInfo.CpuBitTypes := [cpu32,cpu64];
38 {$IFDEF WIN64}
39 DbgInfo.CpuBitTypes := [cpu32,cpu64];
40 {$ENDIF}
41 {$IFDEF WIN32} // Windows can not cross debug
42 DbgInfo.CpuBitTypes := [cpu32];
43 {$ENDIF}
44 DbgInfo.SymbolTypes := [stDwarf, stDwarfSet, stDwarf3, stDwarf4];
45 GdbList := TBaseList.Create;
46 GdbList.Add(DbgInfo);
47
48 CreateCompilerList(FpcList, TTestDbgCompiler);
49 CreateDebuggerList(GdbList, TTestFpDebugDebugger);
50
51 CreateTestSuites(TestDbgCompilerList, TestDbgDebuggerList, TDBGTestsuite);
52
53 TestControlRegisterCompilers(FpcList);
54 TestControlRegisterDebuggers(GdbList);
55 FpcList.Free;
56 GdbList.Free;
57 end;
58
CheckAppDirnull59 function CheckAppDir(AppDir: string): Boolean;
60 begin
61 Result := DirectoryExistsUTF8(AppDir + 'TestApps') and
62 DirectoryExistsUTF8(AppDir + 'TestApps' + DirectorySeparator + 'lib');
63 end;
64
AppDirStripAppBundlenull65 function AppDirStripAppBundle(AppDir: string): String;
66 var
67 p: LongInt;
68 begin
69 Result := AppDir;
70 p := pos('.app' + DirectorySeparator, AppDir);
71 while (p > 1) and (AppDir[p-1] <> DirectorySeparator) do
72 dec(p);
73 if p > 1 then
74 Result := Copy(AppDir, 1, p - 1);
75 end;
76
77 { TTestFpDebugDebugger }
78
79 procedure TTestFpDebugDebugger.DoBetweenWaitForFinish;
80 begin
81 CheckSynchronize(25);
82 Application.ProcessMessages;
83 inherited DoBetweenWaitForFinish;
84 end;
85
TTestFpDebugDebugger.StartDebuggernull86 function TTestFpDebugDebugger.StartDebugger(AppDir, TestExeName: String
87 ): Boolean;
88 begin
89 Result := False;
90 FLazDebugger := TFpDebugDebugger.Create('');
91 //FLazDebugger.OnDbgOutput := @InternalDbgOutPut;
92 //FLazDebugger.OnFeedback := @InternalFeedBack;
93 //FLazDebugger.OnDbgEvent:=@InternalDbgEvent;
94
95 InitDebuggerMonitors(FLazDebugger);
96
97 FLazDebugger.Init;
98 if FLazDebugger.State = dsError then begin
99 FreeAndNil(FLazDebugger);
100 Exit;
101 end;
102
103 FLazDebugger.WorkingDir := AppDir;
104 FLazDebugger.FileName := TestExeName;
105 FLazDebugger.Arguments := '';
106 //FLazDebugger.ShowConsole := True;
107 Result := True;
108 end;
109
110 procedure TTestFpDebugDebugger.CleanAfterTestDone;
111 begin
112 if FLazDebugger = nil then exit;
113 try
114 FLazDebugger.Release;
115 FLazDebugger := nil;
116 ClearDebuggerMonitors;
117 except
118 end;
119 end;
120
121 initialization
122 DebugLogger.FindOrRegisterLogGroup('DBG_CMD_ECHO' , True )^.Enabled := True;
123 DebugLogger.FindOrRegisterLogGroup('DBG_VERBOSE' , True )^.Enabled := True;
124 DebugLogger.FindOrRegisterLogGroup('DBG_WARNINGS', True )^.Enabled := True;
125 DebugLogger.FindOrRegisterLogGroup('DBG_DISASSEMBLER', True )^.Enabled := True;
126
127 DebugLogger.FindOrRegisterLogGroup('FPDBG_DWARF_ERRORS', True);
128 DebugLogger.FindOrRegisterLogGroup('FPDBG_DWARF_SEARCH', True)^.Enabled := True;
129 DebugLogger.FindOrRegisterLogGroup('FPDBG_DWARF_WARNINGS', True)^.Enabled := True;
130 DebugLogger.FindOrRegisterLogGroup('FPDBG_DWARF_VERBOSE', True);
131 DebugLogger.FindOrRegisterLogGroup('FPDBG_DWARF_DATA_WARNINGS', True);
132
133
134 AppDir := AppendPathDelim(ExtractFilePath(ParamStr(0)));
135 if not(CheckAppDir(AppDir))
136 then begin
137 AppDir := AppDirStripAppBundle(AppDir);
138 if not(CheckAppDir(AppDir))
139 then
140 with TSelectDirectoryDialog.Create(nil) do begin
141 if Execute then AppDir := AppendPathDelim(FileName);
142 Free;
143 end;
144 end;
145 ConfDir := AppDir;
146 AppDir := AppendPathDelim(AppDir + 'testapps');
147
148 if DirectoryExistsUTF8(ConfDir+'logs') then
149 TestControlSetLogPath(ConfDir+'logs'+DirectorySeparator)
150 else if DirectoryExistsUTF8(ConfDir+'log') then
151 TestControlSetLogPath(ConfDir+'log'+DirectorySeparator)
152 else
153 TestControlSetLogPath(ConfDir);
154
155 BuildTestSuites;
156
157 finalization
158
159 end.
160
161