paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 15:49:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: trunk@19563 -
This commit is contained in:
paul 2011-10-31 02:54:19 +00:00
parent 6b4a5c3cf6
commit f685d67647
3 changed files with 77 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -11890,6 +11890,7 @@ tests/webtbs/tw2046a.pp svneol=native#text/plain
tests/webtbs/tw20527.pp svneol=native#text/plain
tests/webtbs/tw20557.pp svneol=native#text/pascal
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

33
compiler/ptconst.pas
View File

@ -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 }
@ -1094,9 +1094,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
@ -1146,9 +1158,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
@ -1183,8 +1196,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
@ -1256,12 +1270,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

55
tests/webtbs/tw20594.pp Normal file
View File

@ -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.