View Issue Details

IDProjectCategoryView StatusLast Update
0028820FPCCompilerpublic2019-10-08 12:31
ReporterOndrej Pokorny Assigned ToOndrej Pokorny  
PrioritynormalSeverityminorReproducibilityalways
Status closedResolutionreopened 
Product Version3.1.1 
Summary0028820: Feature request: allow "array" properties to define an enumerator
DescriptionArray properties cannot define an enumerator, which is bad because you can have many array properties within one class but only one enumerator.

Syntax suggestion:

  TTest = class
    // ...
    function GetObjectEnumerator: TTestObjectEnumerator;
    property Objects[Index: Integer]: TObject read GetObject enumerator GetObjectEnumerator;
  end;

Usage:

var
  Test: TTest;
  Obj: TObject;
begin
  //...
  for Obj in Test.Objects do
    //...
end;

-----
This syntax is completely new and unique so it does not break any legacy code.

Please note that the "enumerator" keyword can be used only for "array" properties because normal properties can have a default enumerator defined.

-----
String index type is valid as well, because enumerator doesn't care of the index type:
    property Objects[Index: string]: TObject read GetObject enumerator GetObjectEnumerator;

-----
This allows e.g. code like:

procedure TForm1.Button1Click(Sender: TObject);
var
  Cont: TControl;
begin
  for Cont in Controls do
    //...
end;
TagsNo tags attached.
Fixed in Revision
FPCOldBugId
FPCTarget-
Attached Files

Relationships

related to 0035772 new [PATCH] Default array property overloads 

Activities

Misha Strong

2015-10-11 09:11

reporter   ~0086418

Easy:

property Objects:TEnumeratedObjects read ...

Where TEnumeratedObjects has "for ... in" support.

Don't be lazy!

Ondrej Pokorny

2015-10-11 09:58

developer   ~0086422

Last edited: 2015-10-11 10:47

View 2 revisions

>> Don't be lazy!
What do you want to say? Keep focused on a problem and don't add unnecessary comments.

>> Easy:
>> property Objects:TEnumeratedObjects read ...
>> Where TEnumeratedObjects has "for ... in" support.

You are wrong. This is not a solution.

First, I don't want to publish the TEnumeratedObjects object to the outside of TTest (e.g. you could call Free on it and do other stuff I don't want to be allowed).
Second, TEnumeratedObjects doesn't even need to exist! What about "virtual" array properties that are not mapped to existing objects?

How do you add enumerators to these array properties with your approach?:
- TWinControl.Controls
- TStrings.Names
- TStrings.Objects
- TStrings.Values
- TStrings.ValueFromIndex
- TStringGrid.Cols
- TStringGrid.Rows
- TStringGrid.Cells
etc. etc. There are much more of them in the LCL.

Thaddy de Koning

2015-10-11 11:28

reporter   ~0086423

Last edited: 2015-10-11 11:28

View 2 revisions

I think Misha is referring to a global property, not a class property.
Have a look at:
http://www.freepascal.org/docs-html/ref/refse25.html

Misha's suggestion is indeed very easy to implement that way.

Ondrej Pokorny

2015-10-11 11:45

developer   ~0086424

>> I think Misha is referring to a global property, not a class property.
>> Have a look at:
>> http://www.freepascal.org/docs-html/ref/refse25.html [^]

Global property? How? Maybe I am blind but I don't see anything common. I want every CLASS (or global, doesn't matter here) array property to be extendable with an enumerator.

>> Misha's suggestion is indeed very easy to implement that way.
If it is easy, please show me how to modify TStrings to be able to run such code:

procedure Test;
var
  StrL: TStringList;
  MyNameAndValue, MyValue: string;
begin
  StrL := TStringList.Create;
  try
    StrL.Add('name1=value1');
    StrL.Add('name2=value2');

    WriteLn('names and values:');
    for MyNameAndValue in StrL do
      WriteLn(MyNameAndValue);

    WriteLn('values only:');
    for MyValue in StrL.Values do
      WriteLn(MyValue);
  finally
    StrL.Free;
  end;
end;

Maybe I am blind but I am quite sure it is not possible.

Thaddy de Koning

2015-10-11 11:52

reporter   ~0086425

Using a class/type helper f.e.

Ondrej Pokorny

2015-10-11 11:58

developer   ~0086426

>> Using a class/type helper f.e.
I don't think so. I will be happy if you prove me wrong with some code.

Misha Strong

2015-10-11 12:51

reporter   ~0086436

I agree with you Ondrej.

The only way to combine TStrings.Objects with TStrings.Strings your special way,
is using a pre-processor.

Do not be afraid, I have my own pre-processor for certain Pascal projects.

Sven Barth

2015-10-23 15:31

manager   ~0086827

@Ondrej: it's not perfect, but it shows how it can be accomplished:

=== code begin ===

program tobjectsenum;

{$mode objfpc}
{$modeswitch advancedrecords}

uses
  Classes;

type
  TStringsObjectsEnumerator = record
  private
    fList: TStrings;
    fIndex: LongInt;
    function GetCurrent: TObject;
  public
    constructor Create(aList: TStrings);
    function MoveNext: Boolean;
    property Current: TObject read GetCurrent;
    function GetEnumerator: TStringsObjectsEnumerator;
  end;

  TStringsHelper = class helper for TStrings
  public
    function ObjectsEnum: TStringsObjectsEnumerator;
  end;

constructor TStringsObjectsEnumerator.Create(aList: TStrings);
begin
  fIndex := -1;
  fList := aList;
end;

function TStringsObjectsEnumerator.GetCurrent: TObject;
begin
  Result := fList.Objects[fIndex];
end;

function TStringsObjectsEnumerator.MoveNext: Boolean;
begin
  Inc(fIndex);
  Result := fIndex < fList.Count;
end;

function TStringsObjectsEnumerator.GetEnumerator: TStringsObjectsEnumerator;
begin
  Result := Self;
end;

function TStringsHelper.ObjectsEnum: TStringsObjectsEnumerator;
begin
  Result := TStringsObjectsEnumerator.Create(Self);
end;

var
  s: TStrings;
  o: TObject;
begin
  s := TStringList.Create;
  s.AddObject('A', TObject.Create);
  s.AddObject('B', TObject.Create);
  for o in s.ObjectsEnum do
    Writeln(HexStr(o));
end.
                                                        
=== code end ===

Of course if you need only one enumerator (e.g. only an enumerator for Objects OR for Strings) you could add the GetEnumerator method to the helper directly instead of the enumerator object/record/class.

Regards,
Sven

Ondrej Pokorny

2015-10-25 22:49

developer   ~0086872

Very good, Sven! I didn't think of it.
Still I find the suggested syntax more clear, simple and intuitive :)

Sven Barth

2015-10-30 14:29

manager   ~0087028

I don't know how the other developers see it, but I personally would say patches welcome ;)

Regards,
Sven

Ondrej Pokorny

2015-10-31 11:27

developer  

property-enumerator-1.patch (13,879 bytes)   
Index: compiler/msgidx.inc
===================================================================
--- compiler/msgidx.inc	(revision 32110)
+++ compiler/msgidx.inc	(working copy)
@@ -446,6 +446,7 @@
   parser_e_explicit_method_implementation_for_specializations_not_allowed=03341;
   parser_e_no_genfuncs_in_interfaces=03342;
   parser_e_genfuncs_cannot_be_virtual=03343;
+  parser_e_ill_property_enumerator_sym=03344;
   type_e_mismatch=04000;
   type_e_incompatible_types=04001;
   type_e_not_equal_types=04002;
Index: compiler/ncal.pas
===================================================================
--- compiler/ncal.pas	(revision 32110)
+++ compiler/ncal.pas	(working copy)
@@ -61,6 +61,27 @@
 
        tcallparanode = class;
 
+       { tenumeratornode
+         virtual node for property enumerator "property A[I: Integer]: TObject read GetA <enumerator GetAEnumerator>"
+         in a for-in loop "for _a in <A> do"
+       }
+
+       tenumeratornode = class(tnode)
+       public
+         { tree that contains the pointer to the object for this enumerator }
+         enumowner  : tnode;
+         { enumerator procedure }
+         enumproc: tprocdef;
+
+         function  pass_1 : tnode;override;
+         function  pass_typecheck:tnode;override;
+         procedure det_temp;override;
+         procedure pass_generate_code;override;
+       public
+          constructor create(owner: tnode; proc: tprocdef);virtual;
+          destructor destroy;override;
+       end;
+
        tcallnode = class(tbinarynode)
        private
           { number of parameters passed from the source, this does not include the hidden parameters }
@@ -600,6 +621,47 @@
       end;
 
 
+    {****************************************************************************
+                                  TENUMERATORNODE
+     ****************************************************************************}
+
+    function tenumeratornode.pass_1: tnode;
+    begin
+      Internalerror(201510311);
+      result:=nil;
+    end;
+
+    function tenumeratornode.pass_typecheck: tnode;
+    begin
+      Internalerror(201510312);
+      result:=nil;
+    end;
+
+    procedure tenumeratornode.det_temp;
+    begin
+      Internalerror(201510313);
+    end;
+
+    procedure tenumeratornode.pass_generate_code;
+    begin
+      Internalerror(201510314);
+    end;
+
+    constructor tenumeratornode.create(owner: tnode; proc: tprocdef);
+    begin
+      inherited create(emptynode);
+      enumproc:=proc;
+      enumowner:=owner;
+      resultdef:=enumowner.resultdef;
+    end;
+
+    destructor tenumeratornode.destroy;
+    begin
+      enumowner.free;
+      inherited destroy;
+    end;
+
+
 {****************************************************************************
                               TOBJECTINFOITEM
  ****************************************************************************}
Index: compiler/nflw.pas
===================================================================
--- compiler/nflw.pas	(revision 32110)
+++ compiler/nflw.pas	(working copy)
@@ -872,21 +872,30 @@
               end
             else
               begin
-                // search for operator first
-                pd:=search_enumerator_operator(expr.resultdef, hloopvar.resultdef);
-                // if there is no operator then search for class/object enumerator method
-                if (pd=nil) and (expr.resultdef.typ in [objectdef,recorddef]) then
+                if expr is tenumeratornode then
                   begin
-                    { first search using the helper hierarchy }
-                    if search_last_objectpascal_helper(tabstractrecorddef(expr.resultdef),nil,helperdef) then
-                      repeat
-                        pd:=helperdef.search_enumerator_get;
-                        helperdef:=helperdef.childof;
-                      until (pd<>nil) or (helperdef=nil);
-                    { we didn't find an enumerator in a helper, so search in the
-                      class/record/object itself }
-                    if pd=nil then
-                      pd:=tabstractrecorddef(expr.resultdef).search_enumerator_get;
+                    // the expr is a property enumerator, use it directly
+                    pd:=tenumeratornode(expr).enumproc;
+                    expr:=tenumeratornode(expr).enumowner;
+                  end
+                else
+                  begin
+                    // search for operator first
+                    pd:=search_enumerator_operator(expr.resultdef, hloopvar.resultdef);
+                    // if there is no operator then search for class/object enumerator method
+                    if (pd=nil) and (expr.resultdef.typ in [objectdef,recorddef]) then
+                      begin
+                        { first search using the helper hierarchy }
+                        if search_last_objectpascal_helper(tabstractrecorddef(expr.resultdef),nil,helperdef) then
+                          repeat
+                            pd:=helperdef.search_enumerator_get;
+                            helperdef:=helperdef.childof;
+                          until (pd<>nil) or (helperdef=nil);
+                        { we didn't find an enumerator in a helper, so search in the
+                          class/record/object itself }
+                        if pd=nil then
+                          pd:=tabstractrecorddef(expr.resultdef).search_enumerator_get;
+                      end;
                   end;
                 if pd<>nil then
                   begin
Index: compiler/pdecvar.pas
===================================================================
--- compiler/pdecvar.pas	(revision 32110)
+++ compiler/pdecvar.pas	(working copy)
@@ -339,7 +339,8 @@
          gotreadorwrite: boolean;
          hreadparavs,
          hparavs      : tparavarsym;
-         storedprocdef: tprocvardef;
+         storedprocdef,
+         enumeratorprocdef: tprocvardef;
          readprocdef,
          writeprocdef : tprocdef;
       begin
@@ -564,6 +565,32 @@
          else
            parse_dispinterface(p,readprocdef,writeprocdef,paranr);
 
+         if (ppo_hasparameters in p.propoptions) and try_to_consume(_ENUMERATOR) then
+           begin
+             include(p.propoptions,ppo_hasenumerator);
+             p.propaccesslist[palt_enumerator].clear;
+             if token=_ID then
+               begin
+                 if parse_symlist(p.propaccesslist[palt_enumerator],def) then
+                  begin
+                    sym:=p.propaccesslist[palt_enumerator].firstsym^.sym;
+                    { enumerator is a function returning record/class/interface }
+                    if sym.typ=procsym then
+                      begin
+                        enumeratorprocdef:=cprocvardef.create(normal_function_level);
+                        include(enumeratorprocdef.procoptions,po_methodpointer);
+                        { Insert hidden parameters }
+                        handle_calling_convention(enumeratorprocdef);
+                        p.propaccesslist[palt_enumerator].procdef:=Tprocsym(sym).Find_procdef_bypara(enumeratorprocdef.paras,enumeratorprocdef.returndef,[cpo_allowdefaults,cpo_ignorehidden]);
+                        if not assigned(p.propaccesslist[palt_enumerator].procdef) then
+                          message(parser_e_ill_property_enumerator_sym);
+                        { Not needed anymore }
+                        enumeratorprocdef.owner.deletedef(enumeratorprocdef);
+                      end;
+                  end;
+               end;
+           end;
+
          { stored is not allowed for dispinterfaces, records or class properties }
          if assigned(astruct) and not(is_dispinterface(astruct) or is_record(astruct)) and not is_classproperty then
            begin
Index: compiler/pexpr.pas
===================================================================
--- compiler/pexpr.pas	(revision 32110)
+++ compiler/pexpr.pas	(working copy)
@@ -1124,6 +1124,8 @@
          callflags  : tcallnodeflags;
          propaccesslist : tpropaccesslist;
          sym: tsym;
+         i: Integer;
+         pd, pres: tprocdef;
       begin
          { property parameters? read them only if the property really }
          { has parameters                                             }
@@ -1142,6 +1144,56 @@
              p2:=cordconstnode.create(propsym.index,propsym.indexdef,true);
              paras:=ccallparanode.create(p2,paras);
            end;
+         { we are in "for x in <prop> do" }
+         { prop is a property with a defined enumerator }
+         { and there are no paras }
+         if (token=_DO) and (current_scanner.inforin) and (paras=nil) and
+            (ppo_hasparameters in propsym.propoptions) and
+            (ppo_hasenumerator in propsym.propoptions) then
+           begin
+              if propsym.getpropaccesslist(palt_enumerator,propaccesslist) then
+                begin
+                   sym := propaccesslist.firstsym^.sym;
+                   case sym.typ of
+                     procsym :
+                       begin
+                         pres:=nil;
+                         for i := 0 to Tprocsym(sym).ProcdefList.Count - 1 do
+                         begin
+                           pd:=tprocdef(Tprocsym(sym).ProcdefList[i]);
+                           if (pd.proctypeoption = potype_function) and
+                              (is_class_or_interface_or_object(pd.returndef) or is_record(pd.returndef)) then
+                           begin
+                             pres:=pd;
+                             break;
+                           end;
+                         end;
+
+                         if pres<>nil then
+                           begin
+                             p1:=tenumeratornode.create(p1,pres);
+                           end
+                         else
+                           begin
+                             p1:=cerrornode.create;
+                             Message(type_e_mismatch);
+                           end;
+                       end
+                     else
+                       begin
+                          p1:=cerrornode.create;
+                          Message(type_e_mismatch);
+                       end;
+                  end;
+                end
+              else
+                begin
+                   { error, no function to read property }
+                   p1:=cerrornode.create;
+                   Message(parser_e_no_procedure_to_access_property);
+                end;
+           end
+         else
          { we need only a write property if a := follows }
          { if not(afterassignment) and not(in_args) then }
          if token=_ASSIGNMENT then
Index: compiler/pstatmnt.pas
===================================================================
--- compiler/pstatmnt.pas	(revision 32110)
+++ compiler/pstatmnt.pas	(working copy)
@@ -510,6 +510,8 @@
               expr,hloopbody,hp: tnode;
               loopvarsym: tabstractvarsym;
             begin
+              current_scanner.startforin;
+
               hp:=skip_nodes_before_load(hloopvar);
               if assigned(hp)and(hp.nodetype=loadn) then
                 begin
@@ -523,6 +525,8 @@
 
               consume(_DO);
 
+              current_scanner.stopforin;
+
               set_varstate(hloopvar,vs_written,[]);
               set_varstate(hloopvar,vs_read,[vsf_must_be_valid]);
 
Index: compiler/scanner.pas
===================================================================
--- compiler/scanner.pas	(revision 32110)
+++ compiler/scanner.pas	(working copy)
@@ -126,6 +126,8 @@
           replaytokenbuf,
           recordtokenbuf : tdynamicarray;
 
+          inforin        : boolean; { parsing in section in for: for x in <a> do }
+
           { last settings we stored }
           last_settings : tsettings;
           last_message : pmessagestaterecord;
@@ -181,6 +183,8 @@
           procedure stoprecordtokens;
           procedure replaytoken;
           procedure startreplaytokens(buf:tdynamicarray);
+          procedure startforin;
+          procedure stopforin;
           { bit length asizeint is target depend }
           procedure tokenwritesizeint(val : asizeint);
           procedure tokenwritelongint(val : longint);
@@ -3275,7 +3279,21 @@
         replaytoken;
       end;
 
+    procedure tscannerfile.startforin;
+    begin
+      if inforin then
+        internalerror(201510301);
+      inforin := true;
+    end;
 
+    procedure tscannerfile.stopforin;
+    begin
+      if not inforin then
+        internalerror(201510302);
+      inforin := false;
+    end;
+
+
     function tscannerfile.readtoken: ttoken;
       var
         b,b2 : byte;
Index: compiler/symconst.pas
===================================================================
--- compiler/symconst.pas	(revision 32110)
+++ compiler/symconst.pas	(working copy)
@@ -520,6 +520,7 @@
     ppo_implements,
     ppo_enumerator_current,       { implements current property for enumerator }
     ppo_overrides,                { overrides ancestor property }
+    ppo_hasenumerator,            { has enumerator (only if ppo_hasparameters) }
     ppo_dispid_write              { no longer used }
   );
   tpropertyoptions=set of tpropertyoption;
Index: compiler/symsym.pas
===================================================================
--- compiler/symsym.pas	(revision 32110)
+++ compiler/symsym.pas	(working copy)
@@ -334,7 +334,7 @@
       end;
       tabsolutevarsymclass = class of tabsolutevarsym;
 
-       tpropaccesslisttypes=(palt_none,palt_read,palt_write,palt_stored);
+       tpropaccesslisttypes=(palt_none,palt_read,palt_write,palt_enumerator,palt_stored);
 
        tpropertysym = class(Tstoredsym)
          protected
property-enumerator-1.patch (13,879 bytes)   

Ondrej Pokorny

2015-10-31 11:28

developer  

project1.lpr (2,442 bytes)

Ondrej Pokorny

2015-10-31 11:31

developer   ~0087040

Last edited: 2015-10-31 23:16

View 2 revisions

property-enumerator-1.patch

I implemented it. I also ran the tests suite - the patch seems not to break any test (the failed test count is the same for original and new compiler).

I also added a simple project to test (project1.lpr).

I assume we should add new test programs into the tests suite of FPC as well (I haven't do this yet).

-----
3.patch: I forgot to include some files in the 2.patch ...

Ondrej Pokorny

2015-10-31 20:54

developer  

property-enumerator-2.patch (14,266 bytes)   
Index: compiler/msgidx.inc
===================================================================
--- compiler/msgidx.inc	(revision 32110)
+++ compiler/msgidx.inc	(working copy)
@@ -446,6 +446,7 @@
   parser_e_explicit_method_implementation_for_specializations_not_allowed=03341;
   parser_e_no_genfuncs_in_interfaces=03342;
   parser_e_genfuncs_cannot_be_virtual=03343;
+  parser_e_ill_property_enumerator_sym=03344;
   type_e_mismatch=04000;
   type_e_incompatible_types=04001;
   type_e_not_equal_types=04002;
Index: compiler/ncal.pas
===================================================================
--- compiler/ncal.pas	(revision 32110)
+++ compiler/ncal.pas	(working copy)
@@ -61,6 +61,28 @@
 
        tcallparanode = class;
 
+       { tenumeratornode
+         node for property enumerator "property A[I: Integer]: TObject read GetA <enumerator GetAEnumerator>"
+         in a for-in loop "for _a in <A> do"
+         this node is used exclusively in the for-in loop
+       }
+
+       tenumeratornode = class(tnode)
+       public
+         { tree that contains the pointer to the object for this enumerator }
+         enumowner  : tnode;
+         { enumerator procedure }
+         enumproc: tprocdef;
+
+         function  pass_1 : tnode;override;
+         function  pass_typecheck:tnode;override;
+         procedure det_temp;override;
+         procedure pass_generate_code;override;
+       public
+          constructor create(owner: tnode; proc: tprocdef);virtual;
+          destructor destroy;override;
+       end;
+
        tcallnode = class(tbinarynode)
        private
           { number of parameters passed from the source, this does not include the hidden parameters }
@@ -600,6 +622,47 @@
       end;
 
 
+    {****************************************************************************
+                                  TENUMERATORNODE
+     ****************************************************************************}
+
+    function tenumeratornode.pass_1: tnode;
+    begin
+      Internalerror(201510311);
+      result:=nil;
+    end;
+
+    function tenumeratornode.pass_typecheck: tnode;
+    begin
+      Internalerror(201510312);
+      result:=nil;
+    end;
+
+    procedure tenumeratornode.det_temp;
+    begin
+      Internalerror(201510313);
+    end;
+
+    procedure tenumeratornode.pass_generate_code;
+    begin
+      Internalerror(201510314);
+    end;
+
+    constructor tenumeratornode.create(owner: tnode; proc: tprocdef);
+    begin
+      inherited create(enumeratorn);
+      enumproc:=proc;
+      enumowner:=owner;
+      resultdef:=enumowner.resultdef;
+    end;
+
+    destructor tenumeratornode.destroy;
+    begin
+      enumowner.free;
+      inherited destroy;
+    end;
+
+
 {****************************************************************************
                               TOBJECTINFOITEM
  ****************************************************************************}
Index: compiler/nflw.pas
===================================================================
--- compiler/nflw.pas	(revision 32110)
+++ compiler/nflw.pas	(working copy)
@@ -872,21 +872,30 @@
               end
             else
               begin
-                // search for operator first
-                pd:=search_enumerator_operator(expr.resultdef, hloopvar.resultdef);
-                // if there is no operator then search for class/object enumerator method
-                if (pd=nil) and (expr.resultdef.typ in [objectdef,recorddef]) then
+                if expr.nodetype = enumeratorn then
                   begin
-                    { first search using the helper hierarchy }
-                    if search_last_objectpascal_helper(tabstractrecorddef(expr.resultdef),nil,helperdef) then
-                      repeat
-                        pd:=helperdef.search_enumerator_get;
-                        helperdef:=helperdef.childof;
-                      until (pd<>nil) or (helperdef=nil);
-                    { we didn't find an enumerator in a helper, so search in the
-                      class/record/object itself }
-                    if pd=nil then
-                      pd:=tabstractrecorddef(expr.resultdef).search_enumerator_get;
+                    // the expr is a property enumerator, use it directly
+                    pd:=tenumeratornode(expr).enumproc;
+                    expr:=tenumeratornode(expr).enumowner;
+                  end
+                else
+                  begin
+                    // search for operator first
+                    pd:=search_enumerator_operator(expr.resultdef, hloopvar.resultdef);
+                    // if there is no operator then search for class/object enumerator method
+                    if (pd=nil) and (expr.resultdef.typ in [objectdef,recorddef]) then
+                      begin
+                        { first search using the helper hierarchy }
+                        if search_last_objectpascal_helper(tabstractrecorddef(expr.resultdef),nil,helperdef) then
+                          repeat
+                            pd:=helperdef.search_enumerator_get;
+                            helperdef:=helperdef.childof;
+                          until (pd<>nil) or (helperdef=nil);
+                        { we didn't find an enumerator in a helper, so search in the
+                          class/record/object itself }
+                        if pd=nil then
+                          pd:=tabstractrecorddef(expr.resultdef).search_enumerator_get;
+                      end;
                   end;
                 if pd<>nil then
                   begin
Index: compiler/node.pas
===================================================================
--- compiler/node.pas	(revision 32110)
+++ compiler/node.pas	(working copy)
@@ -111,7 +111,8 @@
           dataconstn,       { node storing some binary data }
           objcselectorn,    { node for an Objective-C message selector }
           objcprotocoln,    { node for an Objective-C @protocol() expression (returns metaclass associated with protocol) }
-          specializen       { parser-only node to handle Delphi-mode inline specializations }
+          specializen,      { parser-only node to handle Delphi-mode inline specializations }
+          enumeratorn       { enumerator node for the for-in statement }
        );
 
        tnodetypeset = set of tnodetype;
@@ -196,7 +197,8 @@
           'dataconstn',
           'objcselectorn',
           'objcprotocoln',
-          'specializen');
+          'specializen',
+          'enumeratorn');
 
       { a set containing all const nodes }
       nodetype_const = [ordconstn,
Index: compiler/pdecvar.pas
===================================================================
--- compiler/pdecvar.pas	(revision 32110)
+++ compiler/pdecvar.pas	(working copy)
@@ -339,7 +339,8 @@
          gotreadorwrite: boolean;
          hreadparavs,
          hparavs      : tparavarsym;
-         storedprocdef: tprocvardef;
+         storedprocdef,
+         enumeratorprocdef: tprocvardef;
          readprocdef,
          writeprocdef : tprocdef;
       begin
@@ -564,6 +565,32 @@
          else
            parse_dispinterface(p,readprocdef,writeprocdef,paranr);
 
+         if (ppo_hasparameters in p.propoptions) and try_to_consume(_ENUMERATOR) then
+           begin
+             include(p.propoptions,ppo_hasenumerator);
+             p.propaccesslist[palt_enumerator].clear;
+             if token=_ID then
+               begin
+                 if parse_symlist(p.propaccesslist[palt_enumerator],def) then
+                  begin
+                    sym:=p.propaccesslist[palt_enumerator].firstsym^.sym;
+                    { enumerator is a function returning record/class/interface }
+                    if sym.typ=procsym then
+                      begin
+                        enumeratorprocdef:=cprocvardef.create(normal_function_level);
+                        include(enumeratorprocdef.procoptions,po_methodpointer);
+                        { Insert hidden parameters }
+                        handle_calling_convention(enumeratorprocdef);
+                        p.propaccesslist[palt_enumerator].procdef:=Tprocsym(sym).Find_procdef_bypara(enumeratorprocdef.paras,enumeratorprocdef.returndef,[cpo_allowdefaults,cpo_ignorehidden]);
+                        if not assigned(p.propaccesslist[palt_enumerator].procdef) then
+                          message(parser_e_ill_property_enumerator_sym);
+                        { Not needed anymore }
+                        enumeratorprocdef.owner.deletedef(enumeratorprocdef);
+                      end;
+                  end;
+               end;
+           end;
+
          { stored is not allowed for dispinterfaces, records or class properties }
          if assigned(astruct) and not(is_dispinterface(astruct) or is_record(astruct)) and not is_classproperty then
            begin
Index: compiler/pexpr.pas
===================================================================
--- compiler/pexpr.pas	(revision 32110)
+++ compiler/pexpr.pas	(working copy)
@@ -1124,6 +1124,8 @@
          callflags  : tcallnodeflags;
          propaccesslist : tpropaccesslist;
          sym: tsym;
+         i: Integer;
+         pd, pres: tprocdef;
       begin
          { property parameters? read them only if the property really }
          { has parameters                                             }
@@ -1142,6 +1144,56 @@
              p2:=cordconstnode.create(propsym.index,propsym.indexdef,true);
              paras:=ccallparanode.create(p2,paras);
            end;
+         { we are in "for x in <prop> do" }
+         { prop is a property with a defined enumerator }
+         { and there are no paras }
+         if (token=_DO) and (current_scanner.inforin) and (paras=nil) and
+            (ppo_hasparameters in propsym.propoptions) and
+            (ppo_hasenumerator in propsym.propoptions) then
+           begin
+              if propsym.getpropaccesslist(palt_enumerator,propaccesslist) then
+                begin
+                   sym := propaccesslist.firstsym^.sym;
+                   case sym.typ of
+                     procsym :
+                       begin
+                         pres:=nil;
+                         for i := 0 to Tprocsym(sym).ProcdefList.Count - 1 do
+                         begin
+                           pd:=tprocdef(Tprocsym(sym).ProcdefList[i]);
+                           if (pd.proctypeoption = potype_function) and
+                              (is_class_or_interface_or_object(pd.returndef) or is_record(pd.returndef)) then
+                           begin
+                             pres:=pd;
+                             break;
+                           end;
+                         end;
+
+                         if pres<>nil then
+                           begin
+                             p1:=tenumeratornode.create(p1,pres);
+                           end
+                         else
+                           begin
+                             p1:=cerrornode.create;
+                             Message(type_e_mismatch);
+                           end;
+                       end
+                     else
+                       begin
+                          p1:=cerrornode.create;
+                          Message(type_e_mismatch);
+                       end;
+                  end;
+                end
+              else
+                begin
+                   { error, no function to read property }
+                   p1:=cerrornode.create;
+                   Message(parser_e_no_procedure_to_access_property);
+                end;
+           end
+         else
          { we need only a write property if a := follows }
          { if not(afterassignment) and not(in_args) then }
          if token=_ASSIGNMENT then
Index: compiler/scanner.pas
===================================================================
--- compiler/scanner.pas	(revision 32110)
+++ compiler/scanner.pas	(working copy)
@@ -126,6 +126,8 @@
           replaytokenbuf,
           recordtokenbuf : tdynamicarray;
 
+          inforin        : boolean; { parsing in section in for: for x in <a> do }
+
           { last settings we stored }
           last_settings : tsettings;
           last_message : pmessagestaterecord;
@@ -181,6 +183,8 @@
           procedure stoprecordtokens;
           procedure replaytoken;
           procedure startreplaytokens(buf:tdynamicarray);
+          procedure startforin;
+          procedure stopforin;
           { bit length asizeint is target depend }
           procedure tokenwritesizeint(val : asizeint);
           procedure tokenwritelongint(val : longint);
@@ -3275,7 +3279,21 @@
         replaytoken;
       end;
 
+    procedure tscannerfile.startforin;
+    begin
+      if inforin then
+        internalerror(201510301);
+      inforin := true;
+    end;
 
+    procedure tscannerfile.stopforin;
+    begin
+      if not inforin then
+        internalerror(201510302);
+      inforin := false;
+    end;
+
+
     function tscannerfile.readtoken: ttoken;
       var
         b,b2 : byte;
Index: compiler/symconst.pas
===================================================================
--- compiler/symconst.pas	(revision 32110)
+++ compiler/symconst.pas	(working copy)
@@ -520,6 +520,7 @@
     ppo_implements,
     ppo_enumerator_current,       { implements current property for enumerator }
     ppo_overrides,                { overrides ancestor property }
+    ppo_hasenumerator,            { has enumerator (only if ppo_hasparameters) }
     ppo_dispid_write              { no longer used }
   );
   tpropertyoptions=set of tpropertyoption;
Index: compiler/symsym.pas
===================================================================
--- compiler/symsym.pas	(revision 32110)
+++ compiler/symsym.pas	(working copy)
@@ -334,7 +334,7 @@
       end;
       tabsolutevarsymclass = class of tabsolutevarsym;
 
-       tpropaccesslisttypes=(palt_none,palt_read,palt_write,palt_stored);
+       tpropaccesslisttypes=(palt_none,palt_read,palt_write,palt_enumerator,palt_stored);
 
        tpropertysym = class(Tstoredsym)
          protected
property-enumerator-2.patch (14,266 bytes)   

Ondrej Pokorny

2015-10-31 23:15

developer  

property-enumerator-3.patch (15,924 bytes)   
Index: compiler/msgidx.inc
===================================================================
--- compiler/msgidx.inc	(revision 32215)
+++ compiler/msgidx.inc	(working copy)
@@ -446,6 +446,7 @@
   parser_e_explicit_method_implementation_for_specializations_not_allowed=03341;
   parser_e_no_genfuncs_in_interfaces=03342;
   parser_e_genfuncs_cannot_be_virtual=03343;
+  parser_e_ill_property_enumerator_sym=03344;
   type_e_mismatch=04000;
   type_e_incompatible_types=04001;
   type_e_not_equal_types=04002;
Index: compiler/ncal.pas
===================================================================
--- compiler/ncal.pas	(revision 32215)
+++ compiler/ncal.pas	(working copy)
@@ -61,6 +61,28 @@
 
        tcallparanode = class;
 
+       { tenumeratornode
+         node for property enumerator "property A[I: Integer]: TObject read GetA <enumerator GetAEnumerator>"
+         in a for-in loop "for _a in <A> do"
+         this node is used exclusively in the for-in loop
+       }
+
+       tenumeratornode = class(tnode)
+       public
+         { tree that contains the pointer to the object for this enumerator }
+         enumowner  : tnode;
+         { enumerator procedure }
+         enumproc: tprocdef;
+
+         function  pass_1 : tnode;override;
+         function  pass_typecheck:tnode;override;
+         procedure det_temp;override;
+         procedure pass_generate_code;override;
+       public
+          constructor create(owner: tnode; proc: tprocdef);virtual;
+          destructor destroy;override;
+       end;
+
        tcallnode = class(tbinarynode)
        private
           { number of parameters passed from the source, this does not include the hidden parameters }
@@ -600,6 +622,47 @@
       end;
 
 
+    {****************************************************************************
+                                  TENUMERATORNODE
+     ****************************************************************************}
+
+    function tenumeratornode.pass_1: tnode;
+    begin
+      Internalerror(201510311);
+      result:=nil;
+    end;
+
+    function tenumeratornode.pass_typecheck: tnode;
+    begin
+      Internalerror(201510312);
+      result:=nil;
+    end;
+
+    procedure tenumeratornode.det_temp;
+    begin
+      Internalerror(201510313);
+    end;
+
+    procedure tenumeratornode.pass_generate_code;
+    begin
+      Internalerror(201510314);
+    end;
+
+    constructor tenumeratornode.create(owner: tnode; proc: tprocdef);
+    begin
+      inherited create(enumeratorn);
+      enumproc:=proc;
+      enumowner:=owner;
+      resultdef:=enumowner.resultdef;
+    end;
+
+    destructor tenumeratornode.destroy;
+    begin
+      enumowner.free;
+      inherited destroy;
+    end;
+
+
 {****************************************************************************
                               TOBJECTINFOITEM
  ****************************************************************************}
Index: compiler/nflw.pas
===================================================================
--- compiler/nflw.pas	(revision 32215)
+++ compiler/nflw.pas	(working copy)
@@ -872,21 +872,30 @@
               end
             else
               begin
-                // search for operator first
-                pd:=search_enumerator_operator(expr.resultdef, hloopvar.resultdef);
-                // if there is no operator then search for class/object enumerator method
-                if (pd=nil) and (expr.resultdef.typ in [objectdef,recorddef]) then
+                if expr.nodetype = enumeratorn then
                   begin
-                    { first search using the helper hierarchy }
-                    if search_last_objectpascal_helper(tabstractrecorddef(expr.resultdef),nil,helperdef) then
-                      repeat
-                        pd:=helperdef.search_enumerator_get;
-                        helperdef:=helperdef.childof;
-                      until (pd<>nil) or (helperdef=nil);
-                    { we didn't find an enumerator in a helper, so search in the
-                      class/record/object itself }
-                    if pd=nil then
-                      pd:=tabstractrecorddef(expr.resultdef).search_enumerator_get;
+                    // the expr is a property enumerator, use it directly
+                    pd:=tenumeratornode(expr).enumproc;
+                    expr:=tenumeratornode(expr).enumowner;
+                  end
+                else
+                  begin
+                    // search for operator first
+                    pd:=search_enumerator_operator(expr.resultdef, hloopvar.resultdef);
+                    // if there is no operator then search for class/object enumerator method
+                    if (pd=nil) and (expr.resultdef.typ in [objectdef,recorddef]) then
+                      begin
+                        { first search using the helper hierarchy }
+                        if search_last_objectpascal_helper(tabstractrecorddef(expr.resultdef),nil,helperdef) then
+                          repeat
+                            pd:=helperdef.search_enumerator_get;
+                            helperdef:=helperdef.childof;
+                          until (pd<>nil) or (helperdef=nil);
+                        { we didn't find an enumerator in a helper, so search in the
+                          class/record/object itself }
+                        if pd=nil then
+                          pd:=tabstractrecorddef(expr.resultdef).search_enumerator_get;
+                      end;
                   end;
                 if pd<>nil then
                   begin
Index: compiler/node.pas
===================================================================
--- compiler/node.pas	(revision 32215)
+++ compiler/node.pas	(working copy)
@@ -111,7 +111,8 @@
           dataconstn,       { node storing some binary data }
           objcselectorn,    { node for an Objective-C message selector }
           objcprotocoln,    { node for an Objective-C @protocol() expression (returns metaclass associated with protocol) }
-          specializen       { parser-only node to handle Delphi-mode inline specializations }
+          specializen,      { parser-only node to handle Delphi-mode inline specializations }
+          enumeratorn       { enumerator node for the for-in statement }
        );
 
        tnodetypeset = set of tnodetype;
@@ -196,7 +197,8 @@
           'dataconstn',
           'objcselectorn',
           'objcprotocoln',
-          'specializen');
+          'specializen',
+          'enumeratorn');
 
       { a set containing all const nodes }
       nodetype_const = [ordconstn,
Index: compiler/pdecvar.pas
===================================================================
--- compiler/pdecvar.pas	(revision 32215)
+++ compiler/pdecvar.pas	(working copy)
@@ -339,7 +339,8 @@
          gotreadorwrite: boolean;
          hreadparavs,
          hparavs      : tparavarsym;
-         storedprocdef: tprocvardef;
+         storedprocdef,
+         enumeratorprocdef: tprocvardef;
          readprocdef,
          writeprocdef : tprocdef;
       begin
@@ -564,6 +565,32 @@
          else
            parse_dispinterface(p,readprocdef,writeprocdef,paranr);
 
+         if (ppo_hasparameters in p.propoptions) and try_to_consume(_ENUMERATOR) then
+           begin
+             include(p.propoptions,ppo_hasenumerator);
+             p.propaccesslist[palt_enumerator].clear;
+             if token=_ID then
+               begin
+                 if parse_symlist(p.propaccesslist[palt_enumerator],def) then
+                  begin
+                    sym:=p.propaccesslist[palt_enumerator].firstsym^.sym;
+                    { enumerator is a function returning record/class/interface }
+                    if sym.typ=procsym then
+                      begin
+                        enumeratorprocdef:=cprocvardef.create(normal_function_level);
+                        include(enumeratorprocdef.procoptions,po_methodpointer);
+                        { Insert hidden parameters }
+                        handle_calling_convention(enumeratorprocdef);
+                        p.propaccesslist[palt_enumerator].procdef:=Tprocsym(sym).Find_procdef_bypara(enumeratorprocdef.paras,enumeratorprocdef.returndef,[cpo_allowdefaults,cpo_ignorehidden]);
+                        if not assigned(p.propaccesslist[palt_enumerator].procdef) then
+                          message(parser_e_ill_property_enumerator_sym);
+                        { Not needed anymore }
+                        enumeratorprocdef.owner.deletedef(enumeratorprocdef);
+                      end;
+                  end;
+               end;
+           end;
+
          { stored is not allowed for dispinterfaces, records or class properties }
          if assigned(astruct) and not(is_dispinterface(astruct) or is_record(astruct)) and not is_classproperty then
            begin
Index: compiler/pexpr.pas
===================================================================
--- compiler/pexpr.pas	(revision 32215)
+++ compiler/pexpr.pas	(working copy)
@@ -1131,6 +1131,8 @@
          callflags  : tcallnodeflags;
          propaccesslist : tpropaccesslist;
          sym: tsym;
+         i: Integer;
+         pd, pres: tprocdef;
       begin
          { property parameters? read them only if the property really }
          { has parameters                                             }
@@ -1149,6 +1151,56 @@
              p2:=cordconstnode.create(propsym.index,propsym.indexdef,true);
              paras:=ccallparanode.create(p2,paras);
            end;
+         { we are in "for x in <prop> do" }
+         { prop is a property with a defined enumerator }
+         { and there are no paras }
+         if (token=_DO) and (current_scanner.inforin) and (paras=nil) and
+            (ppo_hasparameters in propsym.propoptions) and
+            (ppo_hasenumerator in propsym.propoptions) then
+           begin
+              if propsym.getpropaccesslist(palt_enumerator,propaccesslist) then
+                begin
+                   sym := propaccesslist.firstsym^.sym;
+                   case sym.typ of
+                     procsym :
+                       begin
+                         pres:=nil;
+                         for i := 0 to Tprocsym(sym).ProcdefList.Count - 1 do
+                         begin
+                           pd:=tprocdef(Tprocsym(sym).ProcdefList[i]);
+                           if (pd.proctypeoption = potype_function) and
+                              (is_class_or_interface_or_object(pd.returndef) or is_record(pd.returndef)) then
+                           begin
+                             pres:=pd;
+                             break;
+                           end;
+                         end;
+
+                         if pres<>nil then
+                           begin
+                             p1:=tenumeratornode.create(p1,pres);
+                           end
+                         else
+                           begin
+                             p1:=cerrornode.create;
+                             Message(type_e_mismatch);
+                           end;
+                       end
+                     else
+                       begin
+                          p1:=cerrornode.create;
+                          Message(type_e_mismatch);
+                       end;
+                  end;
+                end
+              else
+                begin
+                   { error, no function to read property }
+                   p1:=cerrornode.create;
+                   Message(parser_e_no_procedure_to_access_property);
+                end;
+           end
+         else
          { we need only a write property if a := follows }
          { if not(afterassignment) and not(in_args) then }
          if token=_ASSIGNMENT then
Index: compiler/pstatmnt.pas
===================================================================
--- compiler/pstatmnt.pas	(revision 32215)
+++ compiler/pstatmnt.pas	(working copy)
@@ -510,6 +510,8 @@
               expr,hloopbody,hp: tnode;
               loopvarsym: tabstractvarsym;
             begin
+              current_scanner.startforin;
+
               hp:=skip_nodes_before_load(hloopvar);
               if assigned(hp)and(hp.nodetype=loadn) then
                 begin
@@ -523,6 +525,8 @@
 
               consume(_DO);
 
+              current_scanner.stopforin;
+
               set_varstate(hloopvar,vs_written,[]);
               set_varstate(hloopvar,vs_read,[vsf_must_be_valid]);
 
Index: compiler/scanner.pas
===================================================================
--- compiler/scanner.pas	(revision 32215)
+++ compiler/scanner.pas	(working copy)
@@ -126,6 +126,8 @@
           replaytokenbuf,
           recordtokenbuf : tdynamicarray;
 
+          inforin        : boolean; { parsing in section in for: for x in <a> do }
+
           { last settings we stored }
           last_settings : tsettings;
           last_message : pmessagestaterecord;
@@ -181,6 +183,8 @@
           procedure stoprecordtokens;
           procedure replaytoken;
           procedure startreplaytokens(buf:tdynamicarray);
+          procedure startforin;
+          procedure stopforin;
           { bit length asizeint is target depend }
           procedure tokenwritesizeint(val : asizeint);
           procedure tokenwritelongint(val : longint);
@@ -3275,7 +3279,21 @@
         replaytoken;
       end;
 
+    procedure tscannerfile.startforin;
+    begin
+      if inforin then
+        internalerror(201510301);
+      inforin := true;
+    end;
 
+    procedure tscannerfile.stopforin;
+    begin
+      if not inforin then
+        internalerror(201510302);
+      inforin := false;
+    end;
+
+
     function tscannerfile.readtoken: ttoken;
       var
         b,b2 : byte;
Index: compiler/symconst.pas
===================================================================
--- compiler/symconst.pas	(revision 32215)
+++ compiler/symconst.pas	(working copy)
@@ -520,7 +520,8 @@
     ppo_implements,
     ppo_enumerator_current,       { implements current property for enumerator }
     ppo_overrides,                { overrides ancestor property }
-    ppo_dispid_write              { no longer used }
+    ppo_dispid_write,             { no longer used }
+    ppo_hasenumerator             { has enumerator (only if ppo_hasparameters) }
   );
   tpropertyoptions=set of tpropertyoption;
 
Index: compiler/symsym.pas
===================================================================
--- compiler/symsym.pas	(revision 32215)
+++ compiler/symsym.pas	(working copy)
@@ -334,7 +334,7 @@
       end;
       tabsolutevarsymclass = class of tabsolutevarsym;
 
-       tpropaccesslisttypes=(palt_none,palt_read,palt_write,palt_stored);
+       tpropaccesslisttypes=(palt_none,palt_read,palt_write,palt_stored,palt_enumerator);
 
        tpropertysym = class(Tstoredsym)
          protected
Index: compiler/utils/ppuutils/ppudump.pp
===================================================================
--- compiler/utils/ppuutils/ppudump.pp	(revision 32215)
+++ compiler/utils/ppuutils/ppudump.pp	(working copy)
@@ -2129,7 +2129,8 @@
     ppo_implements,
     ppo_enumerator_current,
     ppo_overrides,
-    ppo_dispid_write              { no longer used }
+    ppo_dispid_write,            { no longer used }
+    ppo_hasenumerator
   );
   tpropertyoptions=set of tpropertyoption;
 *)
@@ -2149,7 +2150,8 @@
     (mask:ppo_implements;str:'implements'),
     (mask:ppo_enumerator_current;str:'enumerator current'),
     (mask:ppo_overrides;str:'overrides'),
-    (mask:ppo_dispid_write;str:'dispid write')  { no longer used }
+    (mask:ppo_dispid_write;str:'dispid write'),  { no longer used }
+    (mask:ppo_hasenumerator;str:'has enumerator')
   );
 var
   i      : longint;
property-enumerator-3.patch (15,924 bytes)   

Ondrej Pokorny

2015-11-02 15:47

developer   ~0087065

I found a bug in the compiler that can be "misused" to allow to declare an array-property enumerator. It is based on an overloaded function.

So if you don't like my patch and don't want to modify the compiler code, don't fix this bug at least :P
(But honestly I think that having a clean syntax and fixing this bug would be better than misusing this bug.)

See arraypropenum.lpr how to achieve it. In tobjectsenum.lpr I demonstrate how the enumerator can be added to TStrings.Objects.

Ondrej Pokorny

2015-11-02 15:49

developer  

arraypropenum.lpr (2,097 bytes)

Ondrej Pokorny

2015-11-02 15:49

developer  

tobjectsenum.lpr (1,460 bytes)

Sven Barth

2015-11-02 19:53

manager   ~0087071

What the?! O.o
No, don't rely on this, that's definitely a bug. Would you report this separately, please?

Regards,
Sven

Ondrej Pokorny

2015-11-02 20:13

developer   ~0087073

No, I won't report it unless you support the alternative syntax with "enumerator" keyword ;)

Ondrej Pokorny

2015-11-08 23:59

developer  

property-enumerator-4.patch (31,017 bytes)   
Index: compiler/msgidx.inc
===================================================================
--- compiler/msgidx.inc	(revision 32275)
+++ compiler/msgidx.inc	(working copy)
@@ -446,6 +446,7 @@
   parser_e_explicit_method_implementation_for_specializations_not_allowed=03341;
   parser_e_no_genfuncs_in_interfaces=03342;
   parser_e_genfuncs_cannot_be_virtual=03343;
+  parser_e_ill_property_enumerator_sym=03344;
   type_e_mismatch=04000;
   type_e_incompatible_types=04001;
   type_e_not_equal_types=04002;
Index: compiler/ncal.pas
===================================================================
--- compiler/ncal.pas	(revision 32275)
+++ compiler/ncal.pas	(working copy)
@@ -61,6 +61,29 @@
 
        tcallparanode = class;
 
+       { tenumeratornode
+         node for property enumerator "property A[I: Integer]: TObject read GetA <enumerator GetAEnumerator>"
+         in a for-in loop "for _a in <A> do"
+         this node is used exclusively in the for-in loop
+       }
+
+       tenumeratornode = class(tnode)
+       public
+         { tree that contains the pointer to the object for this enumerator }
+         enumowner  : tnode;
+         { enumerator procedure }
+         enumproc: tprocdef;
+
+         function  pass_1 : tnode;override;
+         function  pass_typecheck:tnode;override;
+         procedure det_temp;override;
+         procedure pass_generate_code;override;
+       public
+          constructor create(owner: tnode; proc: tprocdef);virtual;
+          destructor destroy;override;
+       end;
+       tenumeratornodeclass = class of tenumeratornode;
+
        tcallnode = class(tbinarynode)
        private
           { number of parameters passed from the source, this does not include the hidden parameters }
@@ -285,6 +308,7 @@
       dispid : longint;resultdef : tdef) : tnode;
 
     var
+      cenumeratornode: tenumeratornodeclass = tenumeratornode;
       ccallnode : tcallnodeclass = tcallnode;
       ccallparanode : tcallparanodeclass = tcallparanode;
 
@@ -600,6 +624,47 @@
       end;
 
 
+    {****************************************************************************
+                                  TENUMERATORNODE
+     ****************************************************************************}
+
+    function tenumeratornode.pass_1: tnode;
+    begin
+      Internalerror(201510311);
+      result:=nil;
+    end;
+
+    function tenumeratornode.pass_typecheck: tnode;
+    begin
+      Internalerror(201510312);
+      result:=nil;
+    end;
+
+    procedure tenumeratornode.det_temp;
+    begin
+      Internalerror(201510313);
+    end;
+
+    procedure tenumeratornode.pass_generate_code;
+    begin
+      Internalerror(201510314);
+    end;
+
+    constructor tenumeratornode.create(owner: tnode; proc: tprocdef);
+    begin
+      inherited create(enumeratorn);
+      enumproc:=proc;
+      enumowner:=owner;
+      resultdef:=enumowner.resultdef;
+    end;
+
+    destructor tenumeratornode.destroy;
+    begin
+      enumowner.free;
+      inherited destroy;
+    end;
+
+
 {****************************************************************************
                               TOBJECTINFOITEM
  ****************************************************************************}
Index: compiler/nflw.pas
===================================================================
--- compiler/nflw.pas	(revision 32275)
+++ compiler/nflw.pas	(working copy)
@@ -872,21 +872,30 @@
               end
             else
               begin
-                // search for operator first
-                pd:=search_enumerator_operator(expr.resultdef, hloopvar.resultdef);
-                // if there is no operator then search for class/object enumerator method
-                if (pd=nil) and (expr.resultdef.typ in [objectdef,recorddef]) then
+                if expr.nodetype = enumeratorn then
                   begin
-                    { first search using the helper hierarchy }
-                    if search_last_objectpascal_helper(tabstractrecorddef(expr.resultdef),nil,helperdef) then
-                      repeat
-                        pd:=helperdef.search_enumerator_get;
-                        helperdef:=helperdef.childof;
-                      until (pd<>nil) or (helperdef=nil);
-                    { we didn't find an enumerator in a helper, so search in the
-                      class/record/object itself }
-                    if pd=nil then
-                      pd:=tabstractrecorddef(expr.resultdef).search_enumerator_get;
+                    // the expr is a property enumerator, use it directly
+                    pd:=tenumeratornode(expr).enumproc;
+                    expr:=tenumeratornode(expr).enumowner;
+                  end
+                else
+                  begin
+                    // search for operator first
+                    pd:=search_enumerator_operator(expr.resultdef, hloopvar.resultdef);
+                    // if there is no operator then search for class/object enumerator method
+                    if (pd=nil) and (expr.resultdef.typ in [objectdef,recorddef]) then
+                      begin
+                        { first search using the helper hierarchy }
+                        if search_last_objectpascal_helper(tabstractrecorddef(expr.resultdef),nil,helperdef) then
+                          repeat
+                            pd:=helperdef.search_enumerator_get;
+                            helperdef:=helperdef.childof;
+                          until (pd<>nil) or (helperdef=nil);
+                        { we didn't find an enumerator in a helper, so search in the
+                          class/record/object itself }
+                        if pd=nil then
+                          pd:=tabstractrecorddef(expr.resultdef).search_enumerator_get;
+                      end;
                   end;
                 if pd<>nil then
                   begin
Index: compiler/node.pas
===================================================================
--- compiler/node.pas	(revision 32275)
+++ compiler/node.pas	(working copy)
@@ -111,7 +111,8 @@
           dataconstn,       { node storing some binary data }
           objcselectorn,    { node for an Objective-C message selector }
           objcprotocoln,    { node for an Objective-C @protocol() expression (returns metaclass associated with protocol) }
-          specializen       { parser-only node to handle Delphi-mode inline specializations }
+          specializen,      { parser-only node to handle Delphi-mode inline specializations }
+          enumeratorn       { enumerator node for the for-in statement }
        );
 
        tnodetypeset = set of tnodetype;
@@ -196,7 +197,8 @@
           'dataconstn',
           'objcselectorn',
           'objcprotocoln',
-          'specializen');
+          'specializen',
+          'enumeratorn');
 
       { a set containing all const nodes }
       nodetype_const = [ordconstn,
Index: compiler/pdecvar.pas
===================================================================
--- compiler/pdecvar.pas	(revision 32275)
+++ compiler/pdecvar.pas	(working copy)
@@ -339,7 +339,8 @@
          gotreadorwrite: boolean;
          hreadparavs,
          hparavs      : tparavarsym;
-         storedprocdef: tprocvardef;
+         storedprocdef,
+         enumeratorprocdef: tprocvardef;
          readprocdef,
          writeprocdef : tprocdef;
       begin
@@ -564,6 +565,32 @@
          else
            parse_dispinterface(p,readprocdef,writeprocdef,paranr);
 
+         if (ppo_hasparameters in p.propoptions) and try_to_consume(_ENUMERATOR) then
+           begin
+             include(p.propoptions,ppo_hasenumerator);
+             p.propaccesslist[palt_enumerator].clear;
+             if token=_ID then
+               begin
+                 if parse_symlist(p.propaccesslist[palt_enumerator],def) then
+                  begin
+                    sym:=p.propaccesslist[palt_enumerator].firstsym^.sym;
+                    { enumerator is a function returning record/class/interface }
+                    if sym.typ=procsym then
+                      begin
+                        enumeratorprocdef:=cprocvardef.create(normal_function_level);
+                        include(enumeratorprocdef.procoptions,po_methodpointer);
+                        { Insert hidden parameters }
+                        handle_calling_convention(enumeratorprocdef);
+                        p.propaccesslist[palt_enumerator].procdef:=Tprocsym(sym).Find_procdef_bypara(enumeratorprocdef.paras,enumeratorprocdef.returndef,[cpo_allowdefaults,cpo_ignorehidden]);
+                        if not assigned(p.propaccesslist[palt_enumerator].procdef) then
+                          message(parser_e_ill_property_enumerator_sym);
+                        { Not needed anymore }
+                        enumeratorprocdef.owner.deletedef(enumeratorprocdef);
+                      end;
+                  end;
+               end;
+           end;
+
          { stored is not allowed for dispinterfaces, records or class properties }
          if assigned(astruct) and not(is_dispinterface(astruct) or is_record(astruct)) and not is_classproperty then
            begin
Index: compiler/pexpr.pas
===================================================================
--- compiler/pexpr.pas	(revision 32275)
+++ compiler/pexpr.pas	(working copy)
@@ -35,7 +35,8 @@
       texprflag = (
         ef_accept_equal,
         ef_type_only,
-        ef_had_specialize
+        ef_had_specialize,
+        ef_forin
       );
       texprflags = set of texprflag;
 
@@ -53,7 +54,7 @@
     function parse_paras(__colon,__namedpara : boolean;end_of_paras : ttoken) : tnode;
 
     { the ID token has to be consumed before calling this function }
-    procedure do_member_read(structh:tabstractrecorddef;getaddr:boolean;sym:tsym;var p1:tnode;var again:boolean;callflags:tcallnodeflags;spezcontext:tspecializationcontext);
+    procedure do_member_read(structh:tabstractrecorddef;getaddr:boolean;sym:tsym;var p1:tnode;var again:boolean;callflags:tcallnodeflags;spezcontext:tspecializationcontext;forin:boolean);
 
     function get_intconst:TConstExprInt;
     function get_stringconst:string;
@@ -1135,7 +1136,7 @@
 
 
     { the following procedure handles the access to a property symbol }
-    procedure handle_propertysym(propsym : tpropertysym;st : TSymtable;var p1 : tnode);
+    procedure handle_propertysym(propsym : tpropertysym;st : TSymtable;forin : boolean;var p1 : tnode);
       var
          paras : tnode;
          p2    : tnode;
@@ -1143,6 +1144,8 @@
          callflags  : tcallnodeflags;
          propaccesslist : tpropaccesslist;
          sym: tsym;
+         i: Integer;
+         pd, pres: tprocdef;
       begin
          { property parameters? read them only if the property really }
          { has parameters                                             }
@@ -1161,6 +1164,56 @@
              p2:=cordconstnode.create(propsym.index,propsym.indexdef,true);
              paras:=ccallparanode.create(p2,paras);
            end;
+         { we are in "for x in <prop> do" }
+         { prop is a property with a defined enumerator }
+         { and there are no paras }
+         if forin and (token=_DO) and (paras=nil) and
+            (ppo_hasparameters in propsym.propoptions) and
+            (ppo_hasenumerator in propsym.propoptions) then
+           begin
+              if propsym.getpropaccesslist(palt_enumerator,propaccesslist) then
+                begin
+                   sym := propaccesslist.firstsym^.sym;
+                   case sym.typ of
+                     procsym :
+                       begin
+                         pres:=nil;
+                         for i := 0 to Tprocsym(sym).ProcdefList.Count - 1 do
+                         begin
+                           pd:=tprocdef(Tprocsym(sym).ProcdefList[i]);
+                           if (pd.proctypeoption = potype_function) and
+                              (is_class_or_interface_or_object(pd.returndef) or is_record(pd.returndef)) then
+                           begin
+                             pres:=pd;
+                             break;
+                           end;
+                         end;
+
+                         if pres<>nil then
+                           begin
+                             p1:=cenumeratornode.create(p1,pres);
+                           end
+                         else
+                           begin
+                             p1:=cerrornode.create;
+                             Message(type_e_mismatch);
+                           end;
+                       end
+                     else
+                       begin
+                          p1:=cerrornode.create;
+                          Message(type_e_mismatch);
+                       end;
+                  end;
+                end
+              else
+                begin
+                   { error, no function to read property }
+                   p1:=cerrornode.create;
+                   Message(parser_e_no_procedure_to_access_property);
+                end;
+           end
+         else
          { we need only a write property if a := follows }
          { if not(afterassignment) and not(in_args) then }
          if token=_ASSIGNMENT then
@@ -1263,7 +1316,7 @@
 
 
     { the ID token has to be consumed before calling this function }
-    procedure do_member_read(structh:tabstractrecorddef;getaddr:boolean;sym:tsym;var p1:tnode;var again:boolean;callflags:tcallnodeflags;spezcontext:tspecializationcontext);
+    procedure do_member_read(structh:tabstractrecorddef;getaddr:boolean;sym:tsym;var p1:tnode;var again:boolean;callflags:tcallnodeflags;spezcontext:tspecializationcontext;forin:boolean);
       var
         isclassref:boolean;
       begin
@@ -1349,7 +1402,7 @@
                    begin
                       if isclassref and not (sp_static in sym.symoptions) then
                         Message(parser_e_only_class_members_via_class_ref);
-                      handle_propertysym(tpropertysym(sym),sym.owner,p1);
+                      handle_propertysym(tpropertysym(sym),sym.owner,forin,p1);
                    end;
                  typesym:
                    begin
@@ -1526,7 +1579,7 @@
                      consume(_ID);
                    end;
                  if result.nodetype<>errorn then
-                   do_member_read(tabstractrecorddef(hdef),false,srsym,result,again,[],spezcontext)
+                   do_member_read(tabstractrecorddef(hdef),false,srsym,result,again,[],spezcontext,false)
                  else
                    spezcontext.free;
                end
@@ -1572,7 +1625,7 @@
                       Message1(sym_e_id_no_member,orgpattern);
                   end;
                 if (result.nodetype<>errorn) and assigned(srsym) then
-                  do_member_read(tabstractrecorddef(hdef),getaddr,srsym,result,again,[],spezcontext)
+                  do_member_read(tabstractrecorddef(hdef),getaddr,srsym,result,again,[],spezcontext,false)
                 else
                   spezcontext.free;
               end;
@@ -1616,7 +1669,7 @@
                         (srsym.typ=procsym) and
                         (token in [_CARET,_POINT]) then
                        result:=cloadvmtaddrnode.create(result);
-                     do_member_read(tabstractrecorddef(hdef),getaddr,srsym,result,again,[],nil);
+                     do_member_read(tabstractrecorddef(hdef),getaddr,srsym,result,again,[],nil,false);
                    end
                   else
                    begin
@@ -1680,7 +1733,7 @@
 ---------------------------------------------}
 
     { returns whether or not p1 has been changed }
-    function postfixoperators(var p1:tnode;var again:boolean;getaddr:boolean): boolean;
+    function postfixoperators(var p1:tnode;var again:boolean;getaddr:boolean;forin:boolean): boolean;
 
       { tries to avoid syntax errors after invalid qualifiers }
       procedure recoverconsume_postfixops;
@@ -1897,7 +1950,7 @@
                     end;
                   check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
                   consume(_ID);
-                  do_member_read(nil,getaddr,srsym,node,again,[],nil);
+                  do_member_read(nil,getaddr,srsym,node,again,[],nil,forin);
                 end;
             end;
         end;
@@ -2010,7 +2063,7 @@
                      begin
                        { The property symbol is referenced indirect }
                        protsym.IncRefCount;
-                       handle_propertysym(protsym,protsym.owner,p1);
+                       handle_propertysym(protsym,protsym.owner,forin,p1);
                      end;
                  end
                else
@@ -2319,7 +2372,7 @@
                            end
                          else
                            if p1.nodetype<>specializen then
-                             do_member_read(structh,getaddr,srsym,p1,again,[],spezcontext);
+                             do_member_read(structh,getaddr,srsym,p1,again,[],spezcontext,forin);
                        end
                      else
                      consume(_ID);
@@ -2474,7 +2527,7 @@
                             end
                           else
                             if p1.nodetype<>specializen then
-                              do_member_read(structh,getaddr,srsym,p1,again,[],spezcontext);
+                              do_member_read(structh,getaddr,srsym,p1,again,[],spezcontext,forin);
                         end
                       else { Error }
                         Consume(_ID);
@@ -2528,7 +2581,7 @@
                             end
                           else
                             if p1.nodetype<>specializen then
-                              do_member_read(structh,getaddr,srsym,p1,again,[],spezcontext);
+                              do_member_read(structh,getaddr,srsym,p1,again,[],spezcontext,forin);
                         end
                       else { Error }
                         Consume(_ID);
@@ -2932,7 +2985,7 @@
                         {  e.g., "with classinstance do field := 5"), then    }
                         { let do_member_read handle it                        }
                         if (srsym.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
-                          do_member_read(tabstractrecorddef(hdef),getaddr,srsym,p1,again,[],nil)
+                          do_member_read(tabstractrecorddef(hdef),getaddr,srsym,p1,again,[],nil,ef_forin in flags)
                         else
                           { otherwise it's a regular record subscript }
                           p1:=csubscriptnode.create(srsym,p1);
@@ -2995,7 +3048,7 @@
                         { not srsymtable.symtabletype since that can be }
                         { withsymtable as well                          }
                         if (srsym.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
-                          do_member_read(tabstractrecorddef(hdef),getaddr,srsym,p1,again,[],nil)
+                          do_member_read(tabstractrecorddef(hdef),getaddr,srsym,p1,again,[],nil,ef_forin in flags)
                         else
                           { no procsyms in records (yet) }
                           internalerror(2007012006);
@@ -3031,7 +3084,7 @@
                         { not srsymtable.symtabletype since that can be }
                         { withsymtable as well                          }
                         if (srsym.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
-                          do_member_read(tabstractrecorddef(hdef),getaddr,srsym,p1,again,[],nil)
+                          do_member_read(tabstractrecorddef(hdef),getaddr,srsym,p1,again,[],nil,ef_forin in flags)
                         else
                           { no propertysyms in records (yet) }
                           internalerror(2009111510);
@@ -3039,7 +3092,7 @@
                     else
                     { no method pointer }
                       begin
-                        handle_propertysym(tpropertysym(srsym),srsymtable,p1);
+                        handle_propertysym(tpropertysym(srsym),srsymtable,ef_forin in flags,p1);
                       end;
                   end;
 
@@ -3237,7 +3290,7 @@
                end;
            { maybe an additional parameter instead of misusing hadspezialize? }
            if dopostfix and not (ef_had_specialize in flags) then
-             updatefpos:=postfixoperators(p1,again,getaddr);
+             updatefpos:=postfixoperators(p1,again,getaddr,ef_forin in flags);
          end
         else
          begin
@@ -3373,7 +3426,7 @@
                        include(current_procinfo.flags,pi_has_inherited);
                        if anon_inherited then
                          include(callflags,cnf_anon_inherited);
-                       do_member_read(hclassdef,getaddr,srsym,p1,again,callflags,nil);
+                       do_member_read(hclassdef,getaddr,srsym,p1,again,callflags,nil,ef_forin in flags);
                      end
                     else
                      begin
@@ -3417,7 +3470,7 @@
                      again:=false;
                      p1:=cerrornode.create;
                    end;
-                 postfixoperators(p1,again,getaddr);
+                 postfixoperators(p1,again,getaddr,ef_forin in flags);
                end;
 
              _INTCONST :
@@ -3464,7 +3517,7 @@
                  if token=_POINT then
                    begin
                      again:=true;
-                     postfixoperators(p1,again,getaddr);
+                     postfixoperators(p1,again,getaddr,ef_forin in flags);
                    end;
                end;
 
@@ -3475,7 +3528,7 @@
                  if token=_POINT then
                    begin
                      again:=true;
-                     postfixoperators(p1,again,getaddr);
+                     postfixoperators(p1,again,getaddr,ef_forin in flags);
                    end;
                end;
 
@@ -3490,7 +3543,7 @@
                     p1:=ctypeconvnode.create_explicit(p1,hdef);
                     { handle postfix operators here e.g. string(a)[10] }
                     again:=true;
-                    postfixoperators(p1,again,getaddr);
+                    postfixoperators(p1,again,getaddr,ef_forin in flags);
                   end
                  else
                   p1:=ctypenode.create(hdef);
@@ -3508,7 +3561,7 @@
                     p1:=ctypeconvnode.create_explicit(p1,hdef);
                     { handle postfix operators here e.g. string(a)[10] }
                     again:=true;
-                    postfixoperators(p1,again,getaddr);
+                    postfixoperators(p1,again,getaddr,ef_forin in flags);
                   end
                  else
                   begin
@@ -3523,7 +3576,7 @@
                  if token in postfixoperator_tokens then
                    begin
                      again:=true;
-                     postfixoperators(p1,again,getaddr);
+                     postfixoperators(p1,again,getaddr,ef_forin in flags);
                    end;
                end;
 
@@ -3534,7 +3587,7 @@
                  if token=_POINT then
                    begin
                      again:=true;
-                     postfixoperators(p1,again,getaddr);
+                     postfixoperators(p1,again,getaddr,ef_forin in flags);
                    end;
                end;
 
@@ -3545,7 +3598,7 @@
                  if token in postfixoperator_tokens then
                    begin
                      again:=true;
-                     postfixoperators(p1,again,getaddr);
+                     postfixoperators(p1,again,getaddr,ef_forin in flags);
                    end;
                end;
 
@@ -3556,7 +3609,7 @@
                  if token=_POINT then
                    begin
                      again:=true;
-                     postfixoperators(p1,again,getaddr);
+                     postfixoperators(p1,again,getaddr,ef_forin in flags);
                    end;
                end;
 
@@ -3578,7 +3631,7 @@
                  if token in postfixoperator_tokens then
                   begin
                     again:=true;
-                    postfixoperators(p1,again,getaddr);
+                    postfixoperators(p1,again,getaddr,ef_forin in flags);
                   end;
                  got_addrn:=false;
                  p1:=caddrnode.create(p1);
@@ -3603,7 +3656,7 @@
                  if token in postfixoperator_tokens then
                   begin
                     again:=true;
-                    postfixoperators(p1,again,getaddr);
+                    postfixoperators(p1,again,getaddr,ef_forin in flags);
                   end;
                end;
 
@@ -3676,7 +3729,7 @@
                  if token in [_CARET,_POINT] then
                   begin
                     again:=true;
-                    postfixoperators(p1,again,getaddr);
+                    postfixoperators(p1,again,getaddr,ef_forin in flags);
                   end;
                end;
            _OBJCPROTOCOL:
@@ -3740,7 +3793,7 @@
         { handle potential typecasts, etc }
         p1:=handle_factor_typenode(def,false,again,nil,false);
         { parse postfix operators }
-        postfixoperators(p1,again,false);
+        postfixoperators(p1,again,false,false);
         if assigned(p1) and (p1.nodetype=typen) then
           def:=ttypenode(p1).typedef
         else
@@ -3891,7 +3944,7 @@
                 else
                   internalerror(2015092703);
               end;
-              do_member_read(structdef,getaddr,gensym,result,again,[],spezcontext);
+              do_member_read(structdef,getaddr,gensym,result,again,[],spezcontext,ef_forin in flags);
             end
           else
             begin
@@ -3909,7 +3962,7 @@
                       { withsymtable as well                          }
                       if (gensym.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
                         begin
-                          do_member_read(tabstractrecorddef(parseddef),getaddr,gensym,result,again,[],spezcontext);
+                          do_member_read(tabstractrecorddef(parseddef),getaddr,gensym,result,again,[],spezcontext,ef_forin in flags);
                           spezcontext:=nil;
                         end
                       else
@@ -3931,7 +3984,7 @@
             end;
 
           { parse postfix operators }
-          if postfixoperators(result,again,false) then
+          if postfixoperators(result,again,false,ef_forin in flags) then
             if assigned(result) then
               result.fileinfo:=filepos
             else
Index: compiler/pinline.pas
===================================================================
--- compiler/pinline.pas	(revision 32275)
+++ compiler/pinline.pas	(working copy)
@@ -125,7 +125,7 @@
                  exit;
               end;
 
-            do_member_read(classh,false,sym,p2,again,[],nil);
+            do_member_read(classh,false,sym,p2,again,[],nil,false);
 
             { we need the real called method }
             do_typecheckpass(p2);
@@ -238,11 +238,11 @@
                 else
                   callflag:=cnf_dispose_call;
                 if is_new then
-                  do_member_read(classh,false,sym,p2,again,[callflag],nil)
+                  do_member_read(classh,false,sym,p2,again,[callflag],nil,false)
                 else
                   begin
                     if not(m_fpc in current_settings.modeswitches) then
-                      do_member_read(classh,false,sym,p2,again,[callflag],nil)
+                      do_member_read(classh,false,sym,p2,again,[callflag],nil,false)
                     else
                       begin
                         p2:=ccallnode.create(nil,tprocsym(sym),sym.owner,p2,[callflag],nil);
@@ -475,7 +475,7 @@
             afterassignment:=false;
             searchsym_in_class(classh,classh,pattern,srsym,srsymtable,[ssf_search_helper]);
             consume(_ID);
-            do_member_read(classh,false,srsym,p1,again,[cnf_new_call],nil);
+            do_member_read(classh,false,srsym,p1,again,[cnf_new_call],nil,false);
             { we need to know which procedure is called }
             do_typecheckpass(p1);
             if not(
Index: compiler/pstatmnt.pas
===================================================================
--- compiler/pstatmnt.pas	(revision 32275)
+++ compiler/pstatmnt.pas	(working copy)
@@ -519,7 +519,7 @@
               else
                 loopvarsym:=nil;
 
-              expr:=comp_expr([ef_accept_equal]);
+              expr:=comp_expr([ef_accept_equal,ef_forin]);
 
               consume(_DO);
 
Index: compiler/symconst.pas
===================================================================
--- compiler/symconst.pas	(revision 32275)
+++ compiler/symconst.pas	(working copy)
@@ -526,7 +526,8 @@
     ppo_implements,
     ppo_enumerator_current,       { implements current property for enumerator }
     ppo_overrides,                { overrides ancestor property }
-    ppo_dispid_write              { no longer used }
+    ppo_dispid_write,             { no longer used }
+    ppo_hasenumerator             { has enumerator (only if ppo_hasparameters) }
   );
   tpropertyoptions=set of tpropertyoption;
 
Index: compiler/symsym.pas
===================================================================
--- compiler/symsym.pas	(revision 32275)
+++ compiler/symsym.pas	(working copy)
@@ -334,7 +334,7 @@
       end;
       tabsolutevarsymclass = class of tabsolutevarsym;
 
-       tpropaccesslisttypes=(palt_none,palt_read,palt_write,palt_stored);
+       tpropaccesslisttypes=(palt_none,palt_read,palt_write,palt_stored,palt_enumerator);
 
        tpropertysym = class(Tstoredsym)
          protected
Index: compiler/utils/ppuutils/ppudump.pp
===================================================================
--- compiler/utils/ppuutils/ppudump.pp	(revision 32275)
+++ compiler/utils/ppuutils/ppudump.pp	(working copy)
@@ -2131,7 +2131,8 @@
     ppo_implements,
     ppo_enumerator_current,
     ppo_overrides,
-    ppo_dispid_write              { no longer used }
+    ppo_dispid_write,            { no longer used }
+    ppo_hasenumerator
   );
   tpropertyoptions=set of tpropertyoption;
 *)
@@ -2151,7 +2152,8 @@
     (mask:ppo_implements;str:'implements'),
     (mask:ppo_enumerator_current;str:'enumerator current'),
     (mask:ppo_overrides;str:'overrides'),
-    (mask:ppo_dispid_write;str:'dispid write')  { no longer used }
+    (mask:ppo_dispid_write;str:'dispid write'),  { no longer used }
+    (mask:ppo_hasenumerator;str:'has enumerator')
   );
 var
   i      : longint;
property-enumerator-4.patch (31,017 bytes)   

Ondrej Pokorny

2016-01-25 19:58

developer   ~0089357

Ping: today I again came across a code that I'd like this feature to use in.
AFAIR some devs liked it and some didn't. I also remembered that I fixed issues we talked about in the mailing list in the 4.patch and no other issues were raised.

Could we get some progress on this? Resolving it as "won't do" is a progress as well, although I'd be quite sad about that :)

Sven Barth

2016-01-27 22:02

manager   ~0089443

Ehm, yes, sorry. This got a bit lost. I'm still thinking about an alternative way for the tenumeratornode though...

Regards,
Sven

Maciej Izak

2016-01-28 00:06

reporter   ~0089445

What about published section? Whole idea is good but the new word "enumerator"? Mmm. I am not sure about this.

Ondrej Pokorny

2016-01-28 00:54

developer   ~0089446

Last edited: 2016-01-28 01:29

View 2 revisions

@Sven: there is an alternative of making the bug from 0028820:0087065 to a feature. I.e. to support property overloading:

  TTest = class
    // ...
    function GetObjectEnumerator: TTestObjectEnumerator;
    property Objects[Index: Integer]: TObject read GetObject;
    property Objects: TTestObjectEnumerator read GetObjectEnumerator;
  end;



pros:
1.) No need for tenumeratornode and the new forin compiler context (the ef_forin flag and forin parameters).
2.) No need for the "enumerator" keyword - although Maciej you haven't said what you don't like about it, so your comment is not really relevant :)
3.) Method overloads are already supported so the concept should be understandable for all pascal folks.

cons:
A.) The enumerator is publicly visible. (Ok, not that bad).
B.) It could affect legacy code if you define e.g.
property Objects[Index: Integer] // legacy
property Objects[Index: String] // new

and you used (with a defined string->integer implicit operator:
Objects['123'] // legacy
(Such usage is very unlikely but possible. It can be avoided with using creating a new compiler flag, if needed - something similar like scopedenums on/off.)
C.) There may be some issues with reintroducing properties (but maybe not). Definitely the same mechanism from method overloading should be used.
D.) Not as straight-forward as the "enumerator" keyword - the overloaded property can be everything, not only enumerator (this could be also a pro).


Maybe there are some more. But the biggest pro is that compiler changes will be probably smaller, maintenance will be easier.

Michael Van Canneyt

2016-01-28 08:59

administrator   ~0089456

I think the overloaded way is also good;
overloaded array properties have long been on my wishlist.

Maciej Izak

2016-01-28 09:45

reporter   ~0089457

@Michael: We have the same wishlist :).

@Ondrej IMO cons B should be rather added to pros.

btw. it is Delphi compatible!

Ondrej Pokorny

2016-01-28 11:31

developer   ~0089459

Last edited: 2016-01-28 11:39

View 2 revisions

@Maciej > What about published section?

What's good/wrong about the published section and the enumerator keyword?

There is a problem with the published section and overloaded properties. Obviously only one property with the same name can be published.
The same problem with property overloads in public section will come up if advanced RTTI is supported (like in Delphi).
-> this is cons (E) - probably the biggest one.

EDIT: sorry, array properties cannot be published, so no problem here.

@Maciej > btw. it is Delphi compatible!

What version? How? I tested 7, XE2 and 10 Seattle and no of them seems to support overloaded properties. I get "Identifier redeclared" error on the second property.

Maciej Izak

2016-01-28 11:59

reporter   ~0089460

Last edited: 2016-01-28 11:59

View 2 revisions

@Ondrej:
I mean additional information in RTTI for "enumerator".
Did you tested the "enumerator" with generics?

It is available for default properties since XE2 or even earlier. Just try this:

type
  TX = class
  private
    function GetA_Integer(idx: Integer): byte; virtual; abstract;
    function GetA_String(idx: string): byte; virtual; abstract;
  public
    property A[I: Integer]: byte read GetA_Integer; default;
    property A[I: string]: byte read GetA_String; default;
  end;

Ondrej Pokorny

2016-01-28 12:07

developer   ~0089461

Last edited: 2016-01-28 12:09

View 2 revisions

@Maciej: Now I see it: the clue is not generics but the "default" keyword. Default array properties seem to support overloading, non-Default properties do not. I don't know when it changed. XE2 suports it, 7 doesn't.

>> I mean additional information in RTTI for "enumerator".
Array properties cannot be published, so no problem here.

Maciej Izak

2016-01-28 12:25

reporter   ~0089462

Thanks word "enumerator" array property has more sense in published section.

Anyway overloaded properties are good :P.

Ondrej Pokorny

2016-01-28 12:54

developer   ~0089464

Last edited: 2016-01-28 12:58

View 2 revisions

>> Thanks word "enumerator" array property has more sense in published section. Anyway overloaded properties are good :P.

in this case the overloaded properties are even better, IMO :)

  TTest = class
  public
    property Objects[Index: Integer]: TObject read GetObject;
  published
    property Objects: TTestObjectEnumerator read GetObjectEnumerator;
  end;


EDIT: but of course you/RTTI cannot explicitly know that Objects is an enumerator and has to be destroyed after the use :(

+ let's talk about in in the mailing list...

Maciej Izak

2016-01-28 12:57

reporter   ~0089465

Fell free to start the thread. But what for "write"? ;d

Michael Van Canneyt

2016-01-28 13:00

administrator   ~0089467

Ondrej, if you make it an interface,
 
  TTest = class
  public
    property Objects[Index: Integer]: TObject read GetObject;
  published
    property Objects: IEnumerator read GetObjectEnumerator;
  end;

Then the compiler will know how to free it.

Kazantsev Alexey

2016-01-28 13:33

reporter   ~0089471

All you need is [s]love[/s] overloaded default properties. As in Delphi.

type

 TObj = Class

   Type

    TValue = Type String;

    TValues = Record

     Function GetEnumerator : TEnumerator;

     Property Items[AIndex : Integer] : TValue Read GetValueByIndex Write SetValueByIndex; Default;
     Property Items[Const AName : String] : TValue Read GetValueByName Write SetValueByName; Default;

    End;

   Property Values : TValues Read GetValues;

 End;

var v : TObj.TValue;
    obj : TObj;

begin

  obj.Values[1] := '1';
  obj.Values['2'] := '2';

  for v in Obj.Values do;

end.

Ondrej Pokorny

2019-10-08 12:31

developer   ~0118410

This language extension doesn't make sense if property overloads are added.

TMyObject = class
public
    property Objects[Index: Integer]: TObject read GetObject;
    property Objects: TObjectEnumerator read GetObjectEnumerator;
end;

does the same once it is supported. Property overloads are the preferred way because they are more universal and powerful.

Issue History

Date Modified Username Field Change
2015-10-10 15:38 Ondrej Pokorny New Issue
2015-10-11 09:11 Misha Strong Note Added: 0086418
2015-10-11 09:58 Ondrej Pokorny Note Added: 0086422
2015-10-11 10:47 Ondrej Pokorny Note Edited: 0086422 View Revisions
2015-10-11 11:28 Thaddy de Koning Note Added: 0086423
2015-10-11 11:28 Thaddy de Koning Note Edited: 0086423 View Revisions
2015-10-11 11:45 Ondrej Pokorny Note Added: 0086424
2015-10-11 11:52 Thaddy de Koning Note Added: 0086425
2015-10-11 11:58 Ondrej Pokorny Note Added: 0086426
2015-10-11 12:51 Misha Strong Note Added: 0086436
2015-10-23 15:31 Sven Barth Note Added: 0086827
2015-10-25 22:49 Ondrej Pokorny Note Added: 0086872
2015-10-30 14:29 Sven Barth Note Added: 0087028
2015-10-31 11:27 Ondrej Pokorny File Added: property-enumerator-1.patch
2015-10-31 11:28 Ondrej Pokorny File Added: project1.lpr
2015-10-31 11:31 Ondrej Pokorny Note Added: 0087040
2015-10-31 20:54 Ondrej Pokorny File Added: property-enumerator-2.patch
2015-10-31 23:15 Ondrej Pokorny File Added: property-enumerator-3.patch
2015-10-31 23:16 Ondrej Pokorny Note Edited: 0087040 View Revisions
2015-11-02 15:47 Ondrej Pokorny Note Added: 0087065
2015-11-02 15:49 Ondrej Pokorny File Added: arraypropenum.lpr
2015-11-02 15:49 Ondrej Pokorny File Added: tobjectsenum.lpr
2015-11-02 19:53 Sven Barth Note Added: 0087071
2015-11-02 20:13 Ondrej Pokorny Note Added: 0087073
2015-11-08 23:59 Ondrej Pokorny File Added: property-enumerator-4.patch
2016-01-25 19:58 Ondrej Pokorny Note Added: 0089357
2016-01-27 22:02 Sven Barth Note Added: 0089443
2016-01-28 00:06 Maciej Izak Note Added: 0089445
2016-01-28 00:54 Ondrej Pokorny Note Added: 0089446
2016-01-28 01:29 Ondrej Pokorny Note Edited: 0089446 View Revisions
2016-01-28 08:59 Michael Van Canneyt Note Added: 0089456
2016-01-28 09:45 Maciej Izak Note Added: 0089457
2016-01-28 11:31 Ondrej Pokorny Note Added: 0089459
2016-01-28 11:39 Ondrej Pokorny Note Edited: 0089459 View Revisions
2016-01-28 11:59 Maciej Izak Note Added: 0089460
2016-01-28 11:59 Maciej Izak Note Edited: 0089460 View Revisions
2016-01-28 12:07 Ondrej Pokorny Note Added: 0089461
2016-01-28 12:09 Ondrej Pokorny Note Edited: 0089461 View Revisions
2016-01-28 12:25 Maciej Izak Note Added: 0089462
2016-01-28 12:54 Ondrej Pokorny Note Added: 0089464
2016-01-28 12:57 Maciej Izak Note Added: 0089465
2016-01-28 12:58 Ondrej Pokorny Note Edited: 0089464 View Revisions
2016-01-28 13:00 Michael Van Canneyt Note Added: 0089467
2016-01-28 13:33 Kazantsev Alexey Note Added: 0089471
2019-10-08 11:39 Ondrej Pokorny Assigned To => Ondrej Pokorny
2019-10-08 11:39 Ondrej Pokorny Status new => resolved
2019-10-08 11:39 Ondrej Pokorny Resolution open => won't fix
2019-10-08 11:39 Ondrej Pokorny FPCTarget => -
2019-10-08 11:39 Ondrej Pokorny Status resolved => closed
2019-10-08 12:29 Ondrej Pokorny Status closed => feedback
2019-10-08 12:29 Ondrej Pokorny Resolution won't fix => reopened
2019-10-08 12:29 Ondrej Pokorny Relationship added related to 0035772
2019-10-08 12:31 Ondrej Pokorny Status feedback => closed
2019-10-08 12:31 Ondrej Pokorny Note Added: 0118410