Recent

Author Topic: Custom attributes  (Read 1066 times)

avk

  • Full Member
  • ***
  • Posts: 154
    • my self-education project
Custom attributes
« on: October 18, 2019, 03:34:53 pm »
Interested in Custom attributes, I implemented the simplest example:
Code: Pascal  [Select]
  1. program attr_test;
  2.  
  3. {$mode objfpc}{$H+}
  4. {$modeswitch prefixedattributes}
  5.  
  6. uses
  7.   heaptrc, SysUtils, typinfo, {%H-}rtti;
  8.  
  9. type
  10.  
  11.   IntRangeAttribute = class(TCustomAttribute)
  12.   private
  13.     FMinValue,
  14.     FMaxValue: Integer;
  15.   public
  16.     constructor Create(aMin, aMax: Integer);
  17.     property MinValue: Integer read FMinValue;
  18.     property MaxValue: Integer read FMaxValue;
  19.   end;
  20.  
  21.   DefaultStrAttribute = class(TCustomAttribute)
  22.   private
  23.     FValue: string;
  24.   public
  25.     constructor Create;
  26.     constructor Create(const aValue: string);
  27.     property Value: string read FValue;
  28.   end;
  29.  
  30.   CheckAttribute = class(TCustomAttribute)
  31.   private
  32.     FChecked: Boolean;
  33.   public
  34.     constructor Create;
  35.     constructor Create(aValue: Boolean);
  36.     property Checked: Boolean read FChecked;
  37.   end;
  38.  
  39.   [Check(True)]
  40.   TMyClass = class
  41.   private
  42.     FName,
  43.     FDescr: string;
  44.     FId: Integer;
  45.   published
  46.     [DefaultStr]
  47.     property Name: string read FName write FName;
  48.     [DefaultStr('nice description')]
  49.     property Description: string read FDescr write FDescr;
  50.     [IntRange(100, 10000)]
  51.     property Id: Integer read FId write FId;
  52.   end;
  53.  
  54.   [DefaultStr('this is TMyRec')][IntRange(0, 100)]
  55.   TMyRec = record
  56.     Name: string;
  57.     Value: Integer;
  58.   end;
  59.  
  60.   [Check][IntRange(-10000, 10000)]
  61.   TMyInt = type Integer;
  62.  
  63. { CheckAttribute }
  64.  
  65. constructor CheckAttribute.Create;
  66. begin
  67.   FChecked := False;
  68. end;
  69.  
  70. constructor CheckAttribute.Create(aValue: Boolean);
  71. begin
  72.   FChecked := aValue;
  73. end;
  74.  
  75. { DefaultStrAttribute }
  76.  
  77. constructor DefaultStrAttribute.Create;
  78. begin
  79.   FValue := 'Unassigned';
  80. end;
  81.  
  82. constructor DefaultStrAttribute.Create(const aValue: string);
  83. begin
  84.   FValue := aValue;
  85. end;
  86.  
  87. { TIntRangeAttribute }
  88.  
  89. constructor IntRangeAttribute.Create(aMin, aMax: Integer);
  90. begin
  91.   FMinValue := aMin;
  92.   FMaxValue := aMax;
  93. end;
  94.  
  95. procedure PrintAttribute(Attr: TCustomAttribute);
  96. begin
  97.   if not Assigned(Attr) then
  98.     exit;
  99.   WriteLn('  Found attribute ', Attr.ClassName, ':');
  100.   if Attr is DefaultStrAttribute then
  101.     WriteLn('    property Value has value "', DefaultStrAttribute(Attr).Value, '"')
  102.   else
  103.     if Attr is IntRangeAttribute then
  104.       begin
  105.         WriteLn('    property MinValue has value ', IntRangeAttribute(Attr).MinValue);
  106.         WriteLn('    property MaxValue has value ', IntRangeAttribute(Attr).MaxValue);
  107.       end
  108.     else
  109.       if Attr is CheckAttribute then
  110.         WriteLn('    property Checked has value ', CheckAttribute(Attr).Checked);
  111. end;
  112.  
  113. procedure PrintClassAttributes(aClass: TClass);
  114. var
  115.  RCtx: TRttiContext;
  116.  RType: TRttiType;
  117.  Prop: TRttiProperty;
  118.  Attr: TCustomAttribute;
  119. begin
  120.   RCtx := TRttiContext.Create;
  121.   try
  122.     RType := RCtx.GetType(aClass);
  123.     WriteLn(RType.Name, ' attributes:');
  124.     for Attr in RType.GetAttributes do
  125.       PrintAttribute(Attr);
  126.     for Prop in RType.GetProperties do
  127.       for Attr in Prop.GetAttributes do
  128.         PrintAttribute(Attr);
  129.   finally
  130.     RCtx.Free;
  131.   end;
  132. end;
  133.  
  134. procedure PrintTypeAttributes(aInfo: PTypeInfo);
  135. var
  136.  RCtx: TRttiContext;
  137.  RType: TRttiType;
  138.  Attr: TCustomAttribute;
  139. begin
  140.   RCtx := TRttiContext.Create;
  141.   try
  142.     RType := RCtx.GetType(aInfo);
  143.     WriteLn(RType.Name, ' attributes:');
  144.     for Attr in RType.GetAttributes do
  145.       PrintAttribute(Attr);
  146.   finally
  147.     RCtx.Free;
  148.   end;
  149. end;
  150.  
  151. begin
  152.   SetHeapTraceOutput('heap.log');
  153.   PrintClassAttributes(TMyClass);
  154.   PrintTypeAttributes(TypeInfo(TMyRec));
  155.   PrintTypeAttributes(TypeInfo(TMyInt));
  156. end.
  157.  
and got the expected result:
Code: Text  [Select]
  1. TMyClass attributes:
  2.   Found attribute CheckAttribute:
  3.     property Checked has value TRUE
  4.   Found attribute DefaultStrAttribute:
  5.     property Value has value "Unassigned"
  6.   Found attribute DefaultStrAttribute:
  7.     property Value has value "nice description"
  8.   Found attribute IntRangeAttribute:
  9.     property MinValue has value 100
  10.     property MaxValue has value 10000
  11. TMyRec attributes:
  12.   Found attribute DefaultStrAttribute:
  13.     property Value has value "this is TMyRec"
  14.   Found attribute IntRangeAttribute:
  15.     property MinValue has value 0
  16.     property MaxValue has value 100
  17. TMyInt attributes:
  18.   Found attribute CheckAttribute:
  19.     property Checked has value FALSE
  20.   Found attribute IntRangeAttribute:
  21.     property MinValue has value -10000
  22.     property MaxValue has value 10000
  23.  
However, HeapTrc reports a memory leak:
Code: Text  [Select]
  1. Heap dump by heaptrc unit of ...\attr_test\bin\x86_64-win64\attr_test.exe
  2. 117 memory blocks allocated : 5638/5848
  3. 114 memory blocks freed     : 5590/5800
  4. 3 unfreed memory blocks : 48
  5. True heap size : 196608 (192 used in System startup)
  6. True free heap : 195744
  7. Should be : 195792
  8. Call trace for block $000000000123E120 size 16
  9.   $000000010000B602
  10.   $00000001000090DA
  11.   $0000000100001A0E
  12.   $00000001000020C2
  13.   $000000010001BB16
  14.   $0000000100023F58
  15.   $0000000100001E67
  16.   $00000001000021C2
  17.   $00000001000021F6
  18.   $0000000100010590
  19.   $0000000100001730
  20.   $000000007779556D
  21.   $00000000779F385D
  22. Call trace for block $000000000123E040 size 16
  23.   $000000010000B602
  24.   $00000001000090DA
  25.   $000000010000195A
  26.   $000000010000208D
  27.   $000000010001BB16
  28.   $0000000100023F58
  29.   $0000000100001E67
  30.   $00000001000021C2
  31.   $00000001000021F6
  32.   $0000000100010590
  33.   $0000000100001730
  34.   $000000007779556D
  35.   $00000000779F385D
  36. Call trace for block $000000000123DF60 size 16
  37.   $000000010000B602
  38.   $00000001000090DA
  39.   $00000001000018A5
  40.   $0000000100002066
  41.   $000000010001BB16
  42.   $0000000100023F58
  43.   $0000000100001E67
  44.   $00000001000021C2
  45.   $00000001000021F6
  46.   $0000000100010590
  47.   $0000000100001730
  48.   $000000007779556D
  49.   $00000000779F385D
  50.  
Is it as intended or am I doing something wrong?

marcov

  • Global Moderator
  • Hero Member
  • *****
  • Posts: 7503
Re: Custom attributes
« Reply #1 on: October 18, 2019, 03:49:43 pm »
Logically, since you have three memory leaks, and from the output there are three attribute lists, it seems it is the getattributes call that leaks.

Thaddy

  • Hero Member
  • *****
  • Posts: 9183
Re: Custom attributes
« Reply #2 on: October 18, 2019, 03:50:26 pm »
I do not think you are doing something wrong.
Just tried test tcustomattr13.pp and got also leaks.
Code: Bash  [Select]
  1.  ./tcustomattr13
  2. 3
  3. CheckAttr1
  4. 137438953500.00003.1416
  5. Heap dump by heaptrc unit of /home/asta/tcustomattr13
  6. 23 memory blocks allocated : 5614/5648
  7. 21 memory blocks freed     : 1494/1528
  8. 2 unfreed memory blocks : 4120
  9. True heap size : 425984
  10. True free heap : 421648
  11. Should be : 421672
  12. Call trace for block $76FB03E0 size 4096
  13. Call trace for block $76F90680 size 24

OTOH the testattributes.pas that I wrote as a demo does not leak
See attachment
« Last Edit: October 18, 2019, 04:02:58 pm by Thaddy »
also related to equus asinus.

avk

  • Full Member
  • ***
  • Posts: 154
    • my self-education project
Re: Custom attributes
« Reply #3 on: October 18, 2019, 04:27:44 pm »
The code compiled with debugging information produces the following result:
Code: Text  [Select]
  1. Heap dump by heaptrc unit of ...\rtti_test\bin\x86_64-win64\attr_test.exe
  2. 117 memory blocks allocated : 5638/5848
  3. 114 memory blocks freed     : 5590/5800
  4. 3 unfreed memory blocks : 48
  5. True heap size : 196608 (192 used in System startup)
  6. True free heap : 195744
  7. Should be : 195792
  8. Call trace for block $000000000124E120 size 16
  9.   $000000010000B9A2
  10.   $000000010000943A
  11.   $0000000100001A1E  CREATE,  line 90 of attr_test.lpr
  12.   $0000000100002118  rttiattrconstr$2,  line 50 of attr_test.lpr
  13.   $000000010001ED56
  14.   $0000000100027198
  15.   $0000000100001EA7  PRINTCLASSATTRIBUTES,  line 127 of attr_test.lpr
  16.   $0000000100002236  main,  line 160 of attr_test.lpr
  17.   $0000000100002266
  18.   $0000000100011090
  19.   $0000000100001740
  20.   $000000007779556D
  21.   $00000000779F385D
  22. Call trace for block $000000000124E040 size 16
  23.   $000000010000B9A2
  24.   $000000010000943A
  25.   $000000010000196A  CREATE,  line 83 of attr_test.lpr
  26.   $00000001000020E1  rttiattrconstr$1,  line 48 of attr_test.lpr
  27.   $000000010001ED56
  28.   $0000000100027198
  29.   $0000000100001EA7  PRINTCLASSATTRIBUTES,  line 127 of attr_test.lpr
  30.   $0000000100002236  main,  line 160 of attr_test.lpr
  31.   $0000000100002266
  32.   $0000000100011090
  33.   $0000000100001740
  34.   $000000007779556D
  35.   $00000000779F385D
  36. Call trace for block $000000000124DF60 size 16
  37.   $000000010000B9A2
  38.   $000000010000943A
  39.   $00000001000018B5  CREATE,  line 78 of attr_test.lpr
  40.   $00000001000020AD  PRINTTYPEATTRIBUTES,  line 156 of attr_test.lpr
  41.   $000000010001ED56
  42.   $0000000100027198
  43.   $0000000100001EA7  PRINTCLASSATTRIBUTES,  line 127 of attr_test.lpr
  44.   $0000000100002236  main,  line 160 of attr_test.lpr
  45.   $0000000100002266
  46.   $0000000100011090
  47.   $0000000100001740
  48.   $000000007779556D
  49.   $00000000779F385D
  50.  

avk

  • Full Member
  • ***
  • Posts: 154
    • my self-education project
Re: Custom attributes
« Reply #4 on: October 18, 2019, 05:02:39 pm »
@Thaddy, I slightly changed the constructor in your example:
Code: Pascal  [Select]
  1. ...
  2.    { We query the rtti to set the value }
  3.    constructor TMyDateTimeClass.Create;
  4.    var
  5.     Context : TRttiContext;
  6.     AType : TRttiType;
  7.     Attribute : TCustomAttribute;
  8.     Prop: TRttiProperty;
  9.    begin
  10.      inherited;  
  11.      Context := TRttiContext.Create;
  12.      try
  13.        AType := Context.GetType(typeinfo(TMyDateTimeClass));
  14.        for Attribute in  AType.GetAttributes do
  15.          if Attribute is ADateTimeAttribute then
  16.            FDateTime := ADateTimeAttribute(Attribute).Date;
  17.        for Prop in AType.GetProperties do
  18.          for Attribute in Prop.GetAttributes do;
  19.      finally
  20.        Context.Free
  21.      end;    
  22.    end;
  23. ...
  24.  
Now there is a leak.

ASerge

  • Hero Member
  • *****
  • Posts: 1411
Re: Custom attributes
« Reply #5 on: October 18, 2019, 07:13:30 pm »
As say @marcov problem in TRttiProperty.GetAttributes.
After changing PrintClassAttributes as
Code: Pascal  [Select]
  1. ...
  2.       for Attr in Prop.GetAttributes do
  3.       begin
  4.         PrintAttribute(Attr);
  5.         Attr.Free; // This added
  6.       end;
  7.   finally
No leaks.

I'm think:
1. It's a bug. In Delphi this works without .Free (with .Free of course we get error).
2. This topic is not for beginners.

avk

  • Full Member
  • ***
  • Posts: 154
    • my self-education project
Re: Custom attributes
« Reply #6 on: October 18, 2019, 07:44:30 pm »
I apologize if I asked a question in the wrong section of the forum, but this is my first acquaintance with Custom attributes.

Thaddy

  • Hero Member
  • *****
  • Posts: 9183
Re: Custom attributes
« Reply #7 on: October 18, 2019, 07:49:50 pm »
No, good question, there is also a bug in multiple places in the test suite. (as per my example from the tests.)
But my attached code example does not leak, probably by accident  :o O:-)

The context should take ownership, I guess. Sven?
« Last Edit: October 18, 2019, 07:52:30 pm by Thaddy »
also related to equus asinus.

Thaddy

  • Hero Member
  • *****
  • Posts: 9183
Re: Custom attributes
« Reply #8 on: October 19, 2019, 09:15:43 am »
I reported the issue as 0036196 on Mantis. I used the test tcustomattr13.pp as an example because that should definitely not fail.
« Last Edit: October 19, 2019, 11:12:38 am by Thaddy »
also related to equus asinus.

avk

  • Full Member
  • ***
  • Posts: 154
    • my self-education project
Re: Custom attributes
« Reply #9 on: October 19, 2019, 10:40:06 am »
Thank you very much.

PascalDragon

  • Hero Member
  • *****
  • Posts: 673
  • Compiler Developer
Re: Custom attributes
« Reply #10 on: October 21, 2019, 09:44:40 pm »
The leak related to property attributes is now fixed.

Thaddy

  • Hero Member
  • *****
  • Posts: 9183
Re: Custom attributes
« Reply #11 on: October 21, 2019, 10:15:48 pm »
Thanks for fixing and the explanation on mantis.
also related to equus asinus.

Thaddy

  • Hero Member
  • *****
  • Posts: 9183
Re: Custom attributes
« Reply #12 on: October 22, 2019, 08:45:54 am »
@avk
Sven added your example to the tests and removed heaptrc from the uses clause because it should not have been there.
If you want to use the logging option, simply do it like so:
Code: Pascal  [Select]
  1.  
  2. begin
  3.   { The compiler! includes heaptrc, never do that by hand in a uses clause }
  4.   {$if declared(UseHeapTrace)}
  5.   { set only if UseHeaptrace = true }
  6.   if UseHeapTrace then SetHeapTraceOutput('heap.log');
  7.   {$endif}
  8.   PrintClassAttributes(TMyClass);
  9.   PrintTypeAttributes(TypeInfo(TMyRec));
  10.   PrintTypeAttributes(TypeInfo(TMyInt));
  11. end.
The UseHeaptrace variable is only declared if Heaptrc is used.
See also: https://wiki.freepascal.org/heaptrc

With this small change your code still works as you expected and without heaptrc in the uses clause.
Nice to see your code was basically completely correct, isn't it? (except "uses heaptrc"..)
 
« Last Edit: October 22, 2019, 09:01:24 am by Thaddy »
also related to equus asinus.

PascalDragon

  • Hero Member
  • *****
  • Posts: 673
  • Compiler Developer
Re: Custom attributes
« Reply #13 on: October 22, 2019, 09:00:35 am »
Nice to see your code was basically completely correct, isn't it? (except "uses heaptrc"..)
We'd add even incorrect code as long as it shows the problem before the fix and no longer after the fix.

Thaddy

  • Hero Member
  • *****
  • Posts: 9183
Re: Custom attributes
« Reply #14 on: October 22, 2019, 09:03:05 am »
I merely added my comment as (the) (a) correct way to solve his logging option. Again, thanks for fixing. A whole lot of my other code now also works without leaks. I suppose devs do not want the test suite to create unintentional log files  :D
Also note trunk now throws an error when heaptrc is added by hand and -gh is used. Nice!
« Last Edit: October 22, 2019, 09:10:39 am by Thaddy »
also related to equus asinus.