Record constants that are actually constant?

[Lars Fosdal 1792]

I have a feeling I've asked this question before, but here I go again?

Is there a way to declare a constant of type rec that actually is constant?
 

{$WRITEABLECONST OFF}
type
  rec = record
    a: string;
    b: string;
  end;

type
  TestAttribute = class(TCustomAttribute)
  public
    r: rec;
    constructor Create(const ar: rec);
  end;

const
  rconst:rec = (a:'foo'; b:'bar');

type
  TTestClass = class
  private
    FProp: string;
  public
    [Test(rconst)]  // [dcc32 Error] E2026 Constant expression expected
    property Prop: string read FProp write FProp;
  end;

 

[Stefan Glienke 2002]

Reading the documentation is underrated these days, eh?

 

http://docwiki.embarcadero.com/RADStudio/Rio/en/Declared_Constants#Typed_Constants

 

To solve this particular case of providing structured data to unit tests via attributes I am referring to an approach where you specify where to get the data from in the test attribute and write the code that then does not have to be const in methods that are accessible via RTTI.

 

Here an example how to use this with the Spring.Testing extensions for DUnit: https://bitbucket.org/snippets/sglienke/pe7xAK/dunit-with-external-test-data

The approach itself is borrowed from NUnit - see https://github.com/nunit/docs/wiki/TestCaseData

Edited July 31, 2019 by Stefan Glienke

[Lars Fosdal 1792]

BDS doc has degenerated badly over the years, and it is often incomplete, inaccurate, or outdated. 
 

Logically, at least in my head, a type const declared with {$WRITEABLECONST OFF} is immutable and hence should be possible to use as any other const.

 

If that is impossible - I should at least be able to follow the pattern of the following

const
  _000000FF = Integer(255)
  s = String('C');

and declare

const
  r = rec(a:'Foo'; b:'Bar');

but alas...

 

Your workaround works, but presents two problems:

- String constants as a reference are fragile.  Renaming through the refactoring methods may very well break the link.

- I use attributes to parameterize a large number of properties per class, and that would mean a lot of extra code.

To me, it is the attribute Create that is the problem.  It doesn't behave the same as other class Create ctors. 
There are probably compiler tech reasons - but valid or not - the behavior is frustrating.

 

program Test;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils;

type
  rec = record
    a: string;
    b: string;
    class function Create(const aa,ab: string): rec; static;
  end;

const
  crec: rec = (a:'X'; b:'Y');

type
  TTestClass = class
  private
    r: rec;
  public
    constructor Create(const arec: rec);
    procedure Test(const arec: rec);
  end;

{ TTestClass }

constructor TTestClass.Create(const arec: rec);
begin
  r:= aRec;
end;

procedure TTestClass.Test(const arec: rec);
begin
  r := aRec;
end;

{ rec }

class function rec.Create(const aa, ab: string): rec;
begin
  Result.a := aa;
  Result.b := ab;
end;

begin
  var TC := TTestClass.Create(crec);
  try
    try
      TC.Test(crec); // typed constant allowed
      TC.Test(rec.Create('X','Y'));
      TC.Test((a:'X'; b:'Y'));   // BARF - IMO this needs to be supported
      TC.Test(rec:(a:'X'; b:'Y'));   // BARF
    except
      on E: Exception do
        Writeln(E.ClassName, ': ', E.Message);
    end;
  finally
    TC.Free;
    Write('Press Enter');
    Readln;
  end;
end.

 

[David Heffernan 2345]

56 minutes ago, Lars Fosdal said:

BDS doc has degenerated badly over the years, and it is often incomplete, inaccurate, or outdated. 

Really?  I think that new features are poorly documented, but long standing language features are actually well documented.

[Attila Kovacs 629]

@Lars Fosdal use json for your attribs, syncommons.pas can convert them to records

[Lars Fosdal 1792]

6 hours ago, Attila Kovacs said:

@Lars Fosdal use json for your attribs, syncommons.pas can convert them to records

That is a good idea, but also somewhat fragile as the Json can't be validated at compile time - or can it... Perhaps a preprocessor would do the trick. Thanks, that is worth looking at. 

[Attila Kovacs 629]

@Lars Fosdal you could also pass classes in attributes. there you could have class vars for example. I like the json way. More flexible. (And more fragile, true)

[Stefan Glienke 2002]

On 7/31/2019 at 4:06 PM, Lars Fosdal said:

To me, it is the attribute Create that is the problem.  It doesn't behave the same as other class Create ctors. 

Of course it does not - because it's not regularly invoked but executed via RTTI taking its arguments from at compiletime specified memory - see System.Rtti.ConstructAttributes

 

 

On 7/31/2019 at 4:06 PM, Lars Fosdal said:

String constants as a reference are fragile.  Renaming through the refactoring methods may very well break the link.

I would agree if it would reference production code method names that might be subject to refactoring without knowing that some test code references to them but in this case the referenced method is part of the test code and you don't usually rename those and even when they are very close to each other so its more unlikely to miss the reference.

 

Anyway feel free to ignore the obvious and already proven to work fine solution and look for an impossible one :)

Edited August 2, 2019 by Stefan Glienke

[Lars Fosdal 1792]

41 minutes ago, Stefan Glienke said:

Anyway feel free to ignore the obvious and already proven to work fine solution and look for an impossible one 🙂

 

@Stefan Glienke The snippet below is one more complex of a few hundred GridSets that I have, and I'd like to change the parameterization of every InitField attribute to a structure.

How well suited is "the obvious and already proven to work fine solution" in this context?

 

  TDeliverySet = class(TGridSet)
  const
    DateFmt = 'dd.mm.yyyy';
  type
    TOnHasExternal = reference to function(const aDeliveryId:Integer):Boolean;
    TFieldSortPosition = class(TFieldEnum<TPSDPositionInGroup>);
    TFieldPickMethod = class(TFieldEnum<TPSDCustomerOrderPickingMethod>);
    TFieldTPackPickMethod = class(TFieldEnum<TPSDCustomerOrderTPackPickingMethod>);
    TRouteKey = record
      Id: Integer;
      Count: Integer;
    end;

  private
    function GetRouteKey(const aIndex: Integer; var RouteEntry: TRouteEntry): Integer;
    function GetShowPickRoutes: Boolean;
  protected
    OnHasExternal: TOnHasExternal;
    PickTPacks: Boolean;
    Environment: TPSDEnviroment;
    RouteDictionary: TRouteDictionary;

  public

    [GridAutoSize, GridMultiSelect //, GridShowFilters
    ]

    [InitField(' ', 20), CustomField]
    Grouping: TFieldGrouping;

    [HiddenField, CustomField] SortPositionInRoute: TFieldSortPosition;
    [HiddenField, CustomField] SortPositionInPickGroup: TFieldSortPosition;

    [InitField(sfrmPSDExpeditionDGridHeadindRoute, 100), CustomField, DefaultSortField]
    DisplayRoute: TFieldString;
    [HiddenField] RouteNo: TFieldString;
    [HiddenField] RouteDepartureTime: TFieldDateTime;


    [InitField(sfrmPSDExpeditionDGridHeadindCustomer, 180), CustomField]
    DisplayCustName: TFieldString;
    [HiddenField] CustomerNo: TFieldString;
    [HiddenField] CustomerName: TFieldString;
    [HiddenField] RefCustomerNo: TFieldString;
    [HiddenField] RefOrderCustomerName: TFieldString;

    [InitField(sfrmPSDExpeditionDGridHeadindDelivery, 110)]
    DeliveryNo: TFieldString;
    [HiddenField] PickingFinishedTime: TFieldDateTime;
    [HiddenField] HasOnlyAutoPickedLaterLines: TFieldBoolean;
    [HiddenField] CompleteTPackCount: TFieldInteger;
    [HiddenField] LineCountWithSmallPick: TFieldInteger;
    [HiddenField] PickMethod: TFieldPickMethod;
    [HiddenField] TPackPickMethod: TFieldTPackPickMethod;
    [HiddenField] PartlyPickedLineCount: TFieldInteger;
    [HiddenField] PickedLineCount: TFieldInteger;

    [InitField(sfrmPSDExpeditionDGridHeadindPickRoute, 60), HiddenField, ToggleField]
    PickRoutes: TFieldString;

    [InitField(sfrmPSDExpeditionDGridHeadindRouteSequenceNo, 60)]
    RouteSequenceNo: TFieldInteger;

    [InitField(sfrmPSDExpeditionDGridHeadindOrderNo, 80)]
    OrderNo: TFieldString;

    [InitField(sfrmPSDExpeditionDGridHeadindLines, 60), CustomField]
    DisplayLineCount: TFieldString;
    [HiddenField] LineCount: TFieldInteger;
    [HiddenField] MissingDPackCount: TFieldInteger;
    [HiddenField] MissingLineCount: TFieldInteger;

    [InitField(sfrmPSDExpeditionDGridHeadindGroupe, 60), CustomField, HiddenField(True)]
    GP: TFieldString;

    [InitField(sfrmPSDExpeditionDGridHeadindColliPickTo, 80), HiddenField(True)]
    ColliPickTo: TFieldString;

    [InitField(sfrmPSDExpeditionDGridHeadindPickDeviationEmpty, 60), HiddenField(True),ToggleField]
    PickDeviationEmptyCount: TFieldInteger;
    [HiddenField] PrioritizedArticleDeviation: TFieldBoolean;

    [InitField(sfrmPSDExpeditionDGridHeadindPickDeviationPickLater, 80), HiddenField(True)]
    PickDeviationWillBePickedLaterCount: TFieldInteger;

    [InitField(sfrmPSDExpeditionDGridHeadindReportingErrors, 50), HiddenField(True)]
    ReportingStatusFailedCount: TFieldInteger;

    [InitField(sfrmPSDExpeditionDGridHeadindConfirmedCollicount, 70), CustomField, HiddenField,ToggleField]
    U: TFieldInteger;
    [HiddenField]
    ConfirmedColliCount: TFieldInteger;

    [InitField(sfrmPSDExpeditionDGridHeadindComments, 80), CustomField, HiddenField(True)]
    K: TFieldInteger;
    [HiddenField, CustomField] Comment: TFieldString;
    [HiddenField] PreComment: TFieldString;
    [HiddenField] PostComment: TFieldString;

    [InitField(sfrmPSDExpeditionDGridHeadindKPackCount, 40)]
    KPackCount: TFieldInteger;

    [InitField(sfrmPSDExpeditionDGridHeadindPrePick, 60), CustomField,  HiddenField(True)]
    Prepick: TFieldString;

    [HiddenField] IsExport: TFieldBoolean;
    [HiddenField] RefOrder: TFieldString;
    [HiddenField] RefOrderRouteNo: TFieldString;
    [HiddenField] RefOrderRouteSequence: TFieldString;

    [InitField(sfrmPSDExpeditionDGridHeadindPickers, 60), HiddenField(True)]
    PickerUserName: TFieldString;

    [InitField(sfrmPSDExpeditionDGridHeadindEstimatedColliCount, 60), HiddenField(True)]
    EstimatedColliCount: TFieldDouble;

    [InitField(sfrmPSDExpeditionDGridHeadindUsedColliSummary, 60), HiddenField(True)]
    UsedColliSummary: TFieldString;

    [HiddenField, ToggleField]
    PickGroupId: TFieldInteger;

    [HiddenField, ToggleField]
    HasConsumers: TFieldBoolean;

    [HiddenField, ToggleField]
    CustomerOrderId: TFieldInteger;

    [HiddenField, CustomField]
    RouteKey: TFieldInteger;

    [UniqueField, HiddenField, ToggleField]
    DeliveryId: TFieldInteger;

    [InitField(sfrmPSDExpeditionDGridHeadindDeliverySummaryId, 'Id', 60), HiddenField, ToggleField]
    DeliverySummaryId: TFieldInteger;

    constructor Create; override;
    destructor Destroy; override;
    function GetEmptyImageIndex(const aIndex: Integer): Integer;
    function GetDeliveryNoImageIndex(const aIndex: Integer): Integer;
    function GetPickedLaterImageIndex(const aIndex: Integer): Integer;
    function RouteNoImageIndex(const aIndex: Integer): Integer;
    function GetReportingStatusImageIndex(const aIndex: Integer): Integer;
    function GetCommentImageIndex(const aIndex: Integer): Integer;
    function GetCommentHint(const aIndex: Integer):String;
    function GetDockImageIndex(const aIndex: Integer): Integer;
    function GetConsumerPickImageIndex(const aIndex:Integer): Integer;

    function DeliveryRowStyler(const aIndex, aCol: Integer; var Style: TCellStyle):Boolean;

    procedure DoAfterConvert(const rx: Integer); override;

    procedure FillRouteSet(const aRouteSet: TRouteSet);

    procedure UpdateFromDeliverySet(FullSet:TDeliverySet; SelectedRouteKeys: TArrayInteger);

    /// <summary> Assumes ReleasedTPack and ReleasedPick have been initialized </summary>
    procedure GetReleaseStates(const aIndex: Integer; out ReleasedTPack, ReleasedPick: TThreeChoices);

    property ShowPickRoutes:Boolean read GetShowPickRoutes;

  end;

 

[Stefan Glienke 2002]

20 minutes ago, Lars Fosdal said:

I'd like to change the parameterization of every InitField attribute to a structure.

How well suited is "the obvious and already proven to work fine solution" in this context?

If you in fact read carefully what I wrote in my first post in this thread you would have noticed that I was merely referring to using attributes for passing test data to unit tests (which probably your made up TestAttribute made me believe you were trying to) and which the snippet showed that I posted - you never mentioned that in fact you are trying something different with your approach.

 

And in this context you just showed it even does not look like a good idea because apart from not working it would even create 2 indirections - you would need to declare all the const records somewhere and then pass those to your attributes.

If all the data being passed to attributes gets so complex that you feel the need to make compound types from them then I would rather consider writing an Init method where I do all this - compiled code, no attribute/rtti overhead, easily testable, done.

 

Or if you don't like writing code - then make a custom component editor for your TGridSet class that you can then edit in the designer - add verification logic and so on.

Edited August 2, 2019 by Stefan Glienke

[Lars Fosdal 1792]

38 minutes ago, Stefan Glienke said:

If all the data being passed to attributes gets so complex that you feel the need to make compound types from them then I would rather consider writing an Init method where I do all this - compiled code, no attribute/rtti overhead, easily testable, done.

I already have init code where stuff like decorators, formatters, secondary sorting etc. is set up, so I guess I have to move this here as well - or add another set of constructor overloads to the attribute 😕 or add an extra attribute or two.

 

It would have been so nice being able to inline declare a record as a constant.  That goes outside the use with attributes as well.

 

type
  coordinate = record
    x,y: Double;
  end

const
  cp = coordinate(x: 10; y:10);  // an actual immutable constant

Explicit
  var p: coordinate := (x: 10; y:10);

Inferred:
  var p := coordinate(x: 10; y:10);

  p := (x:10; y:10);

  p := cp;

 

[Stefan Glienke 2002]

They should just make typed const true consts by dropping that writeableconst - or for the sake of backwards compatibility introduce a new switch $TYPEDCONST that when enabled turns even typed consts into true consts that even if you try $J+ won't be writable.

Edited August 2, 2019 by Stefan Glienke

[David Heffernan 2345]

On 7/31/2019 at 11:39 PM, Lars Fosdal said:

That is a good idea, but also somewhat fragile as the Json can't be validated at compile time

Attributes are fragile by design. The compiler cannot verify that you supplied the appropriate attributes to make your program work correctly.

 

For example, at the outset of this thread you are faced with an attempt to pass a typed constant to an attribute constructor and the compiler objects.  Well, remove the entire attribute declaration and now your program will compile.

[Lars Fosdal 1792]

2 minutes ago, David Heffernan said:

Attributes are fragile by design. The compiler cannot verify that you supplied the appropriate attributes to make your program work correctly.

 

For example, at the outset of this thread you are faced with an attempt to pass a typed constant to an attribute constructor and the compiler objects.  Well, remove the entire attribute declaration and now your program will compile.

They are fragile in the respect that you may omit an attribute or enter a valid attribute that is not used by the class, i.e. not valid to use in the specific scope.

A valid and appropriate attribute is not really fragile as such.