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

fix TAbstractSimpleRemotable serialization

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@867 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
2009-06-27 22:29:45 +00:00
parent b52dd4fc09
commit 43a7a0ca59
1 changed files with 28 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files

40
wst/trunk/base_soap_formatter.pas
View File

@ -4,7 +4,7 @@
This file is provide under modified LGPL licence This file is provide under modified LGPL licence
( the files COPYING.modifiedLGPL and COPYING.LGPL). ( the files COPYING.modifiedLGPL and COPYING.LGPL).
This program is distributed in the hope that it will be useful, This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of but WITHOUT ANY WARRANTY; without even the implied warranty of
@ -51,7 +51,7 @@ type
ESOAPException = class(EBaseRemoteException) ESOAPException = class(EBaseRemoteException)
End; End;
{ TStackItem } { TStackItem }
TStackItem = class TStackItem = class
@ -123,7 +123,7 @@ type
TSOAPEncodingStyle = ( Literal, Encoded ); TSOAPEncodingStyle = ( Literal, Encoded );
TSOAPDocumentStyle = ( RPC, Document ); TSOAPDocumentStyle = ( RPC, Document );
{$M+} {$M+}
{ TSOAPBaseFormatter } { TSOAPBaseFormatter }
@ -135,7 +135,7 @@ type
FEncodingStyle: TSOAPEncodingStyle; FEncodingStyle: TSOAPEncodingStyle;
FStyle: TSOAPDocumentStyle; FStyle: TSOAPDocumentStyle;
FHeaderEnterCount : Integer; FHeaderEnterCount : Integer;
FNameSpaceCounter : Integer; FNameSpaceCounter : Integer;
FDoc : TwstXMLDocument; FDoc : TwstXMLDocument;
FStack : TObjectStack; FStack : TObjectStack;
@ -145,7 +145,7 @@ type
FSerializationStyle : TSerializationStyle; FSerializationStyle : TSerializationStyle;
procedure InternalClear(const ACreateDoc : Boolean);{$IFDEF USE_INLINE}inline;{$ENDIF} procedure InternalClear(const ACreateDoc : Boolean);{$IFDEF USE_INLINE}inline;{$ENDIF}
function NextNameSpaceCounter():Integer;{$IFDEF USE_INLINE}inline;{$ENDIF} function NextNameSpaceCounter():Integer;{$IFDEF USE_INLINE}inline;{$ENDIF}
function HasScope():Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} function HasScope():Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
@ -230,7 +230,7 @@ type
const ATypeInfo : PTypeInfo; const ATypeInfo : PTypeInfo;
const AData : Pointer const AData : Pointer
);{$IFDEF USE_INLINE}inline;{$ENDIF} );{$IFDEF USE_INLINE}inline;{$ENDIF}
function GetNodeValue(const ANameSpace : string; var AName : String):DOMString; function GetNodeValue(const ANameSpace : string; var AName : String):DOMString;
procedure GetEnum( procedure GetEnum(
Const ATypeInfo : PTypeInfo; Const ATypeInfo : PTypeInfo;
@ -454,7 +454,7 @@ type
function BoolToSoapBool(const AValue : Boolean) : string;{$IFDEF USE_INLINE}inline;{$ENDIF} function BoolToSoapBool(const AValue : Boolean) : string;{$IFDEF USE_INLINE}inline;{$ENDIF}
resourcestring resourcestring
SERR_NodeNotFoundByID = 'Node not found with this ID in the document : %s.'; SERR_NodeNotFoundByID = 'Node not found with this ID in the document : %s.';
SERR_ExpectingRemotableObjectClass = 'Expecting remotable object class but found %s.'; SERR_ExpectingRemotableObjectClass = 'Expecting remotable object class but found %s.';
@ -1266,7 +1266,13 @@ begin
If Not Assigned(typData) Then If Not Assigned(typData) Then
Error('Object type not registered : %s',[IfThen(Assigned(ATypeInfo),ATypeInfo^.Name,'')]); Error('Object type not registered : %s',[IfThen(Assigned(ATypeInfo),ATypeInfo^.Name,'')]);
mustAddAtt := False; mustAddAtt := False;
nmspc := typData.NameSpace; if ( ATypeInfo^.Kind = tkClass ) and
GetTypeData(ATypeInfo)^.ClassType.InheritsFrom(TAbstractSimpleRemotable) and
HasScope()
then
nmspc := StackTop().NameSpace
else
nmspc := typData.NameSpace;
If IsStrEmpty(nmspc) Then If IsStrEmpty(nmspc) Then
nmspcSH := 'tns' nmspcSH := 'tns'
Else Begin Else Begin
@ -1296,7 +1302,7 @@ begin
xsiNmspcSH := GetNameSpaceShortName(sXSI_NS,True); xsiNmspcSH := GetNameSpaceShortName(sXSI_NS,True);
if not IsStrEmpty(xsiNmspcSH) then if not IsStrEmpty(xsiNmspcSH) then
xsiNmspcSH := xsiNmspcSH + ':'; xsiNmspcSH := xsiNmspcSH + ':';
AddScopeAttribute(xsiNmspcSH + sTYPE,Format('%s:%s',[nmspcSH,typData.DeclaredName])); AddScopeAttribute(xsiNmspcSH + sTYPE,Format('%s:%s',[GetNameSpaceShortName(typData.NameSpace,True),typData.DeclaredName]));
end; end;
StackTop().SetNameSpace(nmspc); StackTop().SetNameSpace(nmspc);
end; end;
@ -1470,7 +1476,13 @@ begin
if not Assigned(typData) then begin if not Assigned(typData) then begin
Error('Object type not registered : %s',[IfThen(Assigned(ATypeInfo),ATypeInfo^.Name,'')]); Error('Object type not registered : %s',[IfThen(Assigned(ATypeInfo),ATypeInfo^.Name,'')]);
end; end;
nmspc := typData.NameSpace; if ( ATypeInfo^.Kind = tkClass ) and
GetTypeData(ATypeInfo)^.ClassType.InheritsFrom(TAbstractSimpleRemotable) and
HasScope()
then
nmspc := StackTop().NameSpace
else
nmspc := typData.NameSpace;
if IsStrEmpty(nmspc) then begin if IsStrEmpty(nmspc) then begin
nmspcSH := '' nmspcSH := ''
end else begin end else begin
@ -1501,7 +1513,7 @@ begin
end else begin end else begin
locNode := stk.ScopeObject; locNode := stk.ScopeObject;
end; end;
if ( locNode = nil ) then begin if ( locNode = nil ) then begin
Result := -1; Result := -1;
end else begin end else begin
@ -1514,6 +1526,10 @@ begin
StackTop().SetNameSpace(nmspc); StackTop().SetNameSpace(nmspc);
end; end;
Result := StackTop().GetItemsCount(); Result := StackTop().GetItemsCount();
if ( Result = 0 ) and ( AScopeType = stArray ) then begin
PopStack().Free();
Result := -1;
end;
end; end;
end; end;
@ -1764,7 +1780,7 @@ begin
boolData := Boolean(AData); boolData := Boolean(AData);
PutBool(ANameSpace,AName,ATypeInfo,boolData); PutBool(ANameSpace,AName,ATypeInfo,boolData);
End; End;
{$ENDIF} {$ENDIF}
tkInteger, tkEnumeration : tkInteger, tkEnumeration :
begin begin
{$IFDEF WST_DELPHI} {$IFDEF WST_DELPHI}