Selaa lähdekoodia

compiler: extend enumerator support for records:
- search GetEnumerator method in records too (while searching a enumerator for structure)
- allow enumerator operator return type to be a record
- copy/adapt enumerator helpers from tobjectdef to tabstractrecorddef
+ test

git-svn-id: trunk@16807 -

paul 14 vuotta sitten
vanhempi
commit
a39733a0a2
7 muutettua tiedostoa jossa 169 lisäystä ja 16 poistoa
  1. 1 0
      .gitattributes
  2. 4 3
      compiler/htypechk.pas
  3. 5 5
      compiler/nflw.pas
  4. 1 1
      compiler/pdecsub.pas
  5. 104 5
      compiler/symdef.pas
  6. 2 2
      compiler/symsym.pas
  7. 52 0
      tests/test/tforin25.pp

+ 1 - 0
.gitattributes

@@ -9388,6 +9388,7 @@ tests/test/tforin21.pp svneol=native#text/pascal
 tests/test/tforin22.pp svneol=native#text/pascal
 tests/test/tforin22.pp svneol=native#text/pascal
 tests/test/tforin23.pp svneol=native#text/pascal
 tests/test/tforin23.pp svneol=native#text/pascal
 tests/test/tforin24.pp svneol=native#text/pascal
 tests/test/tforin24.pp svneol=native#text/pascal
+tests/test/tforin25.pp svneol=native#text/pascal
 tests/test/tforin3.pp svneol=native#text/pascal
 tests/test/tforin3.pp svneol=native#text/pascal
 tests/test/tforin4.pp svneol=native#text/pascal
 tests/test/tforin4.pp svneol=native#text/pascal
 tests/test/tforin5.pp svneol=native#text/pascal
 tests/test/tforin5.pp svneol=native#text/pascal

+ 4 - 3
compiler/htypechk.pas

@@ -444,15 +444,16 @@ implementation
                 if optoken=_OP_ENUMERATOR then
                 if optoken=_OP_ENUMERATOR then
                   begin
                   begin
                     result:=
                     result:=
-                      is_class_or_interface_or_object(pf.returndef);
+                      is_class_or_interface_or_object(pf.returndef) or
+                      is_record(pf.returndef);
                     if result then
                     if result then
                       begin
                       begin
-                        if not assigned(tobjectdef(pf.returndef).search_enumerator_move) then
+                        if not assigned(tabstractrecorddef(pf.returndef).search_enumerator_move) then
                           begin
                           begin
                             Message1(sym_e_no_enumerator_move, pf.returndef.typename);
                             Message1(sym_e_no_enumerator_move, pf.returndef.typename);
                             result:=false;
                             result:=false;
                           end;
                           end;
-                        if not assigned(tobjectdef(pf.returndef).search_enumerator_current) then
+                        if not assigned(tabstractrecorddef(pf.returndef).search_enumerator_current) then
                           begin
                           begin
                             Message1(sym_e_no_enumerator_current,pf.returndef.typename);
                             Message1(sym_e_no_enumerator_current,pf.returndef.typename);
                             result:=false;
                             result:=false;

+ 5 - 5
compiler/nflw.pas

@@ -859,13 +859,13 @@ implementation
               begin
               begin
                 // search for operator first
                 // search for operator first
                 pd:=search_enumerator_operator(expr.resultdef, hloopvar.resultdef);
                 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=objectdef) then
-                  pd:=tobjectdef(expr.resultdef).search_enumerator_get;
+                // if there is no operator then search for class/object/record enumerator method
+                if (pd=nil) and (expr.resultdef.typ in [objectdef,recorddef]) then
+                  pd:=tabstractrecorddef(expr.resultdef).search_enumerator_get;
                 if pd<>nil then
                 if pd<>nil then
                   begin
                   begin
                     // seach movenext and current symbols
                     // seach movenext and current symbols
-                    movenext:=tobjectdef(pd.returndef).search_enumerator_move;
+                    movenext:=tabstractrecorddef(pd.returndef).search_enumerator_move;
                     if movenext = nil then
                     if movenext = nil then
                       begin
                       begin
                         result:=cerrornode.create;
                         result:=cerrornode.create;
@@ -875,7 +875,7 @@ implementation
                       end
                       end
                     else
                     else
                       begin
                       begin
-                        current:=tpropertysym(tobjectdef(pd.returndef).search_enumerator_current);
+                        current:=tpropertysym(tabstractrecorddef(pd.returndef).search_enumerator_current);
                         if current = nil then
                         if current = nil then
                           begin
                           begin
                             result:=cerrornode.create;
                             result:=cerrornode.create;

+ 1 - 1
compiler/pdecsub.pas

@@ -2472,7 +2472,7 @@ const
       mutexclpo     : [po_public,po_exports,po_interrupt,po_assembler,po_inline]
       mutexclpo     : [po_public,po_exports,po_interrupt,po_assembler,po_inline]
     ),(
     ),(
       idtok:_ENUMERATOR;
       idtok:_ENUMERATOR;
-      pd_flags : [pd_interface,pd_object];
+      pd_flags : [pd_interface,pd_object,pd_record];
       handler  : @pd_enumerator;
       handler  : @pd_enumerator;
       pocall   : pocall_none;
       pocall   : pocall_none;
       pooption : [];
       pooption : [];

+ 104 - 5
compiler/symdef.pas

@@ -186,9 +186,13 @@ interface
           destructor destroy; override;
           destructor destroy; override;
           procedure check_forwards; virtual;
           procedure check_forwards; virtual;
           function find_procdef_bytype(pt:tproctypeoption): tprocdef;
           function find_procdef_bytype(pt:tproctypeoption): tprocdef;
-          function  GetSymtable(t:tGetSymtable):TSymtable;override;
+          function GetSymtable(t:tGetSymtable):TSymtable;override;
           function is_packed:boolean;
           function is_packed:boolean;
           function RttiName: string;
           function RttiName: string;
+          { enumerator support }
+          function search_enumerator_get: tprocdef; virtual;
+          function search_enumerator_move: tprocdef; virtual;
+          function search_enumerator_current: tsym; virtual;
        end;
        end;
 
 
        trecorddef = class(tabstractrecorddef)
        trecorddef = class(tabstractrecorddef)
@@ -315,9 +319,9 @@ interface
           { dispinterface support }
           { dispinterface support }
           function get_next_dispid: longint;
           function get_next_dispid: longint;
           { enumerator support }
           { enumerator support }
-          function search_enumerator_get: tprocdef;
-          function search_enumerator_move: tprocdef;
-          function search_enumerator_current: tsym;
+          function search_enumerator_get: tprocdef; override;
+          function search_enumerator_move: tprocdef; override;
+          function search_enumerator_current: tsym; override;
           { WPO }
           { WPO }
           procedure register_created_object_type;override;
           procedure register_created_object_type;override;
           procedure register_maybe_created_object_type;
           procedure register_maybe_created_object_type;
@@ -2681,6 +2685,101 @@ implementation
         until tmp=nil;
         until tmp=nil;
       end;
       end;
 
 
+    function tabstractrecorddef.search_enumerator_get: tprocdef;
+      var
+        sym : tsym;
+        i : integer;
+        pd : tprocdef;
+        hashedid : THashedIDString;
+      begin
+        result:=nil;
+        hashedid.id:='GETENUMERATOR';
+        sym:=tsym(symtable.FindWithHash(hashedid));
+        if assigned(sym) and (sym.typ=procsym) then
+          begin
+            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)) and
+                 (pd.visibility >= vis_public) then
+              begin
+                result:=pd;
+                exit;
+              end;
+            end;
+          end;
+      end;
+
+    function tabstractrecorddef.search_enumerator_move: tprocdef;
+      var
+        sym : tsym;
+        i : integer;
+        pd : tprocdef;
+        hashedid : THashedIDString;
+      begin
+        result:=nil;
+        // first search for po_enumerator_movenext method modifier
+        // then search for public function MoveNext: Boolean
+        for i:=0 to symtable.SymList.Count-1 do
+          begin
+            sym:=TSym(symtable.SymList[i]);
+            if (sym.typ=procsym) then
+            begin
+              pd:=Tprocsym(sym).find_procdef_byoptions([po_enumerator_movenext]);
+              if assigned(pd) then
+                begin
+                  result:=pd;
+                  exit;
+                end;
+            end;
+          end;
+        hashedid.id:='MOVENEXT';
+        sym:=tsym(symtable.FindWithHash(hashedid));
+        if assigned(sym) and (sym.typ=procsym) then
+          begin
+            for i:=0 to Tprocsym(sym).ProcdefList.Count-1 do
+            begin
+              pd := tprocdef(Tprocsym(sym).ProcdefList[i]);
+              if (pd.proctypeoption = potype_function) and
+                 is_boolean(pd.returndef) and
+                 (pd.minparacount = 0) and
+                 (pd.visibility >= vis_public) then
+              begin
+                result:=pd;
+                exit;
+              end;
+            end;
+          end;
+      end;
+
+    function tabstractrecorddef.search_enumerator_current: tsym;
+      var
+        sym: tsym;
+        i: integer;
+        hashedid : THashedIDString;
+      begin
+        result:=nil;
+        // first search for ppo_enumerator_current property modifier
+        // then search for public property Current
+        for i:=0 to symtable.SymList.Count-1 do
+          begin
+            sym:=TSym(symtable.SymList[i]);
+            if (sym.typ=propertysym) and (ppo_enumerator_current in tpropertysym(sym).propoptions) then
+            begin
+              result:=sym;
+              exit;
+            end;
+          end;
+        hashedid.id:='CURRENT';
+        sym:=tsym(symtable.FindWithHash(hashedid));
+        if assigned(sym) and (sym.typ=propertysym) and
+           (sym.visibility >= vis_public) and not tpropertysym(sym).propaccesslist[palt_read].empty then
+          begin
+            result:=sym;
+            exit;
+          end;
+      end;
 
 
 {***************************************************************************
 {***************************************************************************
                                   trecorddef
                                   trecorddef
@@ -4834,7 +4933,7 @@ implementation
                 begin
                 begin
                   pd := tprocdef(Tprocsym(sym).ProcdefList[i]);
                   pd := tprocdef(Tprocsym(sym).ProcdefList[i]);
                   if (pd.proctypeoption = potype_function) and
                   if (pd.proctypeoption = potype_function) and
-                     is_class_or_interface_or_object(pd.returndef) and
+                     (is_class_or_interface_or_object(pd.returndef) or is_record(pd.returndef)) and
                      (pd.visibility >= vis_public) then
                      (pd.visibility >= vis_public) then
                   begin
                   begin
                     result:=pd;
                     result:=pd;

+ 2 - 2
compiler/symsym.pas

@@ -812,9 +812,9 @@ implementation
             pd:=tprocdef(ProcdefList[i]);
             pd:=tprocdef(ProcdefList[i]);
             if (pd.owner.symtabletype=staticsymtable) and not pd.owner.iscurrentunit then
             if (pd.owner.symtabletype=staticsymtable) and not pd.owner.iscurrentunit then
               continue;
               continue;
-            if not is_class_or_interface_or_object(pd.returndef) then
+            if not (is_class_or_interface_or_object(pd.returndef) or is_record(pd.returndef)) then
               continue;
               continue;
-            current := tpropertysym(tobjectdef(pd.returndef).search_enumerator_current);
+            current := tpropertysym(tabstractrecorddef(pd.returndef).search_enumerator_current);
             if (current = nil) then
             if (current = nil) then
               continue;
               continue;
             // compare current result def with the todef
             // compare current result def with the todef

+ 52 - 0
tests/test/tforin25.pp

@@ -0,0 +1,52 @@
+program tforin25;
+{$mode objfpc}
+{$modeswitch advancedrecords}
+
+type
+  TIntArray = array[0..3] of Integer;
+
+  TEnumerator = record
+  private
+    FIndex: Integer;
+    FArray: TIntArray;
+    function GetCurrent: Integer;
+  public
+    function MoveNext: Boolean;
+    property Current: Integer read GetCurrent;
+  end;
+
+  TMyArray = record
+    F: array[0..3] of Integer;
+    function GetEnumerator: TEnumerator;
+  end;
+
+function TEnumerator.MoveNext: Boolean;
+begin
+  inc(FIndex);
+  Result := FIndex < Length(FArray);
+end;
+
+function TEnumerator.GetCurrent: Integer;
+begin
+  Result := FArray[FIndex];
+end;
+
+function TMyArray.GetEnumerator: TEnumerator;
+begin
+  Result.FArray := F;
+  Result.FIndex := -1;
+end;
+{ this will compile too
+operator Enumerator(const A: TMyArray): TEnumerator;
+begin
+  Result.FArray := A.F;
+  Result.FIndex := -1;
+end;
+}
+var
+  Arr: TMyArray;
+  I: Integer;
+begin
+  for I in Arr do
+    WriteLn(I);
+end.