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

Fix SOAP ReadBuffer implementation

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@796 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa 2009-05-12 10:47:04 +00:00
parent 0cae800f3e
commit 58ab4fd6c9
2 changed files with 112 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
wst/trunk/base_soap_formatter.pas
View File

@ -2105,16 +2105,14 @@ end;
function TSOAPBaseFormatter.ReadBuffer (const AName : string ) : string;
Var
locElt : TDOMNode;
namespaceShortName, strNodeName, s : string;
namespaceShortName, strNodeName : string;
begin
strNodeName := AName;
if ( Style = Document ) then begin
namespaceShortName := Copy(FindAttributeByValueInScope(StackTop().NameSpace),AnsiPos(':',namespaceShortName) + 1,MaxInt);
if not IsStrEmpty(namespaceShortName) then begin
s := ExtractNameSpaceShortName(namespaceShortName);
if not IsStrEmpty(s) then
strNodeName := s + ':' + strNodeName;
end;
namespaceShortName := FindAttributeByValueInScope(StackTop().NameSpace);
namespaceShortName := Copy(namespaceShortName,AnsiPos(':',namespaceShortName) + 1,MaxInt);
if not IsStrEmpty(namespaceShortName) then
strNodeName := namespaceShortName + ':' + strNodeName;
end;
if ( FSerializationStyle = ssNodeSerialization ) then begin

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

@ -359,7 +359,31 @@ type
fieldString : string;
fieldRecord : TTestSmallRecord;
end;
{ TTestSmallClass }
TTestSmallClass = class(TBaseComplexRemotable)
private
FfieldSmallint : Smallint;
FfieldString : string;
FfieldWord : Word;
published
property fieldSmallint : Smallint read FfieldSmallint write FfieldSmallint;
property fieldWord : Word read FfieldWord write FfieldWord;
property fieldString : string read FfieldString write FfieldString;
end;
{ TTestSmallClass2 }
TTestSmallClass2 = class(TBaseComplexRemotable)
private
FfieldString : string;
FObjProperty : TTestSmallClass;
published
property fieldString : string read FfieldString write FfieldString;
property ObjProperty : TTestSmallClass read FObjProperty write FObjProperty;
end;
{ TTestFormatterSimpleType }
TTestFormatterSimpleType= class(TTestCase)
@ -491,6 +515,7 @@ type
function CreateFormatter(ARootType : PTypeInfo):IFormatterBase;override;
published
procedure test_WriteBuffer();
procedure test_ReadBuffer();
end;
{ TTestSOAPFormatterAttributes }
@ -4087,6 +4112,84 @@ begin
end;
end;
procedure TTestSOAPFormatter.test_ReadBuffer();
function SpecialTrim(const AInStr : string) : string;
var
k : Integer;
begin
Result := '';
if ( Length(AInStr) > 0 ) then begin
for k := 1 to Length(AInStr) do begin
if ( AnsiChar(AInStr[k]) in ['a'..'z','A'..'Z','0'..'9',':','<','>'] ) then
Result := Result + AInStr[k];
end;
end;
end;
const
{$IFDEF FPC}
s_XML_BUFFER : AnsiString =
'<ns2:ObjProperty> ' +
' <ns2:fieldSmallint>1</ns2:fieldSmallint> ' +
' <ns2:fieldWord>0</ns2:fieldWord> ' +
' <ns2:fieldString>SampleStringContent</ns2:fieldString> ' +
'</ns2:ObjProperty>';
{$ENDIF FPC}
{$IFDEF DELPHI}
s_XML_BUFFER : AnsiString =
'<ns2:ObjProperty xmlns:ns2uri:testnamespace> ' +
' <ns2:fieldSmallint>1</ns2:fieldSmallint> ' +
' <ns2:fieldWord>0</ns2:fieldWord> ' +
' <ns2:fieldString>SampleStringContent</ns2:fieldString> ' +
'</ns2:ObjProperty>';
{$ENDIF DELPHI}
var
f : IFormatterBase;
strm : TMemoryStream;
da, db : TXMLDocument;
obj2 : TTestSmallClass2;
obj : TTestSmallClass;
strName, strBuffer : string;
begin
strm := nil;
obj := nil;
obj := TTestSmallClass.Create();
try
obj2 := TTestSmallClass2.Create();
obj2.fieldString := 'wst 123';
obj2.ObjProperty := obj;
obj.fieldSmallint := 1;
obj.fieldString := 'fpc';
obj.fieldString := 'SampleStringContent';
f := TSOAPBaseFormatter.Create() as IFormatterBase;
f.GetPropertyManager().SetProperty('Style','Document');
f.BeginObject('Root',TypeInfo(TClass_A));
f.Put('inst',TypeInfo(TTestSmallClass2),obj2);
f.EndScope();
strm := TMemoryStream.Create();
f.SaveToStream(strm);
f := TSOAPBaseFormatter.Create() as IFormatterBase;
f.GetPropertyManager().SetProperty('Style','Document');
strm.Position := 0;
f.LoadFromStream(strm);
strName := 'Root';
f.BeginObjectRead(strName,TypeInfo(TClass_A));
strName := 'inst';
f.BeginObjectRead(strName,TypeInfo(TTestSmallClass2));
strBuffer := f.ReadBuffer('ObjProperty');
f.EndScopeRead();
f.EndScopeRead();
CheckEquals(SpecialTrim(s_XML_BUFFER),SpecialTrim(strBuffer));
finally
FreeAndNil(obj2);
FreeAndNil(obj);
FreeAndNil(strm);
end;
end;
{ TClass_B }
procedure TClass_B.SetObjProp(const AValue: TClass_A);
@ -5340,6 +5443,9 @@ initialization
RegisterExternalPropertyName(sARRAY_STYLE,sScoped);
end;
GetTypeRegistry.Register('uri:test-namespace',TypeInfo(TTestSmallClass2),'TTestSmallClass2');
GetTypeRegistry.Register('uri:test-namespace',TypeInfo(TTestSmallClass),'TTestSmallClass');
GetTypeRegistry().Register(sWST_BASE_NS,TypeInfo(TTestSmallRecord),'TTestSmallRecord').RegisterExternalPropertyName('__FIELDS__','fieldSmallint;fieldWord;fieldString');
{$IFNDEF WST_RECORD_RTTI}
GetTypeRegistry().ItemByTypeInfo[TypeInfo(TTestSmallRecord)].RegisterObject(FIELDS_STRING,TRecordRttiDataObject.Create(MakeRecordTypeInfo(TypeInfo(TTestSmallRecord)),GetTypeRegistry().ItemByTypeInfo[TypeInfo(TTestSmallRecord)].GetExternalPropertyName('__FIELDS__')));