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

Delphi compatibility fix

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@740 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
2009-03-13 17:10:21 +00:00
parent aeb7aaac64
commit be86fa976b
14 changed files with 68 additions and 54 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
wst/trunk/base_service_intf.pas
View File

@ -921,12 +921,12 @@ type
end; end;
{ TArrayOfStringRemotable } { TArrayOfStringRemotable }
// --------- AnsiString !!!! ---------- // --------- Compiler Native String type !!!! ----------
TArrayOfStringRemotable = class(TBaseSimpleTypeArrayRemotable) TArrayOfStringRemotable = class(TBaseSimpleTypeArrayRemotable)
private private
FData : array of ansistring; FData : array of String;
function GetItem(AIndex: Integer): ansistring; function GetItem(AIndex: Integer): String;
procedure SetItem(AIndex: Integer; const AValue: ansistring); procedure SetItem(AIndex: Integer; const AValue: String);
protected protected
function GetLength():Integer;override; function GetLength():Integer;override;
procedure SaveItem( procedure SaveItem(
@ -943,7 +943,7 @@ type
procedure SetLength(const ANewSize : Integer);override; procedure SetLength(const ANewSize : Integer);override;
procedure Assign(Source: TPersistent); override; procedure Assign(Source: TPersistent); override;
function Equal(const ACompareTo : TBaseRemotable) : Boolean;override; function Equal(const ACompareTo : TBaseRemotable) : Boolean;override;
property Item[AIndex:Integer] : ansistring read GetItem write SetItem; default; property Item[AIndex:Integer] : String read GetItem write SetItem; default;
end; end;
{ TArrayOfBooleanRemotable } { TArrayOfBooleanRemotable }
@ -1531,7 +1531,7 @@ const
PROP_LIST_DELIMITER = ';'; PROP_LIST_DELIMITER = ';';
FIELDS_STRING = '__FIELDS__'; FIELDS_STRING = '__FIELDS__';
function GetTypeRegistry():TTypeRegistry;{$IFDEF USE_INLINE}inline;{$ENDIF} function GetTypeRegistry():TTypeRegistry;
procedure RegisterStdTypes();overload;{$IFDEF USE_INLINE}inline;{$ENDIF} procedure RegisterStdTypes();overload;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure RegisterStdTypes(ARegistry : TTypeRegistry);overload; procedure RegisterStdTypes(ARegistry : TTypeRegistry);overload;
procedure RegisterAttributeProperty( procedure RegisterAttributeProperty(
@ -3212,13 +3212,13 @@ end;
{ TArrayOfStringRemotable } { TArrayOfStringRemotable }
function TArrayOfStringRemotable.GetItem(AIndex: Integer): ansistring; function TArrayOfStringRemotable.GetItem(AIndex: Integer): String;
begin begin
CheckIndex(AIndex); CheckIndex(AIndex);
Result := FData[AIndex]; Result := FData[AIndex];
end; end;
procedure TArrayOfStringRemotable.SetItem(AIndex: Integer;const AValue: ansistring); procedure TArrayOfStringRemotable.SetItem(AIndex: Integer;const AValue: String);
begin begin
CheckIndex(AIndex); CheckIndex(AIndex);
FData[AIndex] := AValue; FData[AIndex] := AValue;
@ -3235,7 +3235,7 @@ procedure TArrayOfStringRemotable.SaveItem(
const AIndex : Integer const AIndex : Integer
); );
begin begin
AStore.Put(AName,TypeInfo(ansistring),FData[AIndex]); AStore.Put(AName,TypeInfo(String),FData[AIndex]);
end; end;
procedure TArrayOfStringRemotable.LoadItem( procedure TArrayOfStringRemotable.LoadItem(
@ -3246,12 +3246,12 @@ var
sName : string; sName : string;
begin begin
sName := GetItemName(); sName := GetItemName();
AStore.Get(TypeInfo(ansistring),sName,FData[AIndex]); AStore.Get(TypeInfo(String),sName,FData[AIndex]);
end; end;
class function TArrayOfStringRemotable.GetItemTypeInfo(): PTypeInfo; class function TArrayOfStringRemotable.GetItemTypeInfo(): PTypeInfo;
begin begin
Result := TypeInfo(ansistring); Result := TypeInfo(String);
end; end;
procedure TArrayOfStringRemotable.SetLength(const ANewSize: Integer); procedure TArrayOfStringRemotable.SetLength(const ANewSize: Integer);
@ -6184,7 +6184,7 @@ end;
type TDatePart = ( dpNone, dpYear, dpMonth, dpDay, dpHour, dpMinute, dpSecond, dpFractionalSecond ); type TDatePart = ( dpNone, dpYear, dpMonth, dpDay, dpHour, dpMinute, dpSecond, dpFractionalSecond );
procedure TDurationRemotable.Parse(const ABuffer : string); procedure TDurationRemotable.Parse(const ABuffer : string);
procedure RaiseInvalidBuffer();{$IFDEF USE_INLINE}inline;{$ENDIF} procedure RaiseInvalidBuffer();
begin begin
raise EConvertError.CreateFmt('Invalid duration string : ',[ABuffer]); raise EConvertError.CreateFmt('Invalid duration string : ',[ABuffer]);
end; end;

2
wst/trunk/basex_encode.pas
View File

@ -230,6 +230,8 @@ begin
if ( ALen > 0 ) then begin if ( ALen > 0 ) then begin
SetLength(Result,(2 * ALen)); SetLength(Result,(2 * ALen));
Base16Encode(ABin,ALen,@Result[1]); Base16Encode(ABin,ALen,@Result[1]);
end else begin
Result := '';
end; end;
end; end;

4
wst/trunk/binary_streamer.pas
View File

@ -104,8 +104,8 @@ Type
function ReadCurrency():TFloat_Currency_8; function ReadCurrency():TFloat_Currency_8;
End; End;
function CreateBinaryReader(AStream : TStream):IDataStoreReader;{$IFDEF USE_INLINE}inline;{$ENDIF} function CreateBinaryReader(AStream : TStream):IDataStoreReader;
function CreateBinaryWriter(AStream : TStream):IDataStore;{$IFDEF USE_INLINE}inline;{$ENDIF} function CreateBinaryWriter(AStream : TStream):IDataStore;
{These routines transform their argument to "Big Endian" alignment} {These routines transform their argument to "Big Endian" alignment}
procedure ReverseBytes(var AData; const ALength : Integer);{$IFDEF USE_INLINE}{$IFDEF ENDIAN_BIG}inline;{$ENDIF}{$ENDIF} procedure ReverseBytes(var AData; const ALength : Integer);{$IFDEF USE_INLINE}{$IFDEF ENDIAN_BIG}inline;{$ENDIF}{$ENDIF}

10
wst/trunk/imp_utils.pas
View File

@ -30,7 +30,7 @@ Type
Private Private
FParent : TObject; FParent : TObject;
procedure Error(Const AMsg:string);overload;{$IFDEF USE_INLINE}inline;{$ENDIF} procedure Error(Const AMsg:string);overload;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure Error(Const AMsg:string; Const AArgs : array of const);overload;{$IFDEF USE_INLINE}inline;{$ENDIF} procedure Error(Const AMsg:string; Const AArgs : array of const);overload;
Protected Protected
procedure SetProperty(Const AName,AValue:string); procedure SetProperty(Const AName,AValue:string);
procedure SetProperties(Const APropsStr:string); procedure SetProperties(Const APropsStr:string);
@ -42,7 +42,8 @@ Type
constructor Create(AParent : TObject); constructor Create(AParent : TObject);
End; End;
function IsStrEmpty(Const AStr:String):Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} function IsStrEmpty(Const AStr:String):Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}overload;
function IsStrEmpty(Const AStr:ShortString):Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}overload;
function GetToken(var ABuffer : string; const ADelimiter : string): string; function GetToken(var ABuffer : string; const ADelimiter : string): string;
function ExtractOptionName(const ACompleteName : string):string; function ExtractOptionName(const ACompleteName : string):string;
function TranslateDotToDecimalSeperator(const Value: string) : string; function TranslateDotToDecimalSeperator(const Value: string) : string;
@ -63,6 +64,11 @@ begin
Result := ( Length(Trim(AStr)) = 0 ); Result := ( Length(Trim(AStr)) = 0 );
end; end;
function IsStrEmpty(Const AStr : ShortString) : Boolean;
begin
Result := ( Length(Trim(AStr)) = 0 );
end;
function GetToken(var ABuffer : string; const ADelimiter : string): string; function GetToken(var ABuffer : string; const ADelimiter : string): string;
var var
locPos, locOfs, locLen : PtrInt; locPos, locOfs, locLen : PtrInt;

8
wst/trunk/object_serializer.pas
View File

@ -689,7 +689,7 @@ begin
( GetTypeData(pt)^.BaseType^ = TypeInfo(Boolean) ) ( GetTypeData(pt)^.BaseType^ = TypeInfo(Boolean) )
then begin then begin
boolData := Boolean(GetOrdProp(AObject,APropInfo.PropInfo)); boolData := Boolean(GetOrdProp(AObject,APropInfo.PropInfo));
if ( locData <> '' ) or ( APropInfo.PersisteType = pstAlways ) then //if ( locData <> '' ) or ( APropInfo.PersisteType = pstAlways ) then
AStore.Put(prpName,pt,boolData); AStore.Put(prpName,pt,boolData);
end else begin end else begin
{$ENDIF WST_DELPHI} {$ENDIF WST_DELPHI}
@ -778,9 +778,9 @@ var
locData : UnicodeString; locData : UnicodeString;
begin begin
locName := APropInfo.ExternalName; locName := APropInfo.ExternalName;
locData := GetUnicodeStrProp(AObject,APropInfo.PropInfo);A locData := GetUnicodeStrProp(AObject,APropInfo.PropInfo);
if ( locData <> '' ) or ( APropInfo.PersisteType = pstAlways ) then if ( locData <> '' ) or ( APropInfo.PersisteType = pstAlways ) then
Store.Put(locName,APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locData); AStore.Put(locName,APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locData);
end; end;
{$ENDIF WST_UNICODESTRING} {$ENDIF WST_UNICODESTRING}
@ -900,7 +900,7 @@ begin
( GetTypeData(pt)^.BaseType^ = TypeInfo(Boolean) ) ( GetTypeData(pt)^.BaseType^ = TypeInfo(Boolean) )
then begin then begin
boolData := Boolean(GetOrdProp(AObject,APropInfo.PropInfo)); boolData := Boolean(GetOrdProp(AObject,APropInfo.PropInfo));
if ( locData <> '' ) or ( APropInfo.PersisteType = pstAlways ) then //if ( locData <> '' ) or ( APropInfo.PersisteType = pstAlways ) then
AStore.Put(APropInfo.NameSpace,prpName,pt,boolData); AStore.Put(APropInfo.NameSpace,prpName,pt,boolData);
end else begin end else begin
{$ENDIF WST_DELPHI} {$ENDIF WST_DELPHI}

8
wst/trunk/server_service_intf.pas
View File

@ -207,10 +207,10 @@ type
ARequestBuffer : IRequestBuffer; ARequestBuffer : IRequestBuffer;
AServiceRegistry : IServerServiceRegistry = Nil AServiceRegistry : IServerServiceRegistry = Nil
); );
function GetFormatterRegistry():IFormatterRegistry;{$IFDEF USE_INLINE}inline;{$ENDIF} function GetFormatterRegistry():IFormatterRegistry;
function GetServerServiceRegistry():IServerServiceRegistry;{$IFDEF USE_INLINE}inline;{$ENDIF} function GetServerServiceRegistry():IServerServiceRegistry;
function GetServiceImplementationRegistry():IServiceImplementationRegistry ;{$IFDEF USE_INLINE}inline;{$ENDIF} function GetServiceImplementationRegistry():IServiceImplementationRegistry ;
function GetServiceExtensionRegistry():IServiceExtensionRegistry;{$IFDEF USE_INLINE}inline;{$ENDIF} function GetServiceExtensionRegistry():IServiceExtensionRegistry;
procedure initialize_server_services_intf(); procedure initialize_server_services_intf();
procedure finalize_server_services_intf(); procedure finalize_server_services_intf();

4
wst/trunk/service_intf.pas
View File

@ -146,8 +146,8 @@ Type
); );
End; End;
function GetFormaterRegistry():IFormaterQueryRegistry;{$IFDEF USE_INLINE}inline;{$ENDIF} function GetFormaterRegistry():IFormaterQueryRegistry;
function GetTransportRegistry():ITransportRegistry;{$IFDEF USE_INLINE}inline;{$ENDIF} function GetTransportRegistry():ITransportRegistry;
implementation implementation
uses imp_utils, metadata_repository; uses imp_utils, metadata_repository;

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

@ -41,7 +41,7 @@ type
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; function DumpMemory(AMem : Pointer; const ALength : PtrInt) : ansistring;
function StringToByteArray(const AValue : string) : TByteDynArray; function StringToByteArray(const AValue : TBinaryString) : TByteDynArray;
function RandomRange(const AFrom, ATo : Integer) : Integer ;overload; function RandomRange(const AFrom, ATo : Integer) : Integer ;overload;
function RandomRange(const AFrom, ATo : Int64) : Int64 ; overload; function RandomRange(const AFrom, ATo : Int64) : Int64 ; overload;
@ -74,7 +74,7 @@ begin
Result := a + Random(Abs(ATo - AFrom)); Result := a + Random(Abs(ATo - AFrom));
end; end;
function StringToByteArray(const AValue : string) : TByteDynArray; function StringToByteArray(const AValue : TBinaryString) : TByteDynArray;
begin begin
SetLength(Result,Length(AValue)); SetLength(Result,Length(AValue));
Move(Pointer(AValue)^,Pointer(Result)^,Length(Result)); Move(Pointer(AValue)^,Pointer(Result)^,Length(Result));

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

@ -455,7 +455,7 @@ type
implementation implementation
uses Math, basex_encode, DateUtils, date_utils; uses Math, basex_encode, DateUtils, date_utils;
function RandomValue(const AMaxlen: Integer): ansistring; function RandomValue(const AMaxlen: Integer): TBinaryString;
var var
k : Integer; k : Integer;
begin begin
@ -550,7 +550,7 @@ end;
class function TTest_TArrayOfStringRemotable.GetTypeInfo(): PTypeInfo; class function TTest_TArrayOfStringRemotable.GetTypeInfo(): PTypeInfo;
begin begin
Result := TypeInfo(ansistring); Result := TypeInfo(String);
end; end;
procedure TTest_TArrayOfStringRemotable.test_Assign(); procedure TTest_TArrayOfStringRemotable.test_Assign();
@ -601,7 +601,7 @@ const ITER : Integer = 100;
var var
localObj : TArrayOfStringRemotable; localObj : TArrayOfStringRemotable;
i, j, k : Integer; i, j, k : Integer;
a : array of ansistring; a : array of string;
begin begin
localObj := TArrayOfStringRemotable.Create() ; localObj := TArrayOfStringRemotable.Create() ;
try try
@ -3092,24 +3092,25 @@ const ITER = 100;
var var
i : Integer; i : Integer;
a : TAbstractEncodedStringRemotable; a : TAbstractEncodedStringRemotable;
s, es : string; s : TBinaryString;
es : string;
begin begin
a := CreateObject(); a := CreateObject();
try try
s := ''; es := EncodeData(s); s := ''; es := EncodeData(s);
a.BinaryData := StringToByteArray(s); a.BinaryData := StringToByteArray(s);
CheckEquals(StringToByteArray(s),a.BinaryData); CheckEquals(StringToByteArray(s),a.BinaryData, 'BinaryData 0');
CheckEquals(es,a.EncodedString); CheckEquals(es,a.EncodedString, 'EncodedString 0');
CheckEquals(StringToByteArray(s),a.BinaryData); CheckEquals(StringToByteArray(s),a.BinaryData, 'BinaryData 0.1');
CheckEquals(es,a.EncodedString); CheckEquals(es,a.EncodedString, 'EncodedString 0.1');
for i := 1 to ITER do begin for i := 1 to ITER do begin
s := RandomValue(Random(500)); es := EncodeData(s); s := RandomValue(Random(500)); es := EncodeData(s);
a.BinaryData := StringToByteArray(s); a.BinaryData := StringToByteArray(s);
CheckEquals(StringToByteArray(s),a.BinaryData); CheckEquals(StringToByteArray(s),a.BinaryData, 'BinaryData 1');
CheckEquals(es,a.EncodedString); CheckEquals(es,a.EncodedString, 'EncodedString 1');
CheckEquals(StringToByteArray(s),a.BinaryData); CheckEquals(StringToByteArray(s),a.BinaryData, 'BinaryData 2');
CheckEquals(es,a.EncodedString); CheckEquals(es,a.EncodedString, 'EncodedString 2');
end; end;
finally finally
FreeAndNil(a); FreeAndNil(a);
@ -3121,7 +3122,8 @@ const ITER = 100;
var var
i : Integer; i : Integer;
a : TAbstractEncodedStringRemotable; a : TAbstractEncodedStringRemotable;
s, es : TBinaryString; s : TBinaryString;
es : string;
begin begin
a := CreateObject(); a := CreateObject();
try try
@ -3313,7 +3315,8 @@ const ITER = 100;
var var
i : Integer; i : Integer;
a : TAbstractEncodedStringExtRemotable; a : TAbstractEncodedStringExtRemotable;
s, es : string; s : TBinaryString;
es : string;
begin begin
a := CreateObject(); a := CreateObject();
try try
@ -3342,7 +3345,8 @@ const ITER = 100;
var var
i : Integer; i : Integer;
a : TAbstractEncodedStringExtRemotable; a : TAbstractEncodedStringExtRemotable;
s, es : string; s : TBinaryString;
es : string;
begin begin
a := CreateObject(); a := CreateObject();
try try

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

@ -4116,8 +4116,8 @@ var
begin begin
a := TArrayOfStringRemotable.Create(); a := TArrayOfStringRemotable.Create();
try try
CheckEquals(PTypeInfo(TypeInfo(ansistring))^.Name,a.GetItemTypeInfo()^.Name,'TypeInfo'); CheckEquals(PTypeInfo(TypeInfo(String))^.Name,a.GetItemTypeInfo()^.Name,'TypeInfo');
CheckEquals(Ord(PTypeInfo(TypeInfo(ansistring))^.Kind),Ord(a.GetItemTypeInfo()^.Kind),'TypeInfo'); CheckEquals(Ord(PTypeInfo(TypeInfo(String))^.Kind),Ord(a.GetItemTypeInfo()^.Kind),'TypeInfo');
CheckEquals(0,a.Length); CheckEquals(0,a.Length);
a.SetLength(0); a.SetLength(0);

6
wst/trunk/ws_helper/logger_intf.pas
View File

@ -46,9 +46,9 @@ type
end; end;
function HasLogger() : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} function HasLogger() : Boolean;
function SetLogger(ALogger : ILogger) : ILogger;{$IFDEF USE_INLINE}inline;{$ENDIF} function SetLogger(ALogger : ILogger) : ILogger;
function GetLogger() : ILogger;{$IFDEF USE_INLINE}inline;{$ENDIF} function GetLogger() : ILogger;
implementation implementation

3
wst/trunk/ws_helper/ws_helper.lpi
View File

@ -142,11 +142,12 @@
</Parsing> </Parsing>
<CodeGeneration> <CodeGeneration>
<Optimizations> <Optimizations>
<OptimizationLevel Value="2"/> <OptimizationLevel Value="3"/>
</Optimizations> </Optimizations>
</CodeGeneration> </CodeGeneration>
<Linking> <Linking>
<Debugging> <Debugging>
<UseLineInfoUnit Value="False"/>
<StripSymbols Value="True"/> <StripSymbols Value="True"/>
</Debugging> </Debugging>
<LinkSmart Value="True"/> <LinkSmart Value="True"/>

2
wst/trunk/ws_helper/xsd_generator.pas
View File

@ -153,7 +153,7 @@ type
const APreferedList : TStrings const APreferedList : TStrings
):string; ):string;
function GetXsdTypeHandlerRegistry():IXsdTypeHandlerRegistry;{$IFDEF USE_INLINE}inline;{$ENDIF} function GetXsdTypeHandlerRegistry():IXsdTypeHandlerRegistry;
function CreateElement(const ANodeName : DOMString; AParent : TDOMNode; ADoc : TDOMDocument):TDOMElement;{$IFDEF USE_INLINE}inline;{$ENDIF} function CreateElement(const ANodeName : DOMString; AParent : TDOMNode; ADoc : TDOMDocument):TDOMElement;{$IFDEF USE_INLINE}inline;{$ENDIF}
implementation implementation

1
wst/trunk/wst_global.inc
View File

@ -44,6 +44,7 @@
{$ENDIF} {$ENDIF}
{$IFDEF VER200} // Delphi 2009 {$IFDEF VER200} // Delphi 2009
{$DEFINE WST_UNICODESTRING} {$DEFINE WST_UNICODESTRING}
{$DEFINE USE_INLINE}
{$ENDIF} {$ENDIF}
{$DEFINE WST_SEMAPHORE_TIMEOUT} {$DEFINE WST_SEMAPHORE_TIMEOUT}
{$IFDEF MSWINDOWS} {$IFDEF MSWINDOWS}