Browse Source

* Some delphi compatibility issues solved (PtrToNil and TGUID operator)

Michaël Van Canneyt 1 year ago
parent
commit
7e4aca384f
4 changed files with 90 additions and 43 deletions
  1. 72 1
      rtl/inc/objpas.inc
  2. 18 4
      rtl/inc/objpash.inc
  3. 0 36
      rtl/objpas/sysutils/syshelp.inc
  4. 0 2
      rtl/objpas/sysutils/syshelph.inc

+ 72 - 1
rtl/inc/objpas.inc

@@ -285,6 +285,77 @@
       end;
       end;
 
 
 
 
+{****************************************************************************
+                           TGUID
+ ****************************************************************************}
+
+class operator TGUID.=(const aLeft, aRight: TGUID): Boolean;
+
+var
+  P1,P2 : ^Cardinal;
+
+begin
+  P1:=PCardinal(@aLeft);
+  P2:=PCardinal(@aRight);
+  Result:=(P1[0]=P2[0]) and (P1[1]=P2[1]) and (P1[2]=P2[2]) and (P1[3]=P2[3]);
+end;
+
+class operator TGUID.<>(const aLeft, aRight: TGUID): Boolean;
+
+begin
+  Result:=Not (aLeft=aRight);
+end;
+
+class function TGUID.Empty: TGUID; static;
+
+begin
+  Result:=Default(TGUID);
+end;
+
+
+class function TGUID.Create(const aData; aBigEndian: Boolean = False): TGUID; overload; static;
+
+begin
+  Result:=Create(PByte(@aData),aBigEndian);
+end;
+
+class function TGUID.Create(const aData : PByte; aBigEndian: Boolean = False): TGUID; overload; static;
+
+const
+  SysBigendian = {$IFDEF FPC_LITTLE_ENDIAN} false {$ELSE} true {$ENDIF};
+
+begin
+  Result := PGuid(aData)^;
+  if (aBigEndian=SysBigEndian) then
+    exit;
+  Result.D1:=SwapEndian(Result.D1);
+  Result.D2:=SwapEndian(Result.D2);
+  Result.D3:=SwapEndian(Result.D3);
+end;
+
+
+class function TGUID.Create(const aData: array of Byte; aStartIndex: Cardinal; aBigEndian: Boolean = False): TGUID; overload; static;
+
+begin
+  if ((Length(aData)-aStartIndex)<16) then
+    Result:=Empty
+  else
+    Result:=Create(PByte(@aData[aStartIndex]),aBigEndian);
+end;
+
+
+function TGUID.IsEmpty: Boolean;
+
+var
+  P : ^Cardinal;
+
+begin
+  P:=PCardinal(@Self);
+  Result:=(P[0]=0) and (P[1]=0) and (P[2]=0) and (P[3]=0)
+end;
+
+
+
 {****************************************************************************
 {****************************************************************************
                            TINTERFACEENTRY
                            TINTERFACEENTRY
 ****************************************************************************}
 ****************************************************************************}
@@ -1765,4 +1836,4 @@ begin
   WriteStringAsAnsi(Ptr, Ofs, Value, MaxCharsIncNull, CP_UTF8);
   WriteStringAsAnsi(Ptr, Ofs, Value, MaxCharsIncNull, CP_UTF8);
 end;
 end;
 
 
-{$ENDIF}
+{$ENDIF}

+ 18 - 4
rtl/inc/objpash.inc

@@ -33,7 +33,19 @@
       TextFile = Text;
       TextFile = Text;
 
 
       PGuid = ^TGuid;
       PGuid = ^TGuid;
+
+      { TGuid }
+
       TGuid = packed record
       TGuid = packed record
+      Public
+        class operator =(const aLeft, aRight: TGUID): Boolean;
+        class operator <>(const aLeft, aRight: TGUID): Boolean; inline;
+        class function Empty: TGUID; static;
+        class function Create(const aData; aBigEndian: Boolean = False): TGUID; overload; static;
+        class function Create(const aData: array of Byte; aStartIndex: Cardinal; aBigEndian: Boolean = False): TGUID; overload; static;
+        class function Create(const aData : PByte; aBigEndian: Boolean = False): TGUID; overload; static;
+        function IsEmpty: Boolean;
+      Public
          case integer of
          case integer of
             1 : (
             1 : (
                  Data1 : DWord;
                  Data1 : DWord;
@@ -649,9 +661,8 @@ Type
     Slightly Less useful in FPC, since dyn array compatibility is at the element level. 
     Slightly Less useful in FPC, since dyn array compatibility is at the element level. 
     But still useful for generic methods and of course Delphi compatibility}
     But still useful for generic methods and of course Delphi compatibility}
   generic TArray<T> = array of T;
   generic TArray<T> = array of T;
-  
-  
-  
+
+
   TMarshal = class sealed
   TMarshal = class sealed
   public
   public
     Type 
     Type 
@@ -759,6 +770,9 @@ Type
     class function ReadPtr(Ptr: TPtrWrapper; Ofs: SizeInt = 0): TPtrWrapper; static; inline;
     class function ReadPtr(Ptr: TPtrWrapper; Ofs: SizeInt = 0): TPtrWrapper; static; inline;
     class procedure WritePtr(Ptr: TPtrWrapper; Ofs: SizeInt; Value: TPtrWrapper); static; inline;
     class procedure WritePtr(Ptr: TPtrWrapper; Ofs: SizeInt; Value: TPtrWrapper); static; inline;
     class procedure WritePtr(Ptr, Value: TPtrWrapper); static; inline;
     class procedure WritePtr(Ptr, Value: TPtrWrapper); static; inline;
+  end;
 
 
+Const
+  // In Delphi System.SysInit
+  PtrToNil: Pointer = nil;
 
 
-  end;

+ 0 - 36
rtl/objpas/sysutils/syshelp.inc

@@ -10,42 +10,6 @@ begin
   Raise Exception.Create('Not yet implemented : '+S);
   Raise Exception.Create('Not yet implemented : '+S);
 end;
 end;
 
 
-Class function TGUIDHelper.Create(const Data; BigEndian: Boolean): TGUID; overload; static;
-
-Const
-  GUIDSize = SizeOf(TGUID);
-
-Var
-  B : Array[1..GUIDSize] of Byte;
-
-begin
-  Move(Data,B,GUIDSize);
-  Result:=Create(B,0,BigEndian);
-end;
-
-class function TGUIDHelper.Create(const Data: array of Byte; AStartIndex: Cardinal; BigEndian: Boolean): TGUID; overload; static;
-
-Var
-  A : Cardinal;
-  B,C : Word;
-
-begin
-  if ((System.Length(Data)-AStartIndex)<16) then
-    raise EArgumentException.CreateFmt('The length of a GUID array must be at least %d',[]);
-  Move(Data[AStartIndex],A,SizeOf(Cardinal));
-  Move(Data[AStartIndex+4],B,SizeOf(Word));
-  Move(Data[AStartIndex+6],C,SizeOf(Word));
-//  Writeln('BigEndian : ',BigEndian,', CPU bigendian : ',(CPUendian=TEndian.Big));
-  if BigEndian<>(CPUendian=TEndian.Big) then
-    begin
-//    Writeln('Swapping');
-    A:=SwapEndian(A);
-    B:=SwapEndian(B);
-    C:=SwapEndian(C);
-    end;
-  Result:=Create(A,B,C,Data[AStartIndex+8],Data[AStartIndex+9],Data[AStartIndex+10],Data[AStartIndex+11],Data[AStartIndex+12],Data[AStartIndex+13],Data[AStartIndex+14],Data[AStartIndex+15]);
-end;
-
 Class Function TGUIDHelper.Create(const Data; DataEndian: TEndian = CPUEndian): TGUID; overload; static; inline;
 Class Function TGUIDHelper.Create(const Data; DataEndian: TEndian = CPUEndian): TGUID; overload; static; inline;
 
 
 begin
 begin

+ 0 - 2
rtl/objpas/sysutils/syshelph.inc

@@ -42,8 +42,6 @@ Const
 
 
 Type
 Type
   TGuidHelper = record helper for TGUID
   TGuidHelper = record helper for TGUID
-    Class function Create(const Data; BigEndian: Boolean): TGUID; overload; static;
-    class function Create(const Data: array of Byte; AStartIndex: Cardinal; BigEndian: Boolean): TGUID; overload; static;
     Class Function Create(const Data; DataEndian: TEndian = CPUEndian): TGUID; overload; static; inline;
     Class Function Create(const Data; DataEndian: TEndian = CPUEndian): TGUID; overload; static; inline;
     Class Function Create(const B: TBytes; DataEndian: TEndian = CPUEndian): TGUID; overload; static; inline;
     Class Function Create(const B: TBytes; DataEndian: TEndian = CPUEndian): TGUID; overload; static; inline;
     Class Function Create(const B: TBytes; AStartIndex: Cardinal; DataEndian: TEndian = CPUEndian): TGUID; overload; static;
     Class Function Create(const B: TBytes; AStartIndex: Cardinal; DataEndian: TEndian = CPUEndian): TGUID; overload; static;