Hi
I use DOM from fcl-xml both for Delphi and FPC development.
I work with older version, till I notice serious bugs. Today i've
upgrade it from current svn. And problem: Delphi don't compile
I've made several changes in dom, xmlutil. Diff attached.
As i expect, bugs in new version disappear.
It's not change much.
Can someone review it?
--
Darek
Index: xmlwrite.pp
===================================================================
--- xmlwrite.pp (wersja 13601)
+++ xmlwrite.pp (kopia robocza)
@@ -17,9 +17,11 @@
unit XMLWrite;
-{$MODE objfpc}
-{$H+}
+{$ifdef fpc}
+{$MODE objfpc}{$H+}
+{$endif}
+
interface
uses Classes, DOM;
Index: dom.pp
===================================================================
--- dom.pp (wersja 13601)
+++ dom.pp (kopia robocza)
@@ -43,6 +43,10 @@
// -------------------------------------------------------
// DOMException
// -------------------------------------------------------
+{$ifndef fpc}
+type
+ tFpList = tList;
+{$endif}
const
@@ -101,6 +105,8 @@
TDOMAttrDef = class;
PNodePool = ^TNodePool;
TNodePool = class;
+ TTabNodePool = array[0..0] of TNodePool;
+ PTabNodePool = ^TTabNodePool;
// -------------------------------------------------------
@@ -430,7 +436,7 @@
FEmptyNode: TDOMElement;
FNodeLists: THashTable;
FMaxPoolSize: Integer;
- FPools: PNodePool;
+ FPools: PTabNodePool;
FDocumentURI: DOMString;
function GetDocumentElement: TDOMElement;
function GetDocType: TDOMDocumentType;
@@ -3167,24 +3173,24 @@
sz: Integer;
begin
ext := FCurrExtent;
- ptr := Pointer(FCurrBlock) + FElementSize;
+ ptrInt(ptr) := ptrInt(FCurrBlock) + FElementSize;
sz := FCurrExtentSize;
while Assigned(ext) do
begin
// call destructors for everyone still there
- ptr_end := Pointer(ext) + sizeof(TExtent) + (sz - 1) * FElementSize;
- while ptr <= ptr_end do
+ ptrInt(ptr_end) := ptrInt(ext) + sizeof(TExtent) + (sz - 1) * FElementSize;
+ while ptrInt(ptr) <= ptrInt(ptr_end) do
begin
if TDOMNode(ptr).FPool = Self then
TObject(ptr).Destroy;
- Inc(ptr, FElementSize);
+ Inc(ptrInt(ptr), FElementSize);
end;
// dispose the extent and pass to the next one
next := ext^.Next;
FreeMem(ext);
ext := next;
sz := sz div 2;
- ptr := Pointer(ext) + sizeof(TExtent);
+ ptrInt(ptr) := ptrInt(ext) + sizeof(TExtent);
end;
inherited Destroy;
end;
@@ -3194,13 +3200,13 @@
ext: PExtent;
begin
Assert((FCurrExtent = nil) or
- (Pointer(FCurrBlock) = Pointer(FCurrExtent) + sizeof(TExtent)));
+ (ptrInt(FCurrBlock) = ptrInt(FCurrExtent) + sizeof(TExtent)));
Assert(AElemCount > 0);
GetMem(ext, sizeof(TExtent) + AElemCount * FElementSize);
ext^.Next := FCurrExtent;
// point to the beginning of the last block of extent
- FCurrBlock := TDOMNode(Pointer(ext) + sizeof(TExtent) + (AElemCount - 1) *
FElementSize);
+ FCurrBlock := TDOMNode(ptrInt(ext) + sizeof(TExtent) + (AElemCount - 1) *
FElementSize);
FCurrExtent := ext;
FCurrExtentSize := AElemCount;
end;
@@ -3214,7 +3220,7 @@
end
else
begin
- if Pointer(FCurrBlock) = Pointer(FCurrExtent) + sizeof(TExtent) then
+ if ptrInt(FCurrBlock) = ptrInt(FCurrExtent) + sizeof(TExtent) then
AddExtent(FCurrExtentSize * 2);
Result := FCurrBlock;
Dec(PChar(FCurrBlock), FElementSize);
Index: xmlutils.pp
===================================================================
--- xmlutils.pp (wersja 13601)
+++ xmlutils.pp (kopia robocza)
@@ -14,14 +14,20 @@
**********************************************************************}
unit xmlutils;
-{$mode objfpc}
-{$H+}
+{$ifdef fpc}
+{$MODE objfpc}{$H+}
+{$endif}
interface
uses
SysUtils;
+ {$IFNDEF FPC}
+
+type ptrint=integer;
+{$ENDIF}
+
function IsXmlName(const Value: WideString; Xml11: Boolean = False): Boolean;
overload;
function IsXmlName(Value: PWideChar; Len: Integer; Xml11: Boolean = False):
Boolean; overload;
function IsXmlNames(const Value: WideString; Xml11: Boolean = False): Boolean;
@@ -38,6 +44,7 @@
{ a simple hash table with WideString keys }
type
+ PTabPHashItem = ^TTabPHashItem;
PPHashItem = ^PHashItem;
PHashItem = ^THashItem;
THashItem = record
@@ -46,6 +53,7 @@
Next: PHashItem;
Data: TObject;
end;
+ TTabPHashItem = array[0..0] of pHashItem;
THashForEach = function(Entry: PHashItem; arg: Pointer): Boolean;
@@ -53,7 +61,7 @@
private
FCount: LongWord;
FBucketCount: LongWord;
- FBucket: PPHashItem;
+ FBucket: PTabPHashItem;
FOwnsObjects: Boolean;
function Lookup(Key: PWideChar; KeyLength: Integer; var Found: Boolean;
CanCreate: Boolean): PHashItem;
procedure Resize(NewCapacity: LongWord);
@@ -82,12 +90,15 @@
lname: PWideChar;
lnameLen: Integer;
end;
+ PTabExpHashEntry = ^TTabExpHashEntry;
+ tTabExpHashEntry = array[0..0] of TExpHashEntry;
+
TDblHashArray = class(TObject)
private
FSizeLog: Integer;
FRevision: LongWord;
- FData: PExpHashEntry;
+ FData: PTabExpHashEntry;
public
procedure Init(NumSlots: Integer);
function Locate(uri: PWideString; localName: PWideChar; localLength:
Integer): Boolean;
@@ -347,7 +358,11 @@
function KeyCompare(const Key1: WideString; Key2: Pointer; Key2Len: Integer):
Boolean;
begin
+ {$IFDEF FPC}
Result := (Length(Key1)=Key2Len) and (CompareWord(Pointer(Key1)^, Key2^,
Key2Len) = 0);
+ {$ELSE}
+ Result := comparemem(Pointer(Key1),key2,key2len*2);
+ {$ENDIF}
end;
{ THashTable }
@@ -461,7 +476,8 @@
procedure THashTable.Resize(NewCapacity: LongWord);
var
- p, chain: PPHashItem;
+ p : PTabPHashItem;
+ chain: PPHashItem;
i: Integer;
e, n: PHashItem;
begin
_______________________________________________
fpc-devel maillist - [email protected]
http://lists.freepascal.org/mailman/listinfo/fpc-devel
