paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 14:27:59 +02:00
Code Issues Packages Projects Releases Wiki Activity

Adding pointer access to nullable

Browse Source
This commit is contained in:
Frederic Kehrein 2024-10-01 10:41:50 +02:00 committed by Michael Van Canneyt
parent 3dc3d83757
commit 6ff63107a6
2 changed files with 31 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
packages/rtl-objpas/src/inc/nullable.pp
View File

@ -34,9 +34,12 @@ Type
{ TNullable }
generic TNullable<T> = record
public type
PT = ^T;
private
FValue: T;
FHasValue: Boolean; // Default False
function InitAndGetPtr: PT;
function GetIsNull: Boolean;
function GetValue: T;
function GetValueOrDefault: T;
@ -58,6 +61,8 @@ Type
property IsNull: Boolean read GetIsNull;
// return the value.
property Value: T read GetValue write SetValue;
// Initializes the value if not exists and gets the pointer
property Ptr: PT read InitAndGetPtr;
// If a value is present, return it, otherwise return the default.
property ValueOrDefault: T read GetValueOrDefault;
// Return an empty value
@ -88,6 +93,13 @@ uses rtlconsts,typinfo;
{ TNullable }
function TNullable.InitAndGetPtr:PT;
begin
if not HasValue then
SetValue(Default(T));
Result := @FValue;
end;
function TNullable.GetIsNull: Boolean;
begin
Result:=Not HasValue;

19
tests/test/units/nullable/tnull.pp
View File

@ -253,6 +253,24 @@ begin
Exit('ValueOr not correct');
end;
Function TestPtrAccess : string;
Var
A : specialize TNullable<String>;
begin
Result:='';
A.Value:=Val1;
If Not (A.Ptr^=Val1) then
Exit('Pointer to initialized not correct');
A.Clear;
If Not (A.Ptr^='') then
Exit('Pointer to uninitialized not correct');
A.Clear;
A.Ptr^:=Val1;
If Not (A.HasValue And (A.Value=Val1)) then
Exit('Setting value through PTR access not correct');
end;
Procedure DoTest(aTest,aResult : String);
begin
@ -282,5 +300,6 @@ begin
DoTest('TestBoolCheck',TestBoolCheck);
DoTest('TestUnpack',TestUnpack);
DoTest('TestValueOr',TestValueOr);
DoTest('TestPtrAccess',TestPtrAccess);
end.