TestModules.pas
上传用户:yjb1804
上传日期:2021-01-30
资源大小:3105k
文件大小:3k
源码类别:

Email服务器

开发平台:

Delphi

  1. { $Id: TestModules.pas,v 1.7 2006/07/19 02:45:55 judc Exp $ }
  2. {: DUnit: An XTreme testing framework for Delphi programs.
  3.    @author  The DUnit Group.
  4.    @version $Revision: 1.7 $ 2001/03/08 uberto
  5. }
  6. (*
  7.  * The contents of this file are subject to the Mozilla Public
  8.  * License Version 1.1 (the "License"); you may not use this file
  9.  * except in compliance with the License. You may obtain a copy of
  10.  * the License at http://www.mozilla.org/MPL/
  11.  *
  12.  * Software distributed under the License is distributed on an "AS
  13.  * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
  14.  * implied. See the License for the specific language governing
  15.  * rights and limitations under the License.
  16.  *
  17.  * The Original Code is DUnit.
  18.  *
  19.  * The Initial Developers of the Original Code are Kent Beck, Erich Gamma,
  20.  * and Juancarlo A眅z.
  21.  * Portions created The Initial Developers are Copyright (C) 1999-2000.
  22.  * Portions created by The DUnit Group are Copyright (C) 2000-2003.
  23.  * All rights reserved.
  24.  *
  25.  * Contributor(s):
  26.  * Kent Beck <kentbeck@csi.com>
  27.  * Erich Gamma <Erich_Gamma@oti.com>
  28.  * Juanco A馿z <juanco@users.sourceforge.net>
  29.  * The DUnit group at SourceForge <http://dunit.sourceforge.net>
  30.  *
  31.  *)
  32. unit TestModules;
  33. interface
  34. uses
  35.   Windows,
  36.   TestFramework;
  37. const
  38.   rcs_id :string = '#(@)$Id: TestModules.pas,v 1.7 2006/07/19 02:45:55 judc Exp $';
  39. type
  40.   TModuleRecord = record
  41.     Handle :THandle;
  42.     Test   :ITest;
  43.   end;
  44.   TGetTestFunc = function :ITest;
  45. var
  46.   __Modules   :array of TModuleRecord = nil;
  47. function LoadModuleTests(LibName: string) :ITest;
  48. procedure RegisterModuleTests(LibName: string);
  49. procedure UnloadTestModules;
  50.                                                     
  51. implementation
  52. uses
  53.   SysUtils;
  54. function LoadModuleTests(LibName: string) :ITest;
  55. var
  56.   LibHandle :THandle;
  57.   GetTest   :TGetTestFunc;
  58.   U         :IUnknown;
  59. begin
  60.   Result := nil;
  61.   if ExtractFileExt(LibName) = '' then
  62.   begin
  63.     LibName := ChangeFileExt(LibName, '.dll');
  64.     if not FileExists(LibName) then
  65.        LibName := ChangeFileExt(LibName, '.dtl');
  66.   end;
  67.   LibHandle := LoadLibrary(PChar(AnsiString(LibName)));
  68.   if LibHandle = 0 then
  69.     raise EDUnitException.Create(Format('Could not load module %s: %s', [LibName, SysErrorMessage(GetLastError)]))
  70.   else
  71.   begin
  72.     GetTest := GetProcAddress(LibHandle, 'Test');
  73.     if not Assigned(GetTest) then
  74.       raise EDUnitException.Create(Format('Module "%s" does not export a "Test" function: %s', [LibName, SysErrorMessage(GetLastError)]))
  75.     else
  76.     begin
  77.       U := GetTest;
  78.       if U = nil then
  79.         U := TestFramework.TestSuite(LibName, []);
  80.       if 0 <> U.QueryInterface(ITest, Result) then
  81.         raise EDUnitException.Create(Format('Module "%s.Test" did not return an ITest', [LibName]))
  82.       else
  83.       begin
  84.         Assert(Result <> nil);
  85.         SetLength(__Modules, 1+Length(__Modules));
  86.         __Modules[High(__Modules)].Handle := LibHandle;
  87.         __Modules[High(__Modules)].Test   := Result;
  88.       end;
  89.     end;
  90.   end;
  91. end;
  92. procedure RegisterModuleTests(LibName: string);
  93. begin
  94.   RegisterTest(LoadModuleTests(LibName));
  95. end;
  96. procedure UnloadTestModules;
  97. var
  98.   i :Integer;
  99. begin
  100.   ClearRegistry;
  101.   for i := Low(__Modules) to High(__Modules) do
  102.     with __Modules[i] do
  103.     begin
  104.       Test := nil;
  105.       FreeLibrary(Handle);
  106.     end;
  107.   __Modules := nil;
  108. end;
  109. initialization
  110. finalization
  111.   UnloadTestModules;
  112. end.