paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-22 13:31:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

* save/restore true/false label when secondpassing arrayconstructor

Browse Source 
elements (mantis #10072)

git-svn-id: trunk@9013 -
This commit is contained in:
Jonas Maebe 2007-10-31 12:37:35 +00:00
parent 0dce152199
commit 68570e5471
3 changed files with 48 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -7600,6 +7600,7 @@ tests/webtbs/tw0966.pp svneol=native#text/plain
tests/webtbs/tw0976.pp svneol=native#text/plain
tests/webtbs/tw10009.pp svneol=native#text/plain
tests/webtbs/tw10013.pp svneol=native#text/plain
tests/webtbs/tw10072.pp svneol=native#text/plain
tests/webtbs/tw1021.pp svneol=native#text/plain
tests/webtbs/tw1023.pp svneol=native#text/plain
tests/webtbs/tw1041.pp svneol=native#text/plain

20
compiler/ncgld.pas
View File

@ -867,6 +867,8 @@ implementation
elesize : longint;
tmpreg : tregister;
paraloc : tcgparalocation;
otlabel,
oflabel : tasmlabel;
begin
if is_packed_array(resultdef) then
internalerror(200608042);
@ -891,12 +893,26 @@ implementation
if assigned(hp.left) then
begin
freetemp:=true;
if (hp.left.expectloc=LOC_JUMP) then
begin
otlabel:=current_procinfo.CurrTrueLabel;
oflabel:=current_procinfo.CurrFalseLabel;
current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel);
current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel);
end;
secondpass(hp.left);
if codegenerror then
exit;
{ Move flags and jump in register }
if hp.left.location.loc in [LOC_FLAGS,LOC_JUMP] then
location_force_reg(current_asmdata.CurrAsmList,hp.left.location,def_cgsize(hp.left.resultdef),false);
if (hp.left.location.loc=LOC_JUMP) then
begin
if (hp.left.expectloc<>LOC_JUMP) then
internalerror(2007103101);
current_procinfo.CurrTrueLabel:=otlabel;
current_procinfo.CurrFalseLabel:=oflabel;
end;
if dovariant then
begin
{ find the correct vtype value }

29
tests/webtbs/tw10072.pp Normal file
View File

@ -0,0 +1,29 @@
program project1;
{$mode objfpc}{$H+}
uses
Classes, SysUtils;
procedure DebugLn(Args: array of const);
begin
if (high(args) <> 1) or
(args[0].vtype <> vtboolean) or
not args[0].vboolean or
(args[1].vtype <> vtboolean) or
args[1].vboolean then
halt(1);
end;
procedure DoSomething(ALeft, ATop, AWidth, AHeight : integer);
begin
DebugLn([
(1<>ALeft) or (2<>ATop),
(3<>AWidth) or (4<>AHeight)
]);
end;
begin
dosomething(1,0,3,4);
end.