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

2
wst/trunk/basex_encode.pas
View File

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

4
wst/trunk/binary_streamer.pas
View File

@ -104,8 +104,8 @@ Type
function ReadCurrency():TFloat_Currency_8;
End;
function CreateBinaryReader(AStream : TStream):IDataStoreReader;{$IFDEF USE_INLINE}inline;{$ENDIF}
function CreateBinaryWriter(AStream : TStream):IDataStore;{$IFDEF USE_INLINE}inline;{$ENDIF}
function CreateBinaryReader(AStream : TStream):IDataStoreReader;
function CreateBinaryWriter(AStream : TStream):IDataStore;
{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}

10
wst/trunk/imp_utils.pas
View File

@ -30,7 +30,7 @@ Type
Private
FParent : TObject;
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
procedure SetProperty(Const AName,AValue:string);
procedure SetProperties(Const APropsStr:string);
@ -42,7 +42,8 @@ Type
constructor Create(AParent : TObject);
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 ExtractOptionName(const ACompleteName : string):string;
function TranslateDotToDecimalSeperator(const Value: string) : string;
@ -63,6 +64,11 @@ begin
Result := ( Length(Trim(AStr)) = 0 );
end;
function IsStrEmpty(Const AStr : ShortString) : Boolean;
begin
Result := ( Length(Trim(AStr)) = 0 );
end;
function GetToken(var ABuffer : string; const ADelimiter : string): string;
var
locPos, locOfs, locLen : PtrInt;

8
wst/trunk/object_serializer.pas
View File

@ -689,7 +689,7 @@ begin
( GetTypeData(pt)^.BaseType^ = TypeInfo(Boolean) )
then begin
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);
end else begin
{$ENDIF WST_DELPHI}
@ -778,9 +778,9 @@ var
locData : UnicodeString;
begin
locName := APropInfo.ExternalName;
locData := GetUnicodeStrProp(AObject,APropInfo.PropInfo);A
locData := GetUnicodeStrProp(AObject,APropInfo.PropInfo);
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;
{$ENDIF WST_UNICODESTRING}
@ -900,7 +900,7 @@ begin
( GetTypeData(pt)^.BaseType^ = TypeInfo(Boolean) )
then begin
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);
end else begin
{$ENDIF WST_DELPHI}

8
wst/trunk/server_service_intf.pas
View File

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

4
wst/trunk/service_intf.pas
View File

@ -146,8 +146,8 @@ Type
);
End;
function GetFormaterRegistry():IFormaterQueryRegistry;{$IFDEF USE_INLINE}inline;{$ENDIF}
function GetTransportRegistry():ITransportRegistry;{$IFDEF USE_INLINE}inline;{$ENDIF}
function GetFormaterRegistry():IFormaterQueryRegistry;
function GetTransportRegistry():ITransportRegistry;
implementation
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 wstExpandLocalFileName(const AFileName : string) : string;
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 : Int64) : Int64 ; overload;
@ -74,7 +74,7 @@ begin
Result := a + Random(Abs(ATo - AFrom));
end;
function StringToByteArray(const AValue : string) : TByteDynArray;
function StringToByteArray(const AValue : TBinaryString) : TByteDynArray;
begin
SetLength(Result,Length(AValue));
Move(Pointer(AValue)^,Pointer(Result)^,Length(Result));

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

@ -350,13 +350,13 @@ type
procedure test_Assign();
procedure Equal();
end;
{ TTest_TAbstractEncodedStringRemotable }
TTest_TAbstractEncodedStringRemotable = class(TWstBaseTest)
protected
class function CreateObject() : TAbstractEncodedStringRemotable; virtual; abstract;
class function EncodeData(const AValue : TByteDynArray) : string; overload; virtual; abstract;
class function EncodeData(const AValue : TByteDynArray) : string; overload; virtual; abstract;
class function EncodeData(const AValue : TBinaryString) : string; overload;
published
procedure test_Assign();
@ -455,7 +455,7 @@ type
implementation
uses Math, basex_encode, DateUtils, date_utils;
function RandomValue(const AMaxlen: Integer): ansistring;
function RandomValue(const AMaxlen: Integer): TBinaryString;
var
k : Integer;
begin
@ -550,7 +550,7 @@ end;
class function TTest_TArrayOfStringRemotable.GetTypeInfo(): PTypeInfo;
begin
Result := TypeInfo(ansistring);
Result := TypeInfo(String);
end;
procedure TTest_TArrayOfStringRemotable.test_Assign();
@ -564,7 +564,7 @@ begin
try
b := TArrayOfStringRemotable.Create();
a.Assign(nil);
for i := 1 to ITER do begin
j := Random(ITER);
a.SetLength(j);
@ -580,7 +580,7 @@ begin
CheckEquals(a[k],b[k]);
end;
end;
a.SetLength(0);
a.Assign(b);
CheckEquals(b.Length,a.Length, 'Length');
@ -601,7 +601,7 @@ const ITER : Integer = 100;
var
localObj : TArrayOfStringRemotable;
i, j, k : Integer;
a : array of ansistring;
a : array of string;
begin
localObj := TArrayOfStringRemotable.Create() ;
try
@ -3092,24 +3092,25 @@ const ITER = 100;
var
i : Integer;
a : TAbstractEncodedStringRemotable;
s, es : string;
s : TBinaryString;
es : string;
begin
a := CreateObject();
try
s := ''; es := EncodeData(s);
a.BinaryData := StringToByteArray(s);
CheckEquals(StringToByteArray(s),a.BinaryData);
CheckEquals(es,a.EncodedString);
CheckEquals(StringToByteArray(s),a.BinaryData);
CheckEquals(es,a.EncodedString);
CheckEquals(StringToByteArray(s),a.BinaryData, 'BinaryData 0');
CheckEquals(es,a.EncodedString, 'EncodedString 0');
CheckEquals(StringToByteArray(s),a.BinaryData, 'BinaryData 0.1');
CheckEquals(es,a.EncodedString, 'EncodedString 0.1');
for i := 1 to ITER do begin
s := RandomValue(Random(500)); es := EncodeData(s);
a.BinaryData := StringToByteArray(s);
CheckEquals(StringToByteArray(s),a.BinaryData);
CheckEquals(es,a.EncodedString);
CheckEquals(StringToByteArray(s),a.BinaryData);
CheckEquals(es,a.EncodedString);
CheckEquals(StringToByteArray(s),a.BinaryData, 'BinaryData 1');
CheckEquals(es,a.EncodedString, 'EncodedString 1');
CheckEquals(StringToByteArray(s),a.BinaryData, 'BinaryData 2');
CheckEquals(es,a.EncodedString, 'EncodedString 2');
end;
finally
FreeAndNil(a);
@ -3121,7 +3122,8 @@ const ITER = 100;
var
i : Integer;
a : TAbstractEncodedStringRemotable;
s, es : TBinaryString;
s : TBinaryString;
es : string;
begin
a := CreateObject();
try
@ -3313,7 +3315,8 @@ const ITER = 100;
var
i : Integer;
a : TAbstractEncodedStringExtRemotable;
s, es : string;
s : TBinaryString;
es : string;
begin
a := CreateObject();
try
@ -3342,7 +3345,8 @@ const ITER = 100;
var
i : Integer;
a : TAbstractEncodedStringExtRemotable;
s, es : string;
s : TBinaryString;
es : string;
begin
a := CreateObject();
try

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

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

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

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

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

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

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

@ -153,7 +153,7 @@ type
const APreferedList : TStrings
):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}
implementation

1
wst/trunk/wst_global.inc
View File

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