From de258de5196a40587a6a5957c3bb63d88440240b Mon Sep 17 00:00:00 2001 From: inoussa Date: Fri, 12 Dec 2008 22:02:35 +0000 Subject: [PATCH] Delphi 2009 support git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@626 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- wst/trunk/base_binary_formatter.pas | 21 ++++++++-- wst/trunk/base_service_intf.pas | 20 ++++++++-- wst/trunk/basex_encode.pas | 17 ++++++--- wst/trunk/object_serializer.pas | 6 +++ .../test_suite/test_generators_runtime.pas | 2 +- .../tests/test_suite/test_rtti_filter.pas | 6 +-- wst/trunk/tests/test_suite/test_support.pas | 2 +- .../tests/test_suite/testformatter_unit.pas | 38 +++++++++++-------- wst/trunk/wst_delphi.inc | 1 + wst/trunk/wst_global.inc | 3 ++ wst/trunk/wst_rtti_filter/rtti_filters.pas | 4 ++ wst/trunk/wst_types.pas | 5 ++- 12 files changed, 92 insertions(+), 33 deletions(-) diff --git a/wst/trunk/base_binary_formatter.pas b/wst/trunk/base_binary_formatter.pas index 78c22d6a2..cbe5a3ccb 100644 --- a/wst/trunk/base_binary_formatter.pas +++ b/wst/trunk/base_binary_formatter.pas @@ -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; diff --git a/wst/trunk/base_service_intf.pas b/wst/trunk/base_service_intf.pas index d297b879d..172aa0929 100644 --- a/wst/trunk/base_service_intf.pas +++ b/wst/trunk/base_service_intf.pas @@ -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} diff --git a/wst/trunk/basex_encode.pas b/wst/trunk/basex_encode.pas index 6f930b4c3..deb1bc61e 100644 --- a/wst/trunk/basex_encode.pas +++ b/wst/trunk/basex_encode.pas @@ -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; diff --git a/wst/trunk/object_serializer.pas b/wst/trunk/object_serializer.pas index a0661ce82..8c10e5855 100644 --- a/wst/trunk/object_serializer.pas +++ b/wst/trunk/object_serializer.pas @@ -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} diff --git a/wst/trunk/tests/test_suite/test_generators_runtime.pas b/wst/trunk/tests/test_suite/test_generators_runtime.pas index f2cd82521..703059e09 100644 --- a/wst/trunk/tests/test_suite/test_generators_runtime.pas +++ b/wst/trunk/tests/test_suite/test_generators_runtime.pas @@ -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 diff --git a/wst/trunk/tests/test_suite/test_rtti_filter.pas b/wst/trunk/tests/test_suite/test_rtti_filter.pas index 3f829fbb0..908470664 100644 --- a/wst/trunk/tests/test_suite/test_rtti_filter.pas +++ b/wst/trunk/tests/test_suite/test_rtti_filter.pas @@ -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; diff --git a/wst/trunk/tests/test_suite/test_support.pas b/wst/trunk/tests/test_suite/test_support.pas index 1ba7193d0..cb7529fbd 100644 --- a/wst/trunk/tests/test_suite/test_support.pas +++ b/wst/trunk/tests/test_suite/test_support.pas @@ -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; diff --git a/wst/trunk/tests/test_suite/testformatter_unit.pas b/wst/trunk/tests/test_suite/testformatter_unit.pas index 14a89edcb..308cace9d 100644 --- a/wst/trunk/tests/test_suite/testformatter_unit.pas +++ b/wst/trunk/tests/test_suite/testformatter_unit.pas @@ -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 = ' ' + ' ' + ' ' + @@ -4654,7 +4654,7 @@ end; procedure TTestXmlRpcFormatter.test_WriteBuffer(); const - s_XML_BUFFER = + s_XML_BUFFER : AnsiString = ' ' + ' ' + ' ' + @@ -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); diff --git a/wst/trunk/wst_delphi.inc b/wst/trunk/wst_delphi.inc index 4a753d899..250673fef 100644 --- a/wst/trunk/wst_delphi.inc +++ b/wst/trunk/wst_delphi.inc @@ -7,4 +7,5 @@ ByteArray = array[0..$effffff] of Byte; PtrUInt = Cardinal; SizeInt = Longint; + UnicodeChar = WideChar; {$ENDIF} diff --git a/wst/trunk/wst_global.inc b/wst/trunk/wst_global.inc index 6ca3b6bef..447d8aad3 100644 --- a/wst/trunk/wst_global.inc +++ b/wst/trunk/wst_global.inc @@ -42,6 +42,9 @@ {$IFDEF VER150} {$DEFINE HAS_FORMAT_SETTINGS} {$ENDIF} + {$IFDEF VER200} // Delphi 2009 + {$DEFINE WST_UNICODESTRING} + {$ENDIF} {$DEFINE WST_SEMAPHORE_TIMEOUT} {$ENDIF} diff --git a/wst/trunk/wst_rtti_filter/rtti_filters.pas b/wst/trunk/wst_rtti_filter/rtti_filters.pas index 84cd4cb19..5ded89dd4 100644 --- a/wst/trunk/wst_rtti_filter/rtti_filters.pas +++ b/wst/trunk/wst_rtti_filter/rtti_filters.pas @@ -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(); diff --git a/wst/trunk/wst_types.pas b/wst/trunk/wst_types.pas index d99752b7f..6c2691735 100644 --- a/wst/trunk/wst_types.pas +++ b/wst/trunk/wst_types.pas @@ -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