--- Merging r19563 into '.':

A    tests/webtbs/tw20594.pp
U    compiler/ptconst.pas

# revisions: 19563
------------------------------------------------------------------------
r19563 | paul | 2011-10-31 03:54:19 +0100 (Mon, 31 Oct 2011) | 1 line
Changed paths:
   M /trunk/compiler/ptconst.pas
   A /trunk/tests/webtbs/tw20594.pp

compiler: correctly traverse record fields while generating record constant (bug #0020594)
------------------------------------------------------------------------

git-svn-id: branches/fixes_2_6@19710 -

.gitattributes

@@ -11734,6 +11734,7 @@ tests/webtbs/tw2041.pp svneol=native#text/plain
 tests/webtbs/tw2045.pp svneol=native#text/plain
 tests/webtbs/tw2046a.pp svneol=native#text/plain
 tests/webtbs/tw2059.pp svneol=native#text/plain
+tests/webtbs/tw20594.pp svneol=native#text/pascal
 tests/webtbs/tw2065.pp svneol=native#text/plain
 tests/webtbs/tw2069.pp svneol=native#text/plain
 tests/webtbs/tw2072.pp svneol=native#text/plain

compiler/ptconst.pas

@@ -35,7 +35,7 @@ implementation
     uses
        SysUtils,
        globtype,systems,tokens,verbose,constexp,
-       cutils,globals,widestr,scanner,
+       cclasses,cutils,globals,widestr,scanner,
        symconst,symbase,symdef,symtable,
        aasmbase,aasmtai,aasmcpu,defutil,defcmp,
        { pass 1 }
@@ -1063,9 +1063,21 @@ implementation
               Message(parser_e_improper_guid_syntax);
           end;
 
+        function get_next_varsym(const SymList:TFPHashObjectList; var symidx:longint):tsym;inline;
+          begin
+            while symidx<SymList.Count do
+              begin
+                result:=tsym(def.symtable.SymList[symidx]);
+                inc(symidx);
+                if result.typ=fieldvarsym then
+                  exit;
+              end;
+            result:=nil;
+          end;
+
         var
           i : longint;
-
+          SymList:TFPHashObjectList;
         begin
           { GUID }
           if (def=rec_tguid) and (token=_ID) then
@@ -1115,9 +1127,10 @@ implementation
           { normal record }
           consume(_LKLAMMER);
           curroffset:=0;
-          symidx:=0;
           sorg:='';
-          srsym:=tsym(def.symtable.SymList[symidx]);
+          symidx:=0;
+          symlist:=def.symtable.SymList;
+          srsym:=get_next_varsym(symlist,symidx);
           recsym := nil;
           startoffset:=hr.offset;
           while token<>_RKLAMMER do
@@ -1152,8 +1165,9 @@ implementation
                      {   const r: tr = (w1:1;w2:1;l2:5);                  }
                      (tfieldvarsym(recsym).fieldoffset = curroffset) then
                     begin
-                      srsym := recsym;
-                      symidx := def.symtable.SymList.indexof(srsym)
+                      srsym:=recsym;
+                      { symidx should contain the next symbol id to search }
+                      symidx:=SymList.indexof(srsym)+1;
                     end
                   { going backwards isn't allowed in any mode }
                   else if (tfieldvarsym(recsym).fieldoffset<curroffset) then
@@ -1225,12 +1239,7 @@ implementation
                   { record was initialized (JM)                    }
                   recsym := srsym;
                   { goto next field }
-                  inc(symidx);
-                  if symidx<def.symtable.SymList.Count then
-                    srsym:=tsym(def.symtable.SymList[symidx])
-                  else
-                    srsym:=nil;
-
+                  srsym:=get_next_varsym(SymList,symidx);
                   if token=_SEMICOLON then
                     consume(_SEMICOLON)
                   else if (token=_COMMA) and (m_mac in current_settings.modeswitches) then

tests/webtbs/tw20594.pp

@@ -0,0 +1,55 @@
+{ %norun}
+{ %OPT=-Sew -vw}
+{$MODE delphi}
+
+type
+  TTestRec1 = record
+    A, B: Integer;
+  end;
+
+  TTestRec2 = record
+    A, B: Integer;
+    class operator Explicit(const rec: TTestRec2): ShortString;
+  end;
+
+  TTestRec3 = record
+    A, B: Integer;
+    function ToString: ShortString;
+  end;
+
+  TTestRec4 = record
+    A: Integer;
+    function ToString: ShortString;
+    var B: Integer;
+  end;
+
+class operator TTestRec2.Explicit(const rec: TTestRec2): ShortString;
+begin
+  with rec do WriteStr(Result, A, ':', B);
+end;
+
+function TTestRec3.ToString: ShortString;
+begin
+  Result := ShortString(TTestRec2(Self));
+end;
+
+function TTestRec4.ToString: ShortString;
+begin
+  Result := ShortString(TTestRec2(Self));
+end;
+
+const
+  r1: TTestRec1 = (A: 1; B: 2);
+  r2: TTestRec2 = (A: 3; B: 4);
+  r3: TTestRec3 = (A: 5; B: 6);
+  r4: TTestRec3 = (A: 7; B: 8);
+
+begin
+  Writeln(ShortString(r2));
+
+  Writeln(SizeOf(TTestRec1) = SizeOf(TTestRec2));
+  Writeln(ShortString(TTestRec2(r1)));
+
+  Writeln(r3.ToString);
+  Writeln(r4.ToString);
+end.