From b5a0c3b1b6be6538d7111f2863e4575cd32da662 Mon Sep 17 00:00:00 2001
From: Frederic Kehrein <frederic.kehrein@rwth-aachen.de>
Date: Sat, 28 Sep 2024 14:06:58 +0200
Subject: [PATCH] Adding some convinience functions to TNullable

---
 packages/rtl-objpas/src/inc/nullable.pp | 39 ++++++++++++++++
 tests/test/units/nullable/tnull.pp      | 62 +++++++++++++++++++++++++
 2 files changed, 101 insertions(+)

diff --git a/packages/rtl-objpas/src/inc/nullable.pp b/packages/rtl-objpas/src/inc/nullable.pp
index a2f7de3453..3ac02d0d85 100644
--- a/packages/rtl-objpas/src/inc/nullable.pp
+++ b/packages/rtl-objpas/src/inc/nullable.pp
@@ -28,6 +28,8 @@ uses sysutils;
 {$ENDIF FPC_DOTTEDUNITS}
 
 Type
+  TNull = record
+  end;
 
   { TNullable }
 
@@ -44,6 +46,10 @@ Type
     // Make things more readable
     Type
       TMyType = specialize TNullable<T>;
+    // Return if it has value and if so unpack
+    function Unpack(out aDest: T): Boolean;
+    // Return value if present, else return fallback
+    function ValueOr(const Fallback: T): T;
     // Clear value, no value present after this.
     procedure Clear;
     // Is a value present ?
@@ -62,9 +68,16 @@ Type
     class operator Explicit(aValue: T): TMyType;
     class operator Explicit(aValue: TMyType): T;
     class operator := (aValue: T): TMyType;
+    class operator := (aValue: TNull): TMyType;
     class operator := (aValue: TMyType): T;
+    class operator Not (aValue: TMyType): Boolean;
    end;
 
+{$Push}
+{$WriteableConst Off}
+const null: TNull = ();
+{$Pop}
+
 implementation
 
 {$IFDEF FPC_DOTTEDUNITS}
@@ -110,6 +123,21 @@ begin
   FHasValue:=True;
 end;
 
+function TNullable.Unpack(out aDest: T): Boolean;
+begin
+  Result := HasValue;
+  if Result then
+    aDest := GetValue;
+end;
+
+function TNullable.ValueOr(const Fallback: T): T;
+begin
+  if HasValue then
+    Result := GetValue
+  else
+    Result := Fallback;
+end;
+
 procedure TNullable.Clear;
 begin
   HasValue:=False;
@@ -143,6 +171,12 @@ begin
   Result.Value:=aValue;
 end;
 
+class operator TNullable.:=(aValue: TNull): TMyType;
+begin
+  Result := Default(TMyType);
+  Result.Clear;
+end;
+
 class operator TNullable.:= (aValue: TMyType): T;
 
 begin
@@ -150,4 +184,9 @@ begin
   Result:=aValue.Value;
 end;
 
+class operator TNullable.Not(aValue: TMyType): Boolean;
+begin
+  Result := Not aValue.HasValue;
+end;
+
 end.
diff --git a/tests/test/units/nullable/tnull.pp b/tests/test/units/nullable/tnull.pp
index c22084882a..fd2d39228a 100644
--- a/tests/test/units/nullable/tnull.pp
+++ b/tests/test/units/nullable/tnull.pp
@@ -194,6 +194,64 @@ begin
   end;
 end;
 
+Function TestAssignNull : string;
+
+Var
+  A : specialize TNullable<String>;
+begin
+  Result:='';
+  A.Value:=Val1;
+  If Not A.HasValue then
+    Exit('Assign not correct');
+  A := null;
+  if A.HasValue then
+    Exit('Null assignement not correct');
+end;
+
+Function TestBoolCheck : string;
+
+Var
+  A : specialize TNullable<String>;
+begin
+  Result:='';
+  A.Value:=Val1;
+  If Not A then
+    Exit('Bool check not correct');
+end;
+
+Function TestUnpack : string;
+
+Var
+  A : specialize TNullable<String>;
+  B : String;
+begin
+  Result:='';
+  A.Value:=Val1;
+  if not A.unpack(B) then
+    Exit('Unpack return not correct');
+  If Not (B=Val1) then
+    Exit('Unpack value not correct');
+  A.Clear;
+  if A.unpack(B) then
+    Exit('Unpack return not correct');
+end;
+
+Function TestValueOr : string;
+
+Var
+  A : specialize TNullable<String>;
+  B : String;
+begin
+  Result:='';
+  A.Value:=Val1;
+  B:=A.ValueOr(Val2);
+  If Not (B=Val1) then
+    Exit('ValueOr not correct');
+  A.Clear;
+  B:=A.ValueOr(Val2);
+  If Not (B=Val2) then
+    Exit('ValueOr not correct');
+end;
 
 Procedure DoTest(aTest,aResult : String);
 
@@ -220,5 +278,9 @@ begin
   DoTest('TestAssign2',TestAssign2);
   DoTest('TestGetEmptyValue',TestGetEmptyValue);
   DoTest('TestGetEmptyValueOrDefault',TestGetEmptyValueOrDefault);
+  DoTest('TestAssignNull',TestAssignNull);
+  DoTest('TestBoolCheck',TestBoolCheck);
+  DoTest('TestUnpack',TestUnpack);
+  DoTest('TestValueOr',TestValueOr);
 end.