diff --git a/wst/trunk/base_service_intf.pas b/wst/trunk/base_service_intf.pas
index 28068fcc5..fb8925eb9 100644
--- a/wst/trunk/base_service_intf.pas
+++ b/wst/trunk/base_service_intf.pas
@@ -1569,146 +1569,147 @@ Var
typRegItem : TTypeRegistryItem;
begin
oldSS := AStore.GetSerializationStyle();
- AStore.BeginObjectRead(AName,ATypeInfo);
- try
- if AStore.IsCurrentScopeNil() then
- Exit; // ???? FreeAndNil(AObject);
- If Not Assigned(AObject) Then
- AObject := Create();
- objTypeData := GetTypeData(ATypeInfo);
- propCount := objTypeData^.PropCount;
- If ( propCount > 0 ) Then Begin
- propListLen := GetPropList(ATypeInfo,propList);
- Try
- typRegItem := GetTypeRegistry().ItemByTypeInfo[ATypeInfo];
- For i := 0 To Pred(propCount) Do Begin
- p := propList^[i];
- persistType := IsStoredPropClass(objTypeData^.ClassType,p);
- If ( persistType in [pstOptional,pstAlways] ) Then Begin
- pt := p^.PropType;
- propName := typRegItem.GetExternalPropertyName(p^.Name);
- if IsAttributeProperty(p^.Name) then begin
- ss := ssAttibuteSerialization;
- end else begin
- ss := ssNodeSerialization;
- end;
- if ( ss <> AStore.GetSerializationStyle() ) then
- AStore.SetSerializationStyle(ss);
- try
- Case pt^.Kind Of
- tkInt64,tkQWord :
- Begin
- AStore.Get(pt,propName,int64Data);
- SetOrdProp(AObject,p^.Name,int64Data);
- End;
- tkLString, tkAString :
- Begin
- AStore.Get(pt,propName,strData);
- SetStrProp(AObject,p^.Name,strData);
- End;
- tkBool :
- Begin
- AStore.Get(pt,propName,boolData);
- SetOrdProp(AObject,p^.Name,Ord(boolData));
- End;
- tkClass :
- Begin
- objData := GetObjectProp(AObject,p^.Name);
- objDataCreateHere := not Assigned(objData);
- try
- AStore.Get(pt,propName,objData);
- if objDataCreateHere then
- SetObjectProp(AObject,p^.Name,objData);
- finally
- if objDataCreateHere then
- FreeAndNil(objData);
- end;
- End;
- tkEnumeration,tkInteger :
- Begin
- FillChar(enumData,SizeOf(enumData),#0);
- Case GetTypeData(p^.PropType)^.OrdType Of
- otSByte :
- Begin
- AStore.Get(pt,propName,enumData.ShortIntData);
- int64Data := enumData.ShortIntData;
- End;
- otUByte :
- Begin
- AStore.Get(pt,propName,enumData.ByteData);
- int64Data := enumData.ByteData;
- End;
- otSWord :
- Begin
- AStore.Get(pt,propName,enumData.SmallIntData);
- int64Data := enumData.SmallIntData;
- End;
- otUWord :
- Begin
- AStore.Get(pt,propName,enumData.WordData);
- int64Data := enumData.WordData;
- End;
- otSLong:
- Begin
- AStore.Get(pt,propName,enumData.SLongIntData);
- int64Data := enumData.SLongIntData;
- End;
- otULong :
- Begin
- AStore.Get(pt,propName,enumData.ULongIntData);
- int64Data := enumData.ULongIntData;
- End;
- End;
- SetOrdProp(AObject,p^.Name,int64Data);
- End;
- tkFloat :
- Begin
- FillChar(floatDt,SizeOf(floatBuffer),#0);
- Case GetTypeData(p^.PropType)^.FloatType Of
- ftSingle :
- Begin
- AStore.Get(pt,propName,floatBuffer.SingleData);
- floatDt := floatBuffer.SingleData;
- End;
- ftDouble :
- Begin
- AStore.Get(pt,propName,floatBuffer.DoubleData);
- floatDt := floatBuffer.DoubleData;
- End;
- ftExtended :
- Begin
- AStore.Get(pt,propName,floatBuffer.ExtendedData);
- floatDt := floatBuffer.ExtendedData;
- End;
- ftCurr :
- Begin
- AStore.Get(pt,propName,floatBuffer.CurrencyData);
- floatDt := floatBuffer.CurrencyData;
- End;
- ftComp :
- Begin
- AStore.Get(pt,propName,floatBuffer.CompData);
- floatDt := floatBuffer.CompData;
- End;
- End;
- SetFloatProp(AObject,p^.Name,floatDt);
- End;
- End;
- except
- on E : EServiceException do begin
- if ( persistType = pstAlways ) then
- raise;
+ if ( AStore.BeginObjectRead(AName,ATypeInfo) >= 0 ) then begin
+ try
+ if AStore.IsCurrentScopeNil() then
+ Exit; // ???? FreeAndNil(AObject);
+ If Not Assigned(AObject) Then
+ AObject := Create();
+ objTypeData := GetTypeData(ATypeInfo);
+ propCount := objTypeData^.PropCount;
+ If ( propCount > 0 ) Then Begin
+ propListLen := GetPropList(ATypeInfo,propList);
+ Try
+ typRegItem := GetTypeRegistry().ItemByTypeInfo[ATypeInfo];
+ For i := 0 To Pred(propCount) Do Begin
+ p := propList^[i];
+ persistType := IsStoredPropClass(objTypeData^.ClassType,p);
+ If ( persistType in [pstOptional,pstAlways] ) Then Begin
+ pt := p^.PropType;
+ propName := typRegItem.GetExternalPropertyName(p^.Name);
+ if IsAttributeProperty(p^.Name) then begin
+ ss := ssAttibuteSerialization;
+ end else begin
+ ss := ssNodeSerialization;
end;
- end;
+ if ( ss <> AStore.GetSerializationStyle() ) then
+ AStore.SetSerializationStyle(ss);
+ try
+ Case pt^.Kind Of
+ tkInt64,tkQWord :
+ Begin
+ AStore.Get(pt,propName,int64Data);
+ SetOrdProp(AObject,p^.Name,int64Data);
+ End;
+ tkLString, tkAString :
+ Begin
+ AStore.Get(pt,propName,strData);
+ SetStrProp(AObject,p^.Name,strData);
+ End;
+ tkBool :
+ Begin
+ AStore.Get(pt,propName,boolData);
+ SetOrdProp(AObject,p^.Name,Ord(boolData));
+ End;
+ tkClass :
+ Begin
+ objData := GetObjectProp(AObject,p^.Name);
+ objDataCreateHere := not Assigned(objData);
+ try
+ AStore.Get(pt,propName,objData);
+ if objDataCreateHere then
+ SetObjectProp(AObject,p^.Name,objData);
+ finally
+ if objDataCreateHere and ( objData <> GetObjectProp(AObject,p^.Name) ) then
+ FreeAndNil(objData);
+ end;
+ End;
+ tkEnumeration,tkInteger :
+ Begin
+ FillChar(enumData,SizeOf(enumData),#0);
+ Case GetTypeData(p^.PropType)^.OrdType Of
+ otSByte :
+ Begin
+ AStore.Get(pt,propName,enumData.ShortIntData);
+ int64Data := enumData.ShortIntData;
+ End;
+ otUByte :
+ Begin
+ AStore.Get(pt,propName,enumData.ByteData);
+ int64Data := enumData.ByteData;
+ End;
+ otSWord :
+ Begin
+ AStore.Get(pt,propName,enumData.SmallIntData);
+ int64Data := enumData.SmallIntData;
+ End;
+ otUWord :
+ Begin
+ AStore.Get(pt,propName,enumData.WordData);
+ int64Data := enumData.WordData;
+ End;
+ otSLong:
+ Begin
+ AStore.Get(pt,propName,enumData.SLongIntData);
+ int64Data := enumData.SLongIntData;
+ End;
+ otULong :
+ Begin
+ AStore.Get(pt,propName,enumData.ULongIntData);
+ int64Data := enumData.ULongIntData;
+ End;
+ End;
+ SetOrdProp(AObject,p^.Name,int64Data);
+ End;
+ tkFloat :
+ Begin
+ FillChar(floatDt,SizeOf(floatBuffer),#0);
+ Case GetTypeData(p^.PropType)^.FloatType Of
+ ftSingle :
+ Begin
+ AStore.Get(pt,propName,floatBuffer.SingleData);
+ floatDt := floatBuffer.SingleData;
+ End;
+ ftDouble :
+ Begin
+ AStore.Get(pt,propName,floatBuffer.DoubleData);
+ floatDt := floatBuffer.DoubleData;
+ End;
+ ftExtended :
+ Begin
+ AStore.Get(pt,propName,floatBuffer.ExtendedData);
+ floatDt := floatBuffer.ExtendedData;
+ End;
+ ftCurr :
+ Begin
+ AStore.Get(pt,propName,floatBuffer.CurrencyData);
+ floatDt := floatBuffer.CurrencyData;
+ End;
+ ftComp :
+ Begin
+ AStore.Get(pt,propName,floatBuffer.CompData);
+ floatDt := floatBuffer.CompData;
+ End;
+ End;
+ SetFloatProp(AObject,p^.Name,floatDt);
+ End;
+ End;
+ except
+ on E : EServiceException do begin
+ if ( persistType = pstAlways ) then
+ raise;
+ end;
+ end;
+ End;
End;
+ Finally
+ Freemem(propList,propListLen*SizeOf(Pointer));
End;
- Finally
- Freemem(propList,propListLen*SizeOf(Pointer));
End;
- End;
- finally
- AStore.EndScopeRead();
- AStore.SetSerializationStyle(oldSS);
+ finally
+ AStore.EndScopeRead();
+ AStore.SetSerializationStyle(oldSS);
+ end;
end;
end;
@@ -1786,22 +1787,24 @@ begin
itmName := AName;
end;
len := AStore.BeginArrayRead(AName,ATypeInfo, GetStyle(),itmName);
- Try
- If Not Assigned(AObject) Then
- AObject := Create();
- itmTypInfo := PTypeInfo(GetItemClass().ClassInfo);
- nativObj := AObject as TBaseObjectArrayRemotable;
- If ( len > 0 ) Then Begin
- s := '';
- nativObj.SetLength(len);
- For i := 0 To Pred(len) Do Begin
- itm := nativObj[i];
- AStore.Get(itmTypInfo,s,itm);
+ if ( len > 0 ) then begin
+ Try
+ If Not Assigned(AObject) Then
+ AObject := Create();
+ itmTypInfo := PTypeInfo(GetItemClass().ClassInfo);
+ nativObj := AObject as TBaseObjectArrayRemotable;
+ If ( len > 0 ) Then Begin
+ s := '';
+ nativObj.SetLength(len);
+ For i := 0 To Pred(len) Do Begin
+ itm := nativObj[i];
+ AStore.Get(itmTypInfo,s,itm);
+ End;
End;
+ Finally
+ AStore.EndScopeRead();
End;
- Finally
- AStore.EndScopeRead();
- End;
+ end;
end;
class function TBaseObjectArrayRemotable.GetItemTypeInfo(): PTypeInfo;
@@ -3561,7 +3564,7 @@ begin
AStore.PutScopeInnerValue(TypeInfo(LongInt),(AObject as TComplexInt32SContentRemotable).Value);
end;
-procedure TComplexInt32SContentRemotable.LoadValue(
+class procedure TComplexInt32SContentRemotable.LoadValue(
var AObject : TObject;
AStore : IFormatterBase
);
@@ -3575,7 +3578,7 @@ end;
{ TComplexInt32UContentRemotable }
-procedure TComplexInt32UContentRemotable.SaveValue(
+class procedure TComplexInt32UContentRemotable.SaveValue(
AObject : TBaseRemotable;
AStore : IFormatterBase
);
@@ -3583,7 +3586,7 @@ begin
AStore.PutScopeInnerValue(TypeInfo(LongWord),(AObject as TComplexInt32UContentRemotable).Value);
end;
-procedure TComplexInt32UContentRemotable.LoadValue(
+class procedure TComplexInt32UContentRemotable.LoadValue(
var AObject : TObject;
AStore : IFormatterBase
);
@@ -3597,7 +3600,7 @@ end;
{ TComplexInt16SContentRemotable }
-procedure TComplexInt16SContentRemotable.SaveValue(
+class procedure TComplexInt16SContentRemotable.SaveValue(
AObject : TBaseRemotable;
AStore : IFormatterBase
);
@@ -3605,7 +3608,7 @@ begin
AStore.PutScopeInnerValue(TypeInfo(SmallInt),(AObject as TComplexInt16SContentRemotable).Value);
end;
-procedure TComplexInt16SContentRemotable.LoadValue(
+class procedure TComplexInt16SContentRemotable.LoadValue(
var AObject : TObject;
AStore : IFormatterBase
);
@@ -3619,7 +3622,7 @@ end;
{ TComplexInt16UContentRemotable }
-procedure TComplexInt16UContentRemotable.SaveValue(
+class procedure TComplexInt16UContentRemotable.SaveValue(
AObject : TBaseRemotable;
AStore : IFormatterBase
);
@@ -3627,7 +3630,7 @@ begin
AStore.PutScopeInnerValue(TypeInfo(Word),(AObject as TComplexInt16UContentRemotable).Value);
end;
-procedure TComplexInt16UContentRemotable.LoadValue(
+class procedure TComplexInt16UContentRemotable.LoadValue(
var AObject : TObject;
AStore : IFormatterBase
);
@@ -3641,7 +3644,7 @@ end;
{ TComplexFloatExtendedContentRemotable }
-procedure TComplexFloatExtendedContentRemotable.SaveValue(
+class procedure TComplexFloatExtendedContentRemotable.SaveValue(
AObject : TBaseRemotable;
AStore : IFormatterBase
);
@@ -3649,7 +3652,7 @@ begin
AStore.PutScopeInnerValue(TypeInfo(Extended),(AObject as TComplexFloatExtendedContentRemotable).Value);
end;
-procedure TComplexFloatExtendedContentRemotable.LoadValue(
+class procedure TComplexFloatExtendedContentRemotable.LoadValue(
var AObject : TObject;
AStore : IFormatterBase
);
@@ -3663,7 +3666,7 @@ end;
{ TComplexFloatDoubleContentRemotable }
-procedure TComplexFloatDoubleContentRemotable.SaveValue(
+class procedure TComplexFloatDoubleContentRemotable.SaveValue(
AObject : TBaseRemotable;
AStore : IFormatterBase
);
@@ -3671,7 +3674,7 @@ begin
AStore.PutScopeInnerValue(TypeInfo(Double),(AObject as TComplexFloatDoubleContentRemotable).Value);
end;
-procedure TComplexFloatDoubleContentRemotable.LoadValue(
+class procedure TComplexFloatDoubleContentRemotable.LoadValue(
var AObject : TObject;
AStore : IFormatterBase
);
@@ -3794,9 +3797,8 @@ var
end;
var
- s: string;
d, m, y : Word;
- hh, mn, ss, ssss : Word;
+ hh, mn, ss : Word;
begin
//'-'? yyyy '-' mm '-' dd 'T' hh ':' mm ':' ss ('.' s+)? (zzzzzz)?
@@ -3837,7 +3839,7 @@ begin
FDay := d;
end;
-procedure TBaseDateRemotable.Save(
+class procedure TBaseDateRemotable.Save(
AObject : TBaseRemotable;
AStore : IFormatterBase;
const AName : string;
@@ -3855,7 +3857,7 @@ begin
end;
end;
-procedure TBaseDateRemotable.Load(
+class procedure TBaseDateRemotable.Load(
var AObject : TObject;
AStore : IFormatterBase;
var AName : string;
@@ -3885,7 +3887,7 @@ end;
{ TComplexInt8SContentRemotable }
-procedure TComplexInt8SContentRemotable.SaveValue(
+class procedure TComplexInt8SContentRemotable.SaveValue(
AObject : TBaseRemotable;
AStore : IFormatterBase
);
@@ -3893,7 +3895,7 @@ begin
AStore.PutScopeInnerValue(TypeInfo(ShortInt),(AObject as TComplexInt8SContentRemotable).Value);
end;
-procedure TComplexInt8SContentRemotable.LoadValue(
+class procedure TComplexInt8SContentRemotable.LoadValue(
var AObject : TObject;
AStore : IFormatterBase
);
@@ -3907,7 +3909,7 @@ end;
{ TComplexInt8UContentRemotable }
-procedure TComplexInt8UContentRemotable.SaveValue(
+class procedure TComplexInt8UContentRemotable.SaveValue(
AObject : TBaseRemotable;
AStore : IFormatterBase
);
@@ -3915,7 +3917,7 @@ begin
AStore.PutScopeInnerValue(TypeInfo(Byte),(AObject as TComplexInt8UContentRemotable).Value);
end;
-procedure TComplexInt8UContentRemotable.LoadValue(
+class procedure TComplexInt8UContentRemotable.LoadValue(
var AObject : TObject;
AStore : IFormatterBase
);
@@ -3929,7 +3931,7 @@ end;
{ TComplexFloatSingleContentRemotable }
-procedure TComplexFloatSingleContentRemotable.SaveValue(
+class procedure TComplexFloatSingleContentRemotable.SaveValue(
AObject : TBaseRemotable;
AStore : IFormatterBase
);
@@ -3937,7 +3939,7 @@ begin
AStore.PutScopeInnerValue(TypeInfo(Single),(AObject as TComplexFloatSingleContentRemotable).Value);
end;
-procedure TComplexFloatSingleContentRemotable.LoadValue(
+class procedure TComplexFloatSingleContentRemotable.LoadValue(
var AObject : TObject;
AStore : IFormatterBase
);
@@ -3951,7 +3953,7 @@ end;
{ TComplexInt64SContentRemotable }
-procedure TComplexInt64SContentRemotable.SaveValue(
+class procedure TComplexInt64SContentRemotable.SaveValue(
AObject : TBaseRemotable;
AStore : IFormatterBase
);
@@ -3959,7 +3961,7 @@ begin
AStore.PutScopeInnerValue(TypeInfo(Int64),(AObject as TComplexInt64SContentRemotable).Value);
end;
-procedure TComplexInt64SContentRemotable.LoadValue(
+class procedure TComplexInt64SContentRemotable.LoadValue(
var AObject : TObject;
AStore : IFormatterBase
);
@@ -3973,7 +3975,7 @@ end;
{ TComplexInt64UContentRemotable }
-procedure TComplexInt64UContentRemotable.SaveValue(
+class procedure TComplexInt64UContentRemotable.SaveValue(
AObject : TBaseRemotable;
AStore : IFormatterBase
);
@@ -3981,7 +3983,7 @@ begin
AStore.PutScopeInnerValue(TypeInfo(QWord),(AObject as TComplexInt64UContentRemotable).Value);
end;
-procedure TComplexInt64UContentRemotable.LoadValue(
+class procedure TComplexInt64UContentRemotable.LoadValue(
var AObject : TObject;
AStore : IFormatterBase
);
@@ -3995,7 +3997,7 @@ end;
{ TComplexBooleanContentRemotable }
-procedure TComplexBooleanContentRemotable.SaveValue(
+class procedure TComplexBooleanContentRemotable.SaveValue(
AObject : TBaseRemotable;
AStore : IFormatterBase
);
@@ -4003,7 +4005,7 @@ begin
AStore.PutScopeInnerValue(TypeInfo(Boolean),(AObject as TComplexBooleanContentRemotable).Value);
end;
-procedure TComplexBooleanContentRemotable.LoadValue(
+class procedure TComplexBooleanContentRemotable.LoadValue(
var AObject : TObject;
AStore : IFormatterBase
);
diff --git a/wst/trunk/base_soap_formatter.pas b/wst/trunk/base_soap_formatter.pas
index bdeb254fb..23e7af597 100644
--- a/wst/trunk/base_soap_formatter.pas
+++ b/wst/trunk/base_soap_formatter.pas
@@ -13,6 +13,9 @@
unit base_soap_formatter;
{$mode objfpc}{$H+}
+{$IF (FPC_VERSION = 2) and (FPC_RELEASE > 0)}
+ {$define FPC_211}
+{$ENDIF}
interface
@@ -53,6 +56,7 @@ Type
TStackItem = class
private
+ FEmbeddedScopeCount: Integer;
FNameSpace: string;
FScopeObject: TDOMNode;
FScopeType: TScopeType;
@@ -66,6 +70,10 @@ Type
property ScopeType : TScopeType Read FScopeType;
property NameSpace : string Read FNameSpace;
property ItemsCount : Integer read GetItemsCount;
+
+ property EmbeddedScopeCount : Integer read FEmbeddedScopeCount;
+ function BeginEmbeddedScope() : Integer;
+ function EndEmbeddedScope() : Integer;
End;
{ TObjectStackItem }
@@ -110,7 +118,7 @@ Type
function CreateList(const ANodeName : string):TDOMNodeList;override;
end;
- TSOAPEncodingStyle = ( Encoded, Litteral );
+ TSOAPEncodingStyle = ( Encoded, Literal );
TSOAPDocumentStyle = ( RPC, Document );
{$M+}
@@ -369,6 +377,21 @@ begin
FNameSpace := ANameSpace;
end;
+function TStackItem.BeginEmbeddedScope(): Integer;
+begin
+ Inc(FEmbeddedScopeCount);
+ Result := FEmbeddedScopeCount;
+end;
+
+function TStackItem.EndEmbeddedScope(): Integer;
+begin
+ if ( FEmbeddedScopeCount < 1 ) then begin
+ raise Exception.Create('Invalid opération on scope, their are no embedded scope.');
+ end;
+ Dec(FEmbeddedScopeCount);
+ Result := FEmbeddedScopeCount;
+end;
+
{ TObjectStackItem }
function TObjectStackItem.FindNode(var ANodeName: string): TDOMNode;
@@ -481,7 +504,7 @@ begin
Inc(FHeaderEnterCount);
Prepare();
BeginScope(sHEADER,sSOAP_ENV,sSOAP_ENV_ABR,stObject,asNone);
- SetStyleAndEncoding(Document,Litteral);
+ SetStyleAndEncoding(Document,Literal);
end;
end;
@@ -771,7 +794,6 @@ begin
end else begin
Error('Param or Attribute not found : "%s"',[AName]);
end;
- //WriteLn(StringOfChar(' ',FStack.Count), AName,' = ',Result);
end;
procedure TSOAPBaseFormatter.GetEnum(
@@ -994,9 +1016,9 @@ begin
strNodeName := AName;
end;
- if ( AStyle = asScoped ) then begin
+ //if ( AStyle = asScoped ) then begin
BeginScope(strNodeName,'','',stArray,AStyle);
- end;
+ //end;
if ( EncodingStyle = Encoded ) then begin
//AddScopeAttribute(sXSI_TYPE,nmspc);
@@ -1060,35 +1082,41 @@ Var
e : TDOMElement;
hasNmspc, addAtt : Boolean;
begin
- scpStr := AScopeName;
- hasNmspc := Not IsStrEmpty(ANameSpace);
- If hasNmspc Then Begin
- nsStr := FindAttributeByValueInScope(ANameSpace);
- addAtt := IsStrEmpty(nsStr);
- If addAtt Then Begin
- If IsStrEmpty(ANameSpaceShortName) Then
- nsStr := 'ns' + IntToStr(NextNameSpaceCounter())
- Else
- nsStr := Trim(ANameSpaceShortName);
- End Else Begin
- nsStr := Copy(nsStr,Succ(AnsiPos(':',nsStr)),MaxInt);
+ if ( AScopeType = stObject ) or
+ ( ( AScopeType = stArray ) and ( AStyle = asScoped ) )
+ then begin
+ scpStr := AScopeName;
+ hasNmspc := Not IsStrEmpty(ANameSpace);
+ If hasNmspc Then Begin
+ nsStr := FindAttributeByValueInScope(ANameSpace);
+ addAtt := IsStrEmpty(nsStr);
+ If addAtt Then Begin
+ If IsStrEmpty(ANameSpaceShortName) Then
+ nsStr := 'ns' + IntToStr(NextNameSpaceCounter())
+ Else
+ nsStr := Trim(ANameSpaceShortName);
+ End Else Begin
+ nsStr := Copy(nsStr,Succ(AnsiPos(':',nsStr)),MaxInt);
+ End;
+ scpStr := nsStr + ':' + scpStr;
End;
- scpStr := nsStr + ':' + scpStr;
- End;
- e := FDoc.CreateElement(scpStr);
- If HasScope() Then
- GetCurrentScopeObject().AppendChild(e)
- Else
- FDoc.AppendChild(e);
- if ( AScopeType = stObject ) then begin
- PushStack(e);
- end else begin
- PushStack(e,AStyle,'');
- end;
- if hasNmspc and addAtt then begin
- e.SetAttribute('xmlns:'+nsStr,ANameSpace);
- StackTop().SetNameSpace(ANameSpace);
+ e := FDoc.CreateElement(scpStr);
+ If HasScope() Then
+ GetCurrentScopeObject().AppendChild(e)
+ Else
+ FDoc.AppendChild(e);
+ if ( AScopeType = stObject ) then begin
+ PushStack(e);
+ end else begin
+ PushStack(e,AStyle,'');
+ end;
+ if hasNmspc and addAtt then begin
+ e.SetAttribute('xmlns:'+nsStr,ANameSpace);
+ StackTop().SetNameSpace(ANameSpace);
+ end;
+ end else if ( ( AScopeType = stArray ) and ( AStyle = asEmbeded ) ) then begin
+ StackTop().BeginEmbeddedScope();
end;
end;
@@ -1142,18 +1170,20 @@ begin
end else begin
locNode := stk.ScopeObject;
end;
- if not Assigned(locNode) then begin
- Error('Scope not found : "%s"',[strNodeName]);
- end;
- if ( AScopeType = stObject ) then begin
- PushStack(locNode);
+
+ if ( locNode = nil ) then begin
+ Result := -1;
end else begin
- PushStack(locNode,AStyle,AItemName);
+ if ( AScopeType = stObject ) then begin
+ PushStack(locNode);
+ end else begin
+ PushStack(locNode,AStyle,AItemName);
+ end;
+ if ( Style = Document ) then begin
+ StackTop().SetNameSpace(nmspc);
+ end;
+ Result := StackTop().GetItemsCount();
end;
- if ( Style = Document ) then begin
- StackTop().SetNameSpace(nmspc);
- end;
- Result := StackTop().GetItemsCount();
end;
procedure TSOAPBaseFormatter.SetSerializationStyle(const ASerializationStyle: TSerializationStyle);
@@ -1230,7 +1260,7 @@ var
locName : string;
chdLst : TDOMNodeList;
begin
- SetStyleAndEncoding(Document,Litteral);
+ SetStyleAndEncoding(Document,Literal);
try
Result := StackTop().ItemsCount;
if ( Result > 0 ) then begin
@@ -1287,7 +1317,11 @@ end;
procedure TSOAPBaseFormatter.EndScope();
begin
CheckScope();
- FStack.Pop().Free();
+ if ( StackTop().EmbeddedScopeCount = 0 ) then begin
+ FStack.Pop().Free();
+ end else begin
+ StackTop().EndEmbeddedScope();
+ end;
end;
procedure TSOAPBaseFormatter.AddScopeAttribute(const AName, AValue: string);
@@ -1641,7 +1675,7 @@ end;
function TEmbeddedArrayStackItem.CreateList(const ANodeName: string): TDOMNodeList;
begin
if ScopeObject.HasChildNodes() then begin
- Result := TDOMNodeList.Create(ScopeObject,ANodeName);
+ Result := {$IFNDEF FPC_211}TDOMNodeList{$ELSE}TDOMElementList{$ENDIF}.Create(ScopeObject,ANodeName);
end else begin
Result := nil;
end;
diff --git a/wst/trunk/ics_http_protocol.pas b/wst/trunk/ics_http_protocol.pas
index 0c810035f..329db10e8 100644
--- a/wst/trunk/ics_http_protocol.pas
+++ b/wst/trunk/ics_http_protocol.pas
@@ -14,12 +14,12 @@ unit ics_http_protocol;
{$mode objfpc}{$H+}
-//{$DEFINE WST_DBG}
+{$DEFINE WST_DBG}
interface
uses
- Classes, SysUtils,
+ Classes, SysUtils, {$IFDEF WST_DBG}Dialogs,{$ENDIF}
service_intf, imp_utils, base_service_intf,
HttpProt;
@@ -174,7 +174,7 @@ begin
ARequest.Position := 0;
SetLength(s,ARequest.Size);
ARequest.Read(s[1],ARequest.Size);
- WriteLn(s);
+ TMemoryStream(AResponse).SaveToFile('request.log');
ARequest.Position := i;
{$ENDIF WST_DBG}
@@ -183,10 +183,15 @@ begin
FConnection.Post();
{$IFDEF WST_DBG}
+ TMemoryStream(AResponse).SaveToFile('request.log');
i := AResponse.Position;
SetLength(s,AResponse.Size);
- AResponse.Read(s[1],AResponse.Size);TMemoryStream(AResponse).SaveToFile('E:\Inoussa\Sources\lazarus\wst\v0.3\tests\apache_module\log.log');
- WriteLn(s);
+ AResponse.Read(s[1],AResponse.Size);
+ TMemoryStream(AResponse).SaveToFile('response.log');
+ if IsConsole then
+ WriteLn(s)
+ else
+ ShowMessage(s);
{$ENDIF WST_DBG}
end;
diff --git a/wst/trunk/metadata_repository.pas b/wst/trunk/metadata_repository.pas
index fc513ec4f..40efe7596 100644
--- a/wst/trunk/metadata_repository.pas
+++ b/wst/trunk/metadata_repository.pas
@@ -394,7 +394,6 @@ procedure CloneRepository(
out ADest : PServiceRepository
);
var
- buf : string;
i, c : LongInt;
ps : PService;
begin
diff --git a/wst/trunk/synapse_http_protocol.pas b/wst/trunk/synapse_http_protocol.pas
index 1a30b73c6..91df0964b 100644
--- a/wst/trunk/synapse_http_protocol.pas
+++ b/wst/trunk/synapse_http_protocol.pas
@@ -163,9 +163,10 @@ begin
AResponse.CopyFrom(FConnection.Document,0);
FConnection.Clear();
{$IFDEF WST_DBG}
- TMemoryStream(AResponse).SaveToFile('log.log');
+ TMemoryStream(ARequest).SaveToFile('request.log');
SetLength(s,AResponse.Size);
Move(TMemoryStream(AResponse).Memory^,s[1],Length(s));
+ TMemoryStream(AResponse).SaveToFile('response.log');
if IsConsole then
WriteLn(s)
else
diff --git a/wst/trunk/tests/google_api/test_google_api.lpi b/wst/trunk/tests/google_api/test_google_api.lpi
index f5df8c6a4..1d2aa398b 100644
--- a/wst/trunk/tests/google_api/test_google_api.lpi
+++ b/wst/trunk/tests/google_api/test_google_api.lpi
@@ -37,10 +37,10 @@
-
-
+
+
-
+
@@ -49,7 +49,7 @@
-
+
@@ -153,15 +153,17 @@
-
+
-
-
-
+
+
+
+
+
@@ -180,11 +182,9 @@
-
-
-
+
+
-
@@ -233,7 +233,7 @@
-
+
@@ -242,7 +242,7 @@
-
+
@@ -251,7 +251,7 @@
-
+
@@ -280,9 +280,7 @@
-
-
-
+
@@ -301,9 +299,11 @@
-
-
+
+
+
+
@@ -359,7 +359,7 @@
-
+
@@ -369,7 +369,7 @@
-
+
@@ -377,21 +377,12 @@
-
+
-
-
-
-
-
-
-
-
-
-
+
diff --git a/wst/trunk/tests/google_api/test_google_api.pas b/wst/trunk/tests/google_api/test_google_api.pas
index fde450c92..7dbbc8bd0 100644
--- a/wst/trunk/tests/google_api/test_google_api.pas
+++ b/wst/trunk/tests/google_api/test_google_api.pas
@@ -13,11 +13,11 @@ uses
Const
//sADRESS = 'http:Address=http://api.google.com/search/beta2;Proxy';
- sADDRESS = 'http:Address=http://api.google.com/search/beta2'+
- ';ProxyServer=10.0.0.5;ProxyPort=8080';
+ sADDRESS = 'http:Address=http://api.google.com/search/beta2';//+
+ //';ProxyServer=10.0.0.5;ProxyPort=8080';
sTARGET = 'urn:GoogleSearch';
- sKEY = '';
- sSERVICE_PROTOCOL = 'SOAP';
+ sKEY = '0w9pU3tQFHJyjRUP/bKgv2qwCoXf5pop';//'';
+ sSERVICE_PROTOCOL = 'SOAP:style=rpc';
Var
tmpObj : IGoogleSearch;
qryRes : TGoogleSearchResult;
diff --git a/wst/trunk/ws_helper/generator.pas b/wst/trunk/ws_helper/generator.pas
index 369dd18a3..4c56101c0 100644
--- a/wst/trunk/ws_helper/generator.pas
+++ b/wst/trunk/ws_helper/generator.pas
@@ -146,6 +146,7 @@ type
FDecStream : ISourceStream;
FImpStream : ISourceStream;
FImpTempStream : ISourceStream;
+ FImpLastStream : ISourceStream;
private
function GenerateIntfName(AIntf : TInterfaceDefinition):string;
@@ -1292,7 +1293,8 @@ begin
NewLine();
NewLine();
FImpTempStream.NewLine();
- FImpTempStream.WriteLn('End.');
+ FImpLastStream.NewLine();
+ FImpLastStream.WriteLn('End.');
end;
procedure TInftGenerator.GenerateIntf(AIntf: TInterfaceDefinition);
@@ -1382,7 +1384,7 @@ end;
procedure TInftGenerator.GenerateClass(ASymbol: TClassTypeDefinition);
var
- locClassPropNbr, locStoredPropsNbr : Integer;
+ locClassPropNbr, locStoredPropsNbr, locArrayPropsNbr : Integer;
loc_BaseComplexSimpleContentRemotable : TClassTypeDefinition;
procedure Prepare();
@@ -1392,13 +1394,17 @@ var
begin
locClassPropNbr := 0;
locStoredPropsNbr := 0;
+ locArrayPropsNbr := 0;
for k := 0 to Pred(ASymbol.PropertyCount) do begin
p := ASymbol.Properties[k];
if ( p.StorageOption = soOptional ) then
Inc(locStoredPropsNbr);
if p.DataType.InheritsFrom(TClassTypeDefinition) then
Inc(locClassPropNbr);
+ if p.DataType.InheritsFrom(TArrayDefinition) then
+ Inc(locArrayPropsNbr);
end;
+ locClassPropNbr := locClassPropNbr + locArrayPropsNbr;
end;
procedure WriteDec();
@@ -1440,12 +1446,12 @@ var
Indent();
WriteLn('property %s : %s read F%s write F%s%s;',[propName,AProp.DataType.Name,propName,propName,locStore]);
if not AnsiSameText(AProp.Name,AProp.ExternalName) then begin
- FImpTempStream.Indent();
- FImpTempStream.WriteLn('GetTypeRegistry().ItemByTypeInfo[TypeInfo(%s)].RegisterExternalPropertyName(%s,%s);',[ASymbol.Name,QuotedStr(AProp.Name),QuotedStr(AProp.ExternalName)]);
+ FImpLastStream.Indent();
+ FImpLastStream.WriteLn('GetTypeRegistry().ItemByTypeInfo[TypeInfo(%s)].RegisterExternalPropertyName(%s,%s);',[ASymbol.Name,QuotedStr(AProp.Name),QuotedStr(AProp.ExternalName)]);
end;
- if AProp.IsAttribute and ( not ASymbol.IsDescendantOf(loc_BaseComplexSimpleContentRemotable) ) then begin
- FImpTempStream.Indent();
- FImpTempStream.WriteLn('%s.RegisterAttributeProperty(%s);',[ASymbol.Name,QuotedStr(AProp.Name)]);
+ if AProp.IsAttribute then begin
+ FImpLastStream.Indent();
+ FImpLastStream.WriteLn('%s.RegisterAttributeProperty(%s);',[ASymbol.Name,QuotedStr(AProp.Name)]);
end;
end;
@@ -1478,12 +1484,19 @@ var
DecIndent();
end;
//
- if ( locClassPropNbr > 0 ) then begin
+ if ( locArrayPropsNbr > 0 ) or ( locClassPropNbr > 0 ) then begin
Indent();
WriteLn('public');
+ end;
+ if ( locArrayPropsNbr > 0 ) then begin
IncIndent();
- Indent();
- WriteLn('destructor Destroy();override;');
+ Indent(); WriteLn('constructor Create();override;');
+ DecIndent();
+ end;
+
+ if ( locClassPropNbr > 0 ) then begin
+ IncIndent();
+ Indent(); WriteLn('destructor Destroy();override;');
DecIndent();
end;
//
@@ -1505,6 +1518,24 @@ var
NewLine();
WriteLn('{ %s }',[ASymbol.Name]);
+ if ( locArrayPropsNbr > 0 ) then begin
+ NewLine();
+ WriteLn('constructor %s.Create();',[ASymbol.Name]);
+ WriteLn('begin');
+ IncIndent();
+ Indent();
+ WriteLn('inherited Create();');
+ for k := 0 to Pred(ASymbol.PropertyCount) do begin
+ p := ASymbol.Properties[k];
+ if p.DataType.InheritsFrom(TArrayDefinition) then begin
+ Indent();
+ WriteLn('F%s := %s.Create();',[p.Name,p.DataType.Name]);
+ end;
+ end;
+ DecIndent();
+ WriteLn('end;');
+ end;
+
if ( locClassPropNbr > 0 ) then begin
NewLine();
WriteLn('destructor %s.Destroy();',[ASymbol.Name]);
@@ -1526,7 +1557,7 @@ var
DecIndent();
WriteLn('end;');
end;
-
+
if ( locStoredPropsNbr > 0 ) then begin
for k := 0 to Pred(ASymbol.PropertyCount) do begin
p := ASymbol.Properties[k];
@@ -1819,10 +1850,19 @@ procedure TInftGenerator.GenerateCustomMetadatas();
IncIndent();
Indent(); WriteLn('%s,',[sUNIT_NAME]);
Indent(); WriteLn('%s,',[QuotedStr(AIntf.Name)]);
- Indent(); WriteLn('%s,',[QuotedStr('SoapStyle')]);
+ Indent(); WriteLn('%s,',[QuotedStr('SoapDocumentStyle')]);
Indent(); WriteLn('%s' ,[QuotedStr('rpc')]);
DecIndent();
Indent();WriteLn(');');
+ end else if ( AIntf.BindingStyle = bsDocument ) then begin
+ Indent();WriteLn('mm.SetServiceCustomData(');
+ IncIndent();
+ Indent(); WriteLn('%s,',[sUNIT_NAME]);
+ Indent(); WriteLn('%s,',[QuotedStr(AIntf.Name)]);
+ Indent(); WriteLn('%s,',[QuotedStr('SoapDocumentStyle')]);
+ Indent(); WriteLn('%s' ,[QuotedStr('document')]);
+ DecIndent();
+ Indent();WriteLn(');');
end;
for k := 0 to Pred(AIntf.MethodCount) do begin
@@ -1867,7 +1907,9 @@ begin
FDecStream := SrcMngr.CreateItem(GetDestUnitName() + '.dec');
FImpStream := SrcMngr.CreateItem(GetDestUnitName() + '.imp');
FImpTempStream := SrcMngr.CreateItem(GetDestUnitName() + '.tmp_imp');
+ FImpLastStream := SrcMngr.CreateItem(GetDestUnitName() + '.tmp_imp_last');
FImpTempStream.IncIndent();
+ FImpLastStream.IncIndent();
end;
procedure TInftGenerator.Execute();
@@ -1967,7 +2009,7 @@ begin
GenerateCustomMetadatas();
GenerateUnitImplementationFooter();
- FSrcMngr.Merge(GetDestUnitName() + '.pas',[FDecStream,FImpStream,FImpTempStream]);
+ FSrcMngr.Merge(GetDestUnitName() + '.pas',[FDecStream,FImpStream,FImpTempStream,FImpLastStream]);
FDecStream := nil;
FImpStream := nil;
FImpTempStream := nil;
diff --git a/wst/trunk/ws_helper/parserdefs.pas b/wst/trunk/ws_helper/parserdefs.pas
index b12069d2f..0f9e18af1 100644
--- a/wst/trunk/ws_helper/parserdefs.pas
+++ b/wst/trunk/ws_helper/parserdefs.pas
@@ -255,6 +255,8 @@ Type
property Properties[const Index : Integer] : TPropertyDefinition read GetProperty;
end;
+ TClassTypeDefinitionClass = class of TClassTypeDefinition;
+
TNativeClassTypeDefinition = class(TClassTypeDefinition)
end;
@@ -565,7 +567,7 @@ function TMethodDefinition.AddParameter(
ADataType : TTypeDefinition
): TParameterDefinition;
begin
- If ( GetParameterIndex(Name) = -1 ) Then Begin
+ If ( GetParameterIndex(AName) = -1 ) Then Begin
Result := TParameterDefinition.Create(AName,AModifier,ADataType);
FParameterList.Add(Result);
End Else Begin
@@ -1182,10 +1184,15 @@ function CreateWstInterfaceSymbolTable() : TSymbolTable;
function AddClassDef(
ATable : TSymbolTable;
const AClassName,
- AParentName : string
+ AParentName : string;
+ const AClassType : TClassTypeDefinition = nil
):TClassTypeDefinition;
begin
- Result := TClassTypeDefinition.Create(AClassName);
+ if Assigned(AClassType) then begin
+ Result := AClassType.Create(AClassName);
+ end else begin
+ Result := TClassTypeDefinition.Create(AClassName);
+ end;
if not IsStrEmpty(AParentName) then
Result.SetParent(ATable.ByName(AParentName) as TClassTypeDefinition);
ATable.Add(Result);
diff --git a/wst/trunk/ws_helper/ws_helper.lpi b/wst/trunk/ws_helper/ws_helper.lpi
index 19f782727..e573cebb3 100644
--- a/wst/trunk/ws_helper/ws_helper.lpi
+++ b/wst/trunk/ws_helper/ws_helper.lpi
@@ -12,7 +12,7 @@
-
+
@@ -33,13 +33,13 @@
-
+
-
+
@@ -58,14 +58,14 @@
-
-
+
+
-
-
-
+
+
+
@@ -73,12 +73,12 @@
-
-
+
+
-
+
@@ -96,7 +96,7 @@
-
+
@@ -104,321 +104,366 @@
-
+
-
+
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
+
+
-
-
+
+
-
-
-
-
-
-
-
-
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
+
+
-
+
-
-
+
+
-
+
-
+
-
-
+
+
-
-
+
+
-
+
-
-
+
+
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
+
+
+
-
-
+
+
-
+
-
-
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
+
+
-
+
-
+
-
+
-
+
-
+
-
+
-
-
+
+
-
-
+
+
-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/wst/trunk/ws_helper/wsdl2pas_imp.pas b/wst/trunk/ws_helper/wsdl2pas_imp.pas
index e0c2f5355..9109415e9 100644
--- a/wst/trunk/ws_helper/wsdl2pas_imp.pas
+++ b/wst/trunk/ws_helper/wsdl2pas_imp.pas
@@ -797,11 +797,22 @@ function TWsdlParser.ParseOperation(
if IsStrEmpty(prmName) or IsStrEmpty(prmTypeName) or IsStrEmpty(prmTypeType) then begin
raise EWslParserException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]);
end;
+ if SameText(s_document,ASoapBindingStyle) and
+ AnsiSameText(prmTypeType,s_element)
+ then begin
+ prmName := ExtractNameFromQName(prmTypeName);
+ end;
prmInternameName := Trim(prmName);
- prmHasInternameName := IsReservedKeyWord(prmInternameName) or ( not IsValidIdent(prmInternameName) );
+ if AnsiSameText(prmInternameName,tmpMthd.Name) then begin
+ prmInternameName := prmInternameName + 'Param';
+ end;
+ prmHasInternameName := IsReservedKeyWord(prmInternameName) or
+ ( not IsValidIdent(prmInternameName) ) or
+ ( tmpMthd.GetParameterIndex(prmInternameName) >= 0 );
if prmHasInternameName then begin
prmInternameName := '_' + prmInternameName;
end;
+ prmHasInternameName := not AnsiSameText(prmInternameName,prmName);
prmTypeDef := GetDataType(prmTypeName,prmTypeType);
prmDef := tmpMthd.AddParameter(prmInternameName,pmConst,prmTypeDef);
if prmHasInternameName then begin
@@ -859,11 +870,23 @@ function TWsdlParser.ParseOperation(
prmTypeType := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).NodeName;
if IsStrEmpty(prmName) or IsStrEmpty(prmTypeName) or IsStrEmpty(prmTypeType) then
raise EWslParserException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]);
+ if SameText(s_document,ASoapBindingStyle) and
+ AnsiSameText(prmTypeType,s_element)
+ then begin
+ prmName := ExtractNameFromQName(prmTypeName);
+ end;
prmInternameName := Trim(prmName);
- prmHasInternameName := IsReservedKeyWord(prmInternameName) or ( not IsValidIdent(prmInternameName) );
+ if AnsiSameText(prmInternameName,tmpMthd.Name) then begin
+ prmInternameName := prmInternameName + 'Param';
+ end;
+ //prmHasInternameName := IsReservedKeyWord(prmInternameName) or ( not IsValidIdent(prmInternameName) );
+ prmHasInternameName := IsReservedKeyWord(prmInternameName) or
+ ( not IsValidIdent(prmInternameName) ) or
+ ( tmpMthd.GetParameterIndex(prmInternameName) >= 0 );
if prmHasInternameName then
prmInternameName := '_' + prmInternameName;
- prmDef := tmpMthd.FindParameter(prmName);
+ prmHasInternameName := not AnsiSameText(prmInternameName,prmName);
+ prmDef := tmpMthd.FindParameter(prmInternameName);//(prmName);
if ( prmDef = nil ) then begin
prmDef := tmpMthd.AddParameter(prmInternameName,pmOut,GetDataType(prmTypeName,prmTypeType));
if prmHasInternameName then begin
@@ -1012,11 +1035,15 @@ var
FreeAndNil(locParser);
end;
end;
-
+
+var
+ frwType : TTypeDefinition;
begin
embededType := False;
+ Result := nil;
Result := FSymbols.Find(ExtractNameFromQName(AName),TTypeDefinition) as TTypeDefinition;
if ( not Assigned(Result) ) or ( Result is TForwardTypeDefinition ) then begin
+ frwType := Result;
Result := nil;
Init();
FindTypeNode();
@@ -1025,8 +1052,12 @@ begin
end else if AnsiSameText(ExtractNameFromQName(typNd.NodeName),s_simpleType) then begin
Result := ParseSimpleType();
end;
- if Assigned(Result) then
+ if Assigned(Result) then begin
+ if Assigned(frwType) and AnsiSameText(Result.ExternalName,frwType.ExternalName) then begin
+ TTypeDefinitionCrack(Result).SetName(frwType.Name);
+ end;
FSymbols.Add(Result);
+ end;
end;
end;
@@ -1121,9 +1152,9 @@ procedure TWsdlParser.Parse(const AMode : TParserMode);
sym := FSymbols[i];
if ( sym is TForwardTypeDefinition ) then begin
typeCursor.Reset();
- tmpNode := FindNamedNode(typeCursor,sym.Name);
+ tmpNode := FindNamedNode(typeCursor,sym.ExternalName);
if Assigned(tmpNode) then begin
- ParseType(sym.Name,ExtractNameFromQName(tmpNode.NodeName));
+ ParseType(sym.ExternalName,ExtractNameFromQName(tmpNode.NodeName));
Dec(i);
c := FSymbols.Count;
end else begin
@@ -1402,7 +1433,7 @@ begin
if not locCrs.MoveNext() then
raise EWslParserException.CreateFmt('Invalid extention/restriction of type "%s" : "base" attribute not found.',[FTypeName]);
locBaseTypeName := ExtractNameFromQName((locCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue);
- locSymbol := FSymbols.Find(locBaseTypeName);//,TClassTypeDefinition);
+ locSymbol := FSymbols.Find(locBaseTypeName);
if Assigned(locSymbol) then begin
if locSymbol.InheritsFrom(TTypeDefinition) then begin
FBaseType := locSymbol as TTypeDefinition;
@@ -1430,18 +1461,23 @@ end;
function TComplexTypeParser.ParseComplexContent(const ATypeName : string) : TTypeDefinition;
- function ExtractElementCursor():IObjectCursor;
+ function ExtractElementCursor(out AAttCursor : IObjectCursor):IObjectCursor;
var
frstCrsr, tmpCursor : IObjectCursor;
parentNode, tmpNode : TDOMNode;
begin
Result := nil;
+ AAttCursor := nil;
case FDerivationMode of
dmNone : parentNode := FContentNode;
dmRestriction,
dmExtension : parentNode := FDerivationNode;
end;
if parentNode.HasChildNodes() then begin;
+ AAttCursor := CreateCursorOn(
+ CreateChildrenCursor(parentNode,cetRttiNode),
+ ParseFilter(CreateQualifiedNameFilterStr(s_attribute,FOwner.FXSShortNames),TDOMNodeRttiExposer)
+ );
frstCrsr := CreateChildrenCursor(parentNode,cetRttiNode);
tmpCursor := CreateCursorOn(
frstCrsr.Clone() as IObjectCursor,
@@ -1538,10 +1574,20 @@ var
if IsStrEmpty(locTypeName) then
raise EWslParserException.Create('Invalid definition : empty "type".');
locType := FSymbols.Find(locTypeName);
- if not Assigned(locType) then begin
+ if Assigned(locType) then begin
+ if locIsRefElement then begin
+ locTypeInternalName := locTypeName;
+ locTypeInternalName := locTypeInternalName + '_Type';
+ TTypeDefinitionCrack(locType).SetName(locTypeInternalName);
+ end;
+ end else begin
locTypeInternalName := locTypeName;
- if IsReservedKeyWord(locTypeInternalName) then
+ if locIsRefElement then begin
+ locTypeInternalName := locTypeInternalName + '_Type';
+ end;
+ if IsReservedKeyWord(locTypeInternalName) then begin
locTypeInternalName := '_' + locTypeInternalName;
+ end;
locType := TForwardTypeDefinition.Create(locTypeInternalName);
if not AnsiSameText(locTypeInternalName,locTypeName) then
locType.RegisterExternalAlias(locTypeName);
@@ -1588,6 +1634,9 @@ var
if isArrayDef then begin
arrayItems.Add(locProp);
end;
+ if AnsiSameText(s_attribute,ExtractNameFromQName(AElement.NodeName)) then begin
+ locProp.IsAttribute := True;
+ end;
end;
procedure GenerateArrayTypes(
@@ -1683,23 +1732,18 @@ var
end;
var
- eltCrs : IObjectCursor;
+ eltCrs, eltAttCrs : IObjectCursor;
internalName : string;
hasInternalName : Boolean;
arrayDef : TArrayDefinition;
- propTyp : TPropertyDefinition;
+ propTyp, tmpPropTyp : TPropertyDefinition;
tmpClassDef : TClassTypeDefinition;
i : Integer;
begin
ExtractBaseType();
- eltCrs := ExtractElementCursor();
+ eltCrs := ExtractElementCursor(eltAttCrs);
internalName := ExtractIdentifier(ATypeName);
-{ while IsReservedKeyWord(internalName) or ( FSymbols.IndexOf(internalName) <> -1 ) do begin
- internalName := Format('_%s',[internalName]);
- end;
- hasInternalName := ( not AnsiSameText(internalName,ATypeName) );
-}
hasInternalName := IsReservedKeyWord(internalName) or
( not IsValidIdent(internalName) ) or
//( FSymbols.IndexOf(internalName) <> -1 ) or
@@ -1726,17 +1770,24 @@ begin
(FSymbols.ByName('base_service_intf') as TSymbolTable)
.ByName('TBaseComplexRemotable') as TClassTypeDefinition
);
- if Assigned(eltCrs) then begin
+ if Assigned(eltCrs) or Assigned(eltAttCrs) then begin
isArrayDef := False;
- eltCrs.Reset();
- while eltCrs.MoveNext() do begin
- ParseElement((eltCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject);
+ if Assigned(eltCrs) then begin
+ eltCrs.Reset();
+ while eltCrs.MoveNext() do begin
+ ParseElement((eltCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject);
+ end;
+ end;
+ if Assigned(eltAttCrs) then begin
+ eltAttCrs.Reset();
+ while eltAttCrs.MoveNext() do begin
+ ParseElement((eltAttCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject);
+ end;
end;
if ( arrayItems.Count > 0 ) then begin
if ( arrayItems.Count = 1 ) and ( classDef.PropertyCount = 1 ) then begin
Result := nil;
propTyp := arrayItems[0] as TPropertyDefinition;
- //arrayDef := TArrayDefinition.Create(internalName,(arrayItemType as TTypeDefinition),arrayItemName);
arrayDef := TArrayDefinition.Create(internalName,propTyp.DataType,propTyp.Name,propTyp.ExternalName,asScoped);
FreeAndNil(classDef);
Result := arrayDef;
@@ -1753,7 +1804,10 @@ begin
for i := 0 to Pred(tmpClassDef.PropertyCount) do begin
propTyp := tmpClassDef.Properties[i];
if ( arrayItems.IndexOf(propTyp) = -1 ) then begin
- classDef.AddProperty(propTyp.Name,propTyp.DataType);
+ tmpPropTyp := classDef.AddProperty(propTyp.Name,propTyp.DataType);
+ tmpPropTyp.IsAttribute := propTyp.IsAttribute;
+ tmpPropTyp.StorageOption := propTyp.StorageOption;
+ tmpPropTyp.RegisterExternalAlias(propTyp.ExternalName);
end else begin
classDef.AddProperty(
propTyp.Name,