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

composed name handling (such as "one-prop")

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1331 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa 2010-10-01 20:44:10 +00:00
parent 28bb2f355f
commit fbaef11db8
6 changed files with 251 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
wst/trunk/tests/test_suite/files/class_property_composed_name.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="urn_sample"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
targetNamespace="urn_sample"
xmlns:wst="urn:wst_base">
<types>
<xsd:schema xmlns="http://www.w3.org/2001/XMLSchema" targetNamespace="urn_sample">
<xsd:complexType name="TSampleClass">
<xsd:sequence>
<xsd:element name="one-prop" type="xsd:string" />
</xsd:sequence>
<xsd:attribute name="one-two-prop" type="xsd:string"/>
</xsd:complexType>
</xsd:schema>
</types>
</definitions>

8
wst/trunk/tests/test_suite/files/class_property_composed_name.xsd Normal file
View File

@ -0,0 +1,8 @@
<schema targetNamespace="urn_sample" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:tns="urn_sample" xmlns:wst="urn:wst_base">
<xsd:complexType name="TSampleClass">
<xsd:sequence>
<xsd:element name="one-prop" type="xsd:string" />
</xsd:sequence>
<xsd:attribute name="one-two-prop" type="xsd:string"/>
</xsd:complexType>
</schema>

51
wst/trunk/tests/test_suite/files/parameter_composed_name.wsdl Normal file
View File

@ -0,0 +1,51 @@
<?xml version="1.0"?>
<definitions name="library1" xmlns="http://schemas.xmlsoap.org/wsdl/" xmlns:tns="library1" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/" targetNamespace="library1">
<types>
<xsd:schema xmlns="http://www.w3.org/2001/XMLSchema" xmlns:tns="library1" targetNamespace="library1"/>
</types>
<message name="sampleProc">
<part name="one-param" type="xsd:string"/>
<part name="one-two-param" type="xsd:string"/>
</message>
<message name="sampleProcResponse" />
<message name="sampleFuncResponse">
<part name="one-two-param" type="xsd:string"/>
<part name="result" type="xsd:string"/>
</message>
<portType name="TestService">
<operation name="sampleProc">
<input message="tns:sampleProc"/>
<output message="tns:sampleProcResponse"/>
</operation>
<operation name="sampleFunc">
<input message="tns:sampleProc"/>
<output message="tns:sampleFuncResponse"/>
</operation>
</portType>
<binding name="TestServiceBinding" type="tns:TestService">
<soap:binding style="rpc" transport="http://schemas.xmlsoap.org/soap/http"/>
<operation name="sampleProc">
<soap:operation soapAction=""/>
<input>
<soap:body use="literal" namespace="library1"/>
</input>
<output>
<soap:body use="literal" namespace="library1"/>
</output>
</operation>
<operation name="sampleFunc">
<soap:operation soapAction=""/>
<input>
<soap:body use="literal" namespace="library1"/>
</input>
<output>
<soap:body use="literal" namespace="library1"/>
</output>
</operation>
</binding>
<service name="TestService">
<port name="TestServicePort" binding="tns:TestServiceBinding">
<soap:address location=""/>
</port>
</service>
</definitions>

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

@ -61,6 +61,7 @@ type
function load_class_ansichar_property() : TwstPasTreeContainer;virtual;abstract;
function load_class_widechar_property() : TwstPasTreeContainer;virtual;abstract;
function load_class_currency_property() : TwstPasTreeContainer;virtual;abstract;
function load_class_property_composed_name() : TwstPasTreeContainer;virtual;abstract;
function load_schema_import() : TwstPasTreeContainer;virtual;abstract;
published
@ -100,6 +101,7 @@ type
procedure class_ansichar_property();
procedure class_widechar_property();
procedure class_currency_property();
procedure class_property_composed_name();
procedure schema_import();
end;
@ -143,6 +145,7 @@ type
function load_class_ansichar_property() : TwstPasTreeContainer;override;
function load_class_widechar_property() : TwstPasTreeContainer;override;
function load_class_currency_property() : TwstPasTreeContainer;override;
function load_class_property_composed_name() : TwstPasTreeContainer;override;
function load_schema_import() : TwstPasTreeContainer;override;
end;
@ -185,7 +188,8 @@ type
function load_class_widestring_property() : TwstPasTreeContainer;override;
function load_class_ansichar_property() : TwstPasTreeContainer;override;
function load_class_widechar_property() : TwstPasTreeContainer;override;
function load_class_currency_property() : TwstPasTreeContainer;override;
function load_class_currency_property() : TwstPasTreeContainer;override;
function load_class_property_composed_name() : TwstPasTreeContainer;override;
function load_schema_import() : TwstPasTreeContainer;override;
published
@ -198,6 +202,8 @@ type
procedure message_parts_type_hint();
procedure parameter_var();
procedure parameter_const_default();
procedure parameter_composed_name();
procedure parameter_composed_name_function();
procedure soap_action();
end;
@ -1913,6 +1919,49 @@ begin
end;
end;
procedure TTest_CustomXsdParser.class_property_composed_name();
const s_class_name = 'TSampleClass';
var
clsType : TPasClassType;
tr : TwstPasTreeContainer;
procedure CheckProperty(
const AName,
ADeclaredName,
ATypeName : string;
const AFieldType : TPropertyType
);
var
prp : TPasProperty;
begin
prp := FindMember(clsType,AName) as TPasProperty;
CheckNotNull(prp);
CheckEquals(AName,prp.Name,'Name');
CheckEquals(ADeclaredName,tr.GetExternalName(prp),'External Name');
CheckNotNull(prp.VarType);
CheckEquals(ATypeName,prp.VarType.Name,'TypeName');
CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
end;
var
mdl : TPasModule;
elt : TPasElement;
begin
tr := load_class_property_composed_name();
try
mdl := tr.FindModule('urn_sample');
CheckNotNull(mdl,'urn_sample');
elt := tr.FindElement(s_class_name);
CheckNotNull(elt,s_class_name);
CheckIs(elt,TPasClassType);
clsType := elt as TPasClassType;
CheckProperty('one_prop','one-prop','string',ptField);
CheckProperty('one_two_prop','one-two-prop','string',ptAttribute);
finally
tr.Free();
end;
end;
procedure TTest_CustomXsdParser.schema_import();
const
s_base_namespace = 'urn:base-library';
@ -2094,6 +2143,11 @@ begin
Result := ParseDoc('class_currency_property');
end;
function TTest_XsdParser.load_class_property_composed_name() : TwstPasTreeContainer;
begin
Result := ParseDoc('class_property_composed_name');
end;
function TTest_XsdParser.load_schema_import(): TwstPasTreeContainer;
begin
Result := ParseDoc('import_second_library');
@ -2666,6 +2720,109 @@ begin
end;
end;
procedure TTest_WsdlParser.parameter_composed_name();
function FindProc(const AName : string; AIntf : TPasClassType) : TPasProcedure;
var
k : Integer;
begin
Result := nil;
for k := 0 to (AIntf.Members.Count - 1) do begin
if TObject(AIntf.Members[k]).InheritsFrom(TPasProcedure) and ( TPasProcedure(AIntf.Members[k]).Name = AName ) then begin
Result := TPasProcedure(AIntf.Members[k]);
Break;
end;
end;
end;
var
tr : TwstPasTreeContainer;
elt : TPasElement;
intf : TPasClassType;
mth : TPasProcedure;
mthType : TPasProcedureType;
res : TPasResultElement;
arg : TPasArgument;
begin
tr := ParseDoc('parameter_composed_name');
try
elt := tr.FindElement('TestService');
CheckNotNull(elt,'TestService');
CheckIs(elt,TPasClassType);
intf := elt as TPasClassType;
CheckEquals(Ord(okInterface),Ord(intf.ObjKind));
mth := FindProc('sampleProc',intf);
CheckNotNull(mth,'sampleProc not found');
CheckEquals('sampleProc',mth.Name);
mthType := mth.ProcType;
CheckIs(mthType,TPasProcedureType);
CheckEquals(2, mthType.Args.Count, 'Parameter count');
arg := TPasArgument(mthType.Args[0]);
CheckNotNull(arg);
CheckEquals('one_param',arg.Name,'Param Name');
CheckEquals('one-param',tr.GetExternalName(arg),'Param External Name');
arg := TPasArgument(mthType.Args[1]);
CheckNotNull(arg);
CheckEquals('one_two_param',arg.Name,'Param Name');
CheckEquals('one-two-param',tr.GetExternalName(arg),'Param External Name');
finally
tr.Free();
end;
end;
procedure TTest_WsdlParser.parameter_composed_name_function();
function FindProc(const AName : string; AIntf : TPasClassType) : TPasProcedure;
var
k : Integer;
begin
Result := nil;
for k := 0 to (AIntf.Members.Count - 1) do begin
if TObject(AIntf.Members[k]).InheritsFrom(TPasProcedure) and ( TPasProcedure(AIntf.Members[k]).Name = AName ) then begin
Result := TPasProcedure(AIntf.Members[k]);
Break;
end;
end;
end;
var
tr : TwstPasTreeContainer;
elt : TPasElement;
intf : TPasClassType;
mth : TPasProcedure;
mthType : TPasProcedureType;
res : TPasResultElement;
arg : TPasArgument;
begin
tr := ParseDoc('parameter_composed_name');
try
elt := tr.FindElement('TestService');
CheckNotNull(elt,'TestService');
CheckIs(elt,TPasClassType);
intf := elt as TPasClassType;
CheckEquals(Ord(okInterface),Ord(intf.ObjKind));
mth := FindProc('sampleFunc',intf);
CheckNotNull(mth,'sampleFunc not found');
CheckEquals('sampleFunc',mth.Name);
mthType := mth.ProcType;
CheckIs(mthType,TPasFunctionType);
CheckEquals(2, mthType.Args.Count, 'Parameter count');
arg := TPasArgument(mthType.Args[0]);
CheckNotNull(arg);
CheckEquals('one_param',arg.Name,'Param Name');
CheckEquals('one-param',tr.GetExternalName(arg),'Param External Name');
arg := TPasArgument(mthType.Args[1]);
CheckNotNull(arg);
CheckEquals('one_two_param',arg.Name,'Param Name');
CheckEquals('one-two-param',tr.GetExternalName(arg),'Param External Name');
res := TPasFunctionType(mthType).ResultEl;
CheckNotNull(res, 'Result');
CheckEquals(LowerCase('string'), LowerCase(res.ResultType.Name));
finally
tr.Free();
end;
end;
procedure TTest_WsdlParser.soap_action();
var
tr : TwstPasTreeContainer;
@ -2728,6 +2885,11 @@ begin
Result := ParseDoc('class_currency_property');
end;
function TTest_WsdlParser.load_class_property_composed_name() : TwstPasTreeContainer;
begin
Result := ParseDoc('class_property_composed_name');
end;
function TTest_WsdlParser.load_schema_import(): TwstPasTreeContainer;
begin
Result := ParseDoc('import_second_library');

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

@ -902,10 +902,12 @@ var
FSymbols.RegisterExternalAlias(locType,locTypeName);
end;
locInternalEltName := locName;
locHasInternalName := IsReservedKeyWord(locInternalEltName);
if locHasInternalName then
locInternalEltName := ExtractIdentifier(locName);
locHasInternalName := (locInternalEltName <> locName);
if IsReservedKeyWord(locInternalEltName) then begin
locHasInternalName := True;
locInternalEltName := Format('_%s',[locInternalEltName]);
end;
locProp := TPasProperty(FSymbols.CreateElement(TPasProperty,locInternalEltName,classDef,visPublished,'',0));
classDef.Members.Add(locProp);

2
wst/trunk/ws_helper/wsdl_parser.pas
View File

@ -618,6 +618,7 @@ function TWsdlParser.ParseOperation(
then begin
prmInternameName := prmInternameName + 'Param';
end;
prmInternameName := ExtractIdentifier(prmInternameName);
prmHasInternameName := IsReservedKeyWord(prmInternameName) or
( not IsValidIdent(prmInternameName) ) or
( GetParameterIndex(tmpMthdType,prmInternameName) >= 0 );
@ -742,6 +743,7 @@ function TWsdlParser.ParseOperation(
if AnsiSameText(prmInternameName,tmpMthd.Name) then begin
prmInternameName := prmInternameName + 'Param';
end;
prmInternameName := ExtractIdentifier(prmInternameName);
prmHasInternameName := IsReservedKeyWord(prmInternameName) or
( not IsValidIdent(prmInternameName) );
if prmHasInternameName then