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

Part 2

Browse Source 
FPC UnicodeString support (+ test cases)
WideString support (+ test cases)

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@556 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
2008-09-13 15:19:20 +00:00
parent 812edb945c
commit 5a497d957a
13 changed files with 1028 additions and 123 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
wst/trunk/library_protocol.pas
View File

@ -20,7 +20,7 @@ interface
uses uses
Classes, SysUtils, Classes, SysUtils,
service_intf, imp_utils, base_service_intf, library_base_intf, service_intf, imp_utils, base_service_intf, library_base_intf,
library_imp_utils; library_imp_utils, wst_types;
const const
sTRANSPORT_NAME = 'LIB'; sTRANSPORT_NAME = 'LIB';
@ -105,11 +105,11 @@ procedure TLIBTransport.SendAndReceive(ARequest, AResponse: TStream);
Var Var
wrtr : IDataStore; wrtr : IDataStore;
buffStream : TMemoryStream; buffStream : TMemoryStream;
strBuff : string; strBuff : TBinaryString;
intfBuffer : IwstStream; intfBuffer : IwstStream;
bl : LongInt; bl : LongInt;
{$IFDEF WST_DBG} {$IFDEF WST_DBG}
s : string; s : TBinaryString;
i : Int64; i : Int64;
{$ENDIF WST_DBG} {$ENDIF WST_DBG}
begin begin
@ -118,9 +118,9 @@ begin
try try
wrtr := CreateBinaryWriter(buffStream); wrtr := CreateBinaryWriter(buffStream);
wrtr.WriteInt32S(0); wrtr.WriteInt32S(0);
wrtr.WriteStr(Target); wrtr.WriteAnsiStr(Target);
wrtr.WriteStr(ContentType); wrtr.WriteAnsiStr(ContentType);
wrtr.WriteStr(Self.Format); wrtr.WriteAnsiStr(Self.Format);
SetLength(strBuff,ARequest.Size); SetLength(strBuff,ARequest.Size);
ARequest.Position := 0; ARequest.Position := 0;
ARequest.Read(strBuff[1],Length(strBuff)); ARequest.Read(strBuff[1],Length(strBuff));
@ -128,7 +128,7 @@ begin
if IsConsole then if IsConsole then
WriteLn(strBuff); WriteLn(strBuff);
{$ENDIF WST_DBG} {$ENDIF WST_DBG}
wrtr.WriteStr(strBuff); wrtr.WriteAnsiStr(strBuff);
buffStream.Position := 0; buffStream.Position := 0;
wrtr.WriteInt32S(buffStream.Size-4); wrtr.WriteInt32S(buffStream.Size-4);

17
wst/trunk/library_server_intf.pas
View File

@ -17,10 +17,7 @@ interface
uses uses
Classes, SysUtils, Classes, SysUtils,
library_base_intf; library_base_intf, wst_types;
{$INCLUDE wst.inc}
{$INCLUDE wst_delphi.inc}
function wstHandleRequest( function wstHandleRequest(
ARequestBuffer : IwstStream; ARequestBuffer : IwstStream;
@ -42,7 +39,7 @@ function wstHandleRequest(
j,m : Integer; j,m : Integer;
begin begin
m := AErrorBufferLen; m := AErrorBufferLen;
j := Length(AMsg); j := Length(AMsg) * SizeOf(Char);
if ( j > 0 ) then begin if ( j > 0 ) then begin
if ( j > m ) then if ( j > m ) then
j := m; j := m;
@ -54,7 +51,7 @@ function wstHandleRequest(
end; end;
Var Var
buff, trgt,ctntyp, frmt : string; buff, trgt,ctntyp, frmt : TBinaryString;
rqst : IRequestBuffer; rqst : IRequestBuffer;
rdr : IDataStoreReader; rdr : IDataStoreReader;
inStream, bufStream : TMemoryStream; inStream, bufStream : TMemoryStream;
@ -82,10 +79,10 @@ begin
rdr := CreateBinaryReader(bufStream); rdr := CreateBinaryReader(bufStream);
if ( rdr.ReadInt32S() <> ( bs - 4 ) ) then if ( rdr.ReadInt32S() <> ( bs - 4 ) ) then
wstCheck(RET_FALSE,'Invalid buffer.'); wstCheck(RET_FALSE,'Invalid buffer.');
trgt := rdr.ReadStr(); trgt := rdr.ReadAnsiStr();
ctntyp := rdr.ReadStr(); ctntyp := rdr.ReadAnsiStr();
frmt := rdr.ReadStr(); frmt := rdr.ReadAnsiStr();
buff := rdr.ReadStr(); buff := rdr.ReadAnsiStr();
rdr := nil; rdr := nil;
bufStream.Size := 0; bufStream.Size := 0;
bufStream.Position := 0; bufStream.Position := 0;

12
wst/trunk/metadata_repository.pas
View File

@ -320,8 +320,8 @@ var
procedure LoadParam(APrm : POperationParam); procedure LoadParam(APrm : POperationParam);
begin begin
APrm^.Name := rdr.ReadStr(); APrm^.Name := rdr.ReadAnsiStr();
APrm^.TypeName := rdr.ReadStr(); APrm^.TypeName := rdr.ReadAnsiStr();
APrm^.Modifier := TOperationParamFlag(rdr.ReadEnum()); APrm^.Modifier := TOperationParamFlag(rdr.ReadEnum());
end; end;
@ -329,7 +329,7 @@ var
ii, cc : LongInt; ii, cc : LongInt;
pp : POperationParam; pp : POperationParam;
begin begin
AOperation^.Name := rdr.ReadStr(); AOperation^.Name := rdr.ReadAnsiStr();
AOperation^.Properties := nil; AOperation^.Properties := nil;
cc := rdr.ReadInt8U(); cc := rdr.ReadInt8U();
if ( cc > 0 ) then begin if ( cc > 0 ) then begin
@ -349,7 +349,7 @@ var
j, k : LongInt; j, k : LongInt;
po : PServiceOperation; po : PServiceOperation;
begin begin
AService^.Name := rdr.ReadStr(); AService^.Name := rdr.ReadAnsiStr();
AService^.Properties := nil; AService^.Properties := nil;
k := rdr.ReadInt8U(); k := rdr.ReadInt8U();
if ( k > 0 ) then begin if ( k > 0 ) then begin
@ -372,14 +372,14 @@ var
begin begin
ARepository := nil; ARepository := nil;
rdr := CreateBinaryReader(AStream); rdr := CreateBinaryReader(AStream);
buf := rdr.ReadStr(); buf := rdr.ReadAnsiStr();
if ( sWST_SIGNATURE <> buf ) then if ( sWST_SIGNATURE <> buf ) then
raise EMetadataException.CreateFmt('Invalid Metadata signature : "%s"',[buf]); raise EMetadataException.CreateFmt('Invalid Metadata signature : "%s"',[buf]);
c := SizeOf(TServiceRepository); c := SizeOf(TServiceRepository);
ARepository := wst_GetMem(c); ARepository := wst_GetMem(c);
try try
FillChar(ARepository^,c,#0); FillChar(ARepository^,c,#0);
ARepository^.Name := rdr.ReadStr(); ARepository^.Name := rdr.ReadAnsiStr();
c := rdr.ReadInt8U(); c := rdr.ReadInt8U();
if ( c > 0 ) then begin if ( c > 0 ) then begin
ARepository^.Services := wst_GetMem( c * SizeOf(TService) ); ARepository^.Services := wst_GetMem( c * SizeOf(TService) );

232
wst/trunk/object_serializer.pas
View File

@ -346,6 +346,38 @@ begin
SetStrProp(AObject,APropInfo.PropInfo,locData); SetStrProp(AObject,APropInfo.PropInfo,locData);
end; end;
{$IFDEF WST_UNICODESTRING}
procedure UnicodeStringReader(
AObject : TObject;
APropInfo : TPropSerializationInfo;
AStore : IFormatterBase
);
var
locName : string;
locData : UnicodeString;
begin
locData := '';
locName := APropInfo.ExternalName;
AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locName,locData);
SetUnicodeStrProp(AObject,APropInfo.PropInfo,locData);
end;
{$ENDIF WST_UNICODESTRING}
procedure WideStringReader(
AObject : TObject;
APropInfo : TPropSerializationInfo;
AStore : IFormatterBase
);
var
locName : string;
locData : WideString;
begin
locData := '';
locName := APropInfo.ExternalName;
AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locName,locData);
SetWideStrProp(AObject,APropInfo.PropInfo,locData);
end;
// Qualified readers // Qualified readers
{$IFDEF HAS_TKBOOL} {$IFDEF HAS_TKBOOL}
procedure BoolReaderQualifier( procedure BoolReaderQualifier(
@ -524,6 +556,38 @@ begin
SetStrProp(AObject,APropInfo.PropInfo,locData); SetStrProp(AObject,APropInfo.PropInfo,locData);
end; end;
{$IFDEF WST_UNICODESTRING}
procedure UnicodeStringReaderQualified(
AObject : TObject;
APropInfo : TPropSerializationInfo;
AStore : IFormatterBase
);
var
locName : string;
locData : UnicodeString;
begin
locData := '';
locName := APropInfo.ExternalName;
AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},APropInfo.NameSpace,locName,locData);
SetUnicodeStrProp(AObject,APropInfo.PropInfo,locData);
end;
{$ENDIF WST_UNICODESTRING}
procedure WideStringReaderQualified(
AObject : TObject;
APropInfo : TPropSerializationInfo;
AStore : IFormatterBase
);
var
locName : string;
locData : WideString;
begin
locData := '';
locName := APropInfo.ExternalName;
AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},APropInfo.NameSpace,locName,locData);
SetWideStrProp(AObject,APropInfo.PropInfo,locData);
end;
// Simple Writers // Simple Writers
{$IFDEF HAS_TKBOOL} {$IFDEF HAS_TKBOOL}
procedure BoolWriter( procedure BoolWriter(
@ -687,6 +751,35 @@ begin
AStore.Put(locName,APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locData); AStore.Put(locName,APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locData);
end; end;
{$IFDEF WST_UNICODESTRING}
procedure UnicodeStringWriter(
AObject : TObject;
APropInfo : TPropSerializationInfo;
AStore : IFormatterBase
);
var
locName : string;
locData : UnicodeString;
begin
locName := APropInfo.ExternalName;
locData := GetUnicodeStrProp(AObject,APropInfo.PropInfo);
AStore.Put(locName,APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locData);
end;
{$ENDIF WST_UNICODESTRING}
procedure WideStringWriter(
AObject : TObject;
APropInfo : TPropSerializationInfo;
AStore : IFormatterBase
);
var
locName : string;
locData : WideString;
begin
locName := APropInfo.ExternalName;
locData := GetWideStrProp(AObject,APropInfo.PropInfo);
AStore.Put(locName,APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locData);
end;
// Qualified writers // Qualified writers
{$IFDEF HAS_TKBOOL} {$IFDEF HAS_TKBOOL}
@ -851,6 +944,35 @@ begin
AStore.Put(APropInfo.NameSpace,locName,APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locData); AStore.Put(APropInfo.NameSpace,locName,APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locData);
end; end;
{$IFDEF WST_UNICODESTRING}
procedure UnicodeStringWriterQualified(
AObject : TObject;
APropInfo : TPropSerializationInfo;
AStore : IFormatterBase
);
var
locName : string;
locData : UnicodeString;
begin
locName := APropInfo.ExternalName;
locData := GetUnicodeStrProp(AObject,APropInfo.PropInfo);
AStore.Put(APropInfo.NameSpace,locName,APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locData);
end;
{$ENDIF WST_UNICODESTRING}
procedure WideStringWriterQualified(
AObject : TObject;
APropInfo : TPropSerializationInfo;
AStore : IFormatterBase
);
var
locName : string;
locData : WideString;
begin
locName := APropInfo.ExternalName;
locData := GetWideStrProp(AObject,APropInfo.PropInfo);
AStore.Put(APropInfo.NameSpace,locName,APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locData);
end;
type type
@ -863,54 +985,68 @@ var
{$IFDEF FPC} {$IFDEF FPC}
ReaderWriterInfoMap : array[0..1] of array[TTypeKind] of TReaderWriterInfo = ( ReaderWriterInfoMap : array[0..1] of array[TTypeKind] of TReaderWriterInfo = (
( // Readers ( // Readers
( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkUnknown ( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkUnknown
( Simple : {$IFDEF FPC}@{$ENDIF}IntEnumReader; Qualified : {$IFDEF FPC}@{$ENDIF}IntEnumReaderQualified ;) , //tkInteger ( Simple : @IntEnumReader; Qualified : @IntEnumReaderQualified ;) , //tkInteger
( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkChar ( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkChar
( Simple : {$IFDEF FPC}@{$ENDIF}IntEnumReader; Qualified : {$IFDEF FPC}@{$ENDIF}IntEnumReaderQualified ;) , //tkEnumeration ( Simple : @IntEnumReader; Qualified : @IntEnumReaderQualified ;) , //tkEnumeration
( Simple : {$IFDEF FPC}@{$ENDIF}FloatReader; Qualified : {$IFDEF FPC}@{$ENDIF}FloatReaderQualified ;) , //tkFloat ( Simple : @FloatReader; Qualified : @FloatReaderQualified ;) , //tkFloat
( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkSet ( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkSet
( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkMethod ( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkMethod
( Simple : {$IFDEF FPC}@{$ENDIF}StringReader; Qualified : {$IFDEF FPC}@{$ENDIF}StringReaderQualified ;) , //tkSString ( Simple : @StringReader; Qualified : @StringReaderQualified ;) , //tkSString
( Simple : {$IFDEF FPC}@{$ENDIF}StringReader; Qualified : {$IFDEF FPC}@{$ENDIF}StringReaderQualified ;) , //tkLString ( Simple : @StringReader; Qualified : @StringReaderQualified ;) , //tkLString
( Simple : {$IFDEF FPC}@{$ENDIF}StringReader; Qualified : {$IFDEF FPC}@{$ENDIF}StringReaderQualified ;) , //tkAString ( Simple : @StringReader; Qualified : @StringReaderQualified ;) , //tkAString
( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkWString ( Simple : @WideStringReader; Qualified : @WideStringReaderQualified ;) , //tkWString
( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkVariant ( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkVariant
( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkArray ( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkArray
( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkRecord ( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkRecord
( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkInterface ( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkInterface
( Simple : {$IFDEF FPC}@{$ENDIF}ClassReader; Qualified : {$IFDEF FPC}@{$ENDIF}ClassReaderQualified ;) , //tkClass ( Simple : @ClassReader; Qualified : @ClassReaderQualified ;) , //tkClass
( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkObject ( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkObject
( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkWChar ( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkWChar
( Simple : {$IFDEF FPC}@{$ENDIF}BoolReader; Qualified : {$IFDEF FPC}@{$ENDIF}BoolReaderQualifier ;) , //tkBool ( Simple : @BoolReader; Qualified : @BoolReaderQualifier ;) , //tkBool
( Simple : {$IFDEF FPC}@{$ENDIF}Int64Reader; Qualified : {$IFDEF FPC}@{$ENDIF}Int64ReaderQualified ;) , //tkInt64 ( Simple : @Int64Reader; Qualified : @Int64ReaderQualified ;) , //tkInt64
( Simple : {$IFDEF FPC}@{$ENDIF}Int64Reader; Qualified : {$IFDEF FPC}@{$ENDIF}Int64ReaderQualified ;) , //tkQWord ( Simple : @Int64Reader; Qualified : @Int64ReaderQualified ;) , //tkQWord
( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkDynArray ( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkDynArray
( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) //tkInterfaceRaw ( Simple : @ErrorProc; Qualified : @ErrorProc ;) //tkInterfaceRaw
{$IFDEF WST_TKPROCVAR}
,( Simple : @ErrorProc; Qualified : @ErrorProc ;) //tkProcVar
{$ENDIF WST_TKPROCVAR}
{$IFDEF WST_UNICODESTRING}
,( Simple : @UnicodeStringReader; Qualified : @UnicodeStringReaderQualified ;) //tkUString
,( Simple : @ErrorProc; Qualified : @ErrorProc ;) //tkUChar
{$ENDIF WST_UNICODESTRING}
), ),
( // Writers ( // Writers
( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkUnknown ( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkUnknown
( Simple : {$IFDEF FPC}@{$ENDIF}IntEnumWriter; Qualified : {$IFDEF FPC}@{$ENDIF}IntEnumWriterQualified ;) , //tkInteger ( Simple : @IntEnumWriter; Qualified : @IntEnumWriterQualified ;) , //tkInteger
( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkChar ( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkChar
( Simple : {$IFDEF FPC}@{$ENDIF}IntEnumWriter; Qualified : {$IFDEF FPC}@{$ENDIF}IntEnumWriterQualified ;) , //tkEnumeration ( Simple : @IntEnumWriter; Qualified : @IntEnumWriterQualified ;) , //tkEnumeration
( Simple : {$IFDEF FPC}@{$ENDIF}FloatWriter; Qualified : {$IFDEF FPC}@{$ENDIF}FloatWriterQualified ;) , //tkFloat ( Simple : @FloatWriter; Qualified : @FloatWriterQualified ;) , //tkFloat
( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkSet ( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkSet
( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkMethod ( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkMethod
( Simple : {$IFDEF FPC}@{$ENDIF}StringWriter; Qualified : {$IFDEF FPC}@{$ENDIF}StringWriterQualified ;) , //tkSString ( Simple : @StringWriter; Qualified : @StringWriterQualified ;) , //tkSString
( Simple : {$IFDEF FPC}@{$ENDIF}StringWriter; Qualified : {$IFDEF FPC}@{$ENDIF}StringWriterQualified ;) , //tkLString ( Simple : @StringWriter; Qualified : @StringWriterQualified ;) , //tkLString
( Simple : {$IFDEF FPC}@{$ENDIF}StringWriter; Qualified : {$IFDEF FPC}@{$ENDIF}StringWriterQualified ;) , //tkAString ( Simple : @StringWriter; Qualified : @StringWriterQualified ;) , //tkAString
( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkWString ( Simple : @WideStringWriter; Qualified : @WideStringWriterQualified ;) , //tkWString
( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkVariant ( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkVariant
( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkArray ( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkArray
( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkRecord ( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkRecord
( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkInterface ( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkInterface
( Simple : {$IFDEF FPC}@{$ENDIF}ClassWriter; Qualified : {$IFDEF FPC}@{$ENDIF}ClassWriterQualified ;) , //tkClass ( Simple : @ClassWriter; Qualified : @ClassWriterQualified ;) , //tkClass
( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkObject ( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkObject
( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkWChar ( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkWChar
( Simple : {$IFDEF FPC}@{$ENDIF}BoolWriter; Qualified : {$IFDEF FPC}@{$ENDIF}BoolWriterQualified ;) , //tkBool ( Simple : @BoolWriter; Qualified : @BoolWriterQualified ;) , //tkBool
( Simple : {$IFDEF FPC}@{$ENDIF}Int64Writer; Qualified : {$IFDEF FPC}@{$ENDIF}Int64WriterQualified ;) , //tkInt64 ( Simple : @Int64Writer; Qualified : @Int64WriterQualified ;) , //tkInt64
( Simple : {$IFDEF FPC}@{$ENDIF}Int64Writer; Qualified : {$IFDEF FPC}@{$ENDIF}Int64WriterQualified ;) , //tkQWord ( Simple : @Int64Writer; Qualified : @Int64WriterQualified ;) , //tkQWord
( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) , //tkDynArray ( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkDynArray
( Simple : {$IFDEF FPC}@{$ENDIF}ErrorProc; Qualified : {$IFDEF FPC}@{$ENDIF}ErrorProc ;) //tkInterfaceRaw ( Simple : @ErrorProc; Qualified : @ErrorProc ;) //tkInterfaceRaw
{$IFDEF WST_TKPROCVAR}
,( Simple : @ErrorProc; Qualified : @ErrorProc ;) //tkProcVar
{$ENDIF WST_TKPROCVAR}
{$IFDEF WST_UNICODESTRING}
,( Simple : @UnicodeStringWriter; Qualified : @UnicodeStringWriterQualified ;) //tkUString
,( Simple : @ErrorProc; Qualified : @ErrorProc ;) //tkUChar
{$ENDIF WST_UNICODESTRING}
) )
); );
{$ENDIF FPC} {$ENDIF FPC}
@ -929,7 +1065,7 @@ var
( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkMethod ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkMethod
( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkWChar ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkWChar
( Simple : StringReader; Qualified : StringReaderQualified ;) , //tkLString ( Simple : StringReader; Qualified : StringReaderQualified ;) , //tkLString
( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkWString ( Simple : WideStringReader; Qualified : WideStringReaderQualified ;) , //tkWString
( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkVariant ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkVariant
( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkArray ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkArray
( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkRecord ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkRecord
@ -949,7 +1085,7 @@ var
( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkMethod ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkMethod
( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkWChar ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkWChar
( Simple : StringWriter; Qualified : StringWriterQualified ;) , //tkLString ( Simple : StringWriter; Qualified : StringWriterQualified ;) , //tkLString
( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkWString ( Simple : WideStringWriter; Qualified : WideStringWriterQualified ;) , //tkWString
( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkVariant ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkVariant
( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkArray ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkArray
( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkRecord ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkRecord

4
wst/trunk/same_process_protocol.pas
View File

@ -18,7 +18,7 @@ interface
uses uses
Classes, SysUtils, Classes, SysUtils,
service_intf, imp_utils, service_intf, imp_utils,
server_service_intf, server_service_imputils, base_service_intf; server_service_intf, server_service_imputils, base_service_intf, wst_types;
Const Const
sTRANSPORT_NAME = 'SAME_PROCESS'; sTRANSPORT_NAME = 'SAME_PROCESS';
@ -73,7 +73,7 @@ procedure TInProcessTransport.SendAndReceive(ARequest, AResponse: TStream);
Var Var
bffr : IRequestBuffer; bffr : IRequestBuffer;
{$IFDEF WST_DBG} {$IFDEF WST_DBG}
s : string; s : TBinaryString;
i : Int64; i : Int64;
{$ENDIF WST_DBG} {$ENDIF WST_DBG}
begin begin

2
wst/trunk/synapse_http_protocol.pas
View File

@ -163,7 +163,7 @@ procedure THTTPTransport.SendAndReceive(ARequest, AResponse: TStream);
end; end;
var var
s : string; s : TBinaryString;
{$ENDIF} {$ENDIF}
begin begin
FConnection.Document.Size := 0; FConnection.Document.Size := 0;

8
wst/trunk/synapse_tcp_protocol.pas
View File

@ -119,13 +119,13 @@ begin
Try Try
wrtr := CreateBinaryWriter(buffStream); wrtr := CreateBinaryWriter(buffStream);
wrtr.WriteInt32S(0); wrtr.WriteInt32S(0);
wrtr.WriteStr(Target); wrtr.WriteAnsiStr(Target);
wrtr.WriteStr(ContentType); wrtr.WriteAnsiStr(ContentType);
wrtr.WriteStr(Self.Format); wrtr.WriteAnsiStr(Self.Format);
SetLength(strBuff,ARequest.Size); SetLength(strBuff,ARequest.Size);
ARequest.Position := 0; ARequest.Position := 0;
ARequest.Read(strBuff[1],Length(strBuff)); ARequest.Read(strBuff[1],Length(strBuff));
wrtr.WriteStr(strBuff); wrtr.WriteAnsiStr(strBuff);
buffStream.Position := 0; buffStream.Position := 0;
wrtr.WriteInt32S(buffStream.Size-4); wrtr.WriteInt32S(buffStream.Size-4);

12
wst/trunk/tests/test_suite/test_suite_utils.pas
View File

@ -27,6 +27,7 @@ const
function CompareNodes(const A,B : TDOMNode) : Boolean;overload; function CompareNodes(const A,B : TDOMNode) : Boolean;overload;
function wstExpandLocalFileName(const AFileName : string) : string; function wstExpandLocalFileName(const AFileName : string) : string;
function DumpMemory(AMem : Pointer; const ALength : PtrInt) : ansistring;
implementation implementation
@ -35,6 +36,17 @@ begin
Result := AFileName; Result := AFileName;
end; end;
function DumpMemory(AMem : Pointer; const ALength : PtrInt) : ansistring;
var
i : PtrInt;
begin
Result := '';
for i := 0 to Pred(ALength) do begin
Result := Result + '[' + IntToStr(Ord(PAnsiChar(AMem)^)) + ']';
Inc(PAnsiChar(AMem));
end;
end;
function CompareNodes(const A,B : TDOMNode) : Boolean;overload; function CompareNodes(const A,B : TDOMNode) : Boolean;overload;
var var
ca, cb : TDOMNode; ca, cb : TDOMNode;

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

File diff suppressed because it is too large Load Diff

8
wst/trunk/tests/test_suite/wst_test_suite.lpi
View File

@ -21,11 +21,6 @@
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local> </local>
</RunParams> </RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="FPCUnitTestRunner"/>
</Item1>
</RequiredPackages>
<Units Count="39"> <Units Count="39">
<Unit0> <Unit0>
<Filename Value="wst_test_suite.lpr"/> <Filename Value="wst_test_suite.lpr"/>
@ -225,7 +220,7 @@
</Units> </Units>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>
<Version Value="5"/> <Version Value="8"/>
<PathDelim Value="\"/> <PathDelim Value="\"/>
<Target> <Target>
<Filename Value="wst_test_suite.exe"/> <Filename Value="wst_test_suite.exe"/>
@ -246,7 +241,6 @@
<RangeChecks Value="True"/> <RangeChecks Value="True"/>
<OverflowChecks Value="True"/> <OverflowChecks Value="True"/>
</Checks> </Checks>
<Generate Value="Faster"/>
</CodeGeneration> </CodeGeneration>
<Linking> <Linking>
<Debugging> <Debugging>

3
wst/trunk/tests/test_suite/wst_test_suite_gui.lpi
View File

@ -128,7 +128,7 @@
</Units> </Units>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>
<Version Value="5"/> <Version Value="8"/>
<PathDelim Value="\"/> <PathDelim Value="\"/>
<Target> <Target>
<Filename Value="wst_test_suite_gui.exe"/> <Filename Value="wst_test_suite_gui.exe"/>
@ -143,7 +143,6 @@
<RangeChecks Value="True"/> <RangeChecks Value="True"/>
<OverflowChecks Value="True"/> <OverflowChecks Value="True"/>
</Checks> </Checks>
<Generate Value="Faster"/>
</CodeGeneration> </CodeGeneration>
<Linking> <Linking>
<Debugging> <Debugging>

16
wst/trunk/ws_helper/metadata_generator.pas
View File

@ -58,8 +58,8 @@ var
typeList : TList; typeList : TList;
elt : TPasElement; elt : TPasElement;
begin begin
FStream.WriteStr(sWST_META); FStream.WriteAnsiStr(sWST_META);
FStream.WriteStr(FSymbolTable.CurrentModule.Name); FStream.WriteAnsiStr(FSymbolTable.CurrentModule.Name);
k := 0; k := 0;
typeList := FSymbolTable.CurrentModule.InterfaceSection.Declarations; typeList := FSymbolTable.CurrentModule.InterfaceSection.Declarations;
c := typeList.Count; c := typeList.Count;
@ -77,15 +77,15 @@ procedure TMetadataGenerator.GenerateIntfMetadata(AIntf: TPasClassType);
procedure WriteParam(APrm : TPasArgument); procedure WriteParam(APrm : TPasArgument);
begin begin
FStream.WriteStr(APrm.Name); FStream.WriteAnsiStr(APrm.Name);
FStream.WriteStr(APrm.ArgType.Name); FStream.WriteAnsiStr(APrm.ArgType.Name);
FStream.WriteEnum(Ord(APrm.Access)); FStream.WriteEnum(Ord(APrm.Access));
end; end;
procedure WriteResult(ARes : TPasResultElement); procedure WriteResult(ARes : TPasResultElement);
begin begin
FStream.WriteStr(ARes.Name); FStream.WriteAnsiStr(ARes.Name);
FStream.WriteStr(ARes.ResultType.Name); FStream.WriteAnsiStr(ARes.ResultType.Name);
FStream.WriteEnum(Ord(argOut)); FStream.WriteEnum(Ord(argOut));
end; end;
@ -95,7 +95,7 @@ procedure TMetadataGenerator.GenerateIntfMetadata(AIntf: TPasClassType);
begin begin
argLst := AMeth.ProcType.Args; argLst := AMeth.ProcType.Args;
k := argLst.Count; k := argLst.Count;
FStream.WriteStr(AMeth.Name); FStream.WriteAnsiStr(AMeth.Name);
if AMeth.InheritsFrom(TPasFunction) then begin if AMeth.InheritsFrom(TPasFunction) then begin
FStream.WriteInt8U(k + 1); FStream.WriteInt8U(k + 1);
end else begin end else begin
@ -114,7 +114,7 @@ var
mbrs : TList; mbrs : TList;
elt : TPasElement; elt : TPasElement;
begin begin
FStream.WriteStr(AIntf.Name); FStream.WriteAnsiStr(AIntf.Name);
c := GetElementCount(AIntf.Members,TPasProcedure); c := GetElementCount(AIntf.Members,TPasProcedure);
FStream.WriteInt8U(c); FStream.WriteInt8U(c);
mbrs := AIntf.Members; mbrs := AIntf.Members;

10
wst/trunk/wst_global.inc
View File

@ -1,5 +1,7 @@
{$DEFINE USE_SERIALIZE} {$DEFINE USE_SERIALIZE}
{$UNDEF TRemotableTypeInitializer_Initialize} {$UNDEF TRemotableTypeInitializer_Initialize}
{$UNDEF WST_TKPROCVAR}
{$UNDEF WST_UNICODESTRING}
{$WARNINGS OFF} {$WARNINGS OFF}
@ -10,8 +12,14 @@
{$UNDEF WST_INTF_DOM} {$UNDEF WST_INTF_DOM}
//{$DEFINE USE_INLINE} //{$DEFINE USE_INLINE}
{$IF Defined(FPC_VERSION) and (FPC_VERSION = 2) } {$IF Defined(FPC_VERSION) and (FPC_VERSION = 2) }
{$IF Defined(FPC_RELEASE) and (FPC_RELEASE > 0) } {$IF Defined(FPC_RELEASE) }
{$IF Defined(FPC_VERSION) and (FPC_RELEASE > 0) }
{$define FPC_211} {$define FPC_211}
{$IF Defined(FPC_VERSION) and (FPC_RELEASE > 2) }
{$DEFINE WST_TKPROCVAR}
{$DEFINE WST_UNICODESTRING}
{$IFEND}
{$IFEND}
{$IFEND} {$IFEND}
{$IFEND} {$IFEND}
{$IF Defined(FPC_211)} {$IF Defined(FPC_211)}