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

Delphi 2009 support

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@626 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa 2008-12-12 22:02:35 +00:00
parent 0109a3c3ad
commit de258de519
12 changed files with 92 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
wst/trunk/base_binary_formatter.pas
View File

@ -36,7 +36,7 @@ type
EBinaryException = class(EBaseRemoteException)
end;
TDataName = AnsiString;
TDataName = String;
TDataType = (
dtInt8U, dtInt8S,
dtInt16U, dtInt16S,
@ -50,7 +50,22 @@ type
{$ENDIF WST_UNICODESTRING}
dtObject, dtArray
);
const
dtDefaultString =
{$IFDEF WST_UNICODESTRING}
{$IFDEF WST_DELPHI}
dtUnicodeString
{$ENDIF WST_DELPHI}
{$IFDEF FPC}
dtAnsiString
{$ENDIF FPC}
{$ELSE WST_UNICODESTRING}
dtAnsiString
{$ENDIF WST_UNICODESTRING}
;
type
PAnsiStringBuffer = ^TAnsiStringBuffer;
PWideStringBuffer = ^TWideStringBuffer;
{$IFDEF WST_UNICODESTRING}
@ -1674,7 +1689,7 @@ procedure TBaseBinaryFormatter.Get(
);
Var
int64Data : Int64;
strData : string;
strData : AnsiString;
objData : TObject;
boolData : Boolean;
enumData : TEnumData;

20
wst/trunk/base_service_intf.pas
View File

@ -4603,6 +4603,10 @@ begin
SetOrdProp(Self,p,GetOrdProp(Source,p^.Name));
tkLString{$IFDEF FPC}, tkAString{$ENDIF} :
SetStrProp(Self,p,GetStrProp(Source,p^.Name));
{$IFDEF WST_UNICODESTRING}
tkUString :
SetUnicodeStrProp(Self,p,GetUnicodeStrProp(Source,p^.Name));
{$ENDIF WST_UNICODESTRING}
tkClass :
begin
srcObj := GetObjectProp(Source,p^.Name);
@ -4737,7 +4741,9 @@ begin
int64Data := GetOrdProp(AObject,p^.Name);
AStore.Put(propName,pt,int64Data);
end;
tkLString{$IFDEF FPC},tkAString{$ENDIF} :
tkLString
{$IFDEF FPC},tkAString{$ENDIF}
{$IFDEF WST_UNICODESTRING}, tkUString{$ENDIF}:
begin
strData := GetStrProp(AObject,p^.Name);
AStore.Put(propName,pt,strData);
@ -4900,7 +4906,9 @@ begin
AStore.Get(pt,propName,int64Data);
SetOrdProp(AObject,p^.Name,int64Data);
End;
tkLString{$IFDEF FPC},tkAString{$ENDIF} :
tkLString
{$IFDEF FPC},tkAString{$ENDIF}
{$IFDEF WST_UNICODESTRING}, tkUString{$ENDIF}:
Begin
AStore.Get(pt,propName,strData);
SetStrProp(AObject,p^.Name,strData);
@ -5805,7 +5813,9 @@ begin
{$IFDEF HAS_QWORD}
tkQWord : AStore.Put(prpName,pt,PQWord(recFieldAddress)^);
{$ENDIF}
tkLString{$IFDEF FPC},tkAString{$ENDIF} : AStore.Put(prpName,pt,PString(recFieldAddress)^);
tkLString
{$IFDEF FPC},tkAString{$ENDIF}
{$IFDEF WST_UNICODESTRING},tkUString{$ENDIF} : AStore.Put(prpName,pt,Pointer(recFieldAddress)^);
tkClass : AStore.Put(prpName,pt,PObject(recFieldAddress)^);
tkRecord : AStore.Put(prpName,pt,Pointer(recFieldAddress)^);
{$IFDEF HAS_TKBOOL}
@ -5908,7 +5918,9 @@ begin
{$IFDEF HAS_QWORD}
tkQWord : AStore.Get(pt,propName,PQWord(recFieldAddress)^);
{$ENDIF}
tkLString{$IFDEF FPC}, tkAString{$ENDIF} : AStore.Get(pt,propName,PString(recFieldAddress)^);
tkLString
{$IFDEF FPC},tkAString{$ENDIF}
{$IFDEF WST_UNICODESTRING},tkUString{$ENDIF} : AStore.Get(pt,propName,PPointer(recFieldAddress)^);
{$IFDEF HAS_TKBOOL}
tkBool : AStore.Get(pt,propName,PBoolean(recFieldAddress)^);
{$ENDIF}

17
wst/trunk/basex_encode.pas
View File

@ -79,7 +79,7 @@ begin
locOutQuantom[1] := Base64_CHAR_TABLE[( ( locInQuantom[0] and 3 ) shl 4 ) or ( locInQuantom[1] shr 4 )];
locOutQuantom[2] := Base64_CHAR_TABLE[( ( locInQuantom[1] and 15 ) shl 2 ) or ( locInQuantom[2] shr 6 )];
locOutQuantom[3] := Base64_CHAR_TABLE[( locInQuantom[2] and 63 )];
Move(locOutQuantom[0],Result[locAtualLen + 1],4);
Move(locOutQuantom[0],Result[locAtualLen + 1],( 4 * SizeOf(Char) ));
Inc(locAtualLen,4);
end;
locCopied := ALength mod 3;
@ -104,7 +104,7 @@ begin
locOutQuantom[3] := '=';
end;
end;
Move(locOutQuantom[0],Result[locAtualLen + 1],4);
Move(locOutQuantom[0],Result[locAtualLen + 1],( 4 * SizeOf(Char) ));
Inc(locAtualLen,4);
end;
SetLength(Result,locAtualLen);
@ -121,7 +121,7 @@ end;
function Base64Decode(const AInBuffer : string; const AOptions : TBaseXOptions) : TBinaryString;
var
locBuffer : PByte;
locBuffer : PChar;
locInLen, locInIndex, i, locPadded : PtrInt;
locOutQuantom : array[0..2] of Byte;
locInQuantom : array[0..3] of Byte;
@ -144,12 +144,19 @@ begin
for i := 0 to 3 do begin
ok := False;
while ( locInIndex <= locInLen ) do begin
locInValue := Base64_CHAR_INDEX_TABLE[locBuffer^];
{$IF SizeOf(Char) > SizeOf(Byte) }
if ( Ord(locBuffer^) > High(Byte) ) then
locInValue := INVALID_MARKER
else
locInValue := Base64_CHAR_INDEX_TABLE[Ord(locBuffer^)];
{$ELSE}
locInValue := Base64_CHAR_INDEX_TABLE[Ord(locBuffer^)];
{$IFEND}
Inc(locBuffer);
Inc(locInIndex);
if ( locInValue <> INVALID_MARKER ) then begin
locInQuantom[i] := locInValue;
if ( locBuffer^ = Byte('=') ) then begin
if ( locBuffer^ = '=' ) then begin
Inc(locPadded);
end;
ok := True;

6
wst/trunk/object_serializer.pas
View File

@ -1072,6 +1072,9 @@ var
( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkInterface
( Simple : Int64Reader; Qualified : Int64ReaderQualified ;) , //tkInt64
( Simple : ErrorProc; Qualified : ErrorProc ;) //tkDynArray
{$IFDEF WST_UNICODESTRING}
,( Simple : UnicodeStringReader; Qualified : UnicodeStringReaderQualified ;) //tkUString
{$ENDIF WST_UNICODESTRING}
),
( // Writers
( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkUnknown
@ -1092,6 +1095,9 @@ var
( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkInterface
( Simple : Int64Writer; Qualified : Int64WriterQualified ;) , //tkInt64
( Simple : ErrorProc; Qualified : ErrorProc ;) //tkDynArray
{$IFDEF WST_UNICODESTRING}
,( Simple : UnicodeStringWriter; Qualified : UnicodeStringWriterQualified ;) //tkUString
{$ENDIF WST_UNICODESTRING}
)
);
{$ENDIF WST_DELPHI}

2
wst/trunk/tests/test_suite/test_generators_runtime.pas
View File

@ -207,7 +207,7 @@ begin
RegisterFondamentalTypesHandler(handlerReg);
locDoc := CreateDoc();
GenerateWSDL(locRep,locDoc,typeReg,handlerReg);
//WriteXML(locDoc,wstExpandLocalFileName('wsdl_gen_generate_array.wsdl'));
WriteXML(locDoc,wstExpandLocalFileName('wsdl_gen_generate_array.wsdl'));
ReadXMLFile(locExistDoc,wstExpandLocalFileName(TestFilesPath + 'wsdl_gen_generate_array.wsdl'));
Check(CompareNodes(locExistDoc.DocumentElement,locDoc.DocumentElement),'generated document differs from the existent one.');
finally

6
wst/trunk/tests/test_suite/test_rtti_filter.pas
View File

@ -42,14 +42,14 @@ type
FBoolProp : Boolean;
FEnumProp : TSampleEnum;
FIntProp: Integer;
FStrProp: string;
FStrProp: AnsiString;
FWideStrProp: widestring;
{$IFDEF WST_UNICODESTRING}
FUnicodeStrProp: UnicodeString;
{$ENDIF WST_UNICODESTRING}
published
property IntProp : Integer read FIntProp write FIntProp;
property StrProp : string read FStrProp write FStrProp;
property StrProp : AnsiString read FStrProp write FStrProp;
property WideStrProp : widestring read FWideStrProp write FWideStrProp;
{$IFDEF WST_UNICODESTRING}
property UnicodeStrProp : UnicodeString read FUnicodeStrProp write FUnicodeStrProp;
@ -1277,7 +1277,7 @@ end;
procedure TRttiParser_Test.BeginEnd_Group();
const VAL_1 : Integer = 1210; VAL_2 : Integer = 1076; VAL_3 : Integer = 176;
VAL_4 : Integer = -176;
VAL_S = 'inoussa';
VAL_S : AnsiString = 'inoussa';
var
x, y : TRttiFilterCreator;
sfltr : string;

2
wst/trunk/tests/test_suite/test_support.pas
View File

@ -421,7 +421,7 @@ var
begin
SetLength(Result,AMaxlen);
for k := 1 to AMaxlen do begin
Result[k] := Char((Random(Ord(High(Char)))));
Result[k] := AnsiChar((Random(Ord(High(AnsiChar)))));
end;
end;

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

@ -714,7 +714,7 @@ var
begin
SetLength(Result,AMaxlen);
for k := 1 to AMaxlen do begin
Result[k] := Char((Random(Ord(High(Char)))));
Result[k] := AnsiChar((Random(Ord(High(AnsiChar)))));
end;
end;
@ -763,8 +763,8 @@ begin
f.Get(TypeInfo(AnsiChar),x,xVal_2);
f.EndScopeRead();
CheckEquals(VAL_1,xVal_1);
CheckEquals(VAL_2,xVal_2);
CheckEquals(String(VAL_1),String(xVal_1));
CheckEquals(String(VAL_2),String(xVal_2));
Finally
s.Free();
End;
@ -796,7 +796,7 @@ begin
f.BeginObjectRead(x,TypeInfo(TClass_Int));
f.GetScopeInnerValue(TypeInfo(AnsiChar),xVal_1);
f.EndScopeRead();
CheckEquals(VAL_1,xVal_1);
CheckEquals(String(VAL_1),String(xVal_1));
xVal_1 := VAL_2;
f := CreateFormatter(TypeInfo(TClass_Int));
@ -814,7 +814,7 @@ begin
f.BeginObjectRead(x,TypeInfo(TClass_Int));
f.GetScopeInnerValue(TypeInfo(AnsiChar),xVal_1);
f.EndScopeRead();
CheckEquals(VAL_2,xVal_1);
CheckEquals(String(VAL_2),String(xVal_1));
finally
s.Free();
end;
@ -1671,7 +1671,7 @@ begin
end;
procedure TTestFormatterSimpleType.Test_AnsiString;
const VAL_1 = 'AzErTy'; VAL_2 = 'QwErTy';
const VAL_1 : AnsiString = 'AzErTy'; VAL_2 = 'QwErTy';
Var
f : IFormatterBase;
s : TMemoryStream;
@ -1834,7 +1834,7 @@ begin
end;
procedure TTestFormatterSimpleType.Test_WideString_ScopeData;
const VAL_1 = 'AzErTy1234';
const VAL_1 : WideString = 'AzErTy1234';
Var
f : IFormatterBase;
s : TMemoryStream;
@ -2638,8 +2638,8 @@ begin
end;
procedure TTestFormatter.Test_CplxWideStringSimpleContent_WithClass;
const VAL_S = 'web services toolkit';
VAL_STR_S = 'Test Attribute S';
const VAL_S : WideString = 'web services toolkit';
VAL_STR_S : WideString = 'Test Attribute S';
var
f : IFormatterBase;
s : TMemoryStream;
@ -2815,7 +2815,7 @@ begin
CheckEquals(False,a.Val_Bool);
CheckEquals(Ord(teThree),Ord(a.Val_Enum));
CheckEquals('123',a.Val_String);
CheckEquals('wide123',a.Val_WideString);
CheckEquals(WideString('wide123'),a.Val_WideString);
{$IFDEF WST_UNICODESTRING}
CheckEquals('unicode123',a.Val_UnicodeString);
{$ENDIF WST_UNICODESTRING}
@ -2823,7 +2823,7 @@ begin
CheckEquals(True,a.ObjProp.Val_Bool);
CheckEquals(Ord(teFour),Ord(a.ObjProp.Val_Enum));
CheckEquals('456',a.ObjProp.Val_String);
CheckEquals('wide456',a.ObjProp.Val_WideString);
CheckEquals(WideString('wide456'),a.ObjProp.Val_WideString);
{$IFDEF WST_UNICODESTRING}
CheckEquals('unicode456',a.ObjProp.Val_UnicodeString);
{$ENDIF WST_UNICODESTRING}
@ -4047,7 +4047,7 @@ end;
procedure TTestSOAPFormatter.test_WriteBuffer();
const
s_XML_BUFFER =
s_XML_BUFFER : AnsiString =
'<?xml version="1.0"?> ' +
'<a aa="val_aa"> ' +
' <b> ' +
@ -4654,7 +4654,7 @@ end;
procedure TTestXmlRpcFormatter.test_WriteBuffer();
const
s_XML_BUFFER =
s_XML_BUFFER : AnsiString =
'<?xml version="1.0"?> ' +
'<a aa="val_aa"> ' +
' <b> ' +
@ -5201,14 +5201,22 @@ begin
tmpNode := loc_FindObj(faultNode,'faultcode');
Check(Assigned(tmpNode),'faultcode');
CheckEquals(Ord(dtAnsiString), Ord(tmpNode^.DataType),'faultcode.DataType');
CheckEquals(Ord(dtDefaultString), Ord(tmpNode^.DataType),'faultcode.DataType');
{$IF dtDefaultString = dtAnsiString }
excpt_code := tmpNode^.AnsiStrData^.Data;
{$ELSE}
excpt_code := tmpNode^.UnicodeStrData^.Data;
{$IFEND}
CheckEquals(VAL_CODE,excpt_code,'faultCode');
tmpNode := loc_FindObj(faultNode,'faultstring');
Check(Assigned(tmpNode),'faultstring');
CheckEquals(Ord(dtAnsiString), Ord(tmpNode^.DataType),'faultstring.DataType');
CheckEquals(Ord(dtDefaultString), Ord(tmpNode^.DataType),'faultstring.DataType');
{$IF dtDefaultString = dtAnsiString }
excpt_msg := tmpNode^.AnsiStrData^.Data;
{$ELSE}
excpt_msg := tmpNode^.UnicodeStrData^.Data;
{$IFEND}
CheckEquals(VAL_MSG,excpt_msg,'faultString');
finally
FreeAndNil(strm);

1
wst/trunk/wst_delphi.inc
View File

@ -7,4 +7,5 @@
ByteArray = array[0..$effffff] of Byte;
PtrUInt = Cardinal;
SizeInt = Longint;
UnicodeChar = WideChar;
{$ENDIF}

3
wst/trunk/wst_global.inc
View File

@ -42,6 +42,9 @@
{$IFDEF VER150}
{$DEFINE HAS_FORMAT_SETTINGS}
{$ENDIF}
{$IFDEF VER200} // Delphi 2009
{$DEFINE WST_UNICODESTRING}
{$ENDIF}
{$DEFINE WST_SEMAPHORE_TIMEOUT}
{$ENDIF}

4
wst/trunk/wst_rtti_filter/rtti_filters.pas
View File

@ -325,6 +325,10 @@ var
MoveNext();
prsr.CheckToken(toString);
case propInfo^.PropType^.Kind of
tkString, tkLString :
begin
AFltrCrtr.AddCondition(propName,fltrOp,AnsiString(prsr.TokenString()),lastCntr);
end;
tkWString :
begin
ws := prsr.TokenString();

5
wst/trunk/wst_types.pas
View File

@ -21,8 +21,11 @@ interface
type
{ reprents an array of Byte }
{$IFDEF WST_UNICODESTRING}
TBinaryString = {$IFDEF FPC}ansistring{$ELSE}RawByteString{$ENDIF};
{$ELSE WST_UNICODESTRING}
TBinaryString = ansistring;
{$ENDIF}
{ TDataObject }
TDataObject = class