freepascal
/
utils
1
0
Fork 0
Code Issues 0 Pull Requests 0 Releases 0 Wiki Activity
Browse Source

uutlGenerics: improve TutlEnumHelper (no more macros)

master
Martok 8 years ago
parent
aa48423bc1
commit
d1cc1fa60a
4 changed files with 1332 additions and 1397 deletions
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. +1252
    -1160
      Tests/uGenericsTests.pas
  2. +0
    -58
      uutlEnumHelper.inc
  3. +0
    -101
      uutlEnumHelper.pas
  4. +80
    -78
      uutlGenerics.pas

+ 1252
- 1160
Tests/uGenericsTests.pas
File diff suppressed because it is too large
View File


+ 0
- 58
uutlEnumHelper.inc View File

@@ -1,58 +0,0 @@
{$IF defined(__ENUM_INTERFACE)}

type __ENUM_HELPER = class
private type
TValueArray = packed array[0..__ENUM_LENGTH-1] of __ENUM_TYPE;
public
class function {%H}ToString(const Value: __ENUM_TYPE): String; reintroduce;
class function TryToEnum(const Str: String; out Value: __ENUM_TYPE): boolean; overload;
class function ToEnum(const Str: String; const aDefault: __ENUM_TYPE): __ENUM_TYPE; overload;
class function ToEnum(const Str: String): __ENUM_TYPE; overload;
class function Values: TValueArray;
strict private
const TABLE: packed record
E: TValueArray; // array of values
N: AnsiString; // comma-separated string of names
end =

{$ELSEIF defined (__ENUM_IMPLEMENTATION)}

class function __ENUM_HELPER.ToString(const Value: __ENUM_TYPE): String;
var
i: integer;
begin
Result:= '';
if LookupVal(@Value, @TABLE.E, sizeof(__ENUM_TYPE), length(TABLE.E), i) then
Result:= PickString(TABLE.N, i);
end;

class function __ENUM_HELPER.ToEnum(const Str: String): __ENUM_TYPE;
begin
if not TryToEnum(Str, Result) then
raise EConvertErrorAlias.CreateFmt('"%s" is an invalid value',[Str]);
end;

class function __ENUM_HELPER.ToEnum(const Str: String; const aDefault: __ENUM_TYPE): __ENUM_TYPE;
begin
if not TryToEnum(Str, Result) then
Result:= aDefault;
end;

class function __ENUM_HELPER.TryToEnum(const Str: String; out Value: __ENUM_TYPE): boolean;
var
i: integer;
begin
Result:= LookupString(Str, TABLE.N, i);
if Result then
Value:= TABLE.E[i];
end;

class function __ENUM_HELPER.Values: TValueArray;
begin
Result:= TABLE.E;
end;

{$ENDIF}
{$undef __ENUM_TYPE}
{$undef __ENUM_LENGTH}
{$undef __ENUM_HELPER}

+ 0
- 101
uutlEnumHelper.pas View File

@@ -1,101 +0,0 @@
unit uutlEnumHelper;

(* Package: Utils
Prefix: utl - UTiLs
Beschreibung: diese Unit stellt einen Mechanismus zur Verfügung, ohne viel Aufwand,
Helper Klassen für Enums zu implementieren
Verwendung:
{$MACRO ON}

interface
{$define __ENUM_INTERFACE}
{$define __ENUM_HELPER:=TSomeEnumH}{$define __ENUM_TYPE:=TSomeEnum}{$define __ENUM_LENGTH:=4}
{$I uutlEnumHelper.inc}(
E: (enVal1, enVal2, enVal3, enVal4);
N: 'enVal1,enVal2,enVal3,enVal4';
); end;
//... mehr davon
{$undef __ENUM_INTERFACE}

implementation
{$define __ENUM_IMPLEMENTATION}
{$define __ENUM_HELPER:=TSomeEnumH}{$define __ENUM_TYPE:=TSomeEnum}{$I uutlEnumHelper.inc}
{$undef __ENUM_IMPLEMENTATION} *)

interface

uses
SysUtils, StrUtils;

type
EConvertErrorAlias = SysUtils.EConvertError;

function LookupString(const aStr, aTable: String; out found: integer): boolean;
function PickString(const aTable: String; const aIndex: integer): string;
function LookupVal(const aVal: Pointer; const aPtr: Pointer; const aStep, aCount: PtrInt; out found: integer): boolean;

implementation

function LookupString(const aStr, aTable: String; out found: integer): boolean;
var
tbl: string;
i,p,k: integer;
t: string;
begin
Result:= false;
tbl:= aTable + ',';
t:= '';
k:= 0;
i:= 1;
while i < Length(tbl) do begin
p:= PosEx(',',tbl,i);
t:= Trim(Copy(tbl, i, p-i));
i:= p+1;
if CompareText(t, aStr)=0 then begin
found:= k;
Result:= true;
exit;
end else
inc(k);
end;
end;

function PickString(const aTable: String; const aIndex: integer): string;
var
tbl: String;
k,i,p: integer;
begin
result:= '';
tbl:= aTable + ',';
i:= 1;
k:= aIndex;
while (k>0) and (i>0) do begin
i:= PosEx(',',tbl, i) + 1;
dec(k);
end;
p:= PosEx(',',tbl, i);
if p<=0 then
Result:= ''
else
Result:= Trim(Copy(tbl, i, p-i));
end;


function LookupVal(const aVal: Pointer; const aPtr: Pointer; const aStep, aCount: PtrInt; out found: integer): boolean;
var
pt: Pointer;
i: integer;
begin
Result:= false;
pt:= aPtr;
for i:= 0 to aCount-1 do begin
if CompareMem(pt, aVal, aStep) then begin
Result:= true;
found:= i;
exit;
end;
inc(pt, aStep);
end;
end;

end.

+ 80
- 78
uutlGenerics.pas View File

@@ -416,12 +416,17 @@ type
generic TutlEnumHelper<T> = class(TObject)
private type
TValueArray = array of T;
private class var
FTypeInfo: PTypeInfo;
FValues: TValueArray;
public
class constructor Initialize;
class function ToString(aValue: T): String; reintroduce;
class function TryToEnum(aStr: String; out aValue: T): Boolean;
class function ToEnum(aStr: String): T; overload;
class function ToEnum(aStr: String; const aDefault: T): T; overload;
class function Values: TValueArray;
class function TypeInfo: PTypeInfo;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -1662,78 +1667,86 @@ end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlEnumHelper////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelper.ToString(aValue: T): String;
Var
PS: PShortString;
TI: PTypeInfo;
PT: PTypeData;
num: Integer;
begin
TI := TypeInfo(T);
PT := GetTypeData(TI);
if TI^.Kind = tkBool then begin
case Integer(aValue) of
0,1:
Result:=BooleanIdents[Boolean(aValue)];
else
Result:='';
end;
end else begin
num := Integer(aValue);
if (num >= PT^.MinValue) and (num <= PT^.MaxValue) then begin
PS := @PT^.NameList;
dec(num, PT^.MinValue);
while num > 0 do begin
PS := PShortString(pointer(PS) + PByte(PS)^ + 1);
Dec(Num);
end;
Result := PS^;
end else
Result := '';
class constructor TutlEnumHelper.Initialize;
var
tiArray: PTypeInfo;
tdArray, tdEnum: PTypeData;
aName: PShortString;
i: integer;
en: T;
begin
{
See FPC Bug http://bugs.freepascal.org/view.php?id=27622
For Sparse Enums, the compiler won't give us TypeInfo, because it contains some wrong data. This is
safe, but sadly we don't even get the *correct* fields (TypeName, NameList), even though they are
generated in any case.
Fortunately, arrays do know this type info segment as their Element Type (and we declared one anyway).
}
tiArray := System.TypeInfo(TValueArray);
tdArray := GetTypeData(tiArray);
FTypeInfo:= tdArray^.elType2;

{
Now that we have the TypeInfo, fill our values from it. This is safe because while the *values* in
TypeData are wrong for Sparse Enums, the *names* are always correct.
}
tdEnum:= GetTypeData(FTypeInfo);
aName:= @tdEnum^.NameList;
SetLength(FValues, 0);
i:= 0;
While Length(aName^) > 0 do begin
SetLength(FValues, i+1);
{
Memory layout for TTypeData has the declaring EnumUnitName after the last NameList entry.
This can normally not be the same as a valid enum value, because it is in the same identifier
namespace. However, with scoped enums we might have the same name for module and element, because
the full identifier for the element would be TypeName.ElementName.
In either case, the next PShortString will point to a zero-length string, and the loop is left
with the last element being invalid (either empty or whatever value the unit-named element has).
}
if TryToEnum(aName^, en) then
FValues[i]:= en;
inc(i);
inc(PByte(aName), Length(aName^) + 1);
end;
// remove the EnumUnitName item
SetLength(FValues, Length(FValues) - 1);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelper.ToString(aValue: T): String;
begin
{$Push}
{$IOChecks OFF}
WriteStr(Result, aValue);
if IOResult = 107 then
Result:= '';
{$Pop}
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelper.TryToEnum(aStr: String; out aValue: T): Boolean;
Var
PS: PShortString;
PT: PTypeData;
Count: longint;
sName: shortstring;
TI: PTypeInfo;
begin
TI := TypeInfo(T);
PT := GetTypeData(TI);
Result := False;
var
a: T;
begin
Result:= false;
if Length(aStr) = 0 then
exit;
sName := aStr;

if TI^.Kind = tkBool then begin
If CompareText(BooleanIdents[false], aStr) = 0 then
aValue := T(0)
else if CompareText(BooleanIdents[true], aStr) = 0 then
aValue := T(1);
Result := true;
end else begin
PS := @PT^.NameList;
Count := 0;
While (PByte(PS)^ <> 0) do begin
If ShortCompareText(PS^, sName) = 0 then begin
aValue := T(Count + PT^.MinValue);
exit(true);
end;
PS := PShortString(pointer(PS) + PByte(PS)^ + 1);
Inc(Count);
end;
end;

{$Push}
{$IOChecks OFF}
ReadStr(aStr, a);
Result:= IOResult <> 106;
{$Pop}
if Result then
aValue:= a;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelper.ToEnum(aStr: String): T;
begin
if not TryToEnum(aStr, result) then
raise EutlEnumConvert.Create(aStr, PTypeInfo(TypeInfo(T))^.Name);
raise EutlEnumConvert.Create(aStr, TypeInfo^.Name);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -1745,25 +1758,14 @@ end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelper.Values: TValueArray;
Var
TI: PTypeInfo;
PT: PTypeData;
i,j: integer;
begin
TI := TypeInfo(T);
PT := GetTypeData(TI);
if TI^.Kind = tkBool then begin
SetLength(Result, 2);
Result[0]:= T(true);
Result[1]:= T(false);
end else begin
SetLength(Result, PT^.MaxValue - PT^.MinValue + 1);
j:= 0;
for i:= PT^.MinValue to PT^.MaxValue do begin
Result[j]:= T(i);
inc(j);
end;
end;
begin
Result:= FValues;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEnumHelper.TypeInfo: PTypeInfo;
begin
Result:= FTypeInfo;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////


Write Preview
Loading…
Cancel
Save