paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

linux fixing, TRttiExpUnicodeStringNodeItem implementation

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@569 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa 2008-09-24 01:50:32 +00:00
parent 744eece50d
commit bf2589842a
6 changed files with 242 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

109
wst/trunk/tests/test_suite/test_rtti_filter.pas
View File

@ -44,10 +44,16 @@ type
FIntProp: Integer;
FStrProp: string;
FWideStrProp: widestring;
{$IFDEF WST_UNICODESTRING}
FUnicodeStrProp: UnicodeString;
{$ENDIF WST_UNICODESTRING}
published
property IntProp : Integer read FIntProp write FIntProp;
property StrProp : string read FStrProp write FStrProp;
property WideStrProp : widestring read FWideStrProp write FWideStrProp;
{$IFDEF WST_UNICODESTRING}
property UnicodeStrProp : UnicodeString read FUnicodeStrProp write FUnicodeStrProp;
{$ENDIF WST_UNICODESTRING}
property EnumProp : TSampleEnum read FEnumProp write FEnumProp;
property BoolProp : Boolean read FBoolProp write FBoolProp;
end;
@ -96,6 +102,17 @@ type
procedure Evaluate_EqualCaseInsensitive();
end;
{$IFDEF WST_UNICODESTRING}
{ TRttiExpUnicodeStringNodeItem_Test }
TRttiExpUnicodeStringNodeItem_Test = class(TTestCase)
published
procedure Create_Test();
procedure Evaluate_EqualCaseSensitive();
procedure Evaluate_EqualCaseInsensitive();
end;
{$ENDIF WST_UNICODESTRING}
{ TRttiExpNode_Test }
TRttiExpNode_Test = class(TTestCase)
@ -881,7 +898,7 @@ begin
end;
procedure TRttiExpwWideStringNodeItem_Test.Evaluate_EqualCaseSensitive();
const VAL_1 = 'AzertY';
const VAL_1 : WideString = 'AzertY';
var
x : TRttiExpWideStringNodeItem;
t : TClass_A;
@ -909,7 +926,7 @@ begin
end;
procedure TRttiExpwWideStringNodeItem_Test.Evaluate_EqualCaseInsensitive();
const VAL_1 = 'AzertY';
const VAL_1 : WideString = 'AzertY';
var
x : TRttiExpWideStringNodeItem;
t : TClass_A;
@ -923,12 +940,64 @@ begin
Check( x.Evaluate(t) = False ,'False');
t.WideStrProp := UpperCase(VAL_1);
Check( x.Evaluate(t) = True ,'True');
Check( x.Evaluate(t) = True ,'True 1');
t.WideStrProp := LowerCase(VAL_1);
Check( x.Evaluate(t) = True ,'True');
Check( x.Evaluate(t) = True ,'True 2');
t.WideStrProp := VAL_1;
Check( x.Evaluate(t) = True, 'True 3' );
finally
x.Free();
t.Free();
end;
end;
{$IFDEF WST_UNICODESTRING}
{ TRttiExpUnicodeStringNodeItem_Test }
procedure TRttiExpUnicodeStringNodeItem_Test.Create_Test();
var
x : TRttiExpUnicodeStringNodeItem;
begin
x := nil;
try
try
x := TRttiExpUnicodeStringNodeItem.Create(GetPropInfo(TClass_A,'IntProp'),sfoEqualCaseInsensitive,'Azerty');
Check(False);
except
on e : EAssertionFailedError do
raise;
on e : ERttiFilterException do begin
// nothing!
end;
end;
finally
x.Free();
end;
end;
procedure TRttiExpUnicodeStringNodeItem_Test.Evaluate_EqualCaseSensitive();
const VAL_1 : UnicodeString = 'AzertY';
var
x : TRttiExpUnicodeStringNodeItem;
t : TClass_A;
begin
x := nil;
t := TClass_A.Create();
try
x := TRttiExpUnicodeStringNodeItem.Create(GetPropInfo(t,'UnicodeStrProp'),sfoEqualCaseSensitive,VAL_1);
t.UnicodeStrProp := 'aaadddd';
Check( x.Evaluate(t) = False ,'False');
t.UnicodeStrProp := UpperCase(VAL_1);
Check( x.Evaluate(t) = False ,'False');
t.UnicodeStrProp := LowerCase(VAL_1);
Check( x.Evaluate(t) = False ,'False');
t.UnicodeStrProp := VAL_1;
Check( x.Evaluate(t) = True, 'True' );
finally
x.Free();
@ -936,6 +1005,34 @@ begin
end;
end;
procedure TRttiExpUnicodeStringNodeItem_Test.Evaluate_EqualCaseInsensitive();
const VAL_1 : UnicodeString = 'AzertY';
var
x : TRttiExpUnicodeStringNodeItem;
t : TClass_A;
begin
x := nil;
t := TClass_A.Create();
try
x := TRttiExpUnicodeStringNodeItem.Create(GetPropInfo(t,'UnicodeStrProp'),sfoEqualCaseInsensitive,VAL_1);
t.UnicodeStrProp := 'aaadddd';
Check( x.Evaluate(t) = False ,'False');
t.UnicodeStrProp := UpperCase(VAL_1);
Check( x.Evaluate(t) = True ,'True');
t.UnicodeStrProp := LowerCase(VAL_1);
Check( x.Evaluate(t) = True ,'True');
t.UnicodeStrProp := VAL_1;
Check( x.Evaluate(t) = True, 'True' );
finally
x.Free();
t.Free();
end;
end;
{$ENDIF WST_UNICODESTRING}
{ TRttiParser_Test }
@ -1374,11 +1471,15 @@ begin
end;
end;
Initialization
RegisterTest('Cursors',TRttiExpIntegerNodeItem_Test.Suite);
RegisterTest('Cursors',TRttiExpEnumNodeItem_Test.Suite);
RegisterTest('Cursors',TRttiExpAnsiStringNodeItem_Test.Suite);
RegisterTest('Cursors',TRttiExpwWideStringNodeItem_Test.Suite);
{$IFDEF WST_UNICODESTRING}
RegisterTest('Cursors',TRttiExpUnicodeStringNodeItem_Test.Suite);
{$ENDIF WST_UNICODESTRING}
RegisterTest('Cursors',TRttiExpNode_Test.Suite);
RegisterTest('Cursors',TRttiFilterCreator_Test.Suite);
RegisterTest('Cursors',TRttiParser_Test.Suite);

53
wst/trunk/tests/test_suite/wst_test_suite.lpi
View File

@ -1,7 +1,7 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="\"/>
<PathDelim Value="/"/>
<Version Value="6"/>
<General>
<SessionStorage Value="InProjectDir"/>
@ -33,47 +33,47 @@
<UnitName Value="testformatter_unit"/>
</Unit1>
<Unit2>
<Filename Value="..\..\server_service_soap.pas"/>
<Filename Value="../../server_service_soap.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="server_service_soap"/>
</Unit2>
<Unit3>
<Filename Value="..\..\soap_formatter.pas"/>
<Filename Value="../../soap_formatter.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="soap_formatter"/>
</Unit3>
<Unit4>
<Filename Value="..\..\base_binary_formatter.pas"/>
<Filename Value="../../base_binary_formatter.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="base_binary_formatter"/>
</Unit4>
<Unit5>
<Filename Value="..\..\base_service_intf.pas"/>
<Filename Value="../../base_service_intf.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="base_service_intf"/>
</Unit5>
<Unit6>
<Filename Value="..\..\base_soap_formatter.pas"/>
<Filename Value="../../base_soap_formatter.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="base_soap_formatter"/>
</Unit6>
<Unit7>
<Filename Value="..\..\binary_formatter.pas"/>
<Filename Value="../../binary_formatter.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="binary_formatter"/>
</Unit7>
<Unit8>
<Filename Value="..\..\binary_streamer.pas"/>
<Filename Value="../../binary_streamer.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="binary_streamer"/>
</Unit8>
<Unit9>
<Filename Value="..\..\server_binary_formatter.pas"/>
<Filename Value="../../server_binary_formatter.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="server_binary_formatter"/>
</Unit9>
<Unit10>
<Filename Value="..\..\metadata_repository.pas"/>
<Filename Value="../../metadata_repository.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="metadata_repository"/>
</Unit10>
@ -83,27 +83,27 @@
<UnitName Value="testmetadata_unit"/>
</Unit11>
<Unit12>
<Filename Value="..\..\ws_helper\metadata_generator.pas"/>
<Filename Value="../../ws_helper/metadata_generator.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="metadata_generator"/>
</Unit12>
<Unit13>
<Filename Value="..\..\metadata_wsdl.pas"/>
<Filename Value="../../metadata_wsdl.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="metadata_wsdl"/>
</Unit13>
<Unit14>
<Filename Value="..\..\server_service_intf.pas"/>
<Filename Value="../../server_service_intf.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="server_service_intf"/>
</Unit14>
<Unit15>
<Filename Value="..\..\base_xmlrpc_formatter.pas"/>
<Filename Value="../../base_xmlrpc_formatter.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="base_xmlrpc_formatter"/>
</Unit15>
<Unit16>
<Filename Value="..\..\wst_fpc_xml.pas"/>
<Filename Value="../../wst_fpc_xml.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="wst_fpc_xml"/>
</Unit16>
@ -113,7 +113,7 @@
<UnitName Value="test_utilities"/>
</Unit17>
<Unit18>
<Filename Value="..\..\server_service_xmlrpc.pas"/>
<Filename Value="../../server_service_xmlrpc.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="server_service_xmlrpc"/>
</Unit18>
@ -123,27 +123,27 @@
<UnitName Value="test_parsers"/>
</Unit19>
<Unit20>
<Filename Value="..\..\ws_helper\wsdl_generator.pas"/>
<Filename Value="../../ws_helper/wsdl_generator.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="wsdl_generator"/>
</Unit20>
<Unit21>
<Filename Value="..\..\ws_helper\xsd_generator.pas"/>
<Filename Value="../../ws_helper/xsd_generator.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="xsd_generator"/>
</Unit21>
<Unit22>
<Filename Value="..\..\ws_helper\xsd_consts.pas"/>
<Filename Value="../../ws_helper/xsd_consts.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="xsd_consts"/>
</Unit22>
<Unit23>
<Filename Value="..\..\ws_helper\wsdl_parser.pas"/>
<Filename Value="../../ws_helper/wsdl_parser.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="wsdl_parser"/>
</Unit23>
<Unit24>
<Filename Value="..\..\base_json_formatter.pas"/>
<Filename Value="../../base_json_formatter.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="base_json_formatter"/>
</Unit24>
@ -153,7 +153,7 @@
<UnitName Value="test_support"/>
</Unit25>
<Unit26>
<Filename Value="..\..\basex_encode.pas"/>
<Filename Value="../../basex_encode.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="basex_encode"/>
</Unit26>
@ -163,12 +163,12 @@
<UnitName Value="test_basex_encode"/>
</Unit27>
<Unit28>
<Filename Value="..\..\json_formatter.pas"/>
<Filename Value="../../json_formatter.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="json_formatter"/>
</Unit28>
<Unit29>
<Filename Value="..\..\server_service_json.pas"/>
<Filename Value="../../server_service_json.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="server_service_json"/>
</Unit29>
@ -211,13 +211,12 @@
</ProjectOptions>
<CompilerOptions>
<Version Value="8"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="wst_test_suite.exe"/>
</Target>
<SearchPaths>
<IncludeFiles Value="..\..\"/>
<OtherUnitFiles Value="..\..\;..\..\ws_helper\;..\..\wst_rtti_filter\;..\..\fcl-json\src\"/>
<IncludeFiles Value="../../"/>
<OtherUnitFiles Value="../../;../../ws_helper/;../../wst_rtti_filter/;../../fcl-json/src/"/>
<UnitOutputDirectory Value="obj"/>
</SearchPaths>
<Parsing>

2
wst/trunk/tests/test_suite/wst_test_suite.lpr
View File

@ -5,7 +5,7 @@ program wst_test_suite;
uses
{$IFDEF UNIX}
cthreads,
cthreads, cwstring,
{$ENDIF}
custapp, classes, sysutils, fpcunit, testreport, testregistry,

11
wst/trunk/tests/test_suite/wst_test_suite_gui.lpi
View File

@ -1,7 +1,7 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="\"/>
<PathDelim Value="/"/>
<Version Value="6"/>
<General>
<SessionStorage Value="InProjectDir"/>
@ -96,12 +96,12 @@
<UnitName Value="test_rtti_filter"/>
</Unit11>
<Unit12>
<Filename Value="..\..\wst_rtti_filter\rtti_filters.pas"/>
<Filename Value="../../wst_rtti_filter/rtti_filters.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="rtti_filters"/>
</Unit12>
<Unit13>
<Filename Value="..\..\wst_rtti_filter\wst_cursors.pas"/>
<Filename Value="../../wst_rtti_filter/wst_cursors.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="wst_cursors"/>
</Unit13>
@ -129,13 +129,12 @@
</ProjectOptions>
<CompilerOptions>
<Version Value="8"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="wst_test_suite_gui.exe"/>
</Target>
<SearchPaths>
<IncludeFiles Value="..\..\"/>
<OtherUnitFiles Value="..\..\;..\..\ws_helper\;..\..\wst_rtti_filter\;..\..\fcl-json\src\"/>
<IncludeFiles Value="../../"/>
<OtherUnitFiles Value="../../;../../ws_helper/;../../wst_rtti_filter/;../../fcl-json/src/"/>
<UnitOutputDirectory Value="obj"/>
</SearchPaths>
<Parsing>

2
wst/trunk/tests/test_suite/wst_test_suite_gui.lpr
View File

@ -4,7 +4,7 @@ program wst_test_suite_gui;
uses
{$IFDEF UNIX}
cthreads,
cthreads, cwstring,
{$ENDIF}
Interfaces, Forms, GuiTestRunner,
TestFormatter_unit, testmetadata_unit,

116
wst/trunk/wst_rtti_filter/rtti_filters.pas
View File

@ -86,6 +86,14 @@ type
const AValue : WideString;
const AConnector : TFilterConnector
) : TRttiFilterCreator;overload;
{$IFDEF WST_UNICODESTRING}
function AddCondition(
const APropertyName : string;
const AOperator : TStringFilterOperator;
const AValue : UnicodeString;
const AConnector : TFilterConnector
) : TRttiFilterCreator;overload;
{$ENDIF WST_UNICODESTRING}
function BeginGroup(const AConnector : TFilterConnector):TRttiFilterCreator;
function EndGroup():TRttiFilterCreator;
@ -226,6 +234,23 @@ type
property ComparedValue : WideString read FComparedValue;
end;
{$IFDEF WST_UNICODESTRING}
{ TRttiExpUnicodeStringNodeItem }
TRttiExpUnicodeStringNodeItem = class(TRttiExpStringNodeItem)
private
FComparedValue: UnicodeString;
public
constructor Create(
const APropInfo : PPropInfo;
const AOperation : TStringFilterOperator;
const AComparedValue : UnicodeString
);
function Evaluate(AInstance : TRttiFilterCreatorTarget):Boolean;override;
property ComparedValue : UnicodeString read FComparedValue;
end;
{$ENDIF WST_UNICODESTRING}
procedure ParseFilter(const AFilterText: string; AFltrCrtr : TRttiFilterCreator);overload;
function ParseFilter(
const AFilterText : string;
@ -282,6 +307,9 @@ var
var
s : string;
ws : WideString;
{$IFDEF WST_UNICODESTRING}
us : UnicodeString;
{$ENDIF WST_UNICODESTRING}
fltrOp : TStringFilterOperator;
begin
MoveNext();
@ -301,12 +329,24 @@ var
end;
MoveNext();
prsr.CheckToken(toString);
if ( propInfo^.PropType^.Kind = tkWString ) then begin
ws := prsr.TokenString();
AFltrCrtr.AddCondition(propName,fltrOp,ws,lastCntr);
end else begin
s := prsr.TokenString();
AFltrCrtr.AddCondition(propName,fltrOp,s,lastCntr);
case propInfo^.PropType^.Kind of
tkWString :
begin
ws := prsr.TokenString();
AFltrCrtr.AddCondition(propName,fltrOp,ws,lastCntr);
end;
{$IFDEF WST_UNICODESTRING}
tkUString :
begin
us := prsr.TokenString();
AFltrCrtr.AddCondition(propName,fltrOp,us,lastCntr);
end;
{$ENDIF WST_UNICODESTRING}
else
begin
s := prsr.TokenString();
AFltrCrtr.AddCondition(propName,fltrOp,s,lastCntr);
end;
end;
end;
@ -408,7 +448,13 @@ begin
propInfo := GetPropInfo(AFltrCrtr.TargetClass,propName);
if ( propInfo = nil ) then
raise ERttiFilterException.CreateFmt('Invalid property : "%s"',[propName]);
if ( propInfo^.PropType^.Kind in [{$IFDEF FPC}tkSString,tkAString,{$ENDIF}tkLString,tkWString] ) then
if ( propInfo^.PropType^.Kind in
[ {$IFDEF FPC}tkSString,tkAString,{$ENDIF}
{$IFDEF WST_UNICODESTRING}tkUString,{$ENDIF}
tkLString,tkWString
]
)
then
Handle_String()
else if ( propInfo^.PropType^.Kind in [tkInteger,tkInt64{$IFDEF HAS_QWORD},tkQWord{$ENDIF}] ) then
Handle_Integer()
@ -654,6 +700,22 @@ begin
Result := Self;
end;
{$IFDEF WST_UNICODESTRING}
function TRttiFilterCreator.AddCondition(
const APropertyName: string;
const AOperator: TStringFilterOperator;
const AValue: UnicodeString;
const AConnector: TFilterConnector
) : TRttiFilterCreator;
begin
AddNode(
TRttiExpUnicodeStringNodeItem.Create(GetPropInfo(TargetClass,APropertyName),AOperator,AValue),
AConnector
);
Result := Self;
end;
{$ENDIF WST_UNICODESTRING}
function TRttiFilterCreator.BeginGroup(const AConnector: TFilterConnector):TRttiFilterCreator;
var
gn : TRttiExpNode;
@ -755,8 +817,8 @@ constructor TRttiExpWideStringNodeItem.Create(
);
begin
Assert(Assigned(APropInfo));
if not ( APropInfo^.PropType^.Kind in [tkWString] ) then
raise ERttiFilterException.CreateFmt('Invalid property data type. "%s" excpeted.',['WideString']);
if not ( APropInfo^.PropType^.Kind in [tkWString{$IFDEF WST_UNICODESTRING},tkUString{$ENDIF}] ) then
raise ERttiFilterException.CreateFmt('Invalid property data type. "%s" excpeted, got "%s".',['WideString',GetEnumName(TypeInfo(TTypeKind),Ord(APropInfo^.PropType^.Kind))]);
inherited Create(APropInfo,AOperation);
FComparedValue := AComparedValue;
end;
@ -764,14 +826,44 @@ end;
function TRttiExpWideStringNodeItem.Evaluate(AInstance: TRttiFilterCreatorTarget): Boolean;
begin
case Operation of
sfoEqualCaseSensitive : Result := AnsiSameStr(GetStrProp(AInstance,PropInfo),ComparedValue);
sfoEqualCaseInsensitive : Result := AnsiSameText(GetStrProp(AInstance,PropInfo),ComparedValue);
sfoNotEqual : Result := not AnsiSameText(GetStrProp(AInstance,PropInfo),ComparedValue);
sfoEqualCaseSensitive : Result := ( GetWideStrProp(AInstance,PropInfo) = ComparedValue );
sfoEqualCaseInsensitive : Result := ( LowerCase(GetWideStrProp(AInstance,PropInfo)) = LowerCase(ComparedValue) );
sfoNotEqual : Result := not SameText(GetWideStrProp(AInstance,PropInfo),ComparedValue);
else
Assert(False);
end;
end;
{$IFDEF WST_UNICODESTRING}
{ TRttiExpUnicodeStringNodeItem }
constructor TRttiExpUnicodeStringNodeItem.Create(
const APropInfo: PPropInfo;
const AOperation: TStringFilterOperator;
const AComparedValue: UnicodeString
);
begin
Assert(Assigned(APropInfo));
if not ( APropInfo^.PropType^.Kind in [tkUString,tkWString] ) then
raise ERttiFilterException.CreateFmt('Invalid property data type. "%s" excpeted, got "%s".',['UnicodeString',GetEnumName(TypeInfo(TTypeKind),Ord(APropInfo^.PropType^.Kind))]);
inherited Create(APropInfo,AOperation);
FComparedValue := AComparedValue;
end;
function TRttiExpUnicodeStringNodeItem.Evaluate(
AInstance: TRttiFilterCreatorTarget
): Boolean;
begin
case Operation of
sfoEqualCaseSensitive : Result := ( GetUnicodeStrProp(AInstance,PropInfo) = ComparedValue );
sfoEqualCaseInsensitive : Result := ( LowerCase(GetUnicodeStrProp(AInstance,PropInfo)) = LowerCase(ComparedValue));
sfoNotEqual : Result := not SameText(GetUnicodeStrProp(AInstance,PropInfo),ComparedValue);
else
Assert(False);
end;
end;
{$ENDIF WST_UNICODESTRING}
{ TRttiExpEnumNodeItem }
constructor TRttiExpEnumNodeItem.Create(