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;
 
 
+{****************************************************************************
+                           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
 ****************************************************************************}
@@ -1765,4 +1836,4 @@ begin
   WriteStringAsAnsi(Ptr, Ofs, Value, MaxCharsIncNull, CP_UTF8);
 end;
 
-{$ENDIF}
+{$ENDIF}

+ 18 - 4
rtl/inc/objpash.inc

@@ -33,7 +33,19 @@
       TextFile = Text;
 
       PGuid = ^TGuid;
+
+      { TGuid }
+
       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
             1 : (
                  Data1 : DWord;
@@ -649,9 +661,8 @@ Type
     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}
   generic TArray<T> = array of T;
-  
-  
-  
+
+
   TMarshal = class sealed
   public
     Type 
@@ -759,6 +770,9 @@ Type
     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, 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);
 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;
 
 begin

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

@@ -42,8 +42,6 @@ Const
 
 Type
   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 B: TBytes; DataEndian: TEndian = CPUEndian): TGUID; overload; static; inline;
     Class Function Create(const B: TBytes; AStartIndex: Cardinal; DataEndian: TEndian = CPUEndian): TGUID; overload; static;