mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-12 02:45:58 +02:00
compiler: correctly traverse record fields while generating record constant (bug #0020594)
git-svn-id: trunk@19563 -
This commit is contained in:
parent
6b4a5c3cf6
commit
f685d67647
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -11890,6 +11890,7 @@ tests/webtbs/tw2046a.pp svneol=native#text/plain
|
|||||||
tests/webtbs/tw20527.pp svneol=native#text/plain
|
tests/webtbs/tw20527.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw20557.pp svneol=native#text/pascal
|
tests/webtbs/tw20557.pp svneol=native#text/pascal
|
||||||
tests/webtbs/tw2059.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/tw2065.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw2069.pp svneol=native#text/plain
|
tests/webtbs/tw2069.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw2072.pp svneol=native#text/plain
|
tests/webtbs/tw2072.pp svneol=native#text/plain
|
||||||
|
@ -35,7 +35,7 @@ implementation
|
|||||||
uses
|
uses
|
||||||
SysUtils,
|
SysUtils,
|
||||||
globtype,systems,tokens,verbose,constexp,
|
globtype,systems,tokens,verbose,constexp,
|
||||||
cutils,globals,widestr,scanner,
|
cclasses,cutils,globals,widestr,scanner,
|
||||||
symconst,symbase,symdef,symtable,
|
symconst,symbase,symdef,symtable,
|
||||||
aasmbase,aasmtai,aasmcpu,defutil,defcmp,
|
aasmbase,aasmtai,aasmcpu,defutil,defcmp,
|
||||||
{ pass 1 }
|
{ pass 1 }
|
||||||
@ -1094,9 +1094,21 @@ implementation
|
|||||||
Message(parser_e_improper_guid_syntax);
|
Message(parser_e_improper_guid_syntax);
|
||||||
end;
|
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
|
var
|
||||||
i : longint;
|
i : longint;
|
||||||
|
SymList:TFPHashObjectList;
|
||||||
begin
|
begin
|
||||||
{ GUID }
|
{ GUID }
|
||||||
if (def=rec_tguid) and (token=_ID) then
|
if (def=rec_tguid) and (token=_ID) then
|
||||||
@ -1146,9 +1158,10 @@ implementation
|
|||||||
{ normal record }
|
{ normal record }
|
||||||
consume(_LKLAMMER);
|
consume(_LKLAMMER);
|
||||||
curroffset:=0;
|
curroffset:=0;
|
||||||
symidx:=0;
|
|
||||||
sorg:='';
|
sorg:='';
|
||||||
srsym:=tsym(def.symtable.SymList[symidx]);
|
symidx:=0;
|
||||||
|
symlist:=def.symtable.SymList;
|
||||||
|
srsym:=get_next_varsym(symlist,symidx);
|
||||||
recsym := nil;
|
recsym := nil;
|
||||||
startoffset:=hr.offset;
|
startoffset:=hr.offset;
|
||||||
while token<>_RKLAMMER do
|
while token<>_RKLAMMER do
|
||||||
@ -1183,8 +1196,9 @@ implementation
|
|||||||
{ const r: tr = (w1:1;w2:1;l2:5); }
|
{ const r: tr = (w1:1;w2:1;l2:5); }
|
||||||
(tfieldvarsym(recsym).fieldoffset = curroffset) then
|
(tfieldvarsym(recsym).fieldoffset = curroffset) then
|
||||||
begin
|
begin
|
||||||
srsym := recsym;
|
srsym:=recsym;
|
||||||
symidx := def.symtable.SymList.indexof(srsym)
|
{ symidx should contain the next symbol id to search }
|
||||||
|
symidx:=SymList.indexof(srsym)+1;
|
||||||
end
|
end
|
||||||
{ going backwards isn't allowed in any mode }
|
{ going backwards isn't allowed in any mode }
|
||||||
else if (tfieldvarsym(recsym).fieldoffset<curroffset) then
|
else if (tfieldvarsym(recsym).fieldoffset<curroffset) then
|
||||||
@ -1256,12 +1270,7 @@ implementation
|
|||||||
{ record was initialized (JM) }
|
{ record was initialized (JM) }
|
||||||
recsym := srsym;
|
recsym := srsym;
|
||||||
{ goto next field }
|
{ goto next field }
|
||||||
inc(symidx);
|
srsym:=get_next_varsym(SymList,symidx);
|
||||||
if symidx<def.symtable.SymList.Count then
|
|
||||||
srsym:=tsym(def.symtable.SymList[symidx])
|
|
||||||
else
|
|
||||||
srsym:=nil;
|
|
||||||
|
|
||||||
if token=_SEMICOLON then
|
if token=_SEMICOLON then
|
||||||
consume(_SEMICOLON)
|
consume(_SEMICOLON)
|
||||||
else if (token=_COMMA) and (m_mac in current_settings.modeswitches) then
|
else if (token=_COMMA) and (m_mac in current_settings.modeswitches) then
|
||||||
|
55
tests/webtbs/tw20594.pp
Normal file
55
tests/webtbs/tw20594.pp
Normal 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.
|
Loading…
Reference in New Issue
Block a user