delphi2007中Test单元少文件的解决!
来源:互联网 发布:ios网络获取网路权限 编辑:程序博客网 时间:2024/05/21 08:50
delphi2007中Test单元少文件,一个叫“FastMMMemLeakMonitor.pas”的单元没有,而不能编译,现在找的了这个单元文件特发上来给大家分享!
{#(@)$Id: FastMMMemLeakMonitor.pas,v 1.1 2006/07/19 02:55:29 judc Exp $ }
{ DUnit: An XTreme testing framework for Delphi programs. }
(*
* The contents of this file are subject to the Mozilla Public
* License Version 1.1 (the "License"); you may not use this file
* except in compliance with the License. You may obtain a copy of
* the License at http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
* implied. See the License for the specific language governing
* rights and limitations under the License.
*
* The Original Code is DUnit.
*
* The Initial Developers of the Original Code are Kent Beck, Erich Gamma,
* and Juancarlo Aez.
* Portions created The Initial Developers are Copyright (C) 1999-2000.
* Portions created by The DUnit Group are Copyright (C) 2000-2004.
* All rights reserved.
*
* Contributor(s):
* Kent Beck <kentbeck@csi.com>
* Erich Gamma <Erich_Gamma@oti.com>
* Juanco Aez <juanco@users.sourceforge.net>
* Chris Morris <chrismo@users.sourceforge.net>
* Jeff Moore <JeffMoore@users.sourceforge.net>
* Uberto Barbini <uberto@usa.net>
* Brett Shearer <BrettShearer@users.sourceforge.net>
* Kris Golko <neuromancer@users.sourceforge.net>
* The DUnit group at SourceForge <http://dunit.sourceforge.net>
* Peter McNab <>
*
*******************************************************************************
* Code to provide Memory Leak Detection at the test case level.
* This code makes use of FastMM4.pas available from
* http://fastmm.sourceforge.net
*
* FastMM is a fast replacement memory manager for Borland Delphi Win32
* applications that scales well under multi-threaded usage, is not prone to
* memory fragmentation, and supports shared memory without the use of
* external .DLL files.
* To use FastMM in DUnit for memory leak detection it is necessary to download
* the latest stable release of FastMM from "fastmm.sourceforge.net"
* Then add the path of the folder containing the FastMM4 source code to the
* DUnit project's search path.
*
* Generally it should not be necessary to change FastMMOptions.inc settings.
* However read the notes in FastMMOptions.inc carefully to understand the
* effect of each option and set accordingly to best meet your testing
* environment.
*
* Finally, select
* "Project, Option, Directories/Conditionals, Conditional Defines"
* in the Delphi IDE and add the conditional define
* FASTMM (prefix with an extra ; if there are other defines)
* to allow DUnit to use the FASTMM specific code.
*
*)
unit FastMMMemLeakMonitor;
interface
uses
{$IFDEF VER180}
SysUtils,
{$ELSE}
{$IFDEF FASTMM}
FastMM4,
{$ENDIF}
{$ENDIF}
TestFrameWork;
type
TMemLeakMonitor = class(TInterfacedObject, IMemLeakMonitor)
protected
FMS1: TMemoryManagerState;
FMS2: TMemoryManagerState;
function MemLeakDetected(out LeakSize: Integer): boolean; overload;
public
constructor Create;
end;
TDUnitMemLeakMonitor = class(TMemLeakMonitor, IDUnitMemLeakMonitor)
procedure MarkMemInUse;
function MemLeakDetected(const AllowedLeakSize: Integer;
const FailOnMemoryRecovery: boolean;
out LeakSize: Integer): boolean; overload;
function MemLeakDetected(const AllowedValuesGetter: TListIterator;
const FailOnMemoryRecovery: Boolean;
out LeakIndex: integer;
out LeakSize: Integer): Boolean; overload;
function GetMemoryUseMsg(const FailOnMemoryRecovery: boolean;
const TestProcChangedMem: Integer;
out ErrorMsg: string): boolean; overload;
function GetMemoryUseMsg(const FailOnMemoryRecovery: boolean;
const TestSetupChangedMem: Integer;
const TestProcChangedMem: Integer;
const TestTearDownChangedMem: Integer;
const TestCaseChangedMem: Integer;
out ErrorMsg: string): boolean; overload;
end;
implementation
{$IFNDEF VER180}
uses
SysUtils;
{$ENDIF}
{ TMemLeakMonitor }
constructor TMemLeakMonitor.Create;
begin
inherited;
GetMemoryManagerState(FMS1);
end;
function TMemLeakMonitor.MemLeakDetected(out LeakSize: Integer): boolean;
var
I: Integer;
SMBSize1,
SMBSize2: Int64;
begin
LeakSize := 0;
SMBSize1 := 0;
SMBSize2 := 0;
GetMemoryManagerState(FMS2);
for I := 0 to NumSmallBlockTypes - 1 do // Iterate through the blocks
begin
Inc(SMBSize1, (FMS1.SmallBlockTypeStates[i].InternalBlockSize *
FMS1.SmallBlockTypeStates[i].AllocatedBlockCount));
Inc(SMBSize2, (FMS2.SmallBlockTypeStates[i].InternalBlockSize *
FMS2.SmallBlockTypeStates[i].AllocatedBlockCount));
end;
LeakSize := (SMBSize2 - SMBSize1);
LeakSize := LeakSize +
(Int64(FMS2.TotalAllocatedMediumBlockSize) - Int64(FMS1.TotalAllocatedMediumBlockSize)) +
(Int64(FMS2.TotalAllocatedLargeBlockSize) - Int64(FMS1.TotalAllocatedLargeBlockSize));
Result := LeakSize <> 0;
end;
// May be called after detecting memory use change at Test Procedure level
function TDUnitMemLeakMonitor.GetMemoryUseMsg(const FailOnMemoryRecovery: boolean;
const TestProcChangedMem: Integer;
out ErrorMsg: string): boolean;
begin
ErrorMsg := '';
if (TestProcChangedMem > 0) then
ErrorMsg := IntToStr(TestProcChangedMem) +
' Bytes Memory Leak in Test Procedure'
else
if (TestProcChangedMem < 0) and (FailOnMemoryRecovery) then
ErrorMsg := IntToStr(Abs(TestProcChangedMem)) +
' Bytes Memory Recovered in Test Procedure';
Result := (Length(ErrorMsg) = 0);
end;
function TDUnitMemLeakMonitor.MemLeakDetected(const AllowedLeakSize: Integer;
const FailOnMemoryRecovery: boolean;
out LeakSize: Integer): boolean;
begin
LeakSize := 0;
inherited MemLeakDetected(LeakSize);
Result := ((LeakSize > 0) and (LeakSize <> AllowedLeakSize)) or
((LeakSize < 0) and (FailOnMemoryRecovery) and (LeakSize <> AllowedLeakSize));
end;
procedure TDUnitMemLeakMonitor.MarkMemInUse;
begin
GetMemoryManagerState(FMS1);
end;
function TDUnitMemLeakMonitor.MemLeakDetected(const AllowedValuesGetter: TListIterator;
const FailOnMemoryRecovery: Boolean;
out LeakIndex: integer;
out LeakSize: Integer): Boolean;
var
AllowedLeakSize: Integer;
begin
LeakIndex := 0;
LeakSize := 0;
Result := False;
inherited MemLeakDetected(LeakSize);
if (LeakSize = 0) then
exit;
// Next line access value stored via SetAllowedLeakSize, if any
if LeakSize = AllowedValuesGetter then
Exit;
repeat // loop over values stored via SetAllowedLeakArray
inc(LeakIndex);
AllowedLeakSize := AllowedValuesGetter;
if (LeakSize = AllowedLeakSize) then
Exit;
until (AllowedLeakSize = 0);
Result := (LeakSize > 0) or ((LeakSize < 0) and FailOnMemoryRecovery);
end;
// Expanded message generation for detected leak isolation
// Use additional knowledge of when Setup and or TearDown have nor run.
function TDUnitMemLeakMonitor.GetMemoryUseMsg(const FailOnMemoryRecovery: boolean;
const TestSetupChangedMem: integer;
const TestProcChangedMem: Integer;
const TestTearDownChangedMem: integer;
const TestCaseChangedMem: Integer;
out ErrorMsg: string): boolean;
var
Location: string;
begin
Result := False;
ErrorMsg := '';
if (TestSetupChangedMem = 0) and (TestProcChangedMem = 0) and
(TestTearDownChangedMem = 0) and (TestCaseChangedMem <> 0) then
begin
ErrorMsg :=
'Error in TestFrameWork. No leaks in Setup, TestProc or Teardown but '+
IntToStr(TestCaseChangedMem) +
' Bytes Memory Leak reported across TestCase';
Exit;
end;
if (TestSetupChangedMem + TestProcChangedMem + TestTearDownChangedMem) <>
TestCaseChangedMem then
begin
ErrorMsg :=
'Error in TestFrameWork. Sum of Setup, TestProc and Teardown leaks <> '+
IntToStr(TestCaseChangedMem) +
' Bytes Memory Leak reported across TestCase';
Exit;
end;
Result := True;
if TestCaseChangedMem = 0 then
Exit; // Dont waste further time here
if (TestCaseChangedMem < 0) and not FailOnMemoryRecovery then
Exit; // Dont waste further time here
// We get to here because there is a memory use imbalance to report.
if (TestCaseChangedMem > 0) then
ErrorMsg := IntToStr(TestCaseChangedMem) + ' Bytes memory leak ('
else
ErrorMsg := IntToStr(TestCaseChangedMem) + ' Bytes memory recovered (';
Location := '';
if (TestSetupChangedMem <> 0) then
Location := 'Setup= ' + IntToStr(TestSetupChangedMem) + ' ';
if (TestProcChangedMem <> 0) then
Location := Location + 'TestProc= ' + IntToStr(TestProcChangedMem) + ' ';
if (TestTearDownChangedMem <> 0) then
Location := Location + 'TearDown= ' + IntToStr(TestTearDownChangedMem) + ' ';
ErrorMsg := ErrorMsg + Location + ')';
Result := (Length(ErrorMsg) = 0);
end;
end.
- delphi2007中Test单元少文件的解决!
- 在 DELPHI 中显示GIF动画(only test Delphi2007)
- 如何解决delphi2007中UTF-8转码的奇数汉字出错的问题
- Delphi2007中TPanel的一个问题!
- 解决delphi2007编译后速度变慢的问题
- delphi2007单个文件(pas)的控件安装
- Delphi7中单元文件内各个部分的执行顺序
- Delphi2007中安装DsPack2.3.4的方法(视频插件)
- Delphi2007中使用DbExpress连接MySql的例子
- Delphi2007中提示Application.Exename错误的处理办法
- Delphi2007的一个Bug?
- Delphi的单元文件详解
- Spring Test测试单元
- DELPHI中的ADODB.pas 单元中,一个直到今天都还没有解决的BUG
- 关于Delphi2007 Remote Data Module模块无法注册的问题的解决
- 关于Delphi2007 Remote Data Module 模块无法注册的问题的解决
- iOS开发在类的头文件中要尽可能少的引入其他头文件
- 解决Myeclipse2014 在项目中new的时候少了很多选项
- UML类图关系全面剖析
- charindex函数
- vs2005 学习资料收藏
- GUID和字符串相互转换的函数
- 关于round函数
- delphi2007中Test单元少文件的解决!
- 用RSA加密算法处理文件
- 吃掉所有CPU资源的 svchost.exe
- String转换为Date型
- solaris php and apache Installation introduction
- Java: 写个简单的Client,Server聊天程序
- struts+spring+hibernate整合
- JAVA语言随机数的产生及其应用
- 在窗口中画图