📄 xpdunitparameters.pas
字号:
unit XPDUnitParameters;
{
$Source: /cvsroot/dunit/dunit/Contrib/DUnitWizard/Source/DelphiExperts/DUnitProject/XPDUnitParameters.pas,v $
$Revision: 1.2 $
$Date: 2004/05/03 15:07:16 $
Last amended by $Author: pvspain $
$State: Exp $
XPDUnitParser:
Copyright (c) 2003 by The Excellent Programming Company Pty Ltd
(Australia) (ABN 27 005 394 918). All rights reserved.
Contact Paul Spain via email: paul@xpro.com.au
This unit is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
This unit is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this unit; if not, the license can be viewed at:
http://www.gnu.org/copyleft/lesser.html
or write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
Boston, MA 02111-1307 USA
}
interface
uses
XPDUnitCommon;
///////////////////////////////////////////////////////////////////////////////
// Unit entry point
///////////////////////////////////////////////////////////////////////////////
function CreateXPDUnitParameters: IXPDUnitParameters;
implementation
uses
SysUtils,
IniFiles,
XPTemplateParser,
XPDUnitMacros,
XP_OTAUtils;
const
CVSID: string = '$Header: /cvsroot/dunit/dunit/Contrib/DUnitWizard/Source/DelphiExperts/DUnitProject/XPDUnitParameters.pas,v 1.2 2004/05/03 15:07:16 pvspain Exp $';
resourcestring
sTestedUnitName = 'Name of unit under test. Uses selected IDE Editor file.';
sTestedUnitPath = 'Path of unit under test. Uses selected IDE Editor file.';
sUnitName = 'TestModule unit name.';
sUnitPath = 'Path of TestModule unit file. Include the trailing directory delimiter.';
sClassName = 'TestCase class name.';
sMethodName = 'TestCase class method name.';
sProjectName = 'Name of TestProject.';
sProjectPath = 'Path of TestProject. Include the trailing directory delimiter.';
const
ParameterDescriptions: array[TXPDUnitParameter] of string = (
sTestedUnitName, sTestedUnitPath, sUnitName, sUnitPath,
sClassName, sMethodName, sProjectName, sProjectPath);
TemplateDefaults: array[TXPDUnitParameter] of string = (
'$FILESTEM($CURRENTUNIT)', // current unit name
'$FILEPATH($CURRENTUNIT)', // current unit path
'$FILESTEM($CURRENTUNIT)Tests', // suffix of 'Tests' to current unit
'$FILEPATH($CURRENTUNIT)dunit\', // subdir 'dunit' below current unit
'$TESTEDCLASSNAMETests', // tested class name with 'Tests' suffix
'Test$TESTEDMETHODNAME', // tested method name with 'Test' prefix
'$FILESTEM($CURRENTPROJECT)Tests', // suffix of 'Tests' to current project
'$FILEPATH($CURRENTPROJECT)dunit\' // subdir 'dunit' below current project
);
ParameterIdentifiers: array[TXPDUnitParameter] of string = (
'TESTEDUNITNAME', 'TESTEDUNITPATH', 'UNITNAME', 'UNITPATH', 'CLASSNAME',
'METHODNAME', 'PROJECTNAME', 'PROJECTPATH');
///////////////////////////////////////////////////////////////////////////////
// Interface implementation class
///////////////////////////////////////////////////////////////////////////////
type
TParameters = class (TInterfacedObject, IXPDUnitParameters)
private
FMethods: array[TXPDUnitMethodMacro] of TXPTemplateMethodMap;
FVariables: array[TXPDUnitValueMacro] of TXPTemplateVariableMap;
FMacros: IXPDUnitMacros;
FParser: IXPTemplateParser;
FValues: array[TXPDUnitParameter] of string;
FPersistedValues: TIniFile;
FEvaluated: boolean;
protected
function Identifiers(const Parameter: TXPDUnitParameter): string;
function Descriptions(const Parameter: TXPDUnitParameter): string;
function Templates(const Parameter: TXPDUnitParameter): string;
procedure ClearValues;
function EvaluateValues(const TestedClassName: string = '';
const TestedMethodName: string = ''): boolean;
function GetValue(const Parameter: TXPDUnitParameter): string;
procedure SetValue(const Parameter: TXPDUnitParameter;
const Value: string);
function TestMethodName(const TestedMethodName: string): string;
function TestClassName(const TestedClassName: string): string;
public
constructor Create;
destructor Destroy; override;
end;
///////////////////////////////////////////////////////////////////////////////
// Unit entry point
///////////////////////////////////////////////////////////////////////////////
function CreateXPDUnitParameters: IXPDUnitParameters;
begin
Result := TParameters.Create;
end;
///////////////////////////////////////////////////////////////////////////////
// Interface implementation
///////////////////////////////////////////////////////////////////////////////
constructor TParameters.Create;
var
idx: TXPDUnitMacro;
begin
inherited;
FMacros := XPDUnitMacros.CreateXPDUnitMacros;
FParser := XPTemplateParser.CreateXPTemplateParser;
FPersistedValues := TIniFile.Create(XPDUnitSetupFile);
// We don't assign FVariables[idx].Value as this is dynamic and must be done
// for each call on EvaluateValues()
for idx := System.Low(TXPDUnitValueMacro)
to System.High(TXPDUnitValueMacro) do
FVariables[idx].Name := FMacros.Identifiers(idx);
for idx := System.Low(TXPDUnitMethodMacro)
to System.High(TXPDUnitMethodMacro) do
begin
FMethods[idx].Name := FMacros.Identifiers(idx);
FMethods[idx].Value := FMacros.Methods(idx);
end;
FParser.SetMethods(FMethods);
end;
destructor TParameters.Destroy;
begin
FPersistedValues.Free;
inherited;
end;
function TParameters.Identifiers(
const Parameter: TXPDUnitParameter): string;
begin
Result := ParameterIdentifiers[Parameter];
end;
function TParameters.Templates(const Parameter: TXPDUnitParameter): string;
begin
if Parameter >= System.Low(TXPDUnitVarParameter) then
Result := FPersistedValues.ReadString('Templates', Identifiers(Parameter),
TemplateDefaults[Parameter])
else
Result := TemplateDefaults[Parameter];
end;
function TParameters.Descriptions(const Parameter: TXPDUnitParameter): string;
begin
Result := ParameterDescriptions[Parameter];
end;
function TParameters.GetValue(const Parameter: TXPDUnitParameter): string;
begin
if not FEvaluated then
EvaluateValues;
Result := FValues[Parameter];
end;
procedure TParameters.SetValue(const Parameter: TXPDUnitParameter;
const Value: string);
begin
FValues[Parameter] := Value;
end;
function TParameters.EvaluateValues(const TestedClassName: string;
const TestedMethodName: string): boolean;
var
idx: TXPDUnitMacro;
jdx: TXPDUnitParameter;
ErrorIndex: integer;
ErrorString: string;
begin
Result := true;
FEvaluated := true;
// Recalculate variable values for each invocation
FMacros.SetContextValue(dmTestedClassName, TestedClassName);
FMacros.SetContextValue(dmTestedMethodName, TestedMethodName);
for idx := System.Low(TXPDUnitValueMacro)
to System.High(TXPDUnitValueMacro) do
FVariables[idx].Value := FMacros.Values(idx);
// Finish parser setup
FParser.SetVariables(FVariables);
for jdx := System.Low(TXPDUnitParameter) to System.High(TXPDUnitParameter) do
begin
// Parse parameter templates using current evaluated values of macros. Skip
// parameters that have already been allocated values. *Always* evaluate
// method and class names.
if ((jdx in [dpClassName, dpMethodName]) or (System.Length(FValues[jdx]) = 0)
or (System.Pos(XPDUnitMacroPrefix, FValues[jdx]) > 0))
and not FParser.Parse(Templates(jdx), FValues[jdx]) then
begin
Result := false;
FParser.GetErrorIndex(ErrorIndex);
ErrorString := Templates(jdx);
System.Insert('#', ErrorString, ErrorIndex);
// Add message to IDE's MessageView
XP_OTAUtils.MessageViewAddFmt(
'[DUnitWizard] Syntax error in parameter template. Name: %s, Value: <%s>, (Error preceded by #)',
[Identifiers(jdx), ErrorString, ErrorIndex]);
// Leave parameter unevaluated with error tag suffix.
FValues[jdx] := SysUtils.Format('%s%s:ParameterSyntaxError!',
[XPDUnitParameterPrefix, Identifiers(jdx)]);
end;
end;
end;
function TParameters.TestMethodName(const TestedMethodName: string): string;
begin
Result := SysUtils.StringReplace(FValues[dpMethodName],
FMacros.Text(dmTestedMethodName), TestedMethodName,
[rfReplaceAll, rfIgnoreCase]);
end;
function TParameters.TestClassName(const TestedClassName: string): string;
begin
Result := SysUtils.StringReplace(FValues[dpClassName],
FMacros.Text(dmTestedClassName), TestedClassName,
[rfReplaceAll, rfIgnoreCase]);
end;
procedure TParameters.ClearValues;
var
idx: TXPDUnitParameter;
begin
for idx := System.Low(TXPDUnitParameter) to System.High(TXPDUnitParameter) do
FValues[idx] := '';
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -