pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

WideString and UnicodeString support by the Type Library Editor/ws_helper

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@562 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
2008-09-17 01:45:04 +00:00
parent b2368463cf
commit f44dad52d7
28 changed files with 1542 additions and 1039 deletions
Download Patch File Download Diff File Expand all files Collapse all files

22
wst/trunk/tests/test_suite/files/class_unicodestring_property.WSDL Normal file
View File

@ -0,0 +1,22 @@
<?xml version="1.0"?>
<definitions name="wst_test"
xmlns="http://schemas.xmlsoap.org/wsdl/"
xmlns:tns="class_unicodestring_property"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
targetNamespace="class_unicodestring_property"
xmlns:wst="urn:wst_base">
<types>
<xsd:schema xmlns="http://www.w3.org/2001/XMLSchema" targetNamespace="class_unicodestring_property">
<xsd:complexType name="TSampleClass">
<xsd:sequence>
<xsd:element name="elementProp" type="xsd:string" wst:TypeHint="UnicodeString"/>
</xsd:sequence>
<xsd:attribute use="required" name="elementAtt" type="xsd:string" wst:TypeHint="UnicodeString"/>
</xsd:complexType>
</xsd:schema>
</types>
</definitions>

9
wst/trunk/tests/test_suite/files/class_unicodestring_property.xsd Normal file
View File

@ -0,0 +1,9 @@
<?xml version="1.0"?>
<schema xmlns:tns="class_unicodestring_property" xmlns:wst="urn:wst_base" xmlns:xsd="http://www.w3.org/2001/XMLSchema" targetNamespace="class_unicodestring_property">
<xsd:complexType name="TSampleClass">
<xsd:sequence>
<xsd:element name="elementProp" type="xsd:string" wst:TypeHint="UnicodeString"/>
</xsd:sequence>
<xsd:attribute use="required" name="elementAtt" type="xsd:string" wst:TypeHint="UnicodeString"/>
</xsd:complexType>
</schema>

22
wst/trunk/tests/test_suite/files/class_widestring_property.WSDL Normal file
View File

@ -0,0 +1,22 @@
<?xml version="1.0"?>
<definitions name="wst_test"
xmlns="http://schemas.xmlsoap.org/wsdl/"
xmlns:tns="class_widestring_property"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
targetNamespace="class_widestring_property"
xmlns:wst="urn:wst_base">
<types>
<xsd:schema xmlns="http://www.w3.org/2001/XMLSchema" targetNamespace="class_widestring_property">
<xsd:complexType name="TSampleClass">
<xsd:sequence>
<xsd:element name="elementProp" type="xsd:string" wst:TypeHint="WideString"/>
</xsd:sequence>
<xsd:attribute use="required" name="elementAtt" type="xsd:string" wst:TypeHint="WideString"/>
</xsd:complexType>
</xsd:schema>
</types>
</definitions>

6
wst/trunk/tests/test_suite/files/class_widestring_property.xsd
View File

@ -1,9 +1,9 @@
<?xml version="1.0"?>
<schema xmlns:tns="class_widestring_property" xmlns:xsd="http://www.w3.org/2001/XMLSchema" targetNamespace="class_widestring_property">
<schema xmlns:tns="class_widestring_property" xmlns:wst="urn:wst_base" xmlns:xsd="http://www.w3.org/2001/XMLSchema" targetNamespace="class_widestring_property">
<xsd:complexType name="TSampleClass">
<xsd:sequence>
<xsd:element name="elementProp" type="xsd:string"/>
<xsd:element name="elementProp" type="xsd:string" wst:TypeHint="WideString"/>
</xsd:sequence>
<xsd:attribute use="required" name="elementAtt" type="xsd:string"/>
<xsd:attribute use="required" name="elementAtt" type="xsd:string" wst:TypeHint="WideString"/>
</xsd:complexType>
</schema>

66
wst/trunk/tests/test_suite/test_generators.pas
View File

@ -39,6 +39,9 @@ type
procedure class_headerblock_derived();
procedure class_headerblock_simplecontent_derived();
procedure class_widestring_property();
{$IFDEF WST_UNICODESTRING}
procedure class_unicodestring_property();
{$ENDIF WST_UNICODESTRING}
procedure array_sequence_collection();
end;
@ -457,6 +460,69 @@ begin
end;
end;
{$IFDEF WST_UNICODESTRING}
procedure TTest_CustomXsdGenerator.class_unicodestring_property();
var
tr : TwstPasTreeContainer;
mdl : TPasModule;
cltyp : TPasClassType;
procedure AddProperty(
const AName,
ATypeName,
ADefault : string;
const AKind : TPropertyType
);
var
p : TPasProperty;
begin
p := TPasProperty(tr.CreateElement(TPasProperty,AName,cltyp,visDefault,'',0));
cltyp.Members.Add(p);
p.ReadAccessorName := 'F' + AName;
p.WriteAccessorName := 'F' + AName;
p.VarType := tr.FindElement(ATypeName) as TPasType;
Check( (p.VarType <> nil), Format('Type not found : "%s".',[ATypeName]));
p.VarType.AddRef();
p.DefaultValue := ADefault;
p.Visibility := visPublished;
p.StoredAccessorName := 'True';
if ( AKind = ptAttribute ) then
tr.SetPropertyAsAttribute(p,True);
end;
var
g : IGenerator;
locDoc, locExistDoc : TXMLDocument;
begin
locDoc := nil;
locExistDoc := nil;
tr := TwstPasTreeContainer.Create();
try
CreateWstInterfaceSymbolTable(tr);
mdl := TPasModule(tr.CreateElement(TPasModule,'class_unicodestring_property',tr.Package,visDefault,'',0));
tr.Package.Modules.Add(mdl);
mdl.InterfaceSection := TPasSection(tr.CreateElement(TPasSection,'',mdl,visDefault,'',0));
cltyp := TPasClassType(tr.CreateElement(TPasClassType,'TSampleClass',mdl.InterfaceSection,visDefault,'',0));
cltyp.ObjKind := okClass;
mdl.InterfaceSection.Declarations.Add(cltyp);
mdl.InterfaceSection.Types.Add(cltyp);
AddProperty('elementProp','UnicodeString','',ptField);
AddProperty('elementAtt','UnicodeString','',ptAttribute);
locDoc := CreateDoc();
g := CreateGenerator(locDoc);
g.Execute(tr,mdl.Name);
WriteXMLFile(locDoc,'.\class_unicodestring_property.xsd');
locExistDoc := LoadXmlFromFilesList('class_unicodestring_property.xsd');
Check(CompareNodes(locExistDoc.DocumentElement,locDoc.DocumentElement),'generated document differs from the existent one.');
finally
ReleaseDomNode(locExistDoc);
ReleaseDomNode(locDoc);
FreeAndNil(tr);
end;
end;
{$ENDIF WST_UNICODESTRING}
procedure TTest_CustomXsdGenerator.array_sequence_collection();
var
tr : TwstPasTreeContainer;

55
wst/trunk/tests/test_suite/test_parsers.pas
View File

@ -53,6 +53,7 @@ type
function load_class_headerblock_derived_Schema() : TwstPasTreeContainer;virtual;abstract;
function load_class_headerblock_simplecontent_derived_Schema() : TwstPasTreeContainer;virtual;abstract;
function load_class_widestring_property() : TwstPasTreeContainer;virtual;abstract;
published
procedure EmptySchema();
@ -78,6 +79,7 @@ type
procedure class_headerblock_derived();
procedure class_headerblock_simplecontent_derived();
procedure class_widestring_property();
end;
{ TTest_XsdParser }
@ -111,6 +113,7 @@ type
function load_class_headerblock_derived_Schema() : TwstPasTreeContainer;override;
function load_class_headerblock_simplecontent_derived_Schema() : TwstPasTreeContainer;override;
function load_class_widestring_property() : TwstPasTreeContainer;override;
end;
{ TTest_WsdlParser }
@ -144,6 +147,7 @@ type
function load_class_headerblock_derived_Schema() : TwstPasTreeContainer;override;
function load_class_headerblock_simplecontent_derived_Schema() : TwstPasTreeContainer;override;
function load_class_widestring_property() : TwstPasTreeContainer;override;
published
procedure no_binding_style();
procedure signature_last();
@ -1230,6 +1234,47 @@ begin
end;
end;
procedure TTest_CustomXsdParser.class_widestring_property();
const s_class_name = 'TSampleClass';
var
clsType : TPasClassType;
tr : TwstPasTreeContainer;
procedure CheckProperty(const AName,ATypeName,ADeclaredTypeName : string; const AFieldType : TPropertyType);
var
prp : TPasProperty;
begin
prp := FindMember(clsType,AName) as TPasProperty;
CheckNotNull(prp);
CheckEquals(AName,prp.Name);
CheckEquals(AName,tr.GetExternalName(prp));
CheckNotNull(prp.VarType);
CheckEquals(ATypeName,prp.VarType.Name,'TypeName');
CheckEquals(ADeclaredTypeName,tr.GetExternalName(prp.VarType),'DeclaredTypeName');
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
end;
var
mdl : TPasModule;
elt : TPasElement;
begin
tr := load_class_widestring_property();
try
mdl := tr.FindModule('class_widestring_property');
CheckNotNull(mdl,'class_widestring_property');
elt := tr.FindElement(s_class_name);
CheckNotNull(elt,s_class_name);
CheckEquals(s_class_name,elt.Name);
CheckEquals(s_class_name,tr.GetExternalName(elt));
CheckIs(elt,TPasClassType);
clsType := elt as TPasClassType;
CheckProperty('elementProp','WideString','string',ptField);
CheckProperty('elementAtt','WideString','string',ptAttribute);
finally
tr.Free();
end;
end;
procedure TTest_CustomXsdParser.ComplexType_Class_default_values();
var
tr : TwstPasTreeContainer;
@ -1469,6 +1514,11 @@ begin
Result := ParseDoc('class_headerblock_simplecontent_derived');
end;
function TTest_XsdParser.load_class_widestring_property(): TwstPasTreeContainer;
begin
Result := ParseDoc('class_widestring_property');
end;
function TTest_XsdParser.LoadComplexType_Class_default_values() : TwstPasTreeContainer;
begin
Result := ParseDoc(x_complexType_class_default);
@ -1582,6 +1632,11 @@ begin
Result := ParseDoc('class_headerblock_simplecontent_derived');
end;
function TTest_WsdlParser.load_class_widestring_property(): TwstPasTreeContainer;
begin
Result := ParseDoc('class_widestring_property');
end;
procedure TTest_WsdlParser.no_binding_style();
var
symTable : TwstPasTreeContainer;

101
wst/trunk/tests/test_suite/testformatter_unit.pas
View File

@ -372,6 +372,10 @@ type
procedure Test_AnsiChar_ScopeData;
procedure Test_WideChar;
procedure Test_WideChar_ScopeData;
{$IFDEF WST_UNICODESTRING}
procedure Test_UnicodeChar;
procedure Test_UnicodeChar_ScopeData;
{$ENDIF WST_UNICODESTRING}
procedure Test_Int_8;
procedure Test_Int_8_ScopeData;
procedure Test_Int_16;
@ -905,7 +909,102 @@ begin
CheckEquals(VAL_2,xVal_1);
finally
s.Free();
end; end;
end;
end;
{$IFDEF WST_UNICODESTRING}
procedure TTestFormatterSimpleType.Test_UnicodeChar;
const VAL_1 : UnicodeChar = UnicodeChar(300); VAL_2 : UnicodeChar = UnicodeChar(400);
Var
f : IFormatterBase;
s : TMemoryStream;
x : string;
xVal_1, xVal_2 : UnicodeChar;
begin
s := Nil;
Try
xVal_1 := VAL_1;
xVal_2 := VAL_2;
f := CreateFormatter(TypeInfo(TClass_Int));
f.BeginObject('Root',TypeInfo(TClass_Int));
f.Put('xVal_1',TypeInfo(UnicodeChar),xVal_1);
f.Put('xVal_2',TypeInfo(UnicodeChar),xVal_2);
f.EndScope();
s := TMemoryStream.Create();
f.SaveToStream(s); s.SaveToFile(ClassName + '.Test_UnicodeChar.xml');
xVal_1 := #0;
xVal_2 := #0;
f := CreateFormatter(TypeInfo(TClass_Int));
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginObjectRead(x,TypeInfo(TClass_Int));
x := 'xVal_1';
f.Get(TypeInfo(UnicodeChar),x,xVal_1);
x := 'xVal_2';
f.Get(TypeInfo(UnicodeChar),x,xVal_2);
f.EndScopeRead();
CheckEquals(VAL_1,xVal_1);
CheckEquals(VAL_2,xVal_2);
Finally
s.Free();
End;
end;
procedure TTestFormatterSimpleType.Test_UnicodeChar_ScopeData;
const VAL_1 : UnicodeChar = UnicodeChar(300); VAL_2 : UnicodeChar = UnicodeChar(400);
var
f : IFormatterBase;
s : TMemoryStream;
x : string;
xVal_1 : UnicodeChar;
begin
s := Nil;
try
xVal_1 := VAL_1;
f := CreateFormatter(TypeInfo(TClass_Int));
f.BeginObject('Root',TypeInfo(TClass_Int));
f.PutScopeInnerValue(TypeInfo(UnicodeChar),xVal_1);
f.EndScope();
s := TMemoryStream.Create();
f.SaveToStream(s);
xVal_1 := #0;
f := CreateFormatter(TypeInfo(TClass_Int));
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginObjectRead(x,TypeInfo(TClass_Int));
f.GetScopeInnerValue(TypeInfo(UnicodeChar),xVal_1);
f.EndScopeRead();
CheckEquals(VAL_1,xVal_1);
xVal_1 := VAL_2;
f := CreateFormatter(TypeInfo(TClass_Int));
f.BeginObject('Root',TypeInfo(TClass_Int));
f.PutScopeInnerValue(TypeInfo(UnicodeChar),xVal_1);
f.EndScope();
s := TMemoryStream.Create();
f.SaveToStream(s);
xVal_1 := #0;
f := CreateFormatter(TypeInfo(TClass_Int));
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginObjectRead(x,TypeInfo(TClass_Int));
f.GetScopeInnerValue(TypeInfo(UnicodeChar),xVal_1);
f.EndScopeRead();
CheckEquals(VAL_2,xVal_1);
finally
s.Free();
end;
end;
{$ENDIF WST_UNICODESTRING}
procedure TTestFormatterSimpleType.Test_Int_8;
const VAL_1 = 12; VAL_2 = -10;

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

@ -17,7 +17,7 @@
<RunParams>
<local>
<FormatVersion Value="1"/>
<CommandLineParams Value="-a >res.xml"/>
<CommandLineParams Value="--suite=TTest_XsdParser"/>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>

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

@ -138,6 +138,11 @@
<OtherUnitFiles Value="..\..\;..\..\ws_helper\;..\..\wst_rtti_filter\;..\..\fcl-json\src\"/>
<UnitOutputDirectory Value="obj"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<CStyleOperator Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Checks>
<RangeChecks Value="True"/>