0005454: Patch to allow SVN version of Jcl to compile with latest SVN version of FreePascal compiler.

ID	Project	Category	View Status	Date Submitted	Last Update

0005454	JEDI Code Library	Installation	public	2011-01-08 18:33	2013-09-28 00:38

Reporter	Cyrus	Assigned To
Priority	normal	Severity	tweak	Reproducibility	always
Status	feedback	Resolution	open
Product Version	Version 2.3
Target Version		Fixed in Version

Summary	0005454: Patch to allow SVN version of Jcl to compile with latest SVN version of FreePascal compiler.
Description	This patch only allows Jcl to compile with FPC.
Tags	No tags attached.

Fixed in GIT commit
Fixed in SVN revision
IDE version	FPC

outchy 2011-01-09 17:17 administrator ~0018292	This patch is for win64 but for which version of FPC?

Cyrus 2011-01-09 22:56 reporter ~0018293 Last edited: 2011-01-10 11:15	It is for both win32 and win64. It should work with officially released version 2.4.2 and in development version 2.5.1 (from their SVN repository). EDIT: I take it back. It only works in development version because latest SVN revision of Jcl requires SysStringByteLen to be found in ActiveX unit.

outchy 2011-01-15 13:00 administrator ~0018300	Here is a polished patch for: - JclAlgortithms, - JclBase, - JclCompression, - JclSysInfo, - JclUnicode, - JclHookExcept. Still to be done: - JclAbstractContainers: why the default values need to be IFDEF'ed? FPC does support WideString default values right? - JclStringList: why is IJclStringList.Find commented out? - JclSysUtils: I cannot apply the patch right now, it is not based on a valid subversion revision... Could you use TortoiseSVN to create the patches on top of JCL HEAD?

2011-01-15 13:00	jcl-fpc-polished.patch (4,953 bytes) Index: source/common/JclAlgorithms.pas =================================================================== --- source/common/JclAlgorithms.pas (revision 3478) +++ source/common/JclAlgorithms.pas (working copy) @@ -828,7 +828,7 @@ // case-sensitive and UTF8-encoded function AnsiStrSimpleHashConvertU(const AString: AnsiString): Integer; var - I: Integer; + I: SizeInt; C, IntegerHash: TIntegerHash; begin IntegerHash.H1 := 0; @@ -852,7 +852,7 @@ // case-insensitive and UTF8-encoded function AnsiStrSimpleHashConvertUI(const AString: AnsiString): Integer; var - I, J: Integer; + I, J: SizeInt; C, IntegerHash: TIntegerHash; CA: TUCS4Array; begin @@ -883,7 +883,7 @@ // default is case-sensitive function WideStrSimpleHashConvert(const AString: WideString): Integer; var - I: Integer; + I: SizeInt; C, IntegerHash: TIntegerHash; begin IntegerHash.H1 := 0; @@ -907,7 +907,7 @@ // case-insensitive function WideStrSimpleHashConvertI(const AString: WideString): Integer; var - I, J: Integer; + I, J: SizeInt; C, IntegerHash: TIntegerHash; CA: TUCS4Array; begin Index: source/common/JclBase.pas =================================================================== --- source/common/JclBase.pas (revision 3478) +++ source/common/JclBase.pas (working copy) @@ -321,6 +321,12 @@ function Addr64ToAddr32(const Value: TJclAddr64): TJclAddr32; function Addr32ToAddr64(const Value: TJclAddr32): TJclAddr64; +{$IFDEF FPC} +Type + HWND = type Windows.HWND; + HMODULE = type Windows.HMODULE; +{$ENDIF} + {$IFDEF SUPPORTS_GENERICS} //DOM-IGNORE-BEGIN Index: source/common/JclCompression.pas =================================================================== --- source/common/JclCompression.pas (revision 3478) +++ source/common/JclCompression.pas (working copy) @@ -726,7 +726,7 @@ TJclStreamAccess = (saCreate, saReadOnly, saReadOnlyDenyNone, saWriteOnly, saReadWrite); { TJclCompressionArchive is not ref-counted } - TJclCompressionArchive = class(TObject, IInterface) + TJclCompressionArchive = class(TInterfacedObject, IInterface) private FOnProgress: TJclCompressionProgressEvent; FOnVolume: TJclCompressionVolumeEvent; Index: source/common/JclSysInfo.pas =================================================================== --- source/common/JclSysInfo.pas (revision 3478) +++ source/common/JclSysInfo.pas (working copy) @@ -4285,17 +4285,17 @@ SETNZ Result {$ENDIF CPU32} {$IFDEF CPU64} - // PUSHFQ - PUSHFD + PUSHFQ + //PUSHFD POP RAX MOV RCX, RAX XOR RAX, ID_FLAG AND RCX, ID_FLAG PUSH RAX - // POPFQ - POPFD - // PUSHFQ - PUSHFD + POPFQ + //POPFD + PUSHFQ + //PUSHFD POP RAX AND RAX, ID_FLAG XOR RAX, RCX Index: source/common/JclUnicode.pas =================================================================== --- source/common/JclUnicode.pas (revision 3478) +++ source/common/JclUnicode.pas (working copy) @@ -2742,7 +2742,7 @@ // Looks for all occurences of the pattern passed to FindPrepare and creates an // internal list of their positions. var - Start, Stop: SizeInt; + Start, Stop, CharCount: SizeInt; Run: PWideChar; RunLen: SizeInt; begin @@ -2755,7 +2755,8 @@ while Find(Run, RunLen, Start, Stop) do begin // store this result (consider text pointer movement)... - AddResult(Start + Run - Text, Stop + Run - Text); + CharCount := (TJclAddr(Run) - TJclAddr(Text)) div SizeOf(WideChar); + AddResult(Start + CharCount, Stop + CharCount); // ... and advance text position and length Inc(Run, Stop); Dec(RunLen, Stop); @@ -4713,7 +4714,7 @@ // Looks for all occurences of the pattern passed to FindPrepare and creates an // internal list of their positions. var - Start, Stop: SizeInt; + Start, Stop, CharCount: SizeInt; Run: PWideChar; RunLen: SizeInt; begin @@ -4726,7 +4727,8 @@ while ExecuteURE(0, Run, RunLen, Start, Stop) do begin // store this result (consider text pointer movement)... - AddResult(Start + Run - Text, Stop + Run - Text); + CharCount := (TJclAddr(Run) - TJclAddr(Text)) div SizeOf(WideChar); + AddResult(Start + CharCount, Stop + CharCount); // ... and advance text position and length Inc(Run, Stop); Dec(RunLen, Stop); Index: source/windows/JclHookExcept.pas =================================================================== --- source/windows/JclHookExcept.pas (revision 3478) +++ source/windows/JclHookExcept.pas (working copy) @@ -43,7 +43,7 @@ {$IFDEF UNITVERSIONING} JclUnitVersioning, {$ENDIF UNITVERSIONING} - Windows, SysUtils, Classes; + Windows, SysUtils, Classes, JclBase; type // Exception hooking notifiers routines @@ -96,7 +96,6 @@ implementation uses - JclBase, JclPeImage, JclSysInfo, JclSysUtils; jcl-fpc-polished.patch (4,953 bytes)

Cyrus 2011-02-27 09:15 reporter ~0018418	JclStringList: It was commented out because FPC compiler throws following error: \jcl\source\common\JclStringLists.pas(227,20) Error: No matching implementation for interface method "IJclStringList.Find(const AnsiString,var LongInt):Boolean;" found

Cyrus 2011-02-27 09:26 reporter ~0018419 Last edited: 2011-02-27 09:28	Here is new patch made with TortoiseSVN. Currently my SVN version of FPC is at revision 17018 and SVN version of Lazarus in 29680. Revision of JCL is 3502.

Cyrus 2011-02-27 09:56 reporter ~0018420	JclAbstractContainers: Unfortunately FPC gives erros if I don't IFDEF them: jcl\source\common\JclAbstractContainers.pas(670,35) Error: No matching implementation for interface method "IJclWideStrFlatContainer.GetAsDelimited(const WideString):WideString;" found jcl\source\common\JclAbstractContainers.pas(670,35) Error: No matching implementation for interface method "IJclWideStrFlatContainer.AppendDelimited(const WideString,const WideString);" found jcl\source\common\JclAbstractContainers.pas(670,35) Error: No matching implementation for interface method "IJclWideStrFlatContainer.LoadDelimited(const WideString,const WideString);" found

Cyrus 2011-02-27 09:58 reporter ~0018421	Here is more complete patch. Please ignore patches "fpc compatible 5.diff" and "fpc compatible new.diff" and use this instead.

Cyrus 2011-02-27 11:40 reporter ~0018422	Ignore patch "fpc compatible new 2.diff", too. Here is fixed patch.

Cyrus 2011-03-15 05:08 reporter ~0018450	Could somebody delete these attached files, please? fpc compatible 5.diff fpc compatible new.diff fpc compatible new 2.diff fpc compatible new 3.diff

2011-03-15 05:09	fpc compatible.patch (22,250 bytes) Index: packages/fpc/Jcl.lpk =================================================================== --- packages/fpc/Jcl.lpk (revision 3510) +++ packages/fpc/Jcl.lpk (working copy) @@ -7,11 +7,11 @@ <Author Value="Project JEDI"/> <AutoUpdate Value="OnRebuildingAll"/> <CompilerOptions> - <Version Value="8"/> + <Version Value="10"/> <PathDelim Value="\"/> <SearchPaths> - <IncludeFiles Value="..\..\source\include\"/> - <OtherUnitFiles Value=".;..\..\source\common;..\..\source\windows;"/> + <IncludeFiles Value="..\..\source\include;..\..\source\include\jedi"/> + <OtherUnitFiles Value=".;..\..\source\common;..\..\source\windows"/> <UnitOutputDirectory Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <Parsing> @@ -19,6 +19,7 @@ <SyntaxOptions> <SyntaxMode Value="Delphi"/> <CStyleOperator Value="False"/> + <UseAnsiStrings Value="False"/> </SyntaxOptions> </Parsing> <CodeGeneration> @@ -33,12 +34,15 @@ </Debugging> </Linking> <Other> + <CompilerMessages> + <UseMsgFile Value="True"/> + </CompilerMessages> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> <Description Value="JEDI Code Library RTL package"/> <License Value="Copyright (C) 1999, 2011 Project JEDI"/> - <Version Major="2" Minor="3" Release="0" Build="3847"/> + <Version Major="2" Minor="3" Build="3847"/> <Files Count="75"> <Item1> <Filename Value="..\..\source\common\bzip2.pas"/> @@ -347,10 +351,10 @@ </Item1> </RequiredPkgs> <UsageOptions> - <UnitPath Value="$(PkgOutDir)\"/> - <IncludePath Value="..\..\source\include\"/> - <LibraryPath Value="$(PkgOutDir)\"/> - <ObjectPath Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)\"/> + <IncludePath Value="..\..\source\include;..\..\source\include\jedi"/> + <LibraryPath Value="$(PkgOutDir)"/> + <ObjectPath Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> + <UnitPath Value="$(PkgOutDir)"/> </UsageOptions> <PublishOptions> <Version Value="2"/> Index: packages/fpc/JclContainers.lpk =================================================================== --- packages/fpc/JclContainers.lpk (revision 3510) +++ packages/fpc/JclContainers.lpk (working copy) @@ -7,11 +7,11 @@ <Author Value="Project JEDI"/> <AutoUpdate Value="OnRebuildingAll"/> <CompilerOptions> - <Version Value="8"/> + <Version Value="10"/> <PathDelim Value="\"/> <SearchPaths> - <IncludeFiles Value="..\..\source\include\"/> - <OtherUnitFiles Value=".;..\..\source\common;"/> + <IncludeFiles Value="..\..\source\include;..\..\source\include\jedi"/> + <OtherUnitFiles Value=".;..\..\source\common"/> <UnitOutputDirectory Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <Parsing> @@ -19,6 +19,7 @@ <SyntaxOptions> <SyntaxMode Value="Delphi"/> <CStyleOperator Value="False"/> + <UseAnsiStrings Value="False"/> </SyntaxOptions> </Parsing> <CodeGeneration> @@ -33,12 +34,15 @@ </Debugging> </Linking> <Other> + <CompilerMessages> + <UseMsgFile Value="True"/> + </CompilerMessages> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> <Description Value="JEDI Code Library Containers package"/> <License Value="Copyright (C) 1999, 2011 Project JEDI"/> - <Version Major="2" Minor="3" Release="0" Build="3847"/> + <Version Major="2" Minor="3" Build="3847"/> <Files Count="14"> <Item1> <Filename Value="..\..\source\common\JclAbstractContainers.pas"/> @@ -106,10 +110,10 @@ </Item2> </RequiredPkgs> <UsageOptions> - <UnitPath Value="$(PkgOutDir)\"/> - <IncludePath Value="..\..\source\include\"/> - <LibraryPath Value="$(PkgOutDir)\"/> - <ObjectPath Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)\"/> + <IncludePath Value="..\..\source\include;..\..\source\include\jedi"/> + <LibraryPath Value="$(PkgOutDir)"/> + <ObjectPath Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> + <UnitPath Value="$(PkgOutDir)"/> </UsageOptions> <PublishOptions> <Version Value="2"/> Index: source/common/JclAbstractContainers.pas =================================================================== --- source/common/JclAbstractContainers.pas (revision 3510) +++ source/common/JclAbstractContainers.pas (working copy) @@ -697,9 +697,9 @@ procedure AppendToStrings(Strings: TJclWideStrings); procedure AppendFromStrings(Strings: TJclWideStrings); function GetAsStrings: TJclWideStrings; - function GetAsDelimited(const Separator: WideString = WideLineBreak): WideString; - procedure AppendDelimited(const AString: WideString; const Separator: WideString = WideLineBreak); - procedure LoadDelimited(const AString: WideString; const Separator: WideString = WideLineBreak); + function GetAsDelimited(const Separator: WideString {$IFNDEF FPC}= WideLineBreak {$ENDIF}): WideString; + procedure AppendDelimited(const AString: WideString; const Separator: WideString {$IFNDEF FPC}= WideLineBreak {$ENDIF}); + procedure LoadDelimited(const AString: WideString; const Separator: WideString {$IFNDEF FPC}= WideLineBreak {$ENDIF}); end; {$IFDEF SUPPORTS_UNICODE_STRING} Index: source/common/JclAlgorithms.pas =================================================================== --- source/common/JclAlgorithms.pas (revision 3510) +++ source/common/JclAlgorithms.pas (working copy) @@ -828,7 +828,7 @@ // case-sensitive and UTF8-encoded function AnsiStrSimpleHashConvertU(const AString: AnsiString): Integer; var - I: Integer; + I: SizeInt; C, IntegerHash: TIntegerHash; begin IntegerHash.H1 := 0; @@ -852,7 +852,7 @@ // case-insensitive and UTF8-encoded function AnsiStrSimpleHashConvertUI(const AString: AnsiString): Integer; var - I, J: Integer; + I, J: SizeInt; C, IntegerHash: TIntegerHash; CA: TUCS4Array; begin @@ -883,7 +883,7 @@ // default is case-sensitive function WideStrSimpleHashConvert(const AString: WideString): Integer; var - I: Integer; + I: SizeInt; C, IntegerHash: TIntegerHash; begin IntegerHash.H1 := 0; @@ -907,7 +907,7 @@ // case-insensitive function WideStrSimpleHashConvertI(const AString: WideString): Integer; var - I, J: Integer; + I, J: SizeInt; C, IntegerHash: TIntegerHash; CA: TUCS4Array; begin @@ -4111,4 +4111,4 @@ UnregisterUnitVersion(HInstance); {$ENDIF UNITVERSIONING} -end. \ No newline at end of file +end. Index: source/common/JclCompression.pas =================================================================== --- source/common/JclCompression.pas (revision 3510) +++ source/common/JclCompression.pas (working copy) @@ -726,7 +726,7 @@ TJclStreamAccess = (saCreate, saReadOnly, saReadOnlyDenyNone, saWriteOnly, saReadWrite); { TJclCompressionArchive is not ref-counted } - TJclCompressionArchive = class(TObject, IInterface) + TJclCompressionArchive = class(TInterfacedObject, IInterface) private FOnProgress: TJclCompressionProgressEvent; FOnVolume: TJclCompressionVolumeEvent; Index: source/common/JclRTTI.pas =================================================================== --- source/common/JclRTTI.pas (revision 3510) +++ source/common/JclRTTI.pas (working copy) @@ -1878,7 +1878,11 @@ AInstance := GetObjectProp(FInstance, PropInfo); if AInstance <> nil then begin + {$IFNDEF FPC} SubClassTypeInfo := TJclObjClassTypeInfo.Create(PropInfo.PropType^, Prefix, AInstance); + {$ELSE} + SubClassTypeInfo := TJclObjClassTypeInfo.Create(PropInfo.PropType, Prefix, AInstance); + {$ENDIF} Result := SubClassTypeInfo.ObjPropNames[Suffix]; end else @@ -2945,7 +2949,7 @@ end; var - PropCount: Integer; + PropCount: SizeInt; begin PropCount := 0; SetLength(Result, 16); Index: source/common/JclStreams.pas =================================================================== --- source/common/JclStreams.pas (revision 3510) +++ source/common/JclStreams.pas (working copy) @@ -467,9 +467,9 @@ function LoadBuffer: Boolean; function LoadPeekBuffer: Boolean; function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; virtual; abstract; - function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: Longint): Longint; virtual; + function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; virtual; function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; virtual; abstract; - function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: Longint): Longint; virtual; + function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; virtual; procedure InvalidateBuffers; public constructor Create(AStream: TStream; AOwnsStream: Boolean = False); virtual; @@ -513,9 +513,9 @@ FCodePage: Word; protected function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; override; - function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: Longint): Longint; override; + function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; override; - function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: Longint): Longint; override; + function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; public constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override; property CodePage: Word read FCodePage write FCodePage; @@ -524,9 +524,9 @@ TJclUTF8Stream = class(TJclStringStream) protected function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; override; - function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: Longint): Longint; override; + function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; override; - function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: Longint): Longint; override; + function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; public constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override; end; @@ -534,9 +534,9 @@ TJclUTF16Stream = class(TJclStringStream) protected function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; override; - function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: Longint): Longint; override; + function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; override; - function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: Longint): Longint; override; + function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; public constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override; end; @@ -549,9 +549,9 @@ FEncoding: TJclStringEncoding; protected function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; override; - function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: Longint): Longint; override; + function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; override; - function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: Longint): Longint; override; + function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; public constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override; function SkipBOM: LongInt; override; @@ -2362,7 +2362,7 @@ end; function TJclStringStream.InternalGetNextBuffer(S: TStream; - var Buffer: TUCS4Array; Start, Count: Integer): Longint; + var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; var Ch: UCS4; begin @@ -2383,7 +2383,7 @@ end; function TJclStringStream.InternalSetNextBuffer(S: TStream; - const Buffer: TUCS4Array; Start, Count: Integer): Longint; + const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; begin // override to optimize Result := 0; @@ -2848,7 +2848,7 @@ end; function TJclAnsiStream.InternalGetNextBuffer(S: TStream; - var Buffer: TUCS4Array; Start, Count: Integer): Longint; + var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; begin if FCodePage = CP_ACP then Result := AnsiGetNextBufferFromStream(S, Buffer, Start, Count) @@ -2865,7 +2865,7 @@ end; function TJclAnsiStream.InternalSetNextBuffer(S: TStream; - const Buffer: TUCS4Array; Start, Count: Integer): Longint; + const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; begin if FCodePage = CP_ACP then Result := AnsiSetNextBufferToStream(S, Buffer, Start, Count) @@ -2894,7 +2894,7 @@ end; function TJclUTF8Stream.InternalGetNextBuffer(S: TStream; - var Buffer: TUCS4Array; Start, Count: Integer): Longint; + var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; begin Result := UTF8GetNextBufferFromStream(S, Buffer, Start, Count); end; @@ -2905,7 +2905,7 @@ end; function TJclUTF8Stream.InternalSetNextBuffer(S: TStream; - const Buffer: TUCS4Array; Start, Count: Integer): Longint; + const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; begin Result := UTF8SetNextBufferToStream(S, Buffer, Start, Count); end; @@ -2928,7 +2928,7 @@ end; function TJclUTF16Stream.InternalGetNextBuffer(S: TStream; - var Buffer: TUCS4Array; Start, Count: Integer): Longint; + var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; begin Result := UTF16GetNextBufferFromStream(S, Buffer, Start, Count); end; @@ -2939,7 +2939,7 @@ end; function TJclUTF16Stream.InternalSetNextBuffer(S: TStream; - const Buffer: TUCS4Array; Start, Count: Integer): Longint; + const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; begin Result := UTF16SetNextBufferToStream(S, Buffer, Start, Count); end; @@ -3021,7 +3021,7 @@ end; function TJclAutoStream.InternalGetNextBuffer(S: TStream; - var Buffer: TUCS4Array; Start, Count: Integer): Longint; + var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; begin case FCodePage of CP_UTF8: @@ -3050,7 +3050,7 @@ end; function TJclAutoStream.InternalSetNextBuffer(S: TStream; - const Buffer: TUCS4Array; Start, Count: Integer): Longint; + const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; begin case FCodePage of CP_UTF8: Index: source/common/JclStringLists.pas =================================================================== --- source/common/JclStringLists.pas (revision 3510) +++ source/common/JclStringLists.pas (working copy) @@ -74,7 +74,7 @@ function GetObjects(Index: Integer): TObject; function GetTextStr: string; function GetValue(const Name: string): string; - function Find(const S: string; var Index: Integer): Boolean; +// function Find(const S: string; var Index: Integer): Boolean; function IndexOf(const S: string): Integer; function GetCaseSensitive: Boolean; function GetDuplicates: TDuplicates; @@ -200,7 +200,7 @@ end; type - TJclUpdateControl = class(TObject, IInterface) + TJclUpdateControl = class(TInterfacedObject, IInterface) private FStrings: TStrings; public @@ -211,8 +211,21 @@ function _Release: Integer; stdcall; end; - TJclStringList = class(TStringList, IJclStringList) + TJclInterfacedStringList = class(TStringList, IInterface) private + FOwnerInterface: IInterface; + protected + { IInterface } + function _AddRef: Integer; stdcall; + function _Release: Integer; stdcall; + public + function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; stdcall; + procedure AfterConstruction; override; + end; + + + TJclStringList = class(TJclInterfacedStringList, IJclStringList) + private FObjectsMode: TJclStringListObjectsMode; FSelfAsInterface: IJclStringList; FLastRegExPattern: string; @@ -432,6 +445,45 @@ Result := JclStringList.Add(A); end; +//=== { TJclInterfacedStringList } ============================================== +procedure TJclInterfacedStringList.AfterConstruction; +Var + MyOwner : TPersistent; +begin + inherited; + MyOwner := GetOwner; + if assigned(MyOwner) then + MyOwner.GetInterface(IUnknown,FOwnerInterface); +end; + + +function TJclInterfacedStringList._AddRef: Integer;stdcall; +begin + if assigned(FOwnerInterface) then + Result:=FOwnerInterface._AddRef + else + Result:=-1; +end; + + +function TJclInterfacedStringList._Release: Integer;stdcall; +begin + if assigned(FOwnerInterface) then + Result:=FOwnerInterface._Release + else + Result:=-1; +end; + + +function TJclInterfacedStringList.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult;stdcall; +begin + if GetInterface(IID, Obj) then + Result:=0 + else + Result:=HResult($80004002); +end; + + //=== { TJclStringList } ===================================================== function TJclStringList.Add(const A: array of const): IJclStringList; Index: source/common/JclSysInfo.pas =================================================================== --- source/common/JclSysInfo.pas (revision 3510) +++ source/common/JclSysInfo.pas (working copy) @@ -4285,17 +4285,17 @@ SETNZ Result {$ENDIF CPU32} {$IFDEF CPU64} - // PUSHFQ - PUSHFD + PUSHFQ + //PUSHFD POP RAX MOV RCX, RAX XOR RAX, ID_FLAG AND RCX, ID_FLAG PUSH RAX - // POPFQ - POPFD - // PUSHFQ - PUSHFD + POPFQ + //POPFD + PUSHFQ + //PUSHFD POP RAX AND RAX, ID_FLAG XOR RAX, RCX Index: source/common/JclSysUtils.pas =================================================================== --- source/common/JclSysUtils.pas (revision 3510) +++ source/common/JclSysUtils.pas (working copy) @@ -405,7 +405,7 @@ // interfaced persistent type - TJclInterfacedPersistent = class(TPersistent, IInterface) + TJclInterfacedPersistent = class(TInterfacedPersistent, IInterface) protected FOwnerInterface: IInterface; FRefCount: Integer; @@ -617,7 +617,7 @@ // thread safe support type - TJclIntfCriticalSection = class(TObject, IInterface) + TJclIntfCriticalSection = class(TInterfacedObject, IInterface) private FCriticalSection: TCriticalSection; public Index: source/common/JclUnicode.pas =================================================================== --- source/common/JclUnicode.pas (revision 3510) +++ source/common/JclUnicode.pas (working copy) @@ -2752,7 +2752,7 @@ // Looks for all occurences of the pattern passed to FindPrepare and creates an // internal list of their positions. var - Start, Stop: SizeInt; + Start, Stop, CharCount: SizeInt; Run: PWideChar; RunLen: SizeInt; begin @@ -2765,8 +2765,9 @@ while Find(Run, RunLen, Start, Stop) do begin // store this result (consider text pointer movement)... - AddResult(Start + Run - Text, Stop + Run - Text); // ... and advance text position and length + CharCount := (TJclAddr(Run) - TJclAddr(Text)) div SizeOf(WideChar); + AddResult(Start + CharCount, Stop + CharCount); Inc(Run, Stop); Dec(RunLen, Stop); end; @@ -4723,7 +4724,7 @@ // Looks for all occurences of the pattern passed to FindPrepare and creates an // internal list of their positions. var - Start, Stop: SizeInt; + Start, Stop, CharCount: SizeInt; Run: PWideChar; RunLen: SizeInt; begin @@ -4736,7 +4737,8 @@ while ExecuteURE(0, Run, RunLen, Start, Stop) do begin // store this result (consider text pointer movement)... - AddResult(Start + Run - Text, Stop + Run - Text); + CharCount := (TJclAddr(Run) - TJclAddr(Text)) div SizeOf(WideChar); + AddResult(Start + CharCount, Stop + CharCount); // ... and advance text position and length Inc(Run, Stop); Dec(RunLen, Stop); Index: source/windows/JclHookExcept.pas =================================================================== --- source/windows/JclHookExcept.pas (revision 3510) +++ source/windows/JclHookExcept.pas (working copy) @@ -43,7 +43,7 @@ {$IFDEF UNITVERSIONING} JclUnitVersioning, {$ENDIF UNITVERSIONING} - Windows, SysUtils, Classes; + Windows, SysUtils, Classes, JclBase; type // Exception hooking notifiers routines @@ -96,7 +96,6 @@ implementation uses - JclBase, JclPeImage, JclSysInfo, JclSysUtils; Index: source/windows/JclWin32.pas =================================================================== --- source/windows/JclWin32.pas (revision 3510) +++ source/windows/JclWin32.pas (working copy) @@ -3144,8 +3144,8 @@ function ReBaseImage64(CurrentImageName: PAnsiChar; SymbolPath: PAnsiChar; fReBase: BOOL; fRebaseSysfileOk: BOOL; fGoingDown: BOOL; CheckImageSize: ULONG; - var OldImageSize: TJclAddr; var OldImageBase: TJclAddr64; - var NewImageSize: TJclAddr; var NewImageBase: TJclAddr64; TimeStamp: ULONG): BOOL; stdcall; + var OldImageSize: TJclAddr32; var OldImageBase: TJclAddr64; + var NewImageSize: TJclAddr32; var NewImageBase: TJclAddr64; TimeStamp: ULONG): BOOL; stdcall; {$EXTERNALSYM ReBaseImage64} // line 199 fpc compatible.patch (22,250 bytes)

Cyrus 2011-03-15 05:12 reporter ~0018451	Attached new version of previous patches for Lazarus 0.9.31 r29846 and FPC 2.5.1-r17135.

outchy 2011-03-15 10:39 administrator ~0018453	ok I've deleted these files. I will have a look at your patch later on today.

2011-04-14 17:15	fpc compatible 2.patch (23,037 bytes) Index: packages/fpc/Jcl.lpk =================================================================== --- packages/fpc/Jcl.lpk (revision 3518) +++ packages/fpc/Jcl.lpk (working copy) @@ -7,11 +7,11 @@ <Author Value="Project JEDI"/> <AutoUpdate Value="OnRebuildingAll"/> <CompilerOptions> - <Version Value="8"/> + <Version Value="10"/> <PathDelim Value="\"/> <SearchPaths> - <IncludeFiles Value="..\..\source\include\"/> - <OtherUnitFiles Value=".;..\..\source\common;..\..\source\windows;"/> + <IncludeFiles Value="..\..\source\include;..\..\source\include\jedi"/> + <OtherUnitFiles Value=".;..\..\source\common;..\..\source\windows"/> <UnitOutputDirectory Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <Parsing> @@ -19,6 +19,7 @@ <SyntaxOptions> <SyntaxMode Value="Delphi"/> <CStyleOperator Value="False"/> + <UseAnsiStrings Value="False"/> </SyntaxOptions> </Parsing> <CodeGeneration> @@ -33,12 +34,15 @@ </Debugging> </Linking> <Other> + <CompilerMessages> + <UseMsgFile Value="True"/> + </CompilerMessages> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> <Description Value="JEDI Code Library RTL package"/> <License Value="Copyright (C) 1999, 2011 Project JEDI"/> - <Version Major="2" Minor="3" Release="0" Build="3847"/> + <Version Major="2" Minor="3" Build="3847"/> <Files Count="75"> <Item1> <Filename Value="..\..\source\common\bzip2.pas"/> @@ -347,10 +351,10 @@ </Item1> </RequiredPkgs> <UsageOptions> - <UnitPath Value="$(PkgOutDir)\"/> - <IncludePath Value="..\..\source\include\"/> - <LibraryPath Value="$(PkgOutDir)\"/> - <ObjectPath Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)\"/> + <IncludePath Value="..\..\source\include;..\..\source\include\jedi"/> + <LibraryPath Value="$(PkgOutDir)"/> + <ObjectPath Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> + <UnitPath Value="$(PkgOutDir)"/> </UsageOptions> <PublishOptions> <Version Value="2"/> Index: packages/fpc/JclContainers.lpk =================================================================== --- packages/fpc/JclContainers.lpk (revision 3518) +++ packages/fpc/JclContainers.lpk (working copy) @@ -7,11 +7,11 @@ <Author Value="Project JEDI"/> <AutoUpdate Value="OnRebuildingAll"/> <CompilerOptions> - <Version Value="8"/> + <Version Value="10"/> <PathDelim Value="\"/> <SearchPaths> - <IncludeFiles Value="..\..\source\include\"/> - <OtherUnitFiles Value=".;..\..\source\common;"/> + <IncludeFiles Value="..\..\source\include;..\..\source\include\jedi"/> + <OtherUnitFiles Value=".;..\..\source\common;..\..\source\windows"/> <UnitOutputDirectory Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <Parsing> @@ -19,6 +19,7 @@ <SyntaxOptions> <SyntaxMode Value="Delphi"/> <CStyleOperator Value="False"/> + <UseAnsiStrings Value="False"/> </SyntaxOptions> </Parsing> <CodeGeneration> @@ -33,12 +34,15 @@ </Debugging> </Linking> <Other> + <CompilerMessages> + <UseMsgFile Value="True"/> + </CompilerMessages> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> <Description Value="JEDI Code Library Containers package"/> <License Value="Copyright (C) 1999, 2011 Project JEDI"/> - <Version Major="2" Minor="3" Release="0" Build="3847"/> + <Version Major="2" Minor="3" Build="3847"/> <Files Count="14"> <Item1> <Filename Value="..\..\source\common\JclAbstractContainers.pas"/> @@ -106,10 +110,10 @@ </Item2> </RequiredPkgs> <UsageOptions> - <UnitPath Value="$(PkgOutDir)\"/> - <IncludePath Value="..\..\source\include\"/> - <LibraryPath Value="$(PkgOutDir)\"/> - <ObjectPath Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)\"/> + <IncludePath Value="..\..\source\include;..\..\source\include\jedi"/> + <LibraryPath Value="$(PkgOutDir)"/> + <ObjectPath Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> + <UnitPath Value="$(PkgOutDir)"/> </UsageOptions> <PublishOptions> <Version Value="2"/> Index: source/common/JclAbstractContainers.pas =================================================================== --- source/common/JclAbstractContainers.pas (revision 3518) +++ source/common/JclAbstractContainers.pas (working copy) @@ -697,9 +697,9 @@ procedure AppendToStrings(Strings: TJclWideStrings); procedure AppendFromStrings(Strings: TJclWideStrings); function GetAsStrings: TJclWideStrings; - function GetAsDelimited(const Separator: WideString = WideLineBreak): WideString; - procedure AppendDelimited(const AString: WideString; const Separator: WideString = WideLineBreak); - procedure LoadDelimited(const AString: WideString; const Separator: WideString = WideLineBreak); + function GetAsDelimited(const Separator: WideString {$IFNDEF FPC}= WideLineBreak {$ENDIF}): WideString; + procedure AppendDelimited(const AString: WideString; const Separator: WideString {$IFNDEF FPC}= WideLineBreak {$ENDIF}); + procedure LoadDelimited(const AString: WideString; const Separator: WideString {$IFNDEF FPC}= WideLineBreak {$ENDIF}); end; {$IFDEF SUPPORTS_UNICODE_STRING} Index: source/common/JclAlgorithms.pas =================================================================== --- source/common/JclAlgorithms.pas (revision 3518) +++ source/common/JclAlgorithms.pas (working copy) @@ -828,7 +828,7 @@ // case-sensitive and UTF8-encoded function AnsiStrSimpleHashConvertU(const AString: AnsiString): Integer; var - I: Integer; + I: SizeInt; C, IntegerHash: TIntegerHash; begin IntegerHash.H1 := 0; @@ -852,7 +852,7 @@ // case-insensitive and UTF8-encoded function AnsiStrSimpleHashConvertUI(const AString: AnsiString): Integer; var - I, J: Integer; + I, J: SizeInt; C, IntegerHash: TIntegerHash; CA: TUCS4Array; begin @@ -883,7 +883,7 @@ // default is case-sensitive function WideStrSimpleHashConvert(const AString: WideString): Integer; var - I: Integer; + I: SizeInt; C, IntegerHash: TIntegerHash; begin IntegerHash.H1 := 0; @@ -907,7 +907,7 @@ // case-insensitive function WideStrSimpleHashConvertI(const AString: WideString): Integer; var - I, J: Integer; + I, J: SizeInt; C, IntegerHash: TIntegerHash; CA: TUCS4Array; begin @@ -4111,4 +4111,4 @@ UnregisterUnitVersion(HInstance); {$ENDIF UNITVERSIONING} -end. \ No newline at end of file +end. Index: source/common/JclBase.pas =================================================================== --- source/common/JclBase.pas (revision 3518) +++ source/common/JclBase.pas (working copy) @@ -325,6 +325,7 @@ type HWND = type Windows.HWND; HMODULE = type Windows.HMODULE; + PBoolean = ^Boolean; // In FPC this is defined in base.inc as PBOOLEAN = ^BYTE. {$ENDIF FPC} {$IFDEF SUPPORTS_GENERICS} Index: source/common/JclCompression.pas =================================================================== --- source/common/JclCompression.pas (revision 3518) +++ source/common/JclCompression.pas (working copy) @@ -726,7 +726,7 @@ TJclStreamAccess = (saCreate, saReadOnly, saReadOnlyDenyNone, saWriteOnly, saReadWrite); { TJclCompressionArchive is not ref-counted } - TJclCompressionArchive = class(TObject, IInterface) + TJclCompressionArchive = class(TInterfacedObject, IInterface) private FOnProgress: TJclCompressionProgressEvent; FOnVolume: TJclCompressionVolumeEvent; Index: source/common/JclRTTI.pas =================================================================== --- source/common/JclRTTI.pas (revision 3518) +++ source/common/JclRTTI.pas (working copy) @@ -1878,7 +1878,11 @@ AInstance := GetObjectProp(FInstance, PropInfo); if AInstance <> nil then begin + {$IFNDEF FPC} SubClassTypeInfo := TJclObjClassTypeInfo.Create(PropInfo.PropType^, Prefix, AInstance); + {$ELSE} + SubClassTypeInfo := TJclObjClassTypeInfo.Create(PropInfo.PropType, Prefix, AInstance); + {$ENDIF} Result := SubClassTypeInfo.ObjPropNames[Suffix]; end else @@ -2945,7 +2949,7 @@ end; var - PropCount: Integer; + PropCount: SizeInt; begin PropCount := 0; SetLength(Result, 16); Index: source/common/JclStreams.pas =================================================================== --- source/common/JclStreams.pas (revision 3518) +++ source/common/JclStreams.pas (working copy) @@ -467,9 +467,9 @@ function LoadBuffer: Boolean; function LoadPeekBuffer: Boolean; function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; virtual; abstract; - function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: Longint): Longint; virtual; + function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; virtual; function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; virtual; abstract; - function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: Longint): Longint; virtual; + function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; virtual; procedure InvalidateBuffers; public constructor Create(AStream: TStream; AOwnsStream: Boolean = False); virtual; @@ -513,9 +513,9 @@ FCodePage: Word; protected function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; override; - function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: Longint): Longint; override; + function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; override; - function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: Longint): Longint; override; + function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; public constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override; property CodePage: Word read FCodePage write FCodePage; @@ -524,9 +524,9 @@ TJclUTF8Stream = class(TJclStringStream) protected function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; override; - function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: Longint): Longint; override; + function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; override; - function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: Longint): Longint; override; + function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; public constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override; end; @@ -534,9 +534,9 @@ TJclUTF16Stream = class(TJclStringStream) protected function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; override; - function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: Longint): Longint; override; + function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; override; - function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: Longint): Longint; override; + function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; public constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override; end; @@ -549,9 +549,9 @@ FEncoding: TJclStringEncoding; protected function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; override; - function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: Longint): Longint; override; + function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; override; - function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: Longint): Longint; override; + function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; public constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override; function SkipBOM: LongInt; override; @@ -2362,7 +2362,7 @@ end; function TJclStringStream.InternalGetNextBuffer(S: TStream; - var Buffer: TUCS4Array; Start, Count: Integer): Longint; + var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; var Ch: UCS4; begin @@ -2383,7 +2383,7 @@ end; function TJclStringStream.InternalSetNextBuffer(S: TStream; - const Buffer: TUCS4Array; Start, Count: Integer): Longint; + const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; begin // override to optimize Result := 0; @@ -2848,7 +2848,7 @@ end; function TJclAnsiStream.InternalGetNextBuffer(S: TStream; - var Buffer: TUCS4Array; Start, Count: Integer): Longint; + var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; begin if FCodePage = CP_ACP then Result := AnsiGetNextBufferFromStream(S, Buffer, Start, Count) @@ -2865,7 +2865,7 @@ end; function TJclAnsiStream.InternalSetNextBuffer(S: TStream; - const Buffer: TUCS4Array; Start, Count: Integer): Longint; + const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; begin if FCodePage = CP_ACP then Result := AnsiSetNextBufferToStream(S, Buffer, Start, Count) @@ -2894,7 +2894,7 @@ end; function TJclUTF8Stream.InternalGetNextBuffer(S: TStream; - var Buffer: TUCS4Array; Start, Count: Integer): Longint; + var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; begin Result := UTF8GetNextBufferFromStream(S, Buffer, Start, Count); end; @@ -2905,7 +2905,7 @@ end; function TJclUTF8Stream.InternalSetNextBuffer(S: TStream; - const Buffer: TUCS4Array; Start, Count: Integer): Longint; + const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; begin Result := UTF8SetNextBufferToStream(S, Buffer, Start, Count); end; @@ -2928,7 +2928,7 @@ end; function TJclUTF16Stream.InternalGetNextBuffer(S: TStream; - var Buffer: TUCS4Array; Start, Count: Integer): Longint; + var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; begin Result := UTF16GetNextBufferFromStream(S, Buffer, Start, Count); end; @@ -2939,7 +2939,7 @@ end; function TJclUTF16Stream.InternalSetNextBuffer(S: TStream; - const Buffer: TUCS4Array; Start, Count: Integer): Longint; + const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; begin Result := UTF16SetNextBufferToStream(S, Buffer, Start, Count); end; @@ -3021,7 +3021,7 @@ end; function TJclAutoStream.InternalGetNextBuffer(S: TStream; - var Buffer: TUCS4Array; Start, Count: Integer): Longint; + var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; begin case FCodePage of CP_UTF8: @@ -3050,7 +3050,7 @@ end; function TJclAutoStream.InternalSetNextBuffer(S: TStream; - const Buffer: TUCS4Array; Start, Count: Integer): Longint; + const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; begin case FCodePage of CP_UTF8: Index: source/common/JclStringLists.pas =================================================================== --- source/common/JclStringLists.pas (revision 3518) +++ source/common/JclStringLists.pas (working copy) @@ -74,7 +74,7 @@ function GetObjects(Index: Integer): TObject; function GetTextStr: string; function GetValue(const Name: string): string; - function Find(const S: string; var Index: Integer): Boolean; +// function Find(const S: string; var Index: Integer): Boolean; function IndexOf(const S: string): Integer; function GetCaseSensitive: Boolean; function GetDuplicates: TDuplicates; @@ -200,7 +200,7 @@ end; type - TJclUpdateControl = class(TObject, IInterface) + TJclUpdateControl = class(TInterfacedObject, IInterface) private FStrings: TStrings; public @@ -211,8 +211,21 @@ function _Release: Integer; stdcall; end; - TJclStringList = class(TStringList, IJclStringList) + TJclInterfacedStringList = class(TStringList, IInterface) private + FOwnerInterface: IInterface; + protected + { IInterface } + function _AddRef: Integer; stdcall; + function _Release: Integer; stdcall; + public + function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; stdcall; + procedure AfterConstruction; override; + end; + + + TJclStringList = class(TJclInterfacedStringList, IJclStringList) + private FObjectsMode: TJclStringListObjectsMode; FSelfAsInterface: IJclStringList; FLastRegExPattern: string; @@ -432,6 +445,45 @@ Result := JclStringList.Add(A); end; +//=== { TJclInterfacedStringList } ============================================== +procedure TJclInterfacedStringList.AfterConstruction; +Var + MyOwner : TPersistent; +begin + inherited; + MyOwner := GetOwner; + if assigned(MyOwner) then + MyOwner.GetInterface(IUnknown,FOwnerInterface); +end; + + +function TJclInterfacedStringList._AddRef: Integer;stdcall; +begin + if assigned(FOwnerInterface) then + Result:=FOwnerInterface._AddRef + else + Result:=-1; +end; + + +function TJclInterfacedStringList._Release: Integer;stdcall; +begin + if assigned(FOwnerInterface) then + Result:=FOwnerInterface._Release + else + Result:=-1; +end; + + +function TJclInterfacedStringList.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult;stdcall; +begin + if GetInterface(IID, Obj) then + Result:=0 + else + Result:=HResult($80004002); +end; + + //=== { TJclStringList } ===================================================== function TJclStringList.Add(const A: array of const): IJclStringList; Index: source/common/JclSysInfo.pas =================================================================== --- source/common/JclSysInfo.pas (revision 3518) +++ source/common/JclSysInfo.pas (working copy) @@ -4285,17 +4285,17 @@ SETNZ Result {$ENDIF CPU32} {$IFDEF CPU64} - // PUSHFQ - PUSHFD + PUSHFQ + //PUSHFD POP RAX MOV RCX, RAX XOR RAX, ID_FLAG AND RCX, ID_FLAG PUSH RAX - // POPFQ - POPFD - // PUSHFQ - PUSHFD + POPFQ + //POPFD + PUSHFQ + //PUSHFD POP RAX AND RAX, ID_FLAG XOR RAX, RCX Index: source/common/JclSysUtils.pas =================================================================== --- source/common/JclSysUtils.pas (revision 3518) +++ source/common/JclSysUtils.pas (working copy) @@ -405,7 +405,7 @@ // interfaced persistent type - TJclInterfacedPersistent = class(TPersistent, IInterface) + TJclInterfacedPersistent = class(TInterfacedPersistent, IInterface) protected FOwnerInterface: IInterface; FRefCount: Integer; @@ -630,7 +630,7 @@ // thread safe support type - TJclIntfCriticalSection = class(TObject, IInterface) + TJclIntfCriticalSection = class(TInterfacedObject, IInterface) private FCriticalSection: TCriticalSection; public @@ -789,6 +789,10 @@ {$ENDIF HAS_UNIT_ANSISTRINGS} JclFileUtils, JclMath, JclResources, JclStrings, JclStringConversions, JclSysInfo, Variants; +{$IFDEF FPC} +function CancelIo(hFile: THandle): BOOL; stdcall; external 'kernel32' name 'CancelIo'; +{$ENDIF FPC} + // memory initialization procedure ResetMemory(out P; Size: Longint); begin Index: source/common/JclUnicode.pas =================================================================== --- source/common/JclUnicode.pas (revision 3518) +++ source/common/JclUnicode.pas (working copy) @@ -2752,7 +2752,7 @@ // Looks for all occurences of the pattern passed to FindPrepare and creates an // internal list of their positions. var - Start, Stop: SizeInt; + Start, Stop, CharCount: SizeInt; Run: PWideChar; RunLen: SizeInt; begin @@ -2765,8 +2765,9 @@ while Find(Run, RunLen, Start, Stop) do begin // store this result (consider text pointer movement)... - AddResult(Start + Run - Text, Stop + Run - Text); // ... and advance text position and length + CharCount := (TJclAddr(Run) - TJclAddr(Text)) div SizeOf(WideChar); + AddResult(Start + CharCount, Stop + CharCount); Inc(Run, Stop); Dec(RunLen, Stop); end; @@ -4723,7 +4724,7 @@ // Looks for all occurences of the pattern passed to FindPrepare and creates an // internal list of their positions. var - Start, Stop: SizeInt; + Start, Stop, CharCount: SizeInt; Run: PWideChar; RunLen: SizeInt; begin @@ -4736,7 +4737,8 @@ while ExecuteURE(0, Run, RunLen, Start, Stop) do begin // store this result (consider text pointer movement)... - AddResult(Start + Run - Text, Stop + Run - Text); + CharCount := (TJclAddr(Run) - TJclAddr(Text)) div SizeOf(WideChar); + AddResult(Start + CharCount, Stop + CharCount); // ... and advance text position and length Inc(Run, Stop); Dec(RunLen, Stop); Index: source/windows/JclHookExcept.pas =================================================================== --- source/windows/JclHookExcept.pas (revision 3518) +++ source/windows/JclHookExcept.pas (working copy) @@ -43,7 +43,7 @@ {$IFDEF UNITVERSIONING} JclUnitVersioning, {$ENDIF UNITVERSIONING} - Windows, SysUtils, Classes; + Windows, SysUtils, Classes, JclBase; type // Exception hooking notifiers routines @@ -96,7 +96,6 @@ implementation uses - JclBase, JclPeImage, JclSysInfo, JclSysUtils; Index: source/windows/JclWin32.pas =================================================================== --- source/windows/JclWin32.pas (revision 3518) +++ source/windows/JclWin32.pas (working copy) @@ -3144,8 +3144,8 @@ function ReBaseImage64(CurrentImageName: PAnsiChar; SymbolPath: PAnsiChar; fReBase: BOOL; fRebaseSysfileOk: BOOL; fGoingDown: BOOL; CheckImageSize: ULONG; - var OldImageSize: TJclAddr; var OldImageBase: TJclAddr64; - var NewImageSize: TJclAddr; var NewImageBase: TJclAddr64; TimeStamp: ULONG): BOOL; stdcall; + var OldImageSize: TJclAddr32; var OldImageBase: TJclAddr64; + var NewImageSize: TJclAddr32; var NewImageBase: TJclAddr64; TimeStamp: ULONG): BOOL; stdcall; {$EXTERNALSYM ReBaseImage64} // line 199 fpc compatible 2.patch (23,037 bytes)

Cyrus 2011-04-14 17:17 reporter ~0018519	Another new version of patch uploaded for Lazarus 0.9.31 r30288 and FPC 2.5.1-r17315.

2011-07-30 15:15	jedi svn 3561 fpc compatible.patch (24,489 bytes) Index: packages/fpc/Jcl.lpk =================================================================== --- packages/fpc/Jcl.lpk (revision 3561) +++ packages/fpc/Jcl.lpk (working copy) @@ -7,11 +7,11 @@ <Author Value="Project JEDI"/> <AutoUpdate Value="OnRebuildingAll"/> <CompilerOptions> - <Version Value="8"/> + <Version Value="10"/> <PathDelim Value="\"/> <SearchPaths> - <IncludeFiles Value="..\..\source\include\"/> - <OtherUnitFiles Value=".;..\..\source\common;..\..\source\windows;"/> + <IncludeFiles Value="..\..\source\include;..\..\source\include\jedi"/> + <OtherUnitFiles Value=".;..\..\source\common;..\..\source\windows"/> <UnitOutputDirectory Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <Parsing> @@ -19,12 +19,13 @@ <SyntaxOptions> <SyntaxMode Value="Delphi"/> <CStyleOperator Value="False"/> + <UseAnsiStrings Value="False"/> </SyntaxOptions> </Parsing> <CodeGeneration> <Optimizations> <VariablesInRegisters Value="True"/> - <OptimizationLevel Value="3"/> + <OptimizationLevel Value="0"/> </Optimizations> </CodeGeneration> <Linking> @@ -33,12 +34,16 @@ </Debugging> </Linking> <Other> + <CompilerMessages> + <UseMsgFile Value="True"/> + </CompilerMessages> + <CustomOptions Value="-Ur"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> <Description Value="JEDI Code Library RTL package"/> <License Value="Copyright (C) 1999, 2011 Project JEDI"/> - <Version Major="2" Minor="3" Release="0" Build="3847"/> + <Version Major="2" Minor="3" Build="3847"/> <Files Count="76"> <Item1> <Filename Value="..\..\source\common\bzip2.pas"/> @@ -351,10 +356,10 @@ </Item1> </RequiredPkgs> <UsageOptions> - <UnitPath Value="$(PkgOutDir)\"/> - <IncludePath Value="..\..\source\include\"/> - <LibraryPath Value="$(PkgOutDir)\"/> - <ObjectPath Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)\"/> + <IncludePath Value="..\..\source\include;..\..\source\include\jedi"/> + <LibraryPath Value="$(PkgOutDir)"/> + <ObjectPath Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> + <UnitPath Value="$(PkgOutDir)"/> </UsageOptions> <PublishOptions> <Version Value="2"/> Index: packages/fpc/JclContainers.lpk =================================================================== --- packages/fpc/JclContainers.lpk (revision 3561) +++ packages/fpc/JclContainers.lpk (working copy) @@ -7,11 +7,11 @@ <Author Value="Project JEDI"/> <AutoUpdate Value="OnRebuildingAll"/> <CompilerOptions> - <Version Value="8"/> + <Version Value="10"/> <PathDelim Value="\"/> <SearchPaths> - <IncludeFiles Value="..\..\source\include\"/> - <OtherUnitFiles Value=".;..\..\source\common;"/> + <IncludeFiles Value="..\..\source\include;..\..\source\include\jedi"/> + <OtherUnitFiles Value=".;..\..\source\common;..\..\source\windows"/> <UnitOutputDirectory Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <Parsing> @@ -19,6 +19,7 @@ <SyntaxOptions> <SyntaxMode Value="Delphi"/> <CStyleOperator Value="False"/> + <UseAnsiStrings Value="False"/> </SyntaxOptions> </Parsing> <CodeGeneration> @@ -33,12 +34,16 @@ </Debugging> </Linking> <Other> + <CompilerMessages> + <UseMsgFile Value="True"/> + </CompilerMessages> + <CustomOptions Value="-Ur"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> <Description Value="JEDI Code Library Containers package"/> <License Value="Copyright (C) 1999, 2011 Project JEDI"/> - <Version Major="2" Minor="3" Release="0" Build="3847"/> + <Version Major="2" Minor="3" Build="3847"/> <Files Count="14"> <Item1> <Filename Value="..\..\source\common\JclAbstractContainers.pas"/> @@ -106,10 +111,10 @@ </Item2> </RequiredPkgs> <UsageOptions> - <UnitPath Value="$(PkgOutDir)\"/> - <IncludePath Value="..\..\source\include\"/> - <LibraryPath Value="$(PkgOutDir)\"/> - <ObjectPath Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)\"/> + <IncludePath Value="..\..\source\include;..\..\source\include\jedi"/> + <LibraryPath Value="$(PkgOutDir)"/> + <ObjectPath Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> + <UnitPath Value="$(PkgOutDir)"/> </UsageOptions> <PublishOptions> <Version Value="2"/> Index: source/common/JclCompression.pas =================================================================== --- source/common/JclCompression.pas (revision 3561) +++ source/common/JclCompression.pas (working copy) @@ -727,7 +727,7 @@ TJclStreamAccess = (saCreate, saReadOnly, saReadOnlyDenyNone, saWriteOnly, saReadWrite); { TJclCompressionArchive is not ref-counted } - TJclCompressionArchive = class(TObject, IInterface) + TJclCompressionArchive = class(TInterfacedObject, IInterface) private FOnProgress: TJclCompressionProgressEvent; FOnRatio: TJclCompressionRatioEvent; Index: source/common/JclRTTI.pas =================================================================== --- source/common/JclRTTI.pas (revision 3561) +++ source/common/JclRTTI.pas (working copy) @@ -1878,7 +1878,11 @@ AInstance := GetObjectProp(FInstance, PropInfo); if AInstance <> nil then begin + {$IFNDEF FPC} SubClassTypeInfo := TJclObjClassTypeInfo.Create(PropInfo.PropType^, Prefix, AInstance); + {$ELSE} + SubClassTypeInfo := TJclObjClassTypeInfo.Create(PropInfo.PropType, Prefix, AInstance); + {$ENDIF} Result := SubClassTypeInfo.ObjPropNames[Suffix]; end else @@ -2945,7 +2949,7 @@ end; var - PropCount: Integer; + PropCount: SizeInt; begin PropCount := 0; SetLength(Result, 16); Index: source/common/JclStreams.pas =================================================================== --- source/common/JclStreams.pas (revision 3561) +++ source/common/JclStreams.pas (working copy) @@ -467,9 +467,9 @@ function LoadBuffer: Boolean; function LoadPeekBuffer: Boolean; function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; virtual; abstract; - function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: Longint): Longint; virtual; + function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; virtual; function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; virtual; abstract; - function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: Longint): Longint; virtual; + function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; virtual; procedure InvalidateBuffers; public constructor Create(AStream: TStream; AOwnsStream: Boolean = False); virtual; @@ -513,9 +513,9 @@ FCodePage: Word; protected function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; override; - function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: Longint): Longint; override; + function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; override; - function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: Longint): Longint; override; + function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; public constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override; property CodePage: Word read FCodePage write FCodePage; @@ -524,9 +524,9 @@ TJclUTF8Stream = class(TJclStringStream) protected function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; override; - function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: Longint): Longint; override; + function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; override; - function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: Longint): Longint; override; + function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; public constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override; end; @@ -534,9 +534,9 @@ TJclUTF16Stream = class(TJclStringStream) protected function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; override; - function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: Longint): Longint; override; + function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; override; - function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: Longint): Longint; override; + function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; public constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override; end; @@ -549,9 +549,9 @@ FEncoding: TJclStringEncoding; protected function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; override; - function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: Longint): Longint; override; + function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; override; - function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: Longint): Longint; override; + function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; public constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override; function SkipBOM: LongInt; override; @@ -2362,7 +2362,7 @@ end; function TJclStringStream.InternalGetNextBuffer(S: TStream; - var Buffer: TUCS4Array; Start, Count: Integer): Longint; + var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; var Ch: UCS4; begin @@ -2383,7 +2383,7 @@ end; function TJclStringStream.InternalSetNextBuffer(S: TStream; - const Buffer: TUCS4Array; Start, Count: Integer): Longint; + const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; begin // override to optimize Result := 0; @@ -2848,7 +2848,7 @@ end; function TJclAnsiStream.InternalGetNextBuffer(S: TStream; - var Buffer: TUCS4Array; Start, Count: Integer): Longint; + var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; begin if FCodePage = CP_ACP then Result := AnsiGetNextBufferFromStream(S, Buffer, Start, Count) @@ -2865,7 +2865,7 @@ end; function TJclAnsiStream.InternalSetNextBuffer(S: TStream; - const Buffer: TUCS4Array; Start, Count: Integer): Longint; + const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; begin if FCodePage = CP_ACP then Result := AnsiSetNextBufferToStream(S, Buffer, Start, Count) @@ -2894,7 +2894,7 @@ end; function TJclUTF8Stream.InternalGetNextBuffer(S: TStream; - var Buffer: TUCS4Array; Start, Count: Integer): Longint; + var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; begin Result := UTF8GetNextBufferFromStream(S, Buffer, Start, Count); end; @@ -2905,7 +2905,7 @@ end; function TJclUTF8Stream.InternalSetNextBuffer(S: TStream; - const Buffer: TUCS4Array; Start, Count: Integer): Longint; + const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; begin Result := UTF8SetNextBufferToStream(S, Buffer, Start, Count); end; @@ -2928,7 +2928,7 @@ end; function TJclUTF16Stream.InternalGetNextBuffer(S: TStream; - var Buffer: TUCS4Array; Start, Count: Integer): Longint; + var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; begin Result := UTF16GetNextBufferFromStream(S, Buffer, Start, Count); end; @@ -2939,7 +2939,7 @@ end; function TJclUTF16Stream.InternalSetNextBuffer(S: TStream; - const Buffer: TUCS4Array; Start, Count: Integer): Longint; + const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; begin Result := UTF16SetNextBufferToStream(S, Buffer, Start, Count); end; @@ -3021,7 +3021,7 @@ end; function TJclAutoStream.InternalGetNextBuffer(S: TStream; - var Buffer: TUCS4Array; Start, Count: Integer): Longint; + var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; begin case FCodePage of CP_UTF8: @@ -3050,7 +3050,7 @@ end; function TJclAutoStream.InternalSetNextBuffer(S: TStream; - const Buffer: TUCS4Array; Start, Count: Integer): Longint; + const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; begin case FCodePage of CP_UTF8: Index: source/common/JclStringLists.pas =================================================================== --- source/common/JclStringLists.pas (revision 3561) +++ source/common/JclStringLists.pas (working copy) @@ -74,7 +74,9 @@ function GetObjects(Index: Integer): TObject; function GetTextStr: string; function GetValue(const Name: string): string; + {$IFNDEF FPC} function Find(const S: string; var Index: Integer): Boolean; + {$ENDIF FPC} function IndexOf(const S: string): Integer; function GetCaseSensitive: Boolean; function GetDuplicates: TDuplicates; @@ -200,7 +202,7 @@ end; type - TJclUpdateControl = class(TObject, IInterface) + TJclUpdateControl = class(TInterfacedObject, IInterface) private FStrings: TStrings; public @@ -211,8 +213,20 @@ function _Release: Integer; stdcall; end; - TJclStringList = class(TStringList, IJclStringList) + TJclInterfacedStringList = class(TStringList, IInterface) private + FOwnerInterface: IInterface; + protected + { IInterface } + function _AddRef: Integer; stdcall; + function _Release: Integer; stdcall; + public + function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; stdcall; + procedure AfterConstruction; override; + end; + + TJclStringList = class(TJclInterfacedStringList, IJclStringList) + private FObjectsMode: TJclStringListObjectsMode; FSelfAsInterface: IJclStringList; FLastRegExPattern: string; @@ -432,6 +446,45 @@ Result := JclStringList.Add(A); end; +//=== { TJclInterfacedStringList } ============================================== + +procedure TJclInterfacedStringList.AfterConstruction; +Var + MyOwner : TPersistent; +begin + inherited; + MyOwner := GetOwner; + if assigned(MyOwner) then + MyOwner.GetInterface(IUnknown,FOwnerInterface); +end; + + +function TJclInterfacedStringList._AddRef: Integer;stdcall; +begin + if assigned(FOwnerInterface) then + Result:=FOwnerInterface._AddRef + else + Result:=-1; +end; + + +function TJclInterfacedStringList._Release: Integer;stdcall; +begin + if assigned(FOwnerInterface) then + Result:=FOwnerInterface._Release + else + Result:=-1; +end; + + +function TJclInterfacedStringList.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult;stdcall; +begin + if GetInterface(IID, Obj) then + Result:=0 + else + Result:=HResult($80004002); +end; + //=== { TJclStringList } ===================================================== function TJclStringList.Add(const A: array of const): IJclStringList; Index: source/common/JclSysInfo.pas =================================================================== --- source/common/JclSysInfo.pas (revision 3561) +++ source/common/JclSysInfo.pas (working copy) @@ -4286,17 +4286,17 @@ SETNZ Result {$ENDIF CPU32} {$IFDEF CPU64} - // PUSHFQ - PUSHFD + PUSHFQ + //PUSHFD POP RAX MOV RCX, RAX XOR RAX, ID_FLAG AND RCX, ID_FLAG PUSH RAX - // POPFQ - POPFD - // PUSHFQ - PUSHFD + POPFQ + //POPFD + PUSHFQ + //PUSHFD POP RAX AND RAX, ID_FLAG XOR RAX, RCX Index: source/common/JclSysUtils.pas =================================================================== --- source/common/JclSysUtils.pas (revision 3561) +++ source/common/JclSysUtils.pas (working copy) @@ -405,7 +405,7 @@ // interfaced persistent type - TJclInterfacedPersistent = class(TPersistent, IInterface) + TJclInterfacedPersistent = class(TInterfacedPersistent, IInterface) protected FOwnerInterface: IInterface; FRefCount: Integer; @@ -630,7 +630,7 @@ // thread safe support type - TJclIntfCriticalSection = class(TObject, IInterface) + TJclIntfCriticalSection = class(TInterfacedObject, IInterface) private FCriticalSection: TCriticalSection; public @@ -789,6 +789,10 @@ {$ENDIF HAS_UNIT_ANSISTRINGS} JclFileUtils, JclMath, JclResources, JclStrings, JclStringConversions, JclSysInfo, Variants; +{$IFDEF FPC} +function CancelIo(hFile: THandle): BOOL; stdcall; external 'kernel32' name 'CancelIo'; +{$ENDIF FPC} + // memory initialization procedure ResetMemory(out P; Size: Longint); begin @@ -2832,7 +2836,11 @@ end; InternalAbort := False; if AbortPtr <> nil then + {$IFDEF FPC} + AbortPtr^ := Byte(False) + {$ELSE} AbortPtr^ := False + {$ENDIF FPC} else AbortPtr := @InternalAbort; // init the array of events to wait for @@ -2874,7 +2882,11 @@ InternalExecuteReadPipe(ErrorPipeInfo, ErrorOverlapped); end; // event based loop + {$IFDEF FPC} + while not Boolean(AbortPtr^) do + {$ELSE} while not AbortPtr^ do + {$ENDIF} begin Index := WaitAlertableForMultipleObjects(WaitEvents, False, INFINITE); if Index = WAIT_OBJECT_0 then @@ -2904,7 +2916,11 @@ if ((Index = (WAIT_OBJECT_0 + 2)) and MergeError) or ((Index = (WAIT_OBJECT_0 + 3)) and not MergeError) then // event on abort + {$IFDEF FPC} + AbortPtr^ := Byte(True) + {$ELSE} AbortPtr^ := True + {$ENDIF FPC} else {$IFDEF DELPHI11_UP} RaiseLastOSError(Index); @@ -2912,7 +2928,11 @@ RaiseLastOSError; {$ENDIF DELPHI11_UP} end; + {$IFDEF FPC} + if Boolean(AbortPtr^) then + {$ELSE} if AbortPtr^ then + {$ENDIF FPC} TerminateProcess(ProcessEvent.Handle, Cardinal(ABORT_EXIT_CODE)); if (ProcessEvent.WaitForever = wrSignaled) and not GetExitCodeProcess(ProcessEvent.Handle, Result) then Result := $FFFFFFFF; @@ -2971,6 +2991,7 @@ pclose(Pipe); wait(nil); end; +end; {$ENDIF UNIX} if OutPipeInfo.Line <> '' then if Assigned(OutPipeInfo.TextHandler) then Index: source/common/JclUnicode.pas =================================================================== --- source/common/JclUnicode.pas (revision 3561) +++ source/common/JclUnicode.pas (working copy) @@ -2752,7 +2752,7 @@ // Looks for all occurences of the pattern passed to FindPrepare and creates an // internal list of their positions. var - Start, Stop: SizeInt; + Start, Stop, CharCount: SizeInt; Run: PWideChar; RunLen: SizeInt; begin @@ -2765,7 +2765,8 @@ while Find(Run, RunLen, Start, Stop) do begin // store this result (consider text pointer movement)... - AddResult(Start + Run - Text, Stop + Run - Text); + CharCount := (TJclAddr(Run) - TJclAddr(Text)) div SizeOf(WideChar); + AddResult(Start + CharCount, Stop + CharCount); // ... and advance text position and length Inc(Run, Stop); Dec(RunLen, Stop); @@ -4723,7 +4724,7 @@ // Looks for all occurences of the pattern passed to FindPrepare and creates an // internal list of their positions. var - Start, Stop: SizeInt; + Start, Stop, CharCount: SizeInt; Run: PWideChar; RunLen: SizeInt; begin @@ -4736,7 +4737,8 @@ while ExecuteURE(0, Run, RunLen, Start, Stop) do begin // store this result (consider text pointer movement)... - AddResult(Start + Run - Text, Stop + Run - Text); + CharCount := (TJclAddr(Run) - TJclAddr(Text)) div SizeOf(WideChar); + AddResult(Start + CharCount, Stop + CharCount); // ... and advance text position and length Inc(Run, Stop); Dec(RunLen, Stop); Index: source/windows/JclCppException.pas =================================================================== --- source/windows/JclCppException.pas (revision 3561) +++ source/windows/JclCppException.pas (working copy) @@ -151,7 +151,7 @@ implementation uses - JclResources, JclHookExcept; + JclResources, JclHookExcept, Windows; type @@ -589,8 +589,8 @@ { The exception object is a std::exception subclass and implements the virtual member function what(). } ExcObjectVTbl := Pointer(PCardinal (ExcObject)^); - WhatMethod := TCppTypeInfoWhatMethod(PCardinal ( - Cardinal (ExcObjectVTbl) + SizeOf (Pointer))^); + WhatMethod := TCppTypeInfoWhatMethod(Pointer(PCardinal ( + Cardinal (ExcObjectVTbl) + SizeOf (Pointer))^)); Result := EJclCppStdException.Create(ExcObject, String(WhatMethod(ExcObject)), PAnsiChar(ExcTypeName), Pointer(ExcDesc)); end @@ -611,14 +611,20 @@ 'Cannot install C++ exception filter: call JclHookExcept.JclHookExceptions() first!'); if HookInstalled then Exit; + {$IFDEF BORLAND} HookInstalled := JclHookExcept.JclAddExceptFilter(@CppExceptObjProc, npFirstChain); + {$ELSE} + HookInstalled := False; + {$ENDIF BORLAND} end; procedure JclUninstallCppExceptionFilter; begin if not HookInstalled then Exit; + {$IFDEF BORLAND} JclHookExcept.JclRemoveExceptFilter(@CppExceptObjProc); + {$ENDIF BORLAND} HookInstalled := False; end; Index: source/windows/JclHookExcept.pas =================================================================== --- source/windows/JclHookExcept.pas (revision 3561) +++ source/windows/JclHookExcept.pas (working copy) @@ -43,7 +43,7 @@ {$IFDEF UNITVERSIONING} JclUnitVersioning, {$ENDIF UNITVERSIONING} - Windows, SysUtils, Classes; + Windows, SysUtils, Classes, JclBase; type // Exception hooking notifiers routines @@ -105,7 +105,6 @@ implementation uses - JclBase, JclPeImage, JclSysInfo, JclSysUtils; @@ -566,6 +565,7 @@ end; function GetCppRtlBase: Pointer; +{$IFDEF BORLAND} const {$IFDEF COMPILER6} { Delphi/C++Builder 6 } CppRtlVersion = 60; @@ -586,11 +586,22 @@ in this case TJclPeMapImgHooks.ReplaceImport() is a no-op. The base module is also being hooked separately, so we're covered. } end; +{$ELSE} +begin + Result := NIL; +end; +{$ENDIF BORLAND} function HasCppRtl: Boolean; +{$IFDEF BORLAND} begin Result := GetCppRtlBase <> TJclPeMapImgHooks.SystemBase; end; +{$ELSE} +begin + Result := False; +end; +{$ENDIF BORLAND} function JclHookExceptions: Boolean; var Index: source/windows/JclWin32.pas =================================================================== --- source/windows/JclWin32.pas (revision 3561) +++ source/windows/JclWin32.pas (working copy) @@ -66,8 +66,8 @@ Windows, SysUtils, {$IFNDEF FPC} AccCtrl, + {$ENDIF ~FPC} ActiveX, - {$ENDIF ~FPC} JclBase; {$HPPEMIT '#include <WinDef.h>'} @@ -3144,8 +3144,8 @@ function ReBaseImage64(CurrentImageName: PAnsiChar; SymbolPath: PAnsiChar; fReBase: BOOL; fRebaseSysfileOk: BOOL; fGoingDown: BOOL; CheckImageSize: ULONG; - var OldImageSize: TJclAddr; var OldImageBase: TJclAddr64; - var NewImageSize: TJclAddr; var NewImageBase: TJclAddr64; TimeStamp: ULONG): BOOL; stdcall; + var OldImageSize: TJclAddr32; var OldImageBase: TJclAddr64; + var NewImageSize: TJclAddr32; var NewImageBase: TJclAddr64; TimeStamp: ULONG): BOOL; stdcall; {$EXTERNALSYM ReBaseImage64} // line 199 jedi svn 3561 fpc compatible.patch (24,489 bytes)

Cyrus 2011-07-30 15:17 reporter ~0018841	And another one (jedi svn 3561 fpc compatible.patch) for Lazarus 0.9.31 r31827 and FPC 2.5.1 r18036.

2011-07-31 13:50	jedi svn 3561 fpc compatible 2.patch (26,851 bytes) Index: packages/fpc/Jcl.lpk =================================================================== --- packages/fpc/Jcl.lpk (revision 3561) +++ packages/fpc/Jcl.lpk (working copy) @@ -7,11 +7,11 @@ <Author Value="Project JEDI"/> <AutoUpdate Value="OnRebuildingAll"/> <CompilerOptions> - <Version Value="8"/> + <Version Value="10"/> <PathDelim Value="\"/> <SearchPaths> - <IncludeFiles Value="..\..\source\include\"/> - <OtherUnitFiles Value=".;..\..\source\common;..\..\source\windows;"/> + <IncludeFiles Value="..\..\source\include;..\..\source\include\jedi"/> + <OtherUnitFiles Value=".;..\..\source\common;..\..\source\windows"/> <UnitOutputDirectory Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <Parsing> @@ -19,12 +19,13 @@ <SyntaxOptions> <SyntaxMode Value="Delphi"/> <CStyleOperator Value="False"/> + <UseAnsiStrings Value="False"/> </SyntaxOptions> </Parsing> <CodeGeneration> <Optimizations> <VariablesInRegisters Value="True"/> - <OptimizationLevel Value="3"/> + <OptimizationLevel Value="0"/> </Optimizations> </CodeGeneration> <Linking> @@ -33,12 +34,16 @@ </Debugging> </Linking> <Other> + <CompilerMessages> + <UseMsgFile Value="True"/> + </CompilerMessages> + <CustomOptions Value="-Ur"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> <Description Value="JEDI Code Library RTL package"/> <License Value="Copyright (C) 1999, 2011 Project JEDI"/> - <Version Major="2" Minor="3" Release="0" Build="3847"/> + <Version Major="2" Minor="3" Build="3847"/> <Files Count="76"> <Item1> <Filename Value="..\..\source\common\bzip2.pas"/> @@ -351,10 +356,10 @@ </Item1> </RequiredPkgs> <UsageOptions> - <UnitPath Value="$(PkgOutDir)\"/> - <IncludePath Value="..\..\source\include\"/> - <LibraryPath Value="$(PkgOutDir)\"/> - <ObjectPath Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)\"/> + <IncludePath Value="..\..\source\include;..\..\source\include\jedi"/> + <LibraryPath Value="$(PkgOutDir)"/> + <ObjectPath Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> + <UnitPath Value="$(PkgOutDir)"/> </UsageOptions> <PublishOptions> <Version Value="2"/> Index: packages/fpc/JclContainers.lpk =================================================================== --- packages/fpc/JclContainers.lpk (revision 3561) +++ packages/fpc/JclContainers.lpk (working copy) @@ -7,11 +7,11 @@ <Author Value="Project JEDI"/> <AutoUpdate Value="OnRebuildingAll"/> <CompilerOptions> - <Version Value="8"/> + <Version Value="10"/> <PathDelim Value="\"/> <SearchPaths> - <IncludeFiles Value="..\..\source\include\"/> - <OtherUnitFiles Value=".;..\..\source\common;"/> + <IncludeFiles Value="..\..\source\include;..\..\source\include\jedi"/> + <OtherUnitFiles Value=".;..\..\source\common;..\..\source\windows"/> <UnitOutputDirectory Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <Parsing> @@ -19,6 +19,7 @@ <SyntaxOptions> <SyntaxMode Value="Delphi"/> <CStyleOperator Value="False"/> + <UseAnsiStrings Value="False"/> </SyntaxOptions> </Parsing> <CodeGeneration> @@ -33,12 +34,16 @@ </Debugging> </Linking> <Other> + <CompilerMessages> + <UseMsgFile Value="True"/> + </CompilerMessages> + <CustomOptions Value="-Ur"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> <Description Value="JEDI Code Library Containers package"/> <License Value="Copyright (C) 1999, 2011 Project JEDI"/> - <Version Major="2" Minor="3" Release="0" Build="3847"/> + <Version Major="2" Minor="3" Build="3847"/> <Files Count="14"> <Item1> <Filename Value="..\..\source\common\JclAbstractContainers.pas"/> @@ -106,10 +111,10 @@ </Item2> </RequiredPkgs> <UsageOptions> - <UnitPath Value="$(PkgOutDir)\"/> - <IncludePath Value="..\..\source\include\"/> - <LibraryPath Value="$(PkgOutDir)\"/> - <ObjectPath Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)\"/> + <IncludePath Value="..\..\source\include;..\..\source\include\jedi"/> + <LibraryPath Value="$(PkgOutDir)"/> + <ObjectPath Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> + <UnitPath Value="$(PkgOutDir)"/> </UsageOptions> <PublishOptions> <Version Value="2"/> Index: source/common/JclAbstractContainers.pas =================================================================== --- source/common/JclAbstractContainers.pas (revision 3561) +++ source/common/JclAbstractContainers.pas (working copy) @@ -697,9 +697,9 @@ procedure AppendToStrings(Strings: TJclWideStrings); procedure AppendFromStrings(Strings: TJclWideStrings); function GetAsStrings: TJclWideStrings; - function GetAsDelimited(const Separator: WideString = WideLineBreak): WideString; - procedure AppendDelimited(const AString: WideString; const Separator: WideString = WideLineBreak); - procedure LoadDelimited(const AString: WideString; const Separator: WideString = WideLineBreak); + function GetAsDelimited(const Separator: WideString {$IFNDEF FPC}= WideLineBreak {$ENDIF}): WideString; + procedure AppendDelimited(const AString: WideString; const Separator: WideString {$IFNDEF FPC}= WideLineBreak {$ENDIF}); + procedure LoadDelimited(const AString: WideString; const Separator: WideString {$IFNDEF FPC}= WideLineBreak {$ENDIF}); end; {$IFDEF SUPPORTS_UNICODE_STRING} Index: source/common/JclAlgorithms.pas =================================================================== --- source/common/JclAlgorithms.pas (revision 3561) +++ source/common/JclAlgorithms.pas (working copy) @@ -828,7 +828,7 @@ // case-sensitive and UTF8-encoded function AnsiStrSimpleHashConvertU(const AString: AnsiString): Integer; var - I: Integer; + I: SizeInt; C, IntegerHash: TIntegerHash; begin IntegerHash.H1 := 0; @@ -852,7 +852,7 @@ // case-insensitive and UTF8-encoded function AnsiStrSimpleHashConvertUI(const AString: AnsiString): Integer; var - I, J: Integer; + I, J: SizeInt; C, IntegerHash: TIntegerHash; CA: TUCS4Array; begin @@ -883,7 +883,7 @@ // default is case-sensitive function WideStrSimpleHashConvert(const AString: WideString): Integer; var - I: Integer; + I: SizeInt; C, IntegerHash: TIntegerHash; begin IntegerHash.H1 := 0; @@ -907,7 +907,7 @@ // case-insensitive function WideStrSimpleHashConvertI(const AString: WideString): Integer; var - I, J: Integer; + I, J: SizeInt; C, IntegerHash: TIntegerHash; CA: TUCS4Array; begin @@ -4111,4 +4111,4 @@ UnregisterUnitVersion(HInstance); {$ENDIF UNITVERSIONING} -end. \ No newline at end of file +end. Index: source/common/JclCompression.pas =================================================================== --- source/common/JclCompression.pas (revision 3561) +++ source/common/JclCompression.pas (working copy) @@ -727,7 +727,7 @@ TJclStreamAccess = (saCreate, saReadOnly, saReadOnlyDenyNone, saWriteOnly, saReadWrite); { TJclCompressionArchive is not ref-counted } - TJclCompressionArchive = class(TObject, IInterface) + TJclCompressionArchive = class(TInterfacedObject, IInterface) private FOnProgress: TJclCompressionProgressEvent; FOnRatio: TJclCompressionRatioEvent; Index: source/common/JclRTTI.pas =================================================================== --- source/common/JclRTTI.pas (revision 3561) +++ source/common/JclRTTI.pas (working copy) @@ -1878,7 +1878,11 @@ AInstance := GetObjectProp(FInstance, PropInfo); if AInstance <> nil then begin + {$IFNDEF FPC} SubClassTypeInfo := TJclObjClassTypeInfo.Create(PropInfo.PropType^, Prefix, AInstance); + {$ELSE} + SubClassTypeInfo := TJclObjClassTypeInfo.Create(PropInfo.PropType, Prefix, AInstance); + {$ENDIF} Result := SubClassTypeInfo.ObjPropNames[Suffix]; end else @@ -2945,7 +2949,7 @@ end; var - PropCount: Integer; + PropCount: SizeInt; begin PropCount := 0; SetLength(Result, 16); Index: source/common/JclStreams.pas =================================================================== --- source/common/JclStreams.pas (revision 3561) +++ source/common/JclStreams.pas (working copy) @@ -467,9 +467,9 @@ function LoadBuffer: Boolean; function LoadPeekBuffer: Boolean; function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; virtual; abstract; - function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: Longint): Longint; virtual; + function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; virtual; function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; virtual; abstract; - function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: Longint): Longint; virtual; + function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; virtual; procedure InvalidateBuffers; public constructor Create(AStream: TStream; AOwnsStream: Boolean = False); virtual; @@ -513,9 +513,9 @@ FCodePage: Word; protected function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; override; - function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: Longint): Longint; override; + function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; override; - function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: Longint): Longint; override; + function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; public constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override; property CodePage: Word read FCodePage write FCodePage; @@ -524,9 +524,9 @@ TJclUTF8Stream = class(TJclStringStream) protected function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; override; - function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: Longint): Longint; override; + function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; override; - function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: Longint): Longint; override; + function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; public constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override; end; @@ -534,9 +534,9 @@ TJclUTF16Stream = class(TJclStringStream) protected function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; override; - function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: Longint): Longint; override; + function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; override; - function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: Longint): Longint; override; + function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; public constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override; end; @@ -549,9 +549,9 @@ FEncoding: TJclStringEncoding; protected function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; override; - function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: Longint): Longint; override; + function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; override; - function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: Longint): Longint; override; + function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; public constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override; function SkipBOM: LongInt; override; @@ -2362,7 +2362,7 @@ end; function TJclStringStream.InternalGetNextBuffer(S: TStream; - var Buffer: TUCS4Array; Start, Count: Integer): Longint; + var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; var Ch: UCS4; begin @@ -2383,7 +2383,7 @@ end; function TJclStringStream.InternalSetNextBuffer(S: TStream; - const Buffer: TUCS4Array; Start, Count: Integer): Longint; + const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; begin // override to optimize Result := 0; @@ -2848,7 +2848,7 @@ end; function TJclAnsiStream.InternalGetNextBuffer(S: TStream; - var Buffer: TUCS4Array; Start, Count: Integer): Longint; + var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; begin if FCodePage = CP_ACP then Result := AnsiGetNextBufferFromStream(S, Buffer, Start, Count) @@ -2865,7 +2865,7 @@ end; function TJclAnsiStream.InternalSetNextBuffer(S: TStream; - const Buffer: TUCS4Array; Start, Count: Integer): Longint; + const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; begin if FCodePage = CP_ACP then Result := AnsiSetNextBufferToStream(S, Buffer, Start, Count) @@ -2894,7 +2894,7 @@ end; function TJclUTF8Stream.InternalGetNextBuffer(S: TStream; - var Buffer: TUCS4Array; Start, Count: Integer): Longint; + var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; begin Result := UTF8GetNextBufferFromStream(S, Buffer, Start, Count); end; @@ -2905,7 +2905,7 @@ end; function TJclUTF8Stream.InternalSetNextBuffer(S: TStream; - const Buffer: TUCS4Array; Start, Count: Integer): Longint; + const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; begin Result := UTF8SetNextBufferToStream(S, Buffer, Start, Count); end; @@ -2928,7 +2928,7 @@ end; function TJclUTF16Stream.InternalGetNextBuffer(S: TStream; - var Buffer: TUCS4Array; Start, Count: Integer): Longint; + var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; begin Result := UTF16GetNextBufferFromStream(S, Buffer, Start, Count); end; @@ -2939,7 +2939,7 @@ end; function TJclUTF16Stream.InternalSetNextBuffer(S: TStream; - const Buffer: TUCS4Array; Start, Count: Integer): Longint; + const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; begin Result := UTF16SetNextBufferToStream(S, Buffer, Start, Count); end; @@ -3021,7 +3021,7 @@ end; function TJclAutoStream.InternalGetNextBuffer(S: TStream; - var Buffer: TUCS4Array; Start, Count: Integer): Longint; + var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; begin case FCodePage of CP_UTF8: @@ -3050,7 +3050,7 @@ end; function TJclAutoStream.InternalSetNextBuffer(S: TStream; - const Buffer: TUCS4Array; Start, Count: Integer): Longint; + const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; begin case FCodePage of CP_UTF8: Index: source/common/JclStringLists.pas =================================================================== --- source/common/JclStringLists.pas (revision 3561) +++ source/common/JclStringLists.pas (working copy) @@ -74,7 +74,9 @@ function GetObjects(Index: Integer): TObject; function GetTextStr: string; function GetValue(const Name: string): string; + {$IFNDEF FPC} function Find(const S: string; var Index: Integer): Boolean; + {$ENDIF FPC} function IndexOf(const S: string): Integer; function GetCaseSensitive: Boolean; function GetDuplicates: TDuplicates; @@ -200,7 +202,7 @@ end; type - TJclUpdateControl = class(TObject, IInterface) + TJclUpdateControl = class(TInterfacedObject, IInterface) private FStrings: TStrings; public @@ -211,8 +213,20 @@ function _Release: Integer; stdcall; end; - TJclStringList = class(TStringList, IJclStringList) + TJclInterfacedStringList = class(TStringList, IInterface) private + FOwnerInterface: IInterface; + protected + { IInterface } + function _AddRef: Integer; stdcall; + function _Release: Integer; stdcall; + public + function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; stdcall; + procedure AfterConstruction; override; + end; + + TJclStringList = class(TJclInterfacedStringList, IJclStringList) + private FObjectsMode: TJclStringListObjectsMode; FSelfAsInterface: IJclStringList; FLastRegExPattern: string; @@ -432,6 +446,45 @@ Result := JclStringList.Add(A); end; +//=== { TJclInterfacedStringList } ============================================== + +procedure TJclInterfacedStringList.AfterConstruction; +Var + MyOwner : TPersistent; +begin + inherited; + MyOwner := GetOwner; + if assigned(MyOwner) then + MyOwner.GetInterface(IUnknown,FOwnerInterface); +end; + + +function TJclInterfacedStringList._AddRef: Integer;stdcall; +begin + if assigned(FOwnerInterface) then + Result:=FOwnerInterface._AddRef + else + Result:=-1; +end; + + +function TJclInterfacedStringList._Release: Integer;stdcall; +begin + if assigned(FOwnerInterface) then + Result:=FOwnerInterface._Release + else + Result:=-1; +end; + + +function TJclInterfacedStringList.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult;stdcall; +begin + if GetInterface(IID, Obj) then + Result:=0 + else + Result:=HResult($80004002); +end; + //=== { TJclStringList } ===================================================== function TJclStringList.Add(const A: array of const): IJclStringList; Index: source/common/JclSysInfo.pas =================================================================== --- source/common/JclSysInfo.pas (revision 3561) +++ source/common/JclSysInfo.pas (working copy) @@ -4286,17 +4286,17 @@ SETNZ Result {$ENDIF CPU32} {$IFDEF CPU64} - // PUSHFQ - PUSHFD + PUSHFQ + //PUSHFD POP RAX MOV RCX, RAX XOR RAX, ID_FLAG AND RCX, ID_FLAG PUSH RAX - // POPFQ - POPFD - // PUSHFQ - PUSHFD + POPFQ + //POPFD + PUSHFQ + //PUSHFD POP RAX AND RAX, ID_FLAG XOR RAX, RCX Index: source/common/JclSysUtils.pas =================================================================== --- source/common/JclSysUtils.pas (revision 3561) +++ source/common/JclSysUtils.pas (working copy) @@ -405,7 +405,7 @@ // interfaced persistent type - TJclInterfacedPersistent = class(TPersistent, IInterface) + TJclInterfacedPersistent = class(TInterfacedPersistent, IInterface) protected FOwnerInterface: IInterface; FRefCount: Integer; @@ -630,7 +630,7 @@ // thread safe support type - TJclIntfCriticalSection = class(TObject, IInterface) + TJclIntfCriticalSection = class(TInterfacedObject, IInterface) private FCriticalSection: TCriticalSection; public @@ -789,6 +789,10 @@ {$ENDIF HAS_UNIT_ANSISTRINGS} JclFileUtils, JclMath, JclResources, JclStrings, JclStringConversions, JclSysInfo, Variants; +{$IFDEF FPC} +function CancelIo(hFile: THandle): BOOL; stdcall; external 'kernel32' name 'CancelIo'; +{$ENDIF FPC} + // memory initialization procedure ResetMemory(out P; Size: Longint); begin @@ -2832,7 +2836,11 @@ end; InternalAbort := False; if AbortPtr <> nil then + {$IFDEF FPC} + AbortPtr^ := Byte(False) + {$ELSE} AbortPtr^ := False + {$ENDIF FPC} else AbortPtr := @InternalAbort; // init the array of events to wait for @@ -2874,7 +2882,11 @@ InternalExecuteReadPipe(ErrorPipeInfo, ErrorOverlapped); end; // event based loop + {$IFDEF FPC} + while not Boolean(AbortPtr^) do + {$ELSE} while not AbortPtr^ do + {$ENDIF} begin Index := WaitAlertableForMultipleObjects(WaitEvents, False, INFINITE); if Index = WAIT_OBJECT_0 then @@ -2904,7 +2916,11 @@ if ((Index = (WAIT_OBJECT_0 + 2)) and MergeError) or ((Index = (WAIT_OBJECT_0 + 3)) and not MergeError) then // event on abort + {$IFDEF FPC} + AbortPtr^ := Byte(True) + {$ELSE} AbortPtr^ := True + {$ENDIF FPC} else {$IFDEF DELPHI11_UP} RaiseLastOSError(Index); @@ -2912,7 +2928,11 @@ RaiseLastOSError; {$ENDIF DELPHI11_UP} end; + {$IFDEF FPC} + if Boolean(AbortPtr^) then + {$ELSE} if AbortPtr^ then + {$ENDIF FPC} TerminateProcess(ProcessEvent.Handle, Cardinal(ABORT_EXIT_CODE)); if (ProcessEvent.WaitForever = wrSignaled) and not GetExitCodeProcess(ProcessEvent.Handle, Result) then Result := $FFFFFFFF; @@ -2971,6 +2991,7 @@ pclose(Pipe); wait(nil); end; +end; {$ENDIF UNIX} if OutPipeInfo.Line <> '' then if Assigned(OutPipeInfo.TextHandler) then Index: source/common/JclUnicode.pas =================================================================== --- source/common/JclUnicode.pas (revision 3561) +++ source/common/JclUnicode.pas (working copy) @@ -2752,7 +2752,7 @@ // Looks for all occurences of the pattern passed to FindPrepare and creates an // internal list of their positions. var - Start, Stop: SizeInt; + Start, Stop, CharCount: SizeInt; Run: PWideChar; RunLen: SizeInt; begin @@ -2765,7 +2765,8 @@ while Find(Run, RunLen, Start, Stop) do begin // store this result (consider text pointer movement)... - AddResult(Start + Run - Text, Stop + Run - Text); + CharCount := (TJclAddr(Run) - TJclAddr(Text)) div SizeOf(WideChar); + AddResult(Start + CharCount, Stop + CharCount); // ... and advance text position and length Inc(Run, Stop); Dec(RunLen, Stop); @@ -4723,7 +4724,7 @@ // Looks for all occurences of the pattern passed to FindPrepare and creates an // internal list of their positions. var - Start, Stop: SizeInt; + Start, Stop, CharCount: SizeInt; Run: PWideChar; RunLen: SizeInt; begin @@ -4736,7 +4737,8 @@ while ExecuteURE(0, Run, RunLen, Start, Stop) do begin // store this result (consider text pointer movement)... - AddResult(Start + Run - Text, Stop + Run - Text); + CharCount := (TJclAddr(Run) - TJclAddr(Text)) div SizeOf(WideChar); + AddResult(Start + CharCount, Stop + CharCount); // ... and advance text position and length Inc(Run, Stop); Dec(RunLen, Stop); Index: source/windows/JclCppException.pas =================================================================== --- source/windows/JclCppException.pas (revision 3561) +++ source/windows/JclCppException.pas (working copy) @@ -151,7 +151,7 @@ implementation uses - JclResources, JclHookExcept; + JclResources, JclHookExcept, Windows; type @@ -589,8 +589,8 @@ { The exception object is a std::exception subclass and implements the virtual member function what(). } ExcObjectVTbl := Pointer(PCardinal (ExcObject)^); - WhatMethod := TCppTypeInfoWhatMethod(PCardinal ( - Cardinal (ExcObjectVTbl) + SizeOf (Pointer))^); + WhatMethod := TCppTypeInfoWhatMethod(Pointer(PCardinal ( + Cardinal (ExcObjectVTbl) + SizeOf (Pointer))^)); Result := EJclCppStdException.Create(ExcObject, String(WhatMethod(ExcObject)), PAnsiChar(ExcTypeName), Pointer(ExcDesc)); end @@ -611,14 +611,20 @@ 'Cannot install C++ exception filter: call JclHookExcept.JclHookExceptions() first!'); if HookInstalled then Exit; + {$IFDEF BORLAND} HookInstalled := JclHookExcept.JclAddExceptFilter(@CppExceptObjProc, npFirstChain); + {$ELSE} + HookInstalled := False; + {$ENDIF BORLAND} end; procedure JclUninstallCppExceptionFilter; begin if not HookInstalled then Exit; + {$IFDEF BORLAND} JclHookExcept.JclRemoveExceptFilter(@CppExceptObjProc); + {$ENDIF BORLAND} HookInstalled := False; end; Index: source/windows/JclHookExcept.pas =================================================================== --- source/windows/JclHookExcept.pas (revision 3561) +++ source/windows/JclHookExcept.pas (working copy) @@ -43,7 +43,7 @@ {$IFDEF UNITVERSIONING} JclUnitVersioning, {$ENDIF UNITVERSIONING} - Windows, SysUtils, Classes; + Windows, SysUtils, Classes, JclBase; type // Exception hooking notifiers routines @@ -105,7 +105,6 @@ implementation uses - JclBase, JclPeImage, JclSysInfo, JclSysUtils; @@ -566,6 +565,7 @@ end; function GetCppRtlBase: Pointer; +{$IFDEF BORLAND} const {$IFDEF COMPILER6} { Delphi/C++Builder 6 } CppRtlVersion = 60; @@ -586,11 +586,22 @@ in this case TJclPeMapImgHooks.ReplaceImport() is a no-op. The base module is also being hooked separately, so we're covered. } end; +{$ELSE} +begin + Result := NIL; +end; +{$ENDIF BORLAND} function HasCppRtl: Boolean; +{$IFDEF BORLAND} begin Result := GetCppRtlBase <> TJclPeMapImgHooks.SystemBase; end; +{$ELSE} +begin + Result := False; +end; +{$ENDIF BORLAND} function JclHookExceptions: Boolean; var Index: source/windows/JclWin32.pas =================================================================== --- source/windows/JclWin32.pas (revision 3561) +++ source/windows/JclWin32.pas (working copy) @@ -66,8 +66,8 @@ Windows, SysUtils, {$IFNDEF FPC} AccCtrl, + {$ENDIF ~FPC} ActiveX, - {$ENDIF ~FPC} JclBase; {$HPPEMIT '#include <WinDef.h>'} @@ -3144,8 +3144,8 @@ function ReBaseImage64(CurrentImageName: PAnsiChar; SymbolPath: PAnsiChar; fReBase: BOOL; fRebaseSysfileOk: BOOL; fGoingDown: BOOL; CheckImageSize: ULONG; - var OldImageSize: TJclAddr; var OldImageBase: TJclAddr64; - var NewImageSize: TJclAddr; var NewImageBase: TJclAddr64; TimeStamp: ULONG): BOOL; stdcall; + var OldImageSize: TJclAddr32; var OldImageBase: TJclAddr64; + var NewImageSize: TJclAddr32; var NewImageBase: TJclAddr64; TimeStamp: ULONG): BOOL; stdcall; {$EXTERNALSYM ReBaseImage64} // line 199 jedi svn 3561 fpc compatible 2.patch (26,851 bytes)

Cyrus 2011-07-31 13:55 reporter ~0018842	Uploaded newer version (jedi svn 3561 fpc compatible 2.patch) of previous patch.

2011-12-24 01:52	jcl revision 3644 - fpc compatible.patch (26,618 bytes) Index: packages/fpc/Jcl.lpk =================================================================== --- packages/fpc/Jcl.lpk (revision 3644) +++ packages/fpc/Jcl.lpk (working copy) @@ -1,17 +1,16 @@ <?xml version="1.0"?> <CONFIG> - <Package Version="3"> + <Package Version="4"> <PathDelim Value="\"/> <Name Value="Jcl"/> - <AddToProjectUsesSection Value="False"/> <Author Value="Project JEDI"/> <AutoUpdate Value="OnRebuildingAll"/> <CompilerOptions> - <Version Value="8"/> + <Version Value="11"/> <PathDelim Value="\"/> <SearchPaths> - <IncludeFiles Value="..\..\source\include\"/> - <OtherUnitFiles Value=".;..\..\source\common;..\..\source\windows;"/> + <IncludeFiles Value="..\..\source\include;..\..\source\include\jedi"/> + <OtherUnitFiles Value=".;..\..\source\common;..\..\source\windows"/> <UnitOutputDirectory Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <Parsing> @@ -19,26 +18,26 @@ <SyntaxOptions> <SyntaxMode Value="Delphi"/> <CStyleOperator Value="False"/> + <UseAnsiStrings Value="False"/> </SyntaxOptions> </Parsing> <CodeGeneration> <Optimizations> <VariablesInRegisters Value="True"/> - <OptimizationLevel Value="3"/> + <OptimizationLevel Value="0"/> </Optimizations> </CodeGeneration> - <Linking> - <Debugging> - <UseLineInfoUnit Value="False"/> - </Debugging> - </Linking> <Other> + <CompilerMessages> + <UseMsgFile Value="True"/> + </CompilerMessages> + <CustomOptions Value="-Ur"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> <Description Value="JEDI Code Library RTL package"/> <License Value="Copyright (C) 1999, 2011 Project JEDI"/> - <Version Major="2" Minor="4" Release="0" Build="4198"/> + <Version Build="4198" Major="2" Minor="4"/> <Files Count="76"> <Item1> <Filename Value="..\..\source\common\bzip2.pas"/> @@ -351,10 +350,10 @@ </Item1> </RequiredPkgs> <UsageOptions> - <UnitPath Value="$(PkgOutDir)\"/> - <IncludePath Value="..\..\source\include\"/> - <LibraryPath Value="$(PkgOutDir)\"/> - <ObjectPath Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)\"/> + <IncludePath Value="..\..\source\include;..\..\source\include\jedi"/> + <LibraryPath Value="$(PkgOutDir)"/> + <ObjectPath Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> + <UnitPath Value="$(PkgOutDir)"/> </UsageOptions> <PublishOptions> <Version Value="2"/> Index: packages/fpc/JclContainers.lpk =================================================================== --- packages/fpc/JclContainers.lpk (revision 3644) +++ packages/fpc/JclContainers.lpk (working copy) @@ -7,11 +7,11 @@ <Author Value="Project JEDI"/> <AutoUpdate Value="OnRebuildingAll"/> <CompilerOptions> - <Version Value="8"/> + <Version Value="10"/> <PathDelim Value="\"/> <SearchPaths> - <IncludeFiles Value="..\..\source\include\"/> - <OtherUnitFiles Value=".;..\..\source\common;"/> + <IncludeFiles Value="..\..\source\include;..\..\source\include\jedi"/> + <OtherUnitFiles Value=".;..\..\source\common;..\..\source\windows"/> <UnitOutputDirectory Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <Parsing> @@ -19,6 +19,7 @@ <SyntaxOptions> <SyntaxMode Value="Delphi"/> <CStyleOperator Value="False"/> + <UseAnsiStrings Value="False"/> </SyntaxOptions> </Parsing> <CodeGeneration> @@ -33,6 +34,10 @@ </Debugging> </Linking> <Other> + <CompilerMessages> + <UseMsgFile Value="True"/> + </CompilerMessages> + <CustomOptions Value="-Ur"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> @@ -106,10 +111,10 @@ </Item2> </RequiredPkgs> <UsageOptions> - <UnitPath Value="$(PkgOutDir)\"/> - <IncludePath Value="..\..\source\include\"/> - <LibraryPath Value="$(PkgOutDir)\"/> - <ObjectPath Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)\"/> + <IncludePath Value="..\..\source\include;..\..\source\include\jedi"/> + <LibraryPath Value="$(PkgOutDir)"/> + <ObjectPath Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> + <UnitPath Value="$(PkgOutDir)"/> </UsageOptions> <PublishOptions> <Version Value="2"/> Index: source/common/JclAbstractContainers.pas =================================================================== --- source/common/JclAbstractContainers.pas (revision 3644) +++ source/common/JclAbstractContainers.pas (working copy) @@ -701,9 +701,9 @@ procedure AppendToStrings(Strings: TJclWideStrings); procedure AppendFromStrings(Strings: TJclWideStrings); function GetAsStrings: TJclWideStrings; - function GetAsDelimited(const Separator: WideString = WideLineBreak): WideString; - procedure AppendDelimited(const AString: WideString; const Separator: WideString = WideLineBreak); - procedure LoadDelimited(const AString: WideString; const Separator: WideString = WideLineBreak); + function GetAsDelimited(const Separator: WideString {$IFNDEF FPC}= WideLineBreak {$ENDIF}): WideString; + procedure AppendDelimited(const AString: WideString; const Separator: WideString {$IFNDEF FPC}= WideLineBreak {$ENDIF}); + procedure LoadDelimited(const AString: WideString; const Separator: WideString {$IFNDEF FPC}= WideLineBreak {$ENDIF}); end; {$IFDEF SUPPORTS_UNICODE_STRING} @@ -1372,12 +1372,12 @@ else begin case FEncoding of - seISO: + JclContainerIntf.seISO: if FCaseSensitive then Result := AnsiStrSimpleHashConvert(AString) else Result := AnsiStrSimpleHashConvertI(AString); - seUTF8: + JclContainerIntf.seUTF8: if FCaseSensitive then Result := AnsiStrSimpleHashConvertU(AString) else @@ -1395,7 +1395,7 @@ else begin case FEncoding of - seISO, seUTF8: + JclContainerIntf.seISO, JclContainerIntf.seUTF8: if FCaseSensitive then Result := AnsiStrSimpleCompare(A, B) else @@ -1416,7 +1416,7 @@ else begin case FEncoding of - seISO, seUTF8: + JclContainerIntf.seISO, JclContainerIntf.seUTF8: if FCaseSensitive then Result := AnsiStrSimpleEqualityCompare(A, B) else Index: source/common/JclAlgorithms.pas =================================================================== --- source/common/JclAlgorithms.pas (revision 3644) +++ source/common/JclAlgorithms.pas (working copy) @@ -494,9 +494,9 @@ {$ENDIF HAS_UNIT_ANSISTRINGS} System.SysUtils, {$ELSE ~HAS_UNITSCOPE} - {$IFDEF COMPILER11_UP} + {.$IFDEF COMPILER11_UP} Windows, - {$ENDIF COMPILER11_UP} + {.$ENDIF COMPILER11_UP} {$IFDEF HAS_UNIT_ANSISTRINGS} AnsiStrings, {$ENDIF HAS_UNIT_ANSISTRINGS} @@ -4130,4 +4130,4 @@ UnregisterUnitVersion(HInstance); {$ENDIF UNITVERSIONING} -end. \ No newline at end of file +end. Index: source/common/JclAnsiStrings.pas =================================================================== --- source/common/JclAnsiStrings.pas (revision 3644) +++ source/common/JclAnsiStrings.pas (working copy) @@ -506,8 +506,8 @@ function ArrayOf(List: TJclAnsiStrings): TDynStringArray; overload; -function AnsiCompareNaturalStr(const S1, S2: AnsiString): SizeInt; -function AnsiCompareNaturalText(const S1, S2: AnsiString): SizeInt; +function AnsiCompareNaturalStr(const S1, S2: AnsiString): SizeInt;overload; +function AnsiCompareNaturalText(const S1, S2: AnsiString): SizeInt;overload; // internal structures published to make function inlining working const Index: source/common/JclBase.pas =================================================================== --- source/common/JclBase.pas (revision 3644) +++ source/common/JclBase.pas (working copy) @@ -588,7 +588,7 @@ procedure GetMem(out P; Size: Longint); begin Pointer(P) := nil; - GetMem(Pointer(P), Size); + System.GetMem(Pointer(P), Size); end; {$ENDIF FPC} Index: source/common/JclCompression.pas =================================================================== --- source/common/JclCompression.pas (revision 3644) +++ source/common/JclCompression.pas (working copy) @@ -745,7 +745,7 @@ TJclStreamAccess = (saCreate, saReadOnly, saReadOnlyDenyNone, saWriteOnly, saReadWrite); { TJclCompressionArchive is not ref-counted } - TJclCompressionArchive = class(TObject, IInterface) + TJclCompressionArchive = class(TInterfacedObject, IInterface) private FOnProgress: TJclCompressionProgressEvent; FOnRatio: TJclCompressionRatioEvent; Index: source/common/JclDateTime.pas =================================================================== --- source/common/JclDateTime.pas (revision 3644) +++ source/common/JclDateTime.pas (working copy) @@ -87,7 +87,7 @@ { Encode / Decode functions } -function EncodeDate(const Year: Integer; Month, Day: Word): TDateTime; +function EncodeDate(const Year: Integer; Month, Day: Word): TDateTime;overload; procedure DecodeDate(Date: TDateTime; out Year, Month, Day: Word); overload; procedure DecodeDate(Date: TDateTime; out Year: Integer; out Month, Day: Word); overload; procedure DecodeDate(Date: TDateTime; out Year, Month, Day: Integer); overload; Index: source/common/JclRTTI.pas =================================================================== --- source/common/JclRTTI.pas (revision 3644) +++ source/common/JclRTTI.pas (working copy) @@ -1890,7 +1890,11 @@ AInstance := GetObjectProp(FInstance, PropInfo); if AInstance <> nil then begin + {$IFNDEF FPC} SubClassTypeInfo := TJclObjClassTypeInfo.Create(PropInfo.PropType^, Prefix, AInstance); + {$ELSE} + SubClassTypeInfo := TJclObjClassTypeInfo.Create(PropInfo.PropType, Prefix, AInstance); + {$ENDIF} Result := SubClassTypeInfo.ObjPropNames[Suffix]; end else Index: source/common/JclStringLists.pas =================================================================== --- source/common/JclStringLists.pas (revision 3644) +++ source/common/JclStringLists.pas (working copy) @@ -82,7 +82,9 @@ function GetObjects(Index: Integer): TObject; function GetTextStr: string; function GetValue(const Name: string): string; + {$IFNDEF FPC} function Find(const S: string; var Index: Integer): Boolean; + {$ENDIF FPC} function IndexOf(const S: string): Integer; function GetCaseSensitive: Boolean; function GetDuplicates: TDuplicates; @@ -208,7 +210,7 @@ end; type - TJclUpdateControl = class(TObject, IInterface) + TJclUpdateControl = class(TInterfacedObject, IInterface) private FStrings: TStrings; public @@ -219,8 +221,20 @@ function _Release: Integer; stdcall; end; - TJclStringList = class(TStringList, IJclStringList) + TJclInterfacedStringList = class(TStringList, IInterface) private + FOwnerInterface: IInterface; + protected + { IInterface } + function _AddRef: Integer; stdcall; + function _Release: Integer; stdcall; + public + function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; stdcall; + procedure AfterConstruction; override; + end; + + TJclStringList = class(TJclInterfacedStringList, IJclStringList) + private FObjectsMode: TJclStringListObjectsMode; FSelfAsInterface: IJclStringList; FLastRegExPattern: string; @@ -444,6 +458,45 @@ Result := JclStringList.Add(A); end; +//=== { TJclInterfacedStringList } ============================================== + +procedure TJclInterfacedStringList.AfterConstruction; +Var + MyOwner : TPersistent; +begin + inherited; + MyOwner := GetOwner; + if assigned(MyOwner) then + MyOwner.GetInterface(IUnknown,FOwnerInterface); +end; + + +function TJclInterfacedStringList._AddRef: Integer;stdcall; +begin + if assigned(FOwnerInterface) then + Result:=FOwnerInterface._AddRef + else + Result:=-1; +end; + + +function TJclInterfacedStringList._Release: Integer;stdcall; +begin + if assigned(FOwnerInterface) then + Result:=FOwnerInterface._Release + else + Result:=-1; +end; + + +function TJclInterfacedStringList.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult;stdcall; +begin + if GetInterface(IID, Obj) then + Result:=0 + else + Result:=HResult($80004002); +end; + //=== { TJclStringList } ===================================================== function TJclStringList.Add(const A: array of const): IJclStringList; Index: source/common/JclStrings.pas =================================================================== --- source/common/JclStrings.pas (revision 3644) +++ source/common/JclStrings.pas (working copy) @@ -592,8 +592,8 @@ {$ENDIF SUPPORTS_UNICODE_STRING} // natural comparison functions -function CompareNaturalStr(const S1, S2: string): SizeInt; -function CompareNaturalText(const S1, S2: string): SizeInt; +function CompareNaturalStr(const S1, S2: string): SizeInt;overload; +function CompareNaturalText(const S1, S2: string): SizeInt;overload; {$IFNDEF UNICODE_RTL_DATABASE} // internal structures published to make function inlining working Index: source/common/JclSynch.pas =================================================================== --- source/common/JclSynch.pas (revision 3644) +++ source/common/JclSynch.pas (working copy) @@ -86,8 +86,10 @@ function LockedInc(var Target: Int64): Int64; overload; function LockedSub(var Target: Int64; Value: Int64): Int64; overload; +{$IFNDEF FPC} function LockedDec(var Target: NativeInt): NativeInt; overload; function LockedInc(var Target: NativeInt): NativeInt; overload; +{$ENDIF FPC} {$ENDIF CPU64} // TJclDispatcherObject @@ -729,6 +731,7 @@ ADD RAX, RDX end; +{$IFNDEF FPC} function LockedDec(var Target: NativeInt): NativeInt; asm // --> RCX Target @@ -746,6 +749,7 @@ LOCK XADD [RCX], RAX INC RAX end; +{$ENDIF FPC} {$ENDIF CPU64} //=== { TJclDispatcherObject } =============================================== Index: source/common/JclSysInfo.pas =================================================================== --- source/common/JclSysInfo.pas (revision 3644) +++ source/common/JclSysInfo.pas (working copy) @@ -4321,6 +4321,9 @@ SETNZ Result {$ENDIF CPU32} {$IFDEF CPU64} + {$IFDEF FPC} + {$DEFINE DELPHI64_TEMPORARY} + {$ENDIF FPC} {$IFDEF DELPHI64_TEMPORARY} PUSHFQ {$ELSE ~DELPHI64_TEMPORARY} @@ -4345,6 +4348,9 @@ AND RAX, ID_FLAG XOR RAX, RCX SETNZ Result + {$IFDEF FPC} + {$UNDEF DELPHI64_TEMPORARY} + {$ENDIF FPC} {$ENDIF CPU64} end; {$IFNDEF DELPHI64_TEMPORARY} Index: source/common/JclSysUtils.pas =================================================================== --- source/common/JclSysUtils.pas (revision 3644) +++ source/common/JclSysUtils.pas (working copy) @@ -412,7 +412,7 @@ // interfaced persistent type - TJclInterfacedPersistent = class(TPersistent, IInterface) + TJclInterfacedPersistent = class(TInterfacedPersistent, IInterface) protected FOwnerInterface: IInterface; FRefCount: Integer; @@ -637,7 +637,7 @@ // thread safe support type - TJclIntfCriticalSection = class(TObject, IInterface) + TJclIntfCriticalSection = class(TInterfacedObject, IInterface) private FCriticalSection: TCriticalSection; public @@ -812,6 +812,10 @@ {$ENDIF ~HAS_UNITSCOPE} JclFileUtils, JclMath, JclResources, JclStrings, JclStringConversions, JclSysInfo; +{$IFDEF FPC} +function CancelIo(hFile: THandle): BOOL; stdcall; external 'kernel32' name 'CancelIo'; +{$ENDIF FPC} + // memory initialization procedure ResetMemory(out P; Size: Longint); begin @@ -2855,7 +2859,11 @@ end; InternalAbort := False; if AbortPtr <> nil then + {$IFDEF FPC} + AbortPtr^ := Byte(False) + {$ELSE} AbortPtr^ := False + {$ENDIF FPC} else AbortPtr := @InternalAbort; // init the array of events to wait for @@ -2897,7 +2905,11 @@ InternalExecuteReadPipe(ErrorPipeInfo, ErrorOverlapped); end; // event based loop + {$IFDEF FPC} + while not Boolean(AbortPtr^) do + {$ELSE} while not AbortPtr^ do + {$ENDIF} begin Index := WaitAlertableForMultipleObjects(WaitEvents, False, INFINITE); if Index = WAIT_OBJECT_0 then @@ -2927,7 +2939,11 @@ if ((Index = (WAIT_OBJECT_0 + 2)) and MergeError) or ((Index = (WAIT_OBJECT_0 + 3)) and not MergeError) then // event on abort + {$IFDEF FPC} + AbortPtr^ := Byte(True) + {$ELSE} AbortPtr^ := True + {$ENDIF FPC} else {$IFDEF DELPHI11_UP} RaiseLastOSError(Index); @@ -2935,7 +2951,11 @@ RaiseLastOSError; {$ENDIF DELPHI11_UP} end; + {$IFDEF FPC} + if Boolean(AbortPtr^) then + {$ELSE} if AbortPtr^ then + {$ENDIF FPC} TerminateProcess(ProcessEvent.Handle, Cardinal(ABORT_EXIT_CODE)); if (ProcessEvent.WaitForever = wrSignaled) and not GetExitCodeProcess(ProcessEvent.Handle, Result) then Result := $FFFFFFFF; @@ -2994,6 +3014,7 @@ pclose(Pipe); wait(nil); end; +end; {$ENDIF UNIX} if OutPipeInfo.Line <> '' then if Assigned(OutPipeInfo.TextHandler) then Index: source/common/JclUnicode.pas =================================================================== --- source/common/JclUnicode.pas (revision 3644) +++ source/common/JclUnicode.pas (working copy) @@ -1580,16 +1580,19 @@ SetLength(Categories[First], 256); if Categories[First, Second] = nil then SetLength(Categories[First, Second], 256); - {$IF SizeOf(TCharacterCategories) mod 4 <> 0} + {.$IF SizeOf(TCharacterCategories) mod 4 <> 0} + If SizeOf(TCharacterCategories) mod 4 <> 0 Then Begin // The array is allocated on the exact size, but the compiler generates // a 32 bit "BTS" instruction that accesses memory beyond the allocated block. - if Third < 255 then - Include(Categories[First, Second, Third], Category) + if Third < 255 then + Include(Categories[First, Second, Third], Category) + else + Categories[First, Second, Third] := Categories[First, Second, Third] + [Category]; + {.$ELSE} + end else - Categories[First, Second, Third] := Categories[First, Second, Third] + [Category]; - {$ELSE} - Include(Categories[First, Second, Third], Category); - {$IFEND} + Include(Categories[First, Second, Third], Category); + {.$IFEND} end; end; end; @@ -2839,7 +2842,7 @@ // Looks for all occurences of the pattern passed to FindPrepare and creates an // internal list of their positions. var - Start, Stop: SizeInt; + Start, Stop, CharCount: SizeInt; Run: PWideChar; RunLen: SizeInt; begin @@ -2852,7 +2855,8 @@ while Find(Run, RunLen, Start, Stop) do begin // store this result (consider text pointer movement)... - AddResult(Start + Run - Text, Stop + Run - Text); + CharCount := (TJclAddr(Run) - TJclAddr(Text)) div SizeOf(WideChar); + AddResult(Start + CharCount, Stop + CharCount); // ... and advance text position and length Inc(Run, Stop); Dec(RunLen, Stop); @@ -4810,7 +4814,7 @@ // Looks for all occurences of the pattern passed to FindPrepare and creates an // internal list of their positions. var - Start, Stop: SizeInt; + Start, Stop, CharCount: SizeInt; Run: PWideChar; RunLen: SizeInt; begin @@ -4823,7 +4827,8 @@ while ExecuteURE(0, Run, RunLen, Start, Stop) do begin // store this result (consider text pointer movement)... - AddResult(Start + Run - Text, Stop + Run - Text); + CharCount := (TJclAddr(Run) - TJclAddr(Text)) div SizeOf(WideChar); + AddResult(Start + CharCount, Stop + CharCount); // ... and advance text position and length Inc(Run, Stop); Dec(RunLen, Stop); Index: source/common/JclWideStrings.pas =================================================================== --- source/common/JclWideStrings.pas (revision 3644) +++ source/common/JclWideStrings.pas (working copy) @@ -847,11 +847,13 @@ // --> RCX Str XOR RAX, RAX // clear high order byte to be able to use 64bit operand below @@1: - MOV AX, WORD PTR [ECX] + //MOV AX, WORD PTR [ECX] + MOV AX, WORD PTR [RCX] OR RAX, RAX JZ @@2 XCHG AL, AH - MOV WORD PTR [ECX], AX + //MOV WORD PTR [ECX], AX + MOV WORD PTR [RCX], AX ADD ECX, 2 JMP @@1 @@2: Index: source/windows/JclAppInst.pas =================================================================== --- source/windows/JclAppInst.pas (revision 3644) +++ source/windows/JclAppInst.pas (working copy) @@ -742,7 +742,11 @@ ACLSize := SizeOf(TACL) + SizeOf(ACCESS_ALLOWED_ACE) + SizeOf(DWORD) + GetLengthSid(AccessSID); ACL := AllocMem(ACLSize); Win32Check(InitializeAcl(ACL^, ACLSize, ACL_REVISION)); + {$IFNDEF FPC} Win32Check(AddAccessAllowedAce(ACL^, ACL_REVISION, FILE_MAP_ALL_ACCESS, AccessSID)); + {$ELSE} + Win32Check(AddAccessAllowedAce(ACL, ACL_REVISION, FILE_MAP_ALL_ACCESS, AccessSID)); + {$ENDIF} Assert(IsValidAcl(ACL^)); // create the security descriptor Index: source/windows/JclCppException.pas =================================================================== --- source/windows/JclCppException.pas (revision 3644) +++ source/windows/JclCppException.pas (working copy) @@ -160,7 +160,7 @@ implementation uses - JclResources, JclHookExcept; + JclResources, JclHookExcept, Windows; type @@ -438,7 +438,9 @@ var OldAcquireExceptionProc: Pointer; + {$IFNDEF FPC} OldRaiseExceptionProc: TRaiseExceptionProc; + {$ENDIF FPC} procedure ExceptionAcquiredProc(Obj: Pointer); begin @@ -465,8 +467,10 @@ end; LastCppExcDesc := nil; + {$IFNDEF FPC} if Assigned(OldRaiseExceptionProc) then OldRaiseExceptionProc(ExceptionCode, ExceptionFlags, NumberOfArguments, Args); + {$ENDIF FPC} end; function EJclCppStdException.GetStdException: PJclCppStdException; @@ -676,8 +680,8 @@ { The exception object is a std::exception subclass and implements the virtual member function what(). } ExcObjectVTbl := Pointer(PCardinal(ExcObject)^); - WhatMethod := TCppTypeInfoWhatMethod(PCardinal( - Cardinal(ExcObjectVTbl) + SizeOf(Pointer))^); + WhatMethod := TCppTypeInfoWhatMethod(Pointer(PCardinal( + Cardinal(ExcObjectVTbl) + SizeOf(Pointer))^)); Result := EJclCppStdException.Create(ExcObject, String(WhatMethod(ExcObject)), PAnsiChar(ExcTypeName), Pointer(ExcDesc)); end @@ -698,7 +702,11 @@ 'Cannot install C++ exception filter: call JclHookExcept.JclHookExceptions() first!'); if HookInstalled then Exit; + {$IFDEF BORLAND} HookInstalled := JclHookExcept.JclAddExceptFilter(@CppExceptObjProc, npFirstChain); + {$ELSE} + HookInstalled := False; + {$ENDIF BORLAND} if HookInstalled then begin {$IFDEF COMPILER12_UP} // TODO: this may be supported for earlier versions of Delphi/C++Builder @@ -706,12 +714,14 @@ System.ExceptionAcquired := @ExceptionAcquiredProc; {$ENDIF COMPILER12_UP} + {$IFDEF BORLAND} OldRaiseExceptionProc := System.RaiseExceptionProc; {$IFDEF CPU32} System.RaiseExceptionProc := @RaiseExceptionProc; {$ELSE} System.RaiseExceptionProc := RaiseExceptionProc; {$ENDIF CPU32} + {$ENDIF BORLAND} end; end; @@ -722,12 +732,14 @@ {$IFDEF COMPILER12_UP} // TODO: this may be supported for earlier versions of Delphi/C++Builder System.ExceptionAcquired := OldAcquireExceptionProc; {$ENDIF COMPILER12_UP} + {$IFDEF BORLAND} {$IFDEF CPU32} System.RaiseExceptionProc := @OldRaiseExceptionProc; {$ELSE} System.RaiseExceptionProc := OldRaiseExceptionProc; {$ENDIF CPU32} JclHookExcept.JclRemoveExceptFilter(@CppExceptObjProc); + {$ENDIF BORLAND } HookInstalled := False; end; Index: source/windows/JclHookExcept.pas =================================================================== --- source/windows/JclHookExcept.pas (revision 3644) +++ source/windows/JclHookExcept.pas (working copy) @@ -46,7 +46,7 @@ {$IFDEF HAS_UNITSCOPE} Winapi.Windows, System.SysUtils, System.Classes; {$ELSE ~HAS_UNITSCOPE} - Windows, SysUtils, Classes; + Windows, SysUtils, Classes, JclBase; {$ENDIF ~HAS_UNITSCOPE} type @@ -109,7 +109,6 @@ implementation uses - JclBase, JclPeImage, JclSysInfo, JclSysUtils; @@ -575,6 +574,7 @@ end; function GetCppRtlBase: Pointer; +{$IFDEF BORLAND} const {$IFDEF COMPILER6} { Delphi/C++Builder 6 } CppRtlVersion = 60; @@ -595,12 +595,25 @@ in this case TJclPeMapImgHooks.ReplaceImport() is a no-op. The base module is also being hooked separately, so we're covered. } end; +{$ELSE} +begin + Result := NIL; +end; +{$ENDIF BORLAND} + function HasCppRtl: Boolean; +{$IFDEF BORLAND} begin Result := GetCppRtlBase <> TJclPeMapImgHooks.SystemBase; end; +{$ELSE} +begin + Result := False; +end; +{$ENDIF BORLAND} + function JclHookExceptions: Boolean; var RaiseExceptionAddressCache: Pointer; Index: source/windows/JclWin32.pas =================================================================== --- source/windows/JclWin32.pas (revision 3644) +++ source/windows/JclWin32.pas (working copy) @@ -71,8 +71,9 @@ {$ELSE ~HAS_UNITSCOPE} Windows, SysUtils, {$IFNDEF FPC} - AccCtrl, ActiveX, + AccCtrl, {$ENDIF ~FPC} + ActiveX, {$ENDIF ~HAS_UNITSCOPE} JclBase; jcl revision 3644 - fpc compatible.patch (26,618 bytes)

Cyrus 2011-12-24 01:55 reporter ~0019246	Uploaded newer version of fpc compatibility patch (jcl revision 3644 - fpc compatible.patch) Could somebody delete these files, please? fpc compatible.patch fpc compatible 2.patch jedi svn 3561 fpc compatible.patch jedi svn 3561 fpc compatible 2.patch

2012-01-28 00:19	jcl svn revision 3706 - fpc trunk 2.7.1 svn 20181 compatible.patch (32,043 bytes) Index: packages/fpc/Jcl.lpk =================================================================== --- packages/fpc/Jcl.lpk (revision 3706) +++ packages/fpc/Jcl.lpk (working copy) @@ -1,17 +1,16 @@ <?xml version="1.0"?> <CONFIG> - <Package Version="3"> + <Package Version="4"> <PathDelim Value="\"/> <Name Value="Jcl"/> - <AddToProjectUsesSection Value="False"/> <Author Value="Project JEDI"/> <AutoUpdate Value="OnRebuildingAll"/> <CompilerOptions> - <Version Value="8"/> + <Version Value="11"/> <PathDelim Value="\"/> <SearchPaths> - <IncludeFiles Value="..\..\source\include\"/> - <OtherUnitFiles Value=".;..\..\source\common;..\..\source\windows;"/> + <IncludeFiles Value="..\..\source\include;..\..\source\include\jedi"/> + <OtherUnitFiles Value=".;..\..\source\common;..\..\source\windows"/> <UnitOutputDirectory Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <Parsing> @@ -19,26 +18,26 @@ <SyntaxOptions> <SyntaxMode Value="Delphi"/> <CStyleOperator Value="False"/> + <UseAnsiStrings Value="False"/> </SyntaxOptions> </Parsing> <CodeGeneration> <Optimizations> <VariablesInRegisters Value="True"/> - <OptimizationLevel Value="3"/> + <OptimizationLevel Value="0"/> </Optimizations> </CodeGeneration> - <Linking> - <Debugging> - <UseLineInfoUnit Value="False"/> - </Debugging> - </Linking> <Other> + <CompilerMessages> + <UseMsgFile Value="True"/> + </CompilerMessages> + <CustomOptions Value="-Ur"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> <Description Value="JEDI Code Library RTL package"/> <License Value="Copyright (C) 1999, 2011 Project JEDI"/> - <Version Major="2" Minor="4" Release="0" Build="4198"/> + <Version Build="4198" Major="2" Minor="4"/> <Files Count="76"> <Item1> <Filename Value="..\..\source\common\bzip2.pas"/> @@ -351,10 +350,10 @@ </Item1> </RequiredPkgs> <UsageOptions> - <UnitPath Value="$(PkgOutDir)\"/> - <IncludePath Value="..\..\source\include\"/> - <LibraryPath Value="$(PkgOutDir)\"/> - <ObjectPath Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)\"/> + <IncludePath Value="..\..\source\include;..\..\source\include\jedi"/> + <LibraryPath Value="$(PkgOutDir)"/> + <ObjectPath Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> + <UnitPath Value="$(PkgOutDir)"/> </UsageOptions> <PublishOptions> <Version Value="2"/> Index: packages/fpc/JclContainers.lpk =================================================================== --- packages/fpc/JclContainers.lpk (revision 3706) +++ packages/fpc/JclContainers.lpk (working copy) @@ -7,11 +7,11 @@ <Author Value="Project JEDI"/> <AutoUpdate Value="OnRebuildingAll"/> <CompilerOptions> - <Version Value="8"/> + <Version Value="10"/> <PathDelim Value="\"/> <SearchPaths> - <IncludeFiles Value="..\..\source\include\"/> - <OtherUnitFiles Value=".;..\..\source\common;"/> + <IncludeFiles Value="..\..\source\include;..\..\source\include\jedi"/> + <OtherUnitFiles Value=".;..\..\source\common;..\..\source\windows"/> <UnitOutputDirectory Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <Parsing> @@ -19,6 +19,7 @@ <SyntaxOptions> <SyntaxMode Value="Delphi"/> <CStyleOperator Value="False"/> + <UseAnsiStrings Value="False"/> </SyntaxOptions> </Parsing> <CodeGeneration> @@ -33,6 +34,10 @@ </Debugging> </Linking> <Other> + <CompilerMessages> + <UseMsgFile Value="True"/> + </CompilerMessages> + <CustomOptions Value="-Ur"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> @@ -106,10 +111,10 @@ </Item2> </RequiredPkgs> <UsageOptions> - <UnitPath Value="$(PkgOutDir)\"/> - <IncludePath Value="..\..\source\include\"/> - <LibraryPath Value="$(PkgOutDir)\"/> - <ObjectPath Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)\"/> + <IncludePath Value="..\..\source\include;..\..\source\include\jedi"/> + <LibraryPath Value="$(PkgOutDir)"/> + <ObjectPath Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> + <UnitPath Value="$(PkgOutDir)"/> </UsageOptions> <PublishOptions> <Version Value="2"/> Index: source/common/JclAbstractContainers.pas =================================================================== --- source/common/JclAbstractContainers.pas (revision 3706) +++ source/common/JclAbstractContainers.pas (working copy) @@ -701,9 +701,9 @@ procedure AppendToStrings(Strings: TJclWideStrings); procedure AppendFromStrings(Strings: TJclWideStrings); function GetAsStrings: TJclWideStrings; - function GetAsDelimited(const Separator: WideString = WideLineBreak): WideString; - procedure AppendDelimited(const AString: WideString; const Separator: WideString = WideLineBreak); - procedure LoadDelimited(const AString: WideString; const Separator: WideString = WideLineBreak); + function GetAsDelimited(const Separator: WideString {$IFDEF BORLAND}= WideLineBreak{$ENDIF BORLAND}): WideString; + procedure AppendDelimited(const AString: WideString; const Separator: WideString {$IFDEF BORLAND}= WideLineBreak{$ENDIF BORLAND}); + procedure LoadDelimited(const AString: WideString; const Separator: WideString {$IFDEF BORLAND}= WideLineBreak{$ENDIF BORLAND}); end; {$IFDEF SUPPORTS_UNICODE_STRING} @@ -1372,12 +1372,12 @@ else begin case FEncoding of - seISO: + JclContainerIntf.seISO: if FCaseSensitive then Result := AnsiStrSimpleHashConvert(AString) else Result := AnsiStrSimpleHashConvertI(AString); - seUTF8: + JclContainerIntf.seUTF8: if FCaseSensitive then Result := AnsiStrSimpleHashConvertU(AString) else @@ -1395,7 +1395,7 @@ else begin case FEncoding of - seISO, seUTF8: + JclContainerIntf.seISO, JclContainerIntf.seUTF8: if FCaseSensitive then Result := AnsiStrSimpleCompare(A, B) else @@ -1416,7 +1416,7 @@ else begin case FEncoding of - seISO, seUTF8: + JclContainerIntf.seISO, JclContainerIntf.seUTF8: if FCaseSensitive then Result := AnsiStrSimpleEqualityCompare(A, B) else Index: source/common/JclAnsiStrings.pas =================================================================== --- source/common/JclAnsiStrings.pas (revision 3706) +++ source/common/JclAnsiStrings.pas (working copy) @@ -518,8 +518,8 @@ function ArrayOf(List: TJclAnsiStrings): TDynStringArray; overload; -function AnsiCompareNaturalStr(const S1, S2: AnsiString): SizeInt; -function AnsiCompareNaturalText(const S1, S2: AnsiString): SizeInt; +function AnsiCompareNaturalStr(const S1, S2: AnsiString): SizeInt;overload; +function AnsiCompareNaturalText(const S1, S2: AnsiString): SizeInt;overload; // internal structures published to make function inlining working const Index: source/common/JclCompression.pas =================================================================== --- source/common/JclCompression.pas (revision 3706) +++ source/common/JclCompression.pas (working copy) @@ -764,7 +764,7 @@ TJclStreamAccess = (saCreate, saReadOnly, saReadOnlyDenyNone, saWriteOnly, saReadWrite); { TJclCompressionArchive is not ref-counted } - TJclCompressionArchive = class(TObject, IInterface) + TJclCompressionArchive = class(TInterfacedObject, IInterface) private FOnProgress: TJclCompressionProgressEvent; FOnRatio: TJclCompressionRatioEvent; Index: source/common/JclDateTime.pas =================================================================== --- source/common/JclDateTime.pas (revision 3706) +++ source/common/JclDateTime.pas (working copy) @@ -87,7 +87,7 @@ { Encode / Decode functions } -function EncodeDate(const Year: Integer; Month, Day: Word): TDateTime; +function EncodeDate(const Year: Integer; Month, Day: Word): TDateTime;overload; procedure DecodeDate(Date: TDateTime; out Year, Month, Day: Word); overload; procedure DecodeDate(Date: TDateTime; out Year: Integer; out Month, Day: Word); overload; procedure DecodeDate(Date: TDateTime; out Year, Month, Day: Integer); overload; Index: source/common/JclRTTI.pas =================================================================== --- source/common/JclRTTI.pas (revision 3706) +++ source/common/JclRTTI.pas (working copy) @@ -1890,7 +1890,7 @@ AInstance := GetObjectProp(FInstance, PropInfo); if AInstance <> nil then begin - SubClassTypeInfo := TJclObjClassTypeInfo.Create(PropInfo.PropType^, Prefix, AInstance); + SubClassTypeInfo := TJclObjClassTypeInfo.Create(PropInfo.PropType{$IFNDEF FPC}^{$ENDIF}, Prefix, AInstance); Result := SubClassTypeInfo.ObjPropNames[Suffix]; end else Index: source/common/JclStringLists.pas =================================================================== --- source/common/JclStringLists.pas (revision 3706) +++ source/common/JclStringLists.pas (working copy) @@ -82,7 +82,7 @@ function GetObjects(Index: Integer): TObject; function GetTextStr: string; function GetValue(const Name: string): string; - function Find(const S: string; var Index: Integer): Boolean; + function Find(const S: string; out Index: Integer): Boolean; function IndexOf(const S: string): Integer; function GetCaseSensitive: Boolean; function GetDuplicates: TDuplicates; @@ -208,7 +208,7 @@ end; type - TJclUpdateControl = class(TObject, IInterface) + TJclUpdateControl = class(TInterfacedObject, IInterface) private FStrings: TStrings; public @@ -219,7 +219,20 @@ function _Release: Integer; stdcall; end; - TJclStringList = class(TStringList, IJclStringList) + TJclInterfacedStringList = class(TStringList, IInterface) + private + FOwnerInterface: IInterface; + protected + { IInterface } + function _AddRef: Integer; stdcall; + function _Release: Integer; stdcall; + public + function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; stdcall; + procedure AfterConstruction; override; + end; + + + TJclStringList = class(TJclInterfacedStringList, IJclStringList) private FObjectsMode: TJclStringListObjectsMode; FSelfAsInterface: IJclStringList; @@ -444,6 +457,45 @@ Result := JclStringList.Add(A); end; +//=== { TJclInterfacedStringList } ============================================== + +procedure TJclInterfacedStringList.AfterConstruction; +Var + MyOwner : TPersistent; +begin + inherited; + MyOwner := GetOwner; + if assigned(MyOwner) then + MyOwner.GetInterface(IUnknown,FOwnerInterface); +end; + + +function TJclInterfacedStringList._AddRef: Integer;stdcall; +begin + if assigned(FOwnerInterface) then + Result:=FOwnerInterface._AddRef + else + Result:=-1; +end; + + +function TJclInterfacedStringList._Release: Integer;stdcall; +begin + if assigned(FOwnerInterface) then + Result:=FOwnerInterface._Release + else + Result:=-1; +end; + + +function TJclInterfacedStringList.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult;stdcall; +begin + if GetInterface(IID, Obj) then + Result:=0 + else + Result:=HResult($80004002); +end; + //=== { TJclStringList } ===================================================== function TJclStringList.Add(const A: array of const): IJclStringList; Index: source/common/JclStrings.pas =================================================================== --- source/common/JclStrings.pas (revision 3706) +++ source/common/JclStrings.pas (working copy) @@ -603,8 +603,8 @@ {$ENDIF SUPPORTS_UNICODE_STRING} // natural comparison functions -function CompareNaturalStr(const S1, S2: string): SizeInt; -function CompareNaturalText(const S1, S2: string): SizeInt; +function CompareNaturalStr(const S1, S2: string): SizeInt;overload; +function CompareNaturalText(const S1, S2: string): SizeInt;overload; {$IFNDEF UNICODE_RTL_DATABASE} // internal structures published to make function inlining working Index: source/common/JclSynch.pas =================================================================== --- source/common/JclSynch.pas (revision 3706) +++ source/common/JclSynch.pas (working copy) @@ -86,8 +86,10 @@ function LockedInc(var Target: Int64): Int64; overload; function LockedSub(var Target: Int64; Value: Int64): Int64; overload; +{$IFDEF BORLAND} function LockedDec(var Target: NativeInt): NativeInt; overload; function LockedInc(var Target: NativeInt): NativeInt; overload; +{$ENDIF BORLAND} {$ENDIF CPU64} // TJclDispatcherObject @@ -729,6 +731,8 @@ ADD RAX, RDX end; +{$IFDEF BORLAND} + function LockedDec(var Target: NativeInt): NativeInt; asm // --> RCX Target @@ -746,6 +750,9 @@ LOCK XADD [RCX], RAX INC RAX end; + +{$ENDIF BORLAND} + {$ENDIF CPU64} //=== { TJclDispatcherObject } =============================================== Index: source/common/JclSysInfo.pas =================================================================== --- source/common/JclSysInfo.pas (revision 3706) +++ source/common/JclSysInfo.pas (working copy) @@ -4323,6 +4323,9 @@ SETNZ Result {$ENDIF CPU32} {$IFDEF CPU64} + {$IFDEF FPC} + {$DEFINE DELPHI64_TEMPORARY} + {$ENDIF FPC} {$IFDEF DELPHI64_TEMPORARY} PUSHFQ {$ELSE ~DELPHI64_TEMPORARY} @@ -4347,6 +4350,9 @@ AND RAX, ID_FLAG XOR RAX, RCX SETNZ Result + {$IFDEF FPC} + {$UNDEF DELPHI64_TEMPORARY} + {$ENDIF FPC} {$ENDIF CPU64} end; {$IFNDEF DELPHI64_TEMPORARY} Index: source/common/JclSysUtils.pas =================================================================== --- source/common/JclSysUtils.pas (revision 3706) +++ source/common/JclSysUtils.pas (working copy) @@ -412,7 +412,7 @@ // interfaced persistent type - TJclInterfacedPersistent = class(TPersistent, IInterface) + TJclInterfacedPersistent = class(TInterfacedPersistent, IInterface) protected FOwnerInterface: IInterface; FRefCount: Integer; @@ -637,7 +637,7 @@ // thread safe support type - TJclIntfCriticalSection = class(TObject, IInterface) + TJclIntfCriticalSection = class(TInterfacedObject, IInterface) private FCriticalSection: TCriticalSection; public @@ -2856,7 +2856,7 @@ end; InternalAbort := False; if AbortPtr <> nil then - AbortPtr^ := False + AbortPtr^ := {$IFDEF FPC}Byte({$ENDIF}False{$IFDEF FPC}){$ENDIF} else AbortPtr := @InternalAbort; // init the array of events to wait for @@ -2898,7 +2898,7 @@ InternalExecuteReadPipe(ErrorPipeInfo, ErrorOverlapped); end; // event based loop - while not AbortPtr^ do + while not {$IFDEF FPC}Boolean({$ENDIF}AbortPtr^{$IFDEF FPC}){$ENDIF} do begin Index := WaitAlertableForMultipleObjects(WaitEvents, False, INFINITE); if Index = WAIT_OBJECT_0 then @@ -2928,7 +2928,7 @@ if ((Index = (WAIT_OBJECT_0 + 2)) and MergeError) or ((Index = (WAIT_OBJECT_0 + 3)) and not MergeError) then // event on abort - AbortPtr^ := True + AbortPtr^ := {$IFDEF FPC}Byte({$ENDIF}True{$IFDEF FPC}){$ENDIF} else {$IFDEF DELPHI11_UP} RaiseLastOSError(Index); @@ -2936,7 +2936,7 @@ RaiseLastOSError; {$ENDIF DELPHI11_UP} end; - if AbortPtr^ then + if {$IFDEF FPC}Boolean({$ENDIF}AbortPtr^{$IFDEF FPC}){$ENDIF} then TerminateProcess(ProcessEvent.Handle, Cardinal(ABORT_EXIT_CODE)); if (ProcessEvent.WaitForever = wrSignaled) and not GetExitCodeProcess(ProcessEvent.Handle, Result) then Result := $FFFFFFFF; Index: source/common/JclUnicode.pas =================================================================== --- source/common/JclUnicode.pas (revision 3706) +++ source/common/JclUnicode.pas (working copy) @@ -1843,6 +1843,7 @@ SetLength(Categories[First], 256); if Categories[First, Second] = nil then SetLength(Categories[First, Second], 256); + {$IFNDEF FPC} {$IF SizeOf(TCharacterCategories) mod 4 <> 0} // The array is allocated on the exact size, but the compiler generates // a 32 bit "BTS" instruction that accesses memory beyond the allocated block. @@ -1853,6 +1854,18 @@ {$ELSE} Include(Categories[First, Second, Third], Category); {$IFEND} + {$ELSE FPC} + IF SizeOf(TCharacterCategories) mod 4 <> 0 Then begin + // The array is allocated on the exact size, but the compiler generates + // a 32 bit "BTS" instruction that accesses memory beyond the allocated block. + if Third < 255 then + Include(Categories[First, Second, Third], Category) + else + Categories[First, Second, Third] := Categories[First, Second, Third] + [Category]; + end + else + Include(Categories[First, Second, Third], Category); + {$IFEND FPC} end; end; end; @@ -3116,7 +3129,7 @@ // Looks for all occurences of the pattern passed to FindPrepare and creates an // internal list of their positions. var - Start, Stop: SizeInt; + Start, Stop, CharCount: SizeInt; Run: PWideChar; RunLen: SizeInt; begin @@ -3129,7 +3142,9 @@ while Find(Run, RunLen, Start, Stop) do begin // store this result (consider text pointer movement)... - AddResult(Start + Run - Text, Stop + Run - Text); + CharCount := (TJclAddr(Run) - TJclAddr(Text)) div SizeOf(WideChar); + AddResult(Start + CharCount, Stop + CharCount); + // ... and advance text position and length Inc(Run, Stop); Dec(RunLen, Stop); @@ -5087,7 +5102,7 @@ // Looks for all occurences of the pattern passed to FindPrepare and creates an // internal list of their positions. var - Start, Stop: SizeInt; + Start, Stop, CharCount: SizeInt; Run: PWideChar; RunLen: SizeInt; begin @@ -5100,7 +5115,9 @@ while ExecuteURE(0, Run, RunLen, Start, Stop) do begin // store this result (consider text pointer movement)... - AddResult(Start + Run - Text, Stop + Run - Text); + CharCount := (TJclAddr(Run) - TJclAddr(Text)) div SizeOf(WideChar); + AddResult(Start + CharCount, Stop + CharCount); + // ... and advance text position and length Inc(Run, Stop); Dec(RunLen, Stop); Index: source/common/JclWideStrings.pas =================================================================== --- source/common/JclWideStrings.pas (revision 3706) +++ source/common/JclWideStrings.pas (working copy) @@ -845,11 +845,11 @@ // --> RCX Str XOR RAX, RAX // clear high order byte to be able to use 64bit operand below @@1: - MOV AX, WORD PTR [ECX] + MOV AX, WORD PTR [RCX] OR RAX, RAX JZ @@2 XCHG AL, AH - MOV WORD PTR [ECX], AX + MOV WORD PTR [RCX], AX ADD ECX, 2 JMP @@1 @@2: Index: source/include/jclfpc.inc =================================================================== --- source/include/jclfpc.inc (revision 0) +++ source/include/jclfpc.inc (working copy) @@ -0,0 +1,131 @@ +{************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is jcl.inc } +{ } +{ The Initial Developer of the Original Code is Marcel van Brakel. } +{ Portions created by Marcel van Brakel are Copyright (C) Marcel van Brakel. } +{ } +{ Contributors: } +{ Marcel van Brakel } +{ Matthias Thoma (mthoma) } +{ Petr Vones } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Florent Ouchet (outchy) } +{ } +{**********************************************************************************************} +{ } +{ This include file defines various JCL specific defines. } +{ The more generic JCL defines are defined in jcl.inc and the generic defines in the jedi.inc file } +{ which is shared with the JEDI VCL. } +{ } +{**********************************************************************************************} +{ } +{ This file is filled by the JCL installer, all the changes made in its content will be lost the } +{ next time the JCL is installed. } +{ } +{***********************************************************************************************} + +// $Id: jcl.template.inc 3362 2010-10-05 13:24:05Z outchy $ + +// Math precision selection, mutually exclusive +// FPC does not support EXTENDED when targetting x86_64, MATH_DOUBLE_PRECISION is the default in this situation +{.$DEFINE MATH_EXTENDED_PRECISION} // default +{.$DEFINE MATH_DOUBLE_PRECISION} +{.$DEFINE MATH_SINGLE_PRECISION} + + +// Math functions takes care of infinites and NaN +{.$DEFINE MATH_EXT_EXTREMEVALUES} + + +// JclHookExcept support for hooking exceptions from DLLs +{.$DEFINE HOOK_DLL_EXCEPTIONS} + + +//Threadsafe directive +{.$DEFINE THREADSAFE} + + +// To exclude obsolete code from compilation, remove the point from the line below +{.$DEFINE DROP_OBSOLETE_CODE} + + +//Support for JclUnitVersioning.pas, not supported by Delphi 2005 (automatically disabled afterward) +{.$DEFINE UNITVERSIONING} + + +// debug sources +// defining these symbols will the debug source to be automatically registered +{.$DEFINE DEBUG_NO_BINARY} +{.$DEFINE DEBUG_NO_TD32} // automatically defined for FPC +{.$DEFINE DEBUG_NO_MAP} +{.$DEFINE DEBUG_NO_EXPORTS} +{.$DEFINE DEBUG_NO_SYMBOLS} + + +// PCRE options, mutually exclusive +// IMPORTANT: The static link works only for Delphi 2005 and newer +// (an internal error is raised on other compilers) +// Only one of the following defines can be defined at a time +// static link: PCRE_STATICLINK +// static dll import: PCRE_LINKDLL +// dynamic dll import: PCRE_LINKONREQUEST + +{.$DEFINE PCRE_STATICLINK} +{.$DEFINE PCRE_LINKDLL} +{.$DEFINE PCRE_LINKONREQUEST} // default + + +// BZIP2 options, mutually exclusive + +{.$DEFINE BZIP2_STATICLINK} // default +{.$DEFINE BZIP2_LINKDLL} +{$DEFINE BZIP2_LINKONREQUEST} + + +// ZLIB options, mutually exclusive + +{.$DEFINE ZLIB_STATICLINK} // default +{.$DEFINE ZLIB_LINKDLL} +{$DEFINE ZLIB_LINKONREQUEST} + + +// Unicode options +// use RTL Character Database rather than JCL one, less accurate but reduce executable size +{.$DEFINE UNICODE_RTL_DATABASE} + +// insert a replacement character if sequence is corrupted rather than raising an exception +{.$DEFINE UNICODE_SILENT_FAILURE} + +// defines resource compression (uncompressed, compressed with ZLib, compressed with BZip2), mutually exclusive +{.$DEFINE UNICODE_RAW_DATA} // default +{.$DEFINE UNICODE_ZLIB_DATA} +{.$DEFINE UNICODE_BZIP2_DATA} + + +// container options +// define mapping of TJclStr containers to TJclAnsiStr* or TJclWideStr* (mutually exclusive) +{.$DEFINE CONTAINER_ANSISTR} // default for D2007 and older +{.$DEFINE CONTAINER_WIDESTR} +{.$DEFINE CONTAINER_UNICODESTR} // default for D2009 and newer, not supported for Delphi 2007 and older +{.$DEFINE CONTAINER_NOSTR} + + +// 7Zip options, mutually exclusive +// IMPORTANT: The static link is not supported yet + +{.$DEFINE 7ZIP_STATICLINK} // not supported yet +{.$DEFINE 7ZIP_LINKDLL} +{.$DEFINE 7ZIP_LINKONREQUEST} // default + Index: source/windows/JclAppInst.pas =================================================================== --- source/windows/JclAppInst.pas (revision 3706) +++ source/windows/JclAppInst.pas (working copy) @@ -742,7 +742,7 @@ ACLSize := SizeOf(TACL) + SizeOf(ACCESS_ALLOWED_ACE) + SizeOf(DWORD) + GetLengthSid(AccessSID); ACL := AllocMem(ACLSize); Win32Check(InitializeAcl(ACL^, ACLSize, ACL_REVISION)); - Win32Check(AddAccessAllowedAce(ACL^, ACL_REVISION, FILE_MAP_ALL_ACCESS, AccessSID)); + Win32Check(AddAccessAllowedAce(ACL{$IFNDEF FPC}^{$ENDIF}, ACL_REVISION, FILE_MAP_ALL_ACCESS, AccessSID)); Assert(IsValidAcl(ACL{$IFNDEF RTL230_UP}^{$ENDIF})); // QC #102231 // create the security descriptor Index: source/windows/JclCppException.pas =================================================================== --- source/windows/JclCppException.pas (revision 3706) +++ source/windows/JclCppException.pas (working copy) @@ -160,7 +160,7 @@ implementation uses - JclResources, JclHookExcept; + JclResources, JclHookExcept, Windows; type @@ -438,7 +438,9 @@ var OldAcquireExceptionProc: Pointer; + {$IFDEF CPU32} OldRaiseExceptionProc: TRaiseExceptionProc; + {$ENDIF CPU32} procedure ExceptionAcquiredProc(Obj: Pointer); begin @@ -465,8 +467,10 @@ end; LastCppExcDesc := nil; + {$IFDEF CPU32} if Assigned(OldRaiseExceptionProc) then OldRaiseExceptionProc(ExceptionCode, ExceptionFlags, NumberOfArguments, Args); + {$ENDIF CPU32} end; function EJclCppStdException.GetStdException: PJclCppStdException; @@ -676,8 +680,8 @@ { The exception object is a std::exception subclass and implements the virtual member function what(). } ExcObjectVTbl := Pointer(PCardinal(ExcObject)^); - WhatMethod := TCppTypeInfoWhatMethod(PCardinal( - Cardinal(ExcObjectVTbl) + SizeOf(Pointer))^); + WhatMethod := TCppTypeInfoWhatMethod(Pointer(PCardinal( + Cardinal(ExcObjectVTbl) + SizeOf(Pointer))^)); Result := EJclCppStdException.Create(ExcObject, String(WhatMethod(ExcObject)), PAnsiChar(ExcTypeName), Pointer(ExcDesc)); end @@ -698,7 +702,11 @@ 'Cannot install C++ exception filter: call JclHookExcept.JclHookExceptions() first!'); if HookInstalled then Exit; + {$IFDEF BORLAND} HookInstalled := JclHookExcept.JclAddExceptFilter(@CppExceptObjProc, npFirstChain); + {$ELSE BORLAND} + HookInstalled := False; + {$ENDIF BORLAND} if HookInstalled then begin {$IFDEF COMPILER12_UP} // TODO: this may be supported for earlier versions of Delphi/C++Builder @@ -706,12 +714,14 @@ System.ExceptionAcquired := @ExceptionAcquiredProc; {$ENDIF COMPILER12_UP} + {$IFDEF BORLAND} OldRaiseExceptionProc := System.RaiseExceptionProc; {$IFDEF CPU32} System.RaiseExceptionProc := @RaiseExceptionProc; {$ELSE} System.RaiseExceptionProc := RaiseExceptionProc; {$ENDIF CPU32} + {$ENDIF BORLAND} end; end; @@ -722,12 +732,14 @@ {$IFDEF COMPILER12_UP} // TODO: this may be supported for earlier versions of Delphi/C++Builder System.ExceptionAcquired := OldAcquireExceptionProc; {$ENDIF COMPILER12_UP} + {$IFDEF BORLAND} {$IFDEF CPU32} System.RaiseExceptionProc := @OldRaiseExceptionProc; {$ELSE} System.RaiseExceptionProc := OldRaiseExceptionProc; {$ENDIF CPU32} JclHookExcept.JclRemoveExceptFilter(@CppExceptObjProc); + {$ENDIF BORLAND} HookInstalled := False; end; Index: source/windows/JclHookExcept.pas =================================================================== --- source/windows/JclHookExcept.pas (revision 3706) +++ source/windows/JclHookExcept.pas (working copy) @@ -46,7 +46,7 @@ {$IFDEF HAS_UNITSCOPE} Winapi.Windows, System.SysUtils, System.Classes; {$ELSE ~HAS_UNITSCOPE} - Windows, SysUtils, Classes; + Windows, SysUtils, Classes, JclBase; {$ENDIF ~HAS_UNITSCOPE} type @@ -109,7 +109,6 @@ implementation uses - JclBase, JclPeImage, JclSysInfo, JclSysUtils; @@ -575,10 +574,12 @@ end; function GetCppRtlBase: Pointer; +{$IFDEF BORLAND} const {$IFDEF COMPILER6} { Delphi/C++Builder 6 } CppRtlVersion = 60; {$ELSE ~COMPILER6} + {$IF (RtlVersion > 18.0) and (RtlVersion < 19.0)} { Delphi/C++Builder 2007 were aiming for binary compatibility with BDS2006, which complicates things a bit } @@ -595,6 +596,11 @@ in this case TJclPeMapImgHooks.ReplaceImport() is a no-op. The base module is also being hooked separately, so we're covered. } end; +{$ELSE BORLAND} +begin + Result := NIL; +end; +{$ENDIF BORLAND} function HasCppRtl: Boolean; begin Index: source/windows/JclWin32.pas =================================================================== --- source/windows/JclWin32.pas (revision 3706) +++ source/windows/JclWin32.pas (working copy) @@ -71,8 +71,9 @@ {$ELSE ~HAS_UNITSCOPE} Windows, SysUtils, {$IFNDEF FPC} - AccCtrl, ActiveX, + AccCtrl, {$ENDIF ~FPC} + ActiveX, {$ENDIF ~HAS_UNITSCOPE} JclBase; jcl svn revision 3706 - fpc trunk 2.7.1 svn 20181 compatible.patch (32,043 bytes)

Cyrus 2012-01-28 00:20 reporter ~0019358	Uploaded updated patch (jcl svn revision 3706 - fpc trunk 2.7.1 svn 20181 compatible.patch).

outchy 2012-03-04 19:40 administrator ~0019646	CPP exceptions have been completly disabled in revision 3757. Committed in revisions 3758 and 3759 except: - JclAbstractContainers - JclAnsiStrings - JclDateTime - JclStrings (these changes are not required by FPC 2.6.0) Please review the changes in JclUnicode.pas revision 3759.

2012-05-18 16:32	patch against jcl revision 3795 - fpc trunk compatible.patch (16,533 bytes) Index: packages/fpc/Jcl.lpk =================================================================== --- packages/fpc/Jcl.lpk (revision 3795) +++ packages/fpc/Jcl.lpk (working copy) @@ -1,17 +1,15 @@ <?xml version="1.0"?> <CONFIG> - <Package Version="3"> + <Package Version="4"> <PathDelim Value="\"/> <Name Value="Jcl"/> - <AddToProjectUsesSection Value="False"/> <Author Value="Project JEDI"/> - <AutoUpdate Value="OnRebuildingAll"/> <CompilerOptions> - <Version Value="9"/> + <Version Value="11"/> <PathDelim Value="\"/> <SearchPaths> - <IncludeFiles Value="..\..\source\include\"/> - <OtherUnitFiles Value=".;..\..\source\common;..\..\source\windows;;..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> + <IncludeFiles Value="..\..\source\include;..\..\source\include\jedi"/> + <OtherUnitFiles Value=".;..\..\source\common;..\..\source\windows;..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> <UnitOutputDirectory Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <Parsing> @@ -25,21 +23,17 @@ <CodeGeneration> <Optimizations> <VariablesInRegisters Value="True"/> - <OptimizationLevel Value="3"/> + <OptimizationLevel Value="0"/> </Optimizations> </CodeGeneration> - <Linking> - <Debugging> - <UseLineInfoUnit Value="False"/> - </Debugging> - </Linking> <Other> + <CustomOptions Value="-Ur"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> <Description Value="JEDI Code Library RTL package"/> <License Value="Copyright (C) 1999, 2011 Project JEDI"/> - <Version Major="2" Minor="4" Release="0" Build="4198"/> + <Version Major="2" Minor="4" Build="4198"/> <Files Count="76"> <Item1> <Filename Value="..\..\source\common\bzip2.pas"/> @@ -346,16 +340,15 @@ <UnitName Value="Snmp"/> </Item76> </Files> + <Type Value="RunTimeOnly"/> <RequiredPkgs Count="1"> <Item1> <PackageName Value="FCL"/> </Item1> </RequiredPkgs> <UsageOptions> - <IncludePath Value="..\..\source\include\"/> - <LibraryPath Value="$(PkgOutDir)\"/> - <ObjectPath Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)\"/> - <UnitPath Value="$(PkgOutDir)\"/> + <IncludePath Value="..\..\source\include;..\..\source\include\jedi"/> + <UnitPath Value="$(PkgOutDir)"/> </UsageOptions> <PublishOptions> <Version Value="2"/> Index: packages/fpc/JclContainers.lpk =================================================================== --- packages/fpc/JclContainers.lpk (revision 3795) +++ packages/fpc/JclContainers.lpk (working copy) @@ -1,17 +1,15 @@ <?xml version="1.0"?> <CONFIG> - <Package Version="3"> + <Package Version="4"> <PathDelim Value="\"/> <Name Value="JclContainers"/> - <AddToProjectUsesSection Value="False"/> <Author Value="Project JEDI"/> - <AutoUpdate Value="OnRebuildingAll"/> <CompilerOptions> - <Version Value="9"/> + <Version Value="11"/> <PathDelim Value="\"/> <SearchPaths> - <IncludeFiles Value="..\..\source\include\"/> - <OtherUnitFiles Value=".;..\..\source\common;;..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> + <IncludeFiles Value="..\..\source\include;..\..\source\include\jedi"/> + <OtherUnitFiles Value=".;..\..\source\common;..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> <UnitOutputDirectory Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <Parsing> @@ -25,21 +23,17 @@ <CodeGeneration> <Optimizations> <VariablesInRegisters Value="True"/> - <OptimizationLevel Value="3"/> + <OptimizationLevel Value="0"/> </Optimizations> </CodeGeneration> - <Linking> - <Debugging> - <UseLineInfoUnit Value="False"/> - </Debugging> - </Linking> <Other> + <CustomOptions Value="-Ur"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> <Description Value="JEDI Code Library Containers package"/> <License Value="Copyright (C) 1999, 2011 Project JEDI"/> - <Version Major="2" Minor="4" Release="0" Build="4198"/> + <Version Major="2" Minor="4" Build="4198"/> <Files Count="14"> <Item1> <Filename Value="..\..\source\common\JclAbstractContainers.pas"/> @@ -98,6 +92,7 @@ <UnitName Value="JclVectors"/> </Item14> </Files> + <Type Value="RunTimeOnly"/> <RequiredPkgs Count="2"> <Item1> <PackageName Value="FCL"/> @@ -107,10 +102,8 @@ </Item2> </RequiredPkgs> <UsageOptions> - <IncludePath Value="..\..\source\include\"/> - <LibraryPath Value="$(PkgOutDir)\"/> - <ObjectPath Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)\"/> - <UnitPath Value="$(PkgOutDir)\"/> + <IncludePath Value="..\..\source\include;..\..\source\include\jedi"/> + <UnitPath Value="$(PkgOutDir)"/> </UsageOptions> <PublishOptions> <Version Value="2"/> Index: source/common/JclAbstractContainers.pas =================================================================== --- source/common/JclAbstractContainers.pas (revision 3795) +++ source/common/JclAbstractContainers.pas (working copy) @@ -1374,12 +1374,12 @@ else begin case FEncoding of - seISO: + JclContainerIntf.seISO: if FCaseSensitive then Result := AnsiStrSimpleHashConvert(AString) else Result := AnsiStrSimpleHashConvertI(AString); - seUTF8: + JclContainerIntf.seUTF8: if FCaseSensitive then Result := AnsiStrSimpleHashConvertU(AString) else @@ -1397,7 +1397,7 @@ else begin case FEncoding of - seISO, seUTF8: + JclContainerIntf.seISO, JclContainerIntf.seUTF8: if FCaseSensitive then Result := AnsiStrSimpleCompare(A, B) else @@ -1418,7 +1418,7 @@ else begin case FEncoding of - seISO, seUTF8: + JclContainerIntf.seISO, JclContainerIntf.seUTF8: if FCaseSensitive then Result := AnsiStrSimpleEqualityCompare(A, B) else Index: source/common/JclAnsiStrings.pas =================================================================== --- source/common/JclAnsiStrings.pas (revision 3795) +++ source/common/JclAnsiStrings.pas (working copy) @@ -4056,12 +4056,12 @@ end; end; -function AnsiCompareNaturalStr(const S1, S2: AnsiString): SizeInt; overload; +function AnsiCompareNaturalStr(const S1, S2: AnsiString): SizeInt; {$IFDEF BORLAND}overload;{$ENDIF} begin Result := AnsiCompareNatural(S1, S2, False); end; -function AnsiCompareNaturalText(const S1, S2: AnsiString): SizeInt; overload; +function AnsiCompareNaturalText(const S1, S2: AnsiString): SizeInt; {$IFDEF BORLAND}overload;{$ENDIF} begin Result := AnsiCompareNatural(S1, S2, True); end; Index: source/common/JclContainerIntf.pas =================================================================== --- source/common/JclContainerIntf.pas (revision 3795) +++ source/common/JclContainerIntf.pas (working copy) @@ -365,9 +365,9 @@ procedure AppendToStrings(Strings: TJclWideStrings); procedure AppendFromStrings(Strings: TJclWideStrings); function GetAsStrings: TJclWideStrings; - function GetAsDelimited(const Separator: WideString = WideLineBreak): WideString; - procedure AppendDelimited(const AString: WideString; const Separator: WideString = WideLineBreak); - procedure LoadDelimited(const AString: WideString; const Separator: WideString = WideLineBreak); + function GetAsDelimited(const Separator: WideString {$IFDEF BORLAND}= WideLineBreak {$ENDIF BORLAND}): WideString; + procedure AppendDelimited(const AString: WideString; const Separator: WideString {$IFDEF BORLAND}= WideLineBreak{$ENDIF BORLAND}); + procedure LoadDelimited(const AString: WideString; const Separator: WideString {$IFDEF BORLAND}= WideLineBreak{$ENDIF BORLAND}); end; {$IFDEF SUPPORTS_UNICODE_STRING} Index: source/common/JclDateTime.pas =================================================================== --- source/common/JclDateTime.pas (revision 3795) +++ source/common/JclDateTime.pas (working copy) @@ -263,7 +263,7 @@ // 7 : first full week //ISOFirstWeekMinDays = 4; -function EncodeDate(const Year: Integer; Month, Day: Word): TDateTime; overload; +function EncodeDate(const Year: Integer; Month, Day: Word): TDateTime; {$IFDEF BORLAND}overload;{$ENDIF} begin if (Year > 0) and (Year < EncodeDateMaxYear + 1) then Result := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.EncodeDate(Year, Month, Day) Index: source/common/JclStrings.pas =================================================================== --- source/common/JclStrings.pas (revision 3795) +++ source/common/JclStrings.pas (working copy) @@ -5380,12 +5380,12 @@ end; end; -function CompareNaturalStr(const S1, S2: string): SizeInt; overload; +function CompareNaturalStr(const S1, S2: string): SizeInt; {$IFDEF BORLAND}overload;{$ENDIF} begin Result := CompareNatural(S1, S2, False); end; -function CompareNaturalText(const S1, S2: string): SizeInt; overload; +function CompareNaturalText(const S1, S2: string): SizeInt; {$IFDEF BORLAND}overload;{$ENDIF} begin Result := CompareNatural(S1, S2, True); end; Index: source/include/jclfpc.inc =================================================================== --- source/include/jclfpc.inc (revision 0) +++ source/include/jclfpc.inc (working copy) @@ -0,0 +1,131 @@ +{************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is jcl.inc } +{ } +{ The Initial Developer of the Original Code is Marcel van Brakel. } +{ Portions created by Marcel van Brakel are Copyright (C) Marcel van Brakel. } +{ } +{ Contributors: } +{ Marcel van Brakel } +{ Matthias Thoma (mthoma) } +{ Petr Vones } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Florent Ouchet (outchy) } +{ } +{**********************************************************************************************} +{ } +{ This include file defines various JCL specific defines. } +{ The more generic JCL defines are defined in jcl.inc and the generic defines in the jedi.inc file } +{ which is shared with the JEDI VCL. } +{ } +{**********************************************************************************************} +{ } +{ This file is filled by the JCL installer, all the changes made in its content will be lost the } +{ next time the JCL is installed. } +{ } +{***********************************************************************************************} + +// $Id: jcl.template.inc 3362 2010-10-05 13:24:05Z outchy $ + +// Math precision selection, mutually exclusive +// FPC does not support EXTENDED when targetting x86_64, MATH_DOUBLE_PRECISION is the default in this situation +{.$DEFINE MATH_EXTENDED_PRECISION} // default +{.$DEFINE MATH_DOUBLE_PRECISION} +{.$DEFINE MATH_SINGLE_PRECISION} + + +// Math functions takes care of infinites and NaN +{.$DEFINE MATH_EXT_EXTREMEVALUES} + + +// JclHookExcept support for hooking exceptions from DLLs +{.$DEFINE HOOK_DLL_EXCEPTIONS} + + +//Threadsafe directive +{.$DEFINE THREADSAFE} + + +// To exclude obsolete code from compilation, remove the point from the line below +{.$DEFINE DROP_OBSOLETE_CODE} + + +//Support for JclUnitVersioning.pas, not supported by Delphi 2005 (automatically disabled afterward) +{.$DEFINE UNITVERSIONING} + + +// debug sources +// defining these symbols will the debug source to be automatically registered +{.$DEFINE DEBUG_NO_BINARY} +{.$DEFINE DEBUG_NO_TD32} // automatically defined for FPC +{.$DEFINE DEBUG_NO_MAP} +{.$DEFINE DEBUG_NO_EXPORTS} +{.$DEFINE DEBUG_NO_SYMBOLS} + + +// PCRE options, mutually exclusive +// IMPORTANT: The static link works only for Delphi 2005 and newer +// (an internal error is raised on other compilers) +// Only one of the following defines can be defined at a time +// static link: PCRE_STATICLINK +// static dll import: PCRE_LINKDLL +// dynamic dll import: PCRE_LINKONREQUEST + +{.$DEFINE PCRE_STATICLINK} +{.$DEFINE PCRE_LINKDLL} +{.$DEFINE PCRE_LINKONREQUEST} // default + + +// BZIP2 options, mutually exclusive + +{.$DEFINE BZIP2_STATICLINK} // default +{.$DEFINE BZIP2_LINKDLL} +{$DEFINE BZIP2_LINKONREQUEST} + + +// ZLIB options, mutually exclusive + +{.$DEFINE ZLIB_STATICLINK} // default +{.$DEFINE ZLIB_LINKDLL} +{$DEFINE ZLIB_LINKONREQUEST} + + +// Unicode options +// use RTL Character Database rather than JCL one, less accurate but reduce executable size +{.$DEFINE UNICODE_RTL_DATABASE} + +// insert a replacement character if sequence is corrupted rather than raising an exception +{.$DEFINE UNICODE_SILENT_FAILURE} + +// defines resource compression (uncompressed, compressed with ZLib, compressed with BZip2), mutually exclusive +{.$DEFINE UNICODE_RAW_DATA} // default +{.$DEFINE UNICODE_ZLIB_DATA} +{.$DEFINE UNICODE_BZIP2_DATA} + + +// container options +// define mapping of TJclStr containers to TJclAnsiStr* or TJclWideStr* (mutually exclusive) +{.$DEFINE CONTAINER_ANSISTR} // default for D2007 and older +{.$DEFINE CONTAINER_WIDESTR} +{.$DEFINE CONTAINER_UNICODESTR} // default for D2009 and newer, not supported for Delphi 2007 and older +{.$DEFINE CONTAINER_NOSTR} + + +// 7Zip options, mutually exclusive +// IMPORTANT: The static link is not supported yet + +{.$DEFINE 7ZIP_STATICLINK} // not supported yet +{.$DEFINE 7ZIP_LINKDLL} +{.$DEFINE 7ZIP_LINKONREQUEST} // default + patch against jcl revision 3795 - fpc trunk compatible.patch (16,533 bytes)

Cyrus 2012-05-18 16:32 reporter ~0019763	Uploaded updated patch (patch against jcl revision 3795 - fpc trunk compatible.patch).

Cyrus 2012-05-18 16:40 reporter ~0019764 Last edited: 2012-05-18 17:23	These are error messages FPC trunk gives at compile time if latest patch weren't applied to jcl trunk. .\jcl\source\common\JclAbstractContainers.pas(1382,13) Error: Constant and CASE types do not match .\jcl\source\common\JclAbstractContainers.pas(1382,13) Warning: range check error while evaluating constants (5 must be between 0 and 1) .\jcl\source\common\JclAbstractContainers.pas(1400,20) Error: Constant and CASE types do not match .\jcl\source\common\JclAbstractContainers.pas(1400,20) Warning: range check error while evaluating constants (5 must be between 0 and 1) .\jcl\source\common\JclAbstractContainers.pas(1421,20) Error: Constant and CASE types do not match .\jcl\source\common\JclAbstractContainers.pas(1421,20) Warning: range check error while evaluating constants (5 must be between 0 and 1) This error message is same for JclDateTime.pas and JclStrings.pas: .\jcl\source\common\JclAnsiStrings.pas(4059,10) Error: function header doesn't match the previous declaration "procedure AnsiCompareNaturalStr(const AnsiString;const AnsiString):LongInt;" .\jcl\source\common\JclAnsiStrings.pas(4064,10) Error: function header doesn't match the previous declaration "procedure AnsiCompareNaturalText(const AnsiString;const AnsiString):LongInt;" This error message pops up when compiling with FPC trunk 64-bit compiler: JclRegistry.pas(65,42) Error: Identifier not found "Winapi"

2012-05-18 16:59	patch against jcl revision 3795 - fpc trunk revision 21320 2.patch (15,339 bytes) Index: packages/fpc/Jcl.lpk =================================================================== --- packages/fpc/Jcl.lpk (revision 3795) +++ packages/fpc/Jcl.lpk (working copy) @@ -1,17 +1,15 @@ <?xml version="1.0"?> <CONFIG> - <Package Version="3"> + <Package Version="4"> <PathDelim Value="\"/> <Name Value="Jcl"/> - <AddToProjectUsesSection Value="False"/> <Author Value="Project JEDI"/> - <AutoUpdate Value="OnRebuildingAll"/> <CompilerOptions> - <Version Value="9"/> + <Version Value="11"/> <PathDelim Value="\"/> <SearchPaths> - <IncludeFiles Value="..\..\source\include\"/> - <OtherUnitFiles Value=".;..\..\source\common;..\..\source\windows;;..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> + <IncludeFiles Value="..\..\source\include;..\..\source\include\jedi"/> + <OtherUnitFiles Value=".;..\..\source\common;..\..\source\windows;..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> <UnitOutputDirectory Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <Parsing> @@ -25,21 +23,17 @@ <CodeGeneration> <Optimizations> <VariablesInRegisters Value="True"/> - <OptimizationLevel Value="3"/> + <OptimizationLevel Value="0"/> </Optimizations> </CodeGeneration> - <Linking> - <Debugging> - <UseLineInfoUnit Value="False"/> - </Debugging> - </Linking> <Other> + <CustomOptions Value="-Ur"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> <Description Value="JEDI Code Library RTL package"/> <License Value="Copyright (C) 1999, 2011 Project JEDI"/> - <Version Major="2" Minor="4" Release="0" Build="4198"/> + <Version Major="2" Minor="4" Build="4198"/> <Files Count="76"> <Item1> <Filename Value="..\..\source\common\bzip2.pas"/> @@ -346,16 +340,15 @@ <UnitName Value="Snmp"/> </Item76> </Files> + <Type Value="RunTimeOnly"/> <RequiredPkgs Count="1"> <Item1> <PackageName Value="FCL"/> </Item1> </RequiredPkgs> <UsageOptions> - <IncludePath Value="..\..\source\include\"/> - <LibraryPath Value="$(PkgOutDir)\"/> - <ObjectPath Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)\"/> - <UnitPath Value="$(PkgOutDir)\"/> + <IncludePath Value="..\..\source\include;..\..\source\include\jedi"/> + <UnitPath Value="$(PkgOutDir)"/> </UsageOptions> <PublishOptions> <Version Value="2"/> Index: packages/fpc/JclContainers.lpk =================================================================== --- packages/fpc/JclContainers.lpk (revision 3795) +++ packages/fpc/JclContainers.lpk (working copy) @@ -1,17 +1,15 @@ <?xml version="1.0"?> <CONFIG> - <Package Version="3"> + <Package Version="4"> <PathDelim Value="\"/> <Name Value="JclContainers"/> - <AddToProjectUsesSection Value="False"/> <Author Value="Project JEDI"/> - <AutoUpdate Value="OnRebuildingAll"/> <CompilerOptions> - <Version Value="9"/> + <Version Value="11"/> <PathDelim Value="\"/> <SearchPaths> - <IncludeFiles Value="..\..\source\include\"/> - <OtherUnitFiles Value=".;..\..\source\common;;..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> + <IncludeFiles Value="..\..\source\include;..\..\source\include\jedi"/> + <OtherUnitFiles Value=".;..\..\source\common;..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> <UnitOutputDirectory Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <Parsing> @@ -25,21 +23,17 @@ <CodeGeneration> <Optimizations> <VariablesInRegisters Value="True"/> - <OptimizationLevel Value="3"/> + <OptimizationLevel Value="0"/> </Optimizations> </CodeGeneration> - <Linking> - <Debugging> - <UseLineInfoUnit Value="False"/> - </Debugging> - </Linking> <Other> + <CustomOptions Value="-Ur"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> <Description Value="JEDI Code Library Containers package"/> <License Value="Copyright (C) 1999, 2011 Project JEDI"/> - <Version Major="2" Minor="4" Release="0" Build="4198"/> + <Version Major="2" Minor="4" Build="4198"/> <Files Count="14"> <Item1> <Filename Value="..\..\source\common\JclAbstractContainers.pas"/> @@ -98,6 +92,7 @@ <UnitName Value="JclVectors"/> </Item14> </Files> + <Type Value="RunTimeOnly"/> <RequiredPkgs Count="2"> <Item1> <PackageName Value="FCL"/> @@ -107,10 +102,8 @@ </Item2> </RequiredPkgs> <UsageOptions> - <IncludePath Value="..\..\source\include\"/> - <LibraryPath Value="$(PkgOutDir)\"/> - <ObjectPath Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)\"/> - <UnitPath Value="$(PkgOutDir)\"/> + <IncludePath Value="..\..\source\include;..\..\source\include\jedi"/> + <UnitPath Value="$(PkgOutDir)"/> </UsageOptions> <PublishOptions> <Version Value="2"/> Index: source/common/JclAbstractContainers.pas =================================================================== --- source/common/JclAbstractContainers.pas (revision 3795) +++ source/common/JclAbstractContainers.pas (working copy) @@ -1374,12 +1374,12 @@ else begin case FEncoding of - seISO: + JclContainerIntf.seISO: if FCaseSensitive then Result := AnsiStrSimpleHashConvert(AString) else Result := AnsiStrSimpleHashConvertI(AString); - seUTF8: + JclContainerIntf.seUTF8: if FCaseSensitive then Result := AnsiStrSimpleHashConvertU(AString) else @@ -1397,7 +1397,7 @@ else begin case FEncoding of - seISO, seUTF8: + JclContainerIntf.seISO, JclContainerIntf.seUTF8: if FCaseSensitive then Result := AnsiStrSimpleCompare(A, B) else @@ -1418,7 +1418,7 @@ else begin case FEncoding of - seISO, seUTF8: + JclContainerIntf.seISO, JclContainerIntf.seUTF8: if FCaseSensitive then Result := AnsiStrSimpleEqualityCompare(A, B) else Index: source/common/JclAnsiStrings.pas =================================================================== --- source/common/JclAnsiStrings.pas (revision 3795) +++ source/common/JclAnsiStrings.pas (working copy) @@ -518,8 +518,8 @@ function ArrayOf(List: TJclAnsiStrings): TDynStringArray; overload; -function AnsiCompareNaturalStr(const S1, S2: AnsiString): SizeInt; -function AnsiCompareNaturalText(const S1, S2: AnsiString): SizeInt; +function AnsiCompareNaturalStr(const S1, S2: AnsiString): SizeInt; overload; +function AnsiCompareNaturalText(const S1, S2: AnsiString): SizeInt; overload; // internal structures published to make function inlining working const Index: source/common/JclDateTime.pas =================================================================== --- source/common/JclDateTime.pas (revision 3795) +++ source/common/JclDateTime.pas (working copy) @@ -87,7 +87,7 @@ { Encode / Decode functions } -function EncodeDate(const Year: Integer; Month, Day: Word): TDateTime; +function EncodeDate(const Year: Integer; Month, Day: Word): TDateTime; overload; procedure DecodeDate(Date: TDateTime; out Year, Month, Day: Word); overload; procedure DecodeDate(Date: TDateTime; out Year: Integer; out Month, Day: Word); overload; procedure DecodeDate(Date: TDateTime; out Year, Month, Day: Integer); overload; Index: source/common/JclStrings.pas =================================================================== --- source/common/JclStrings.pas (revision 3795) +++ source/common/JclStrings.pas (working copy) @@ -603,8 +603,8 @@ {$ENDIF SUPPORTS_UNICODE_STRING} // natural comparison functions -function CompareNaturalStr(const S1, S2: string): SizeInt; -function CompareNaturalText(const S1, S2: string): SizeInt; +function CompareNaturalStr(const S1, S2: string): SizeInt; overload; +function CompareNaturalText(const S1, S2: string): SizeInt; overload; {$IFNDEF UNICODE_RTL_DATABASE} // internal structures published to make function inlining working Index: source/include/jclfpc.inc =================================================================== --- source/include/jclfpc.inc (revision 0) +++ source/include/jclfpc.inc (working copy) @@ -0,0 +1,131 @@ +{************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is jcl.inc } +{ } +{ The Initial Developer of the Original Code is Marcel van Brakel. } +{ Portions created by Marcel van Brakel are Copyright (C) Marcel van Brakel. } +{ } +{ Contributors: } +{ Marcel van Brakel } +{ Matthias Thoma (mthoma) } +{ Petr Vones } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Florent Ouchet (outchy) } +{ } +{**********************************************************************************************} +{ } +{ This include file defines various JCL specific defines. } +{ The more generic JCL defines are defined in jcl.inc and the generic defines in the jedi.inc file } +{ which is shared with the JEDI VCL. } +{ } +{**********************************************************************************************} +{ } +{ This file is filled by the JCL installer, all the changes made in its content will be lost the } +{ next time the JCL is installed. } +{ } +{***********************************************************************************************} + +// $Id: jcl.template.inc 3362 2010-10-05 13:24:05Z outchy $ + +// Math precision selection, mutually exclusive +// FPC does not support EXTENDED when targetting x86_64, MATH_DOUBLE_PRECISION is the default in this situation +{.$DEFINE MATH_EXTENDED_PRECISION} // default +{.$DEFINE MATH_DOUBLE_PRECISION} +{.$DEFINE MATH_SINGLE_PRECISION} + + +// Math functions takes care of infinites and NaN +{.$DEFINE MATH_EXT_EXTREMEVALUES} + + +// JclHookExcept support for hooking exceptions from DLLs +{.$DEFINE HOOK_DLL_EXCEPTIONS} + + +//Threadsafe directive +{.$DEFINE THREADSAFE} + + +// To exclude obsolete code from compilation, remove the point from the line below +{.$DEFINE DROP_OBSOLETE_CODE} + + +//Support for JclUnitVersioning.pas, not supported by Delphi 2005 (automatically disabled afterward) +{.$DEFINE UNITVERSIONING} + + +// debug sources +// defining these symbols will the debug source to be automatically registered +{.$DEFINE DEBUG_NO_BINARY} +{.$DEFINE DEBUG_NO_TD32} // automatically defined for FPC +{.$DEFINE DEBUG_NO_MAP} +{.$DEFINE DEBUG_NO_EXPORTS} +{.$DEFINE DEBUG_NO_SYMBOLS} + + +// PCRE options, mutually exclusive +// IMPORTANT: The static link works only for Delphi 2005 and newer +// (an internal error is raised on other compilers) +// Only one of the following defines can be defined at a time +// static link: PCRE_STATICLINK +// static dll import: PCRE_LINKDLL +// dynamic dll import: PCRE_LINKONREQUEST + +{.$DEFINE PCRE_STATICLINK} +{.$DEFINE PCRE_LINKDLL} +{.$DEFINE PCRE_LINKONREQUEST} // default + + +// BZIP2 options, mutually exclusive + +{.$DEFINE BZIP2_STATICLINK} // default +{.$DEFINE BZIP2_LINKDLL} +{$DEFINE BZIP2_LINKONREQUEST} + + +// ZLIB options, mutually exclusive + +{.$DEFINE ZLIB_STATICLINK} // default +{.$DEFINE ZLIB_LINKDLL} +{$DEFINE ZLIB_LINKONREQUEST} + + +// Unicode options +// use RTL Character Database rather than JCL one, less accurate but reduce executable size +{.$DEFINE UNICODE_RTL_DATABASE} + +// insert a replacement character if sequence is corrupted rather than raising an exception +{.$DEFINE UNICODE_SILENT_FAILURE} + +// defines resource compression (uncompressed, compressed with ZLib, compressed with BZip2), mutually exclusive +{.$DEFINE UNICODE_RAW_DATA} // default +{.$DEFINE UNICODE_ZLIB_DATA} +{.$DEFINE UNICODE_BZIP2_DATA} + + +// container options +// define mapping of TJclStr containers to TJclAnsiStr* or TJclWideStr* (mutually exclusive) +{.$DEFINE CONTAINER_ANSISTR} // default for D2007 and older +{.$DEFINE CONTAINER_WIDESTR} +{.$DEFINE CONTAINER_UNICODESTR} // default for D2009 and newer, not supported for Delphi 2007 and older +{.$DEFINE CONTAINER_NOSTR} + + +// 7Zip options, mutually exclusive +// IMPORTANT: The static link is not supported yet + +{.$DEFINE 7ZIP_STATICLINK} // not supported yet +{.$DEFINE 7ZIP_LINKDLL} +{.$DEFINE 7ZIP_LINKONREQUEST} // default + patch against jcl revision 3795 - fpc trunk revision 21320 2.patch (15,339 bytes)

Cyrus 2012-05-18 17:00 reporter ~0019765	This patch file "patch against jcl revision 3795 - fpc trunk revision 21320 2.patch" replaces "patch against jcl revision 3795 - fpc trunk compatible.patch".

2012-05-18 17:26	patch against jcl revision 3795 - fpc trunk revision 21320 3.patch (15,984 bytes) Index: packages/fpc/Jcl.lpk =================================================================== --- packages/fpc/Jcl.lpk (revision 3795) +++ packages/fpc/Jcl.lpk (working copy) @@ -1,17 +1,15 @@ <?xml version="1.0"?> <CONFIG> - <Package Version="3"> + <Package Version="4"> <PathDelim Value="\"/> <Name Value="Jcl"/> - <AddToProjectUsesSection Value="False"/> <Author Value="Project JEDI"/> - <AutoUpdate Value="OnRebuildingAll"/> <CompilerOptions> - <Version Value="9"/> + <Version Value="11"/> <PathDelim Value="\"/> <SearchPaths> - <IncludeFiles Value="..\..\source\include\"/> - <OtherUnitFiles Value=".;..\..\source\common;..\..\source\windows;;..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> + <IncludeFiles Value="..\..\source\include;..\..\source\include\jedi"/> + <OtherUnitFiles Value=".;..\..\source\common;..\..\source\windows;..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> <UnitOutputDirectory Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <Parsing> @@ -25,21 +23,17 @@ <CodeGeneration> <Optimizations> <VariablesInRegisters Value="True"/> - <OptimizationLevel Value="3"/> + <OptimizationLevel Value="0"/> </Optimizations> </CodeGeneration> - <Linking> - <Debugging> - <UseLineInfoUnit Value="False"/> - </Debugging> - </Linking> <Other> + <CustomOptions Value="-Ur"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> <Description Value="JEDI Code Library RTL package"/> <License Value="Copyright (C) 1999, 2011 Project JEDI"/> - <Version Major="2" Minor="4" Release="0" Build="4198"/> + <Version Major="2" Minor="4" Build="4198"/> <Files Count="76"> <Item1> <Filename Value="..\..\source\common\bzip2.pas"/> @@ -346,16 +340,15 @@ <UnitName Value="Snmp"/> </Item76> </Files> + <Type Value="RunTimeOnly"/> <RequiredPkgs Count="1"> <Item1> <PackageName Value="FCL"/> </Item1> </RequiredPkgs> <UsageOptions> - <IncludePath Value="..\..\source\include\"/> - <LibraryPath Value="$(PkgOutDir)\"/> - <ObjectPath Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)\"/> - <UnitPath Value="$(PkgOutDir)\"/> + <IncludePath Value="..\..\source\include;..\..\source\include\jedi"/> + <UnitPath Value="$(PkgOutDir)"/> </UsageOptions> <PublishOptions> <Version Value="2"/> Index: packages/fpc/JclContainers.lpk =================================================================== --- packages/fpc/JclContainers.lpk (revision 3795) +++ packages/fpc/JclContainers.lpk (working copy) @@ -1,17 +1,15 @@ <?xml version="1.0"?> <CONFIG> - <Package Version="3"> + <Package Version="4"> <PathDelim Value="\"/> <Name Value="JclContainers"/> - <AddToProjectUsesSection Value="False"/> <Author Value="Project JEDI"/> - <AutoUpdate Value="OnRebuildingAll"/> <CompilerOptions> - <Version Value="9"/> + <Version Value="11"/> <PathDelim Value="\"/> <SearchPaths> - <IncludeFiles Value="..\..\source\include\"/> - <OtherUnitFiles Value=".;..\..\source\common;;..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> + <IncludeFiles Value="..\..\source\include;..\..\source\include\jedi"/> + <OtherUnitFiles Value=".;..\..\source\common;..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> <UnitOutputDirectory Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <Parsing> @@ -25,21 +23,17 @@ <CodeGeneration> <Optimizations> <VariablesInRegisters Value="True"/> - <OptimizationLevel Value="3"/> + <OptimizationLevel Value="0"/> </Optimizations> </CodeGeneration> - <Linking> - <Debugging> - <UseLineInfoUnit Value="False"/> - </Debugging> - </Linking> <Other> + <CustomOptions Value="-Ur"/> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> <Description Value="JEDI Code Library Containers package"/> <License Value="Copyright (C) 1999, 2011 Project JEDI"/> - <Version Major="2" Minor="4" Release="0" Build="4198"/> + <Version Major="2" Minor="4" Build="4198"/> <Files Count="14"> <Item1> <Filename Value="..\..\source\common\JclAbstractContainers.pas"/> @@ -98,6 +92,7 @@ <UnitName Value="JclVectors"/> </Item14> </Files> + <Type Value="RunTimeOnly"/> <RequiredPkgs Count="2"> <Item1> <PackageName Value="FCL"/> @@ -107,10 +102,8 @@ </Item2> </RequiredPkgs> <UsageOptions> - <IncludePath Value="..\..\source\include\"/> - <LibraryPath Value="$(PkgOutDir)\"/> - <ObjectPath Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)\"/> - <UnitPath Value="$(PkgOutDir)\"/> + <IncludePath Value="..\..\source\include;..\..\source\include\jedi"/> + <UnitPath Value="$(PkgOutDir)"/> </UsageOptions> <PublishOptions> <Version Value="2"/> Index: source/common/JclAbstractContainers.pas =================================================================== --- source/common/JclAbstractContainers.pas (revision 3795) +++ source/common/JclAbstractContainers.pas (working copy) @@ -1374,12 +1374,12 @@ else begin case FEncoding of - seISO: + JclContainerIntf.seISO: if FCaseSensitive then Result := AnsiStrSimpleHashConvert(AString) else Result := AnsiStrSimpleHashConvertI(AString); - seUTF8: + JclContainerIntf.seUTF8: if FCaseSensitive then Result := AnsiStrSimpleHashConvertU(AString) else @@ -1397,7 +1397,7 @@ else begin case FEncoding of - seISO, seUTF8: + JclContainerIntf.seISO, JclContainerIntf.seUTF8: if FCaseSensitive then Result := AnsiStrSimpleCompare(A, B) else @@ -1418,7 +1418,7 @@ else begin case FEncoding of - seISO, seUTF8: + JclContainerIntf.seISO, JclContainerIntf.seUTF8: if FCaseSensitive then Result := AnsiStrSimpleEqualityCompare(A, B) else Index: source/common/JclAnsiStrings.pas =================================================================== --- source/common/JclAnsiStrings.pas (revision 3795) +++ source/common/JclAnsiStrings.pas (working copy) @@ -518,8 +518,8 @@ function ArrayOf(List: TJclAnsiStrings): TDynStringArray; overload; -function AnsiCompareNaturalStr(const S1, S2: AnsiString): SizeInt; -function AnsiCompareNaturalText(const S1, S2: AnsiString): SizeInt; +function AnsiCompareNaturalStr(const S1, S2: AnsiString): SizeInt; overload; +function AnsiCompareNaturalText(const S1, S2: AnsiString): SizeInt; overload; // internal structures published to make function inlining working const Index: source/common/JclDateTime.pas =================================================================== --- source/common/JclDateTime.pas (revision 3795) +++ source/common/JclDateTime.pas (working copy) @@ -87,7 +87,7 @@ { Encode / Decode functions } -function EncodeDate(const Year: Integer; Month, Day: Word): TDateTime; +function EncodeDate(const Year: Integer; Month, Day: Word): TDateTime; overload; procedure DecodeDate(Date: TDateTime; out Year, Month, Day: Word); overload; procedure DecodeDate(Date: TDateTime; out Year: Integer; out Month, Day: Word); overload; procedure DecodeDate(Date: TDateTime; out Year, Month, Day: Integer); overload; Index: source/common/JclStrings.pas =================================================================== --- source/common/JclStrings.pas (revision 3795) +++ source/common/JclStrings.pas (working copy) @@ -603,8 +603,8 @@ {$ENDIF SUPPORTS_UNICODE_STRING} // natural comparison functions -function CompareNaturalStr(const S1, S2: string): SizeInt; -function CompareNaturalText(const S1, S2: string): SizeInt; +function CompareNaturalStr(const S1, S2: string): SizeInt; overload; +function CompareNaturalText(const S1, S2: string): SizeInt; overload; {$IFNDEF UNICODE_RTL_DATABASE} // internal structures published to make function inlining working Index: source/include/jclfpc.inc =================================================================== --- source/include/jclfpc.inc (revision 0) +++ source/include/jclfpc.inc (working copy) @@ -0,0 +1,131 @@ +{************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is jcl.inc } +{ } +{ The Initial Developer of the Original Code is Marcel van Brakel. } +{ Portions created by Marcel van Brakel are Copyright (C) Marcel van Brakel. } +{ } +{ Contributors: } +{ Marcel van Brakel } +{ Matthias Thoma (mthoma) } +{ Petr Vones } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Florent Ouchet (outchy) } +{ } +{**********************************************************************************************} +{ } +{ This include file defines various JCL specific defines. } +{ The more generic JCL defines are defined in jcl.inc and the generic defines in the jedi.inc file } +{ which is shared with the JEDI VCL. } +{ } +{**********************************************************************************************} +{ } +{ This file is filled by the JCL installer, all the changes made in its content will be lost the } +{ next time the JCL is installed. } +{ } +{***********************************************************************************************} + +// $Id: jcl.template.inc 3362 2010-10-05 13:24:05Z outchy $ + +// Math precision selection, mutually exclusive +// FPC does not support EXTENDED when targetting x86_64, MATH_DOUBLE_PRECISION is the default in this situation +{.$DEFINE MATH_EXTENDED_PRECISION} // default +{.$DEFINE MATH_DOUBLE_PRECISION} +{.$DEFINE MATH_SINGLE_PRECISION} + + +// Math functions takes care of infinites and NaN +{.$DEFINE MATH_EXT_EXTREMEVALUES} + + +// JclHookExcept support for hooking exceptions from DLLs +{.$DEFINE HOOK_DLL_EXCEPTIONS} + + +//Threadsafe directive +{.$DEFINE THREADSAFE} + + +// To exclude obsolete code from compilation, remove the point from the line below +{.$DEFINE DROP_OBSOLETE_CODE} + + +//Support for JclUnitVersioning.pas, not supported by Delphi 2005 (automatically disabled afterward) +{.$DEFINE UNITVERSIONING} + + +// debug sources +// defining these symbols will the debug source to be automatically registered +{.$DEFINE DEBUG_NO_BINARY} +{.$DEFINE DEBUG_NO_TD32} // automatically defined for FPC +{.$DEFINE DEBUG_NO_MAP} +{.$DEFINE DEBUG_NO_EXPORTS} +{.$DEFINE DEBUG_NO_SYMBOLS} + + +// PCRE options, mutually exclusive +// IMPORTANT: The static link works only for Delphi 2005 and newer +// (an internal error is raised on other compilers) +// Only one of the following defines can be defined at a time +// static link: PCRE_STATICLINK +// static dll import: PCRE_LINKDLL +// dynamic dll import: PCRE_LINKONREQUEST + +{.$DEFINE PCRE_STATICLINK} +{.$DEFINE PCRE_LINKDLL} +{.$DEFINE PCRE_LINKONREQUEST} // default + + +// BZIP2 options, mutually exclusive + +{.$DEFINE BZIP2_STATICLINK} // default +{.$DEFINE BZIP2_LINKDLL} +{$DEFINE BZIP2_LINKONREQUEST} + + +// ZLIB options, mutually exclusive + +{.$DEFINE ZLIB_STATICLINK} // default +{.$DEFINE ZLIB_LINKDLL} +{$DEFINE ZLIB_LINKONREQUEST} + + +// Unicode options +// use RTL Character Database rather than JCL one, less accurate but reduce executable size +{.$DEFINE UNICODE_RTL_DATABASE} + +// insert a replacement character if sequence is corrupted rather than raising an exception +{.$DEFINE UNICODE_SILENT_FAILURE} + +// defines resource compression (uncompressed, compressed with ZLib, compressed with BZip2), mutually exclusive +{.$DEFINE UNICODE_RAW_DATA} // default +{.$DEFINE UNICODE_ZLIB_DATA} +{.$DEFINE UNICODE_BZIP2_DATA} + + +// container options +// define mapping of TJclStr containers to TJclAnsiStr* or TJclWideStr* (mutually exclusive) +{.$DEFINE CONTAINER_ANSISTR} // default for D2007 and older +{.$DEFINE CONTAINER_WIDESTR} +{.$DEFINE CONTAINER_UNICODESTR} // default for D2009 and newer, not supported for Delphi 2007 and older +{.$DEFINE CONTAINER_NOSTR} + + +// 7Zip options, mutually exclusive +// IMPORTANT: The static link is not supported yet + +{.$DEFINE 7ZIP_STATICLINK} // not supported yet +{.$DEFINE 7ZIP_LINKDLL} +{.$DEFINE 7ZIP_LINKONREQUEST} // default + Index: source/windows/JclRegistry.pas =================================================================== --- source/windows/JclRegistry.pas (revision 3795) +++ source/windows/JclRegistry.pas (working copy) @@ -62,7 +62,7 @@ JclBase, JclStrings; type - DelphiHKEY = {$IFDEF CPUX64}type Winapi.Windows.HKEY{$ELSE}Longword{$ENDIF CPUX64}; + DelphiHKEY = {$IFDEF CPUX64}type {$IFDEF BORLAND}Winapi.{$ENDIF BORLAND}Windows.HKEY{$ELSE}Longword{$ENDIF CPUX64}; {$HPPEMIT '// BCB users must typecast the HKEY values to DelphiHKEY or use the HK-values below.'} TExecKind = (ekMachineRun, ekMachineRunOnce, ekUserRun, ekUserRunOnce, patch against jcl revision 3795 - fpc trunk revision 21320 3.patch (15,984 bytes)

Cyrus 2012-05-18 17:26 reporter ~0019766	Uploaded file (patch against jcl revision 3795 - fpc trunk revision 21320 3.patch) replaces all previous patches.

2012-09-06 16:17	06.09.2012 - patch against jcl trunk revision 3864 - fpc trunk revision 22332.patch (17,558 bytes) Index: packages/fpc/Jcl.lpk =================================================================== --- packages/fpc/Jcl.lpk (revision 3869) +++ packages/fpc/Jcl.lpk (working copy) @@ -1,17 +1,16 @@ <?xml version="1.0"?> <CONFIG> - <Package Version="3"> + <Package Version="4"> <PathDelim Value="\"/> <Name Value="Jcl"/> - <AddToProjectUsesSection Value="False"/> <Author Value="Project JEDI"/> <AutoUpdate Value="OnRebuildingAll"/> <CompilerOptions> - <Version Value="9"/> + <Version Value="11"/> <PathDelim Value="\"/> <SearchPaths> - <IncludeFiles Value="..\..\source\include\"/> - <OtherUnitFiles Value=".;..\..\source\common;..\..\source\windows;;..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> + <IncludeFiles Value="..\..\source\include"/> + <OtherUnitFiles Value=".;..\..\source\common;..\..\source\windows;..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> <UnitOutputDirectory Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <Parsing> @@ -30,6 +29,7 @@ </CodeGeneration> <Linking> <Debugging> + <GenerateDebugInfo Value="False"/> <UseLineInfoUnit Value="False"/> </Debugging> </Linking> @@ -39,7 +39,7 @@ </CompilerOptions> <Description Value="JEDI Code Library RTL package"/> <License Value="Copyright (C) 1999, 2012 Project JEDI"/> - <Version Major="2" Minor="5" Release="0" Build="4572"/> + <Version Major="2" Minor="5" Build="4572"/> <Files Count="74"> <Item1> <Filename Value="..\..\source\common\bzip2.pas"/> @@ -344,10 +344,10 @@ </Item1> </RequiredPkgs> <UsageOptions> - <IncludePath Value="..\..\source\include\"/> - <LibraryPath Value="$(PkgOutDir)\"/> - <ObjectPath Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)\"/> - <UnitPath Value="$(PkgOutDir)\"/> + <IncludePath Value="..\..\source\include"/> + <LibraryPath Value="$(PkgOutDir)"/> + <ObjectPath Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> + <UnitPath Value="$(PkgOutDir)"/> </UsageOptions> <PublishOptions> <Version Value="2"/> Index: packages/fpc/JclContainers.lpk =================================================================== --- packages/fpc/JclContainers.lpk (revision 3869) +++ packages/fpc/JclContainers.lpk (working copy) @@ -1,17 +1,16 @@ <?xml version="1.0"?> <CONFIG> - <Package Version="3"> + <Package Version="4"> <PathDelim Value="\"/> <Name Value="JclContainers"/> - <AddToProjectUsesSection Value="False"/> <Author Value="Project JEDI"/> <AutoUpdate Value="OnRebuildingAll"/> <CompilerOptions> - <Version Value="9"/> + <Version Value="11"/> <PathDelim Value="\"/> <SearchPaths> - <IncludeFiles Value="..\..\source\include\"/> - <OtherUnitFiles Value=".;..\..\source\common;;..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> + <IncludeFiles Value="..\..\source\include"/> + <OtherUnitFiles Value=".;..\..\source\common;..\..\lib\fpc\$(TargetCPU)-$(TargetOS);..\..\source\windows"/> <UnitOutputDirectory Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <Parsing> @@ -30,6 +29,7 @@ </CodeGeneration> <Linking> <Debugging> + <GenerateDebugInfo Value="False"/> <UseLineInfoUnit Value="False"/> </Debugging> </Linking> @@ -39,7 +39,7 @@ </CompilerOptions> <Description Value="JEDI Code Library Containers package"/> <License Value="Copyright (C) 1999, 2012 Project JEDI"/> - <Version Major="2" Minor="5" Release="0" Build="4572"/> + <Version Major="2" Minor="5" Build="4572"/> <Files Count="15"> <Item1> <Filename Value="..\..\source\common\JclAbstractContainers.pas"/> @@ -111,10 +111,10 @@ </Item2> </RequiredPkgs> <UsageOptions> - <IncludePath Value="..\..\source\include\"/> - <LibraryPath Value="$(PkgOutDir)\"/> - <ObjectPath Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)\"/> - <UnitPath Value="$(PkgOutDir)\"/> + <IncludePath Value="..\..\source\include"/> + <LibraryPath Value="$(PkgOutDir)"/> + <ObjectPath Value="..\..\lib\fpc\$(TargetCPU)-$(TargetOS)"/> + <UnitPath Value="$(PkgOutDir)"/> </UsageOptions> <PublishOptions> <Version Value="2"/> Index: source/common/JclAbstractContainers.pas =================================================================== --- source/common/JclAbstractContainers.pas (revision 3869) +++ source/common/JclAbstractContainers.pas (working copy) @@ -1374,12 +1374,12 @@ else begin case FEncoding of - seISO: + JclContainerIntf.seISO: if FCaseSensitive then Result := AnsiStrSimpleHashConvert(AString) else Result := AnsiStrSimpleHashConvertI(AString); - seUTF8: + JclContainerIntf.seUTF8: if FCaseSensitive then Result := AnsiStrSimpleHashConvertU(AString) else @@ -1397,7 +1397,7 @@ else begin case FEncoding of - seISO, seUTF8: + JclContainerIntf.seISO, JclContainerIntf.seUTF8: if FCaseSensitive then Result := AnsiStrSimpleCompare(A, B) else @@ -1418,7 +1418,7 @@ else begin case FEncoding of - seISO, seUTF8: + JclContainerIntf.seISO, JclContainerIntf.seUTF8: if FCaseSensitive then Result := AnsiStrSimpleEqualityCompare(A, B) else Index: source/common/JclAnsiStrings.pas =================================================================== --- source/common/JclAnsiStrings.pas (revision 3869) +++ source/common/JclAnsiStrings.pas (working copy) @@ -518,8 +518,8 @@ function ArrayOf(List: TJclAnsiStrings): TDynStringArray; overload; -function AnsiCompareNaturalStr(const S1, S2: AnsiString): SizeInt; -function AnsiCompareNaturalText(const S1, S2: AnsiString): SizeInt; +function AnsiCompareNaturalStr(const S1, S2: AnsiString): SizeInt;overload; +function AnsiCompareNaturalText(const S1, S2: AnsiString): SizeInt;overload; // internal structures published to make function inlining working const Index: source/common/JclDateTime.pas =================================================================== --- source/common/JclDateTime.pas (revision 3869) +++ source/common/JclDateTime.pas (working copy) @@ -87,7 +87,7 @@ { Encode / Decode functions } -function EncodeDate(const Year: Integer; Month, Day: Word): TDateTime; +function EncodeDate(const Year: Integer; Month, Day: Word): TDateTime;overload; procedure DecodeDate(Date: TDateTime; out Year, Month, Day: Word); overload; procedure DecodeDate(Date: TDateTime; out Year: Integer; out Month, Day: Word); overload; procedure DecodeDate(Date: TDateTime; out Year, Month, Day: Integer); overload; Index: source/common/JclSimpleXml.pas =================================================================== --- source/common/JclSimpleXml.pas (revision 3869) +++ source/common/JclSimpleXml.pas (working copy) @@ -68,8 +68,16 @@ IniFiles, Contnrs, {$ENDIF ~HAS_UNITSCOPE} + {$IFDEF FPC} + fgl, + {$ENDIF FPC} JclBase, JclStreams; +{$IFDEF FPC} +Type + TFPCStringHash = TFPGMap<String, Integer>; +{$ENDIF FPC} + type TJclSimpleItem = class(TObject) private @@ -83,7 +91,11 @@ type TJclSimpleItemHashedList = class(TObjectList) private + {$IFNDEF FPC} FNameHash: TStringHash; + {$ELSE} + FNameHash: TFPCStringHash; + {$ENDIF } FCaseSensitive: Boolean; function GetSimpleItemByName(const Name: string): TJclSimpleItem; function GetSimpleItem(Index: Integer): TJclSimpleItem; @@ -1076,21 +1088,43 @@ begin if FNameHash = nil then begin + {$IFNDEF FPC} FNameHash := TStringHash.Create(8); + {$ELSE} + FNameHash := TFPCStringHash.Create; + {$ENDIF} for I := 0 to Count - 1 do FNameHash.Add(TJclSimpleData(Items[I]).Name, I); end; + {$IFNDEF FPC} Result := FNameHash.ValueOf(Name); + {$ELSE} + I := FNameHash.IndexOf(Name); + Result := I; + If I <> -1 Then + Result := FNameHash.Data[I]; + {$ENDIF} end else begin if FNameHash = nil then begin + {$IFNDEF FPC} FNameHash := TStringHash.Create(8); + {$ELSE} + FNameHash := TFPCStringHash.Create; + {$ENDIF} for I := 0 to Count - 1 do FNameHash.Add(UpperCase(TJclSimpleData(Items[I]).Name), I); end; + {$IFNDEF FPC} Result := FNameHash.ValueOf(UpperCase(Name)); + {$ELSE} + I := FNameHash.IndexOf(UpperCase(Name)); + Result := I; + If I <> -1 Then + Result := FNameHash.Data[I]; + {$ENDIF} end; end; Index: source/common/JclStrings.pas =================================================================== --- source/common/JclStrings.pas (revision 3869) +++ source/common/JclStrings.pas (working copy) @@ -603,8 +603,8 @@ {$ENDIF SUPPORTS_UNICODE_STRING} // natural comparison functions -function CompareNaturalStr(const S1, S2: string): SizeInt; -function CompareNaturalText(const S1, S2: string): SizeInt; +function CompareNaturalStr(const S1, S2: string): SizeInt;overload; +function CompareNaturalText(const S1, S2: string): SizeInt;overload; {$IFNDEF UNICODE_RTL_DATABASE} // internal structures published to make function inlining working Index: source/include/jclfpc.inc =================================================================== --- source/include/jclfpc.inc (revision 0) +++ source/include/jclfpc.inc (working copy) @@ -0,0 +1,141 @@ +{************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is jcl.inc } +{ } +{ The Initial Developer of the Original Code is Marcel van Brakel. } +{ Portions created by Marcel van Brakel are Copyright (C) Marcel van Brakel. } +{ } +{ Contributors: } +{ Marcel van Brakel } +{ Matthias Thoma (mthoma) } +{ Petr Vones } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Florent Ouchet (outchy) } +{ } +{**********************************************************************************************} +{ } +{ This include file defines various JCL specific defines. } +{ The more generic JCL defines are defined in jcl.inc and the generic defines in the jedi.inc file } +{ which is shared with the JEDI VCL. } +{ } +{**********************************************************************************************} +{ } +{ This file is filled by the JCL installer, all the changes made in its content will be lost the } +{ next time the JCL is installed. } +{ } +{***********************************************************************************************} + +// $Id: jcl.template.inc 3855 2012-09-02 22:25:26Z outchy $ + +// Math precision selection, mutually exclusive +// FPC does not support EXTENDED when targetting x86_64, MATH_DOUBLE_PRECISION is the default in this situation +{.$DEFINE MATH_EXTENDED_PRECISION} // default +{.$DEFINE MATH_DOUBLE_PRECISION} +{.$DEFINE MATH_SINGLE_PRECISION} + + +// Math functions takes care of infinites and NaN +{.$DEFINE MATH_EXT_EXTREMEVALUES} + + +// JclHookExcept support for hooking exceptions from DLLs +{.$DEFINE HOOK_DLL_EXCEPTIONS} + + +//Threadsafe directive +{.$DEFINE THREADSAFE} + + +// To exclude obsolete code from compilation, remove the point from the line below +{.$DEFINE DROP_OBSOLETE_CODE} + + +//Support for JclUnitVersioning.pas, not supported by Delphi 2005 (automatically disabled afterward) +{.$DEFINE UNITVERSIONING} + + +// debug sources +// defining these symbols will the debug source to be automatically registered +{.$DEFINE DEBUG_NO_BINARY} +{.$DEFINE DEBUG_NO_TD32} // automatically defined for FPC +{.$DEFINE DEBUG_NO_MAP} +{.$DEFINE DEBUG_NO_EXPORTS} +{.$DEFINE DEBUG_NO_SYMBOLS} + + +// PCRE options, mutually exclusive +// IMPORTANT: The static link works only for Delphi 2005 and newer +// (an internal error is raised on other compilers) +// Only one of the following defines can be defined at a time +// static link: PCRE_STATICLINK +// static dll import: PCRE_LINKDLL +// dynamic dll import: PCRE_LINKONREQUEST +// RTL's RegularExpressionsAPI: PCRE_RTL + +{.$DEFINE PCRE_STATICLINK} +{.$DEFINE PCRE_LINKDLL} +{.$DEFINE PCRE_LINKONREQUEST} // default +{.$DEFINE PCRE_RTL} // DXE and newer + +// ANSI/UTF8 PCRE +{$DEFINE PCRE_8} +// UCS2/UTF16 enabled PCRE +{$DEFINE PCRE_16} // only valid when PCRE_STATICLINK is enabled, the RTL does not support it and the DLL found over the internet are completly outdated. + +// use PCRE16 when available rather than good old PCRE8 +{$DEFINE PCRE_PREFER_16} + +// BZIP2 options, mutually exclusive + +{.$DEFINE BZIP2_STATICLINK} // default +{.$DEFINE BZIP2_LINKDLL} +{$DEFINE BZIP2_LINKONREQUEST} + + +// ZLIB options, mutually exclusive + +{.$DEFINE ZLIB_STATICLINK} // default +{.$DEFINE ZLIB_LINKDLL} +{$DEFINE ZLIB_LINKONREQUEST} +{.$DEFINE ZLIB_RTL} // DXE2 and newer only + + +// Unicode options +// use RTL Character Database rather than JCL one, less accurate but reduce executable size +{.$DEFINE UNICODE_RTL_DATABASE} + +// insert a replacement character if sequence is corrupted rather than raising an exception +{.$DEFINE UNICODE_SILENT_FAILURE} + +// defines resource compression (uncompressed, compressed with ZLib, compressed with BZip2), mutually exclusive +{.$DEFINE UNICODE_RAW_DATA} // default +{.$DEFINE UNICODE_ZLIB_DATA} +{.$DEFINE UNICODE_BZIP2_DATA} + + +// container options +// define mapping of TJclStr containers to TJclAnsiStr* or TJclWideStr* (mutually exclusive) +{.$DEFINE CONTAINER_ANSISTR} // default for D2007 and older +{.$DEFINE CONTAINER_WIDESTR} +{.$DEFINE CONTAINER_UNICODESTR} // default for D2009 and newer, not supported for Delphi 2007 and older +{.$DEFINE CONTAINER_NOSTR} + + +// 7Zip options, mutually exclusive +// IMPORTANT: The static link is not supported yet + +{.$DEFINE 7ZIP_STATICLINK} // not supported yet +{.$DEFINE 7ZIP_LINKDLL} +{.$DEFINE 7ZIP_LINKONREQUEST} // default + Index: source/windows/JclRegistry.pas =================================================================== --- source/windows/JclRegistry.pas (revision 3869) +++ source/windows/JclRegistry.pas (working copy) @@ -62,7 +62,7 @@ JclBase, JclStrings; type - DelphiHKEY = {$IFDEF CPUX64}type Winapi.Windows.HKEY{$ELSE}Longword{$ENDIF CPUX64}; + DelphiHKEY = {$IFDEF CPUX64}type {$IFDEF BORLAND}Winapi.{$ENDIF BORLAND}Windows.HKEY{$ELSE}Longword{$ENDIF CPUX64}; {$HPPEMIT '// BCB users must typecast the HKEY values to DelphiHKEY or use the HK-values below.'} TExecKind = (ekMachineRun, ekMachineRunOnce, ekUserRun, ekUserRunOnce, 06.09.2012 - patch against jcl trunk revision 3864 - fpc trunk revision 22332.patch (17,558 bytes)

Cyrus 2012-09-06 16:17 reporter ~0020160	"06.09.2012 - patch against jcl trunk revision 3864 - fpc trunk revision 22332.patch" is lastest one and replaces all previous patches.

2013-09-28 00:36	git - jcl - fpc trunk r25585.patch.serial (18,639 bytes)

Cyrus 2013-09-28 00:38 reporter ~0020645	Uploaded new version of patch "git - jcl - fpc trunk r25585.patch.serial". All other patches are now obsolete. So they can be removed.

Date Modified	Username	Field	Change
2011-01-08 18:33	Cyrus	New Issue
2011-01-08 18:33	Cyrus	File Added: fpc compatible 5.diff
2011-01-08 18:33	Cyrus	IDE version	=> FPC
2011-01-09 17:17	outchy	Note Added: 0018292
2011-01-09 22:56	Cyrus	Note Added: 0018293
2011-01-10 11:15	Cyrus	Note Edited: 0018293
2011-01-15 13:00	outchy	Note Added: 0018300
2011-01-15 13:00	outchy	File Added: jcl-fpc-polished.patch
2011-01-18 13:10	outchy	Status	new => feedback
2011-02-15 08:42	CCRDude2	Relationship added	related to 0005480
2011-02-27 09:15	Cyrus	Note Added: 0018418
2011-02-27 09:26	Cyrus	Note Added: 0018419
2011-02-27 09:28	Cyrus	Note Edited: 0018419
2011-02-27 09:29	Cyrus	File Added: fpc compatible new.diff
2011-02-27 09:56	Cyrus	Note Added: 0018420
2011-02-27 09:58	Cyrus	Note Added: 0018421
2011-02-27 09:58	Cyrus	File Added: fpc compatible new 2.diff
2011-02-27 11:40	Cyrus	Note Added: 0018422
2011-02-27 11:41	Cyrus	File Added: fpc compatible new 3.diff
2011-03-15 05:08	Cyrus	Note Added: 0018450
2011-03-15 05:09	Cyrus	File Added: fpc compatible.patch
2011-03-15 05:12	Cyrus	Note Added: 0018451
2011-03-15 10:37	outchy	File Deleted: fpc compatible 5.diff
2011-03-15 10:37	outchy	File Deleted: fpc compatible new.diff
2011-03-15 10:38	outchy	File Deleted: fpc compatible new 2.diff
2011-03-15 10:38	outchy	File Deleted: fpc compatible new 3.diff
2011-03-15 10:39	outchy	Note Added: 0018453
2011-04-14 17:15	Cyrus	File Added: fpc compatible 2.patch
2011-04-14 17:17	Cyrus	Note Added: 0018519
2011-07-30 15:15	Cyrus	File Added: jedi svn 3561 fpc compatible.patch
2011-07-30 15:17	Cyrus	Note Added: 0018841
2011-07-31 13:50	Cyrus	File Added: jedi svn 3561 fpc compatible 2.patch
2011-07-31 13:55	Cyrus	Note Added: 0018842
2011-12-24 01:53	Cyrus	File Added: jcl revision 3644 - fpc compatible.patch
2011-12-24 01:55	Cyrus	Note Added: 0019246
2012-01-28 00:19	Cyrus	File Added: jcl svn revision 3706 - fpc trunk 2.7.1 svn 20181 compatible.patch
2012-01-28 00:20	Cyrus	Note Added: 0019358
2012-03-04 19:40	outchy	Note Added: 0019646
2012-05-18 16:32	Cyrus	File Added: patch against jcl revision 3795 - fpc trunk compatible.patch
2012-05-18 16:32	Cyrus	Note Added: 0019763
2012-05-18 16:40	Cyrus	Note Added: 0019764
2012-05-18 16:43	Cyrus	Note Edited: 0019764
2012-05-18 16:59	Cyrus	File Added: patch against jcl revision 3795 - fpc trunk revision 21320 2.patch
2012-05-18 17:00	Cyrus	Note Added: 0019765
2012-05-18 17:08	Cyrus	Note Edited: 0019764
2012-05-18 17:23	Cyrus	Note Edited: 0019764
2012-05-18 17:26	Cyrus	File Added: patch against jcl revision 3795 - fpc trunk revision 21320 3.patch
2012-05-18 17:26	Cyrus	Note Added: 0019766
2012-09-06 16:17	Cyrus	File Added: 06.09.2012 - patch against jcl trunk revision 3864 - fpc trunk revision 22332.patch
2012-09-06 16:17	Cyrus	Note Added: 0020160
2013-09-28 00:36	Cyrus	File Added: git - jcl - fpc trunk r25585.patch.serial
2013-09-28 00:38	Cyrus	Note Added: 0020645

View Issue Details

Relationships

Activities

Issue History