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

<choice> construct parsing : Fix for unbounded embedded cases.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4634 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa 2016-05-04 12:32:49 +00:00
parent c9347b902a
commit 6e209c21fa
4 changed files with 170 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
wst/trunk/tests/test_suite/files/embedded_unbounded_choice.wsdl Normal file
View File

@ -0,0 +1,48 @@
<?xml version="1.0"?>
<definitions name="wst_test"
xmlns="http://schemas.xmlsoap.org/wsdl/"
xmlns:tns="library1"
xmlns:xs="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
targetNamespace="urn:wst-test">
<types>
<xs:schema xmlns="http://www.w3.org/2001/XMLSchema" targetNamespace="urn:wst-test">
<xs:element name="EntityContainer">
<xs:complexType>
<xs:sequence>
<xs:element name="Documentation" type="xs:string" minOccurs="0" maxOccurs="1" />
<xs:choice minOccurs="0" maxOccurs="unbounded">
<xs:element name="FunctionImport">
<xs:complexType>
<xs:sequence>
<xs:element name="Documentation" type="xs:string" minOccurs="0" maxOccurs="1" />
<xs:choice minOccurs="0" maxOccurs="unbounded">
<xs:element name="ReturnType" type="xs:string" minOccurs="0" maxOccurs="unbounded" />
<xs:element name="Parameter" type="xs:string" minOccurs="0" maxOccurs="unbounded" />
</xs:choice>
</xs:sequence>
</xs:complexType>
</xs:element>
<xs:element name="EntitySet">
<xs:complexType>
<xs:sequence>
<xs:element name="Documentation" type="xs:string" minOccurs="0" maxOccurs="1" />
<xs:choice minOccurs="0" maxOccurs="unbounded">
<xs:element name="ValueAnnotation" type="xs:string" minOccurs="0" maxOccurs="unbounded" />
<xs:element name="TypeAnnotation" type="xs:integer" minOccurs="0" maxOccurs="unbounded" />
</xs:choice>
</xs:sequence>
</xs:complexType>
</xs:element>
</xs:choice>
</xs:sequence>
</xs:complexType>
</xs:element>
</xs:schema>
</types>
</definitions>

39
wst/trunk/tests/test_suite/files/embedded_unbounded_choice.xsd Normal file
View File

@ -0,0 +1,39 @@
<?xml version="1.0" encoding="UTF-8"?>
<xs:schema xmlns:n="urn:wst-test"
xmlns:xs="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xs:element name="EntityContainer">
<xs:complexType>
<xs:sequence>
<xs:element name="Documentation" type="xs:string" minOccurs="0" maxOccurs="1" />
<xs:choice minOccurs="0" maxOccurs="unbounded">
<xs:element name="FunctionImport">
<xs:complexType>
<xs:sequence>
<xs:element name="Documentation" type="xs:string" minOccurs="0" maxOccurs="1" />
<xs:choice minOccurs="0" maxOccurs="unbounded">
<xs:element name="ReturnType" type="xs:string" minOccurs="0" maxOccurs="unbounded" />
<xs:element name="Parameter" type="xs:string" minOccurs="0" maxOccurs="unbounded" />
</xs:choice>
</xs:sequence>
</xs:complexType>
</xs:element>
<xs:element name="EntitySet">
<xs:complexType>
<xs:sequence>
<xs:element name="Documentation" type="xs:string" minOccurs="0" maxOccurs="1" />
<xs:choice minOccurs="0" maxOccurs="unbounded">
<xs:element name="ValueAnnotation" type="xs:string" minOccurs="0" maxOccurs="unbounded" />
<xs:element name="TypeAnnotation" type="xs:integer" minOccurs="0" maxOccurs="unbounded" />
</xs:choice>
</xs:sequence>
</xs:complexType>
</xs:element>
</xs:choice>
</xs:sequence>
</xs:complexType>
</xs:element>
</xs:schema>

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

@ -109,6 +109,7 @@ type
function load_global_attribute() : TwstPasTreeContainer;virtual;abstract;
function load_att_inherited_maxbound() : TwstPasTreeContainer;virtual;
function load_embedded_unbounded_choice() : TwstPasTreeContainer;virtual;
published
procedure EmptySchema();
@ -183,6 +184,7 @@ type
procedure global_attribute();
procedure att_inherited_maxbound();
procedure embedded_unbounded_choice();
end;
{ TTest_XsdParser }
@ -438,6 +440,11 @@ begin
Result := ParseDoc('att_inherited_maxbound');
end;
function TTest_CustomXsdParser.load_embedded_unbounded_choice : TwstPasTreeContainer;
begin
Result := ParseDoc('embedded_unbounded_choice');
end;
procedure TTest_CustomXsdParser.EmptySchema();
var
tr : TwstPasTreeContainer;
@ -4145,6 +4152,79 @@ begin
end;
end;
procedure TTest_CustomXsdParser.embedded_unbounded_choice();
const s_class_name = 'EntityContainer';
var
clsType : TPasClassType;
tr : TwstPasTreeContainer;
procedure CheckProperty(
const AName,
ADeclaredName,
ATypeName : string;
const AFieldType : TPropertyType;
const AIsArray : Boolean
);
var
prp : TPasProperty;
t : TPasType;
begin
prp := FindMember(clsType,AName) as TPasProperty;
CheckNotNull(prp);
CheckEquals(AName,prp.Name,'Name');
CheckEquals(ADeclaredName,tr.GetExternalName(prp),'External Name');
CheckNotNull(prp.VarType);
t := GetUltimeType(prp.VarType);
CheckNotNull(t,'Property''s Ultime Type not found.');
if AIsArray then begin
CheckEquals(AIsArray,(t is TPasArrayType));
CheckNotNull(TPasArrayType(t).ElType,'array element type');
CheckEquals(ATypeName,tr.GetExternalName(TPasArrayType(t).ElType),'TypeName');
end else begin
CheckEquals(ATypeName,tr.GetExternalName(t),'TypeName');
end;
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
end;
var
mdl : TPasModule;
elt : TPasElement;
s : string;
begin
tr := load_embedded_unbounded_choice();
try
mdl := tr.FindModule('urn:wst-test');
CheckNotNull(mdl,'urn:wst-test');
elt := tr.FindElement(s_class_name);
CheckNotNull(elt,s_class_name);
CheckIs(elt,TPasClassType);
clsType := elt as TPasClassType;
CheckProperty('Documentation','Documentation','string',ptField,False);
CheckProperty('FunctionImport','FunctionImport','EntityContainer_FunctionImport_Type',ptField,True);
CheckProperty('EntitySet','EntitySet','EntityContainer_EntitySet_Type',ptField,True);
s := 'EntityContainer_FunctionImport_Type';
elt := tr.FindElement(s);
CheckNotNull(elt,s);
CheckIs(elt,TPasClassType);
clsType := elt as TPasClassType;
CheckProperty('Documentation','Documentation','string',ptField,False);
CheckProperty('ReturnType','ReturnType','string',ptField,True);
CheckProperty('Parameter','Parameter','string',ptField,True);
s := 'EntityContainer_EntitySet_Type';
elt := tr.FindElement(s);
CheckNotNull(elt,s);
CheckIs(elt,TPasClassType);
clsType := elt as TPasClassType;
CheckProperty('Documentation','Documentation','string',ptField,False);
CheckProperty('ValueAnnotation','ValueAnnotation','string',ptField,True);
CheckProperty('TypeAnnotation','TypeAnnotation','integer',ptField,True);
finally
tr.Free();
end;
end;
{ TTest_XsdParser }
function TTest_XsdParser.ParseDoc(

4
wst/trunk/ws_helper/ws_parser_imp.pas
View File

@ -1330,10 +1330,12 @@ var
if (locLN = s_choice) then begin
locEltCrs := ExtractElement(locNode);
if (locEltCrs <> nil) then begin
locEltAttCrs := CreateAttributesCursor(locNode,cetRttiNode);
FillChar(locBoundInfos,SizeOf(locBoundInfos),#0);
ExtractOccurences(s_choice,locEltAttCrs,locBoundInfos.MinOccurs,locBoundInfos.MaxOccurs,locBoundInfos.Unboundded);
locBoundInfos.MinOccurs := 0;
locBoundInfos.Valid := True;
ParseElementsAndAttributes(locEltCrs,locEltAttCrs,locBoundInfos,AIsChoiceParent);
ParseElementsAndAttributes(locEltCrs,nil,locBoundInfos,True);
end;
end else begin
ParseElement(locNode,ABoundInfos,AIsChoiceParent);