paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-03 22:53:33 +01:00
Code Issues Packages Projects Releases Wiki Activity

* do replace one temp with another while inlining in case the former can

Browse Source 
be a regvar while the latter cannot be (mantis #16018)

git-svn-id: trunk@15218 -
This commit is contained in:
Jonas Maebe 2010-05-03 16:29:03 +00:00
parent a055ed873d
commit 2911435c5a
3 changed files with 95 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -10335,6 +10335,7 @@ tests/webtbs/tw15909.pp svneol=native#text/plain
tests/webtbs/tw1592.pp svneol=native#text/plain
tests/webtbs/tw15930.pp svneol=native#text/plain
tests/webtbs/tw16004.pp svneol=native#text/plain
tests/webtbs/tw16018.pp svneol=native#text/plain
tests/webtbs/tw16040.pp svneol=native#text/plain
tests/webtbs/tw16065.pp svneol=native#text/pascal
tests/webtbs/tw16083.pp svneol=native#text/plain

7
compiler/ncal.pas
View File

@ -3478,7 +3478,12 @@ implementation
)
) then
begin
if para.left.nodetype<>temprefn then
{ don't create a new temp unnecessarily, but make sure we
do create a new one if the old one could be a regvar and
the new one cannot be one }
if (para.left.nodetype<>temprefn) or
(((tparavarsym(para.parasym).varregable in [vr_none,vr_addr])) and
(ti_may_be_in_reg in ttemprefnode(para.left).tempinfo^.flags)) then
begin
tempnode := ctempcreatenode.create(para.parasym.vardef,para.parasym.vardef.size,tt_persistent,tparavarsym(para.parasym).is_regvar(false));
addstatement(inlineinitstatement,tempnode);

88
tests/webtbs/tw16018.pp Normal file
View File

@ -0,0 +1,88 @@
program testbug;
{$APPTYPE CONSOLE}
{$ifdef fpc}
{$mode delphi}
{$ifdef cpui386}
{$define cpu386}
{$endif}
{$ifdef cpu386}
{$asmmode intel}
{$endif}
{$ifdef FPC_LITTLE_ENDIAN}
{$define LITTLE_ENDIAN}
{$else}
{$ifdef FPC_BIG_ENDIAN}
{$define BIG_ENDIAN}
{$endif}
{$endif}
{$define caninline}
{$else}
{$define LITTLE_ENDIAN}
{$ifndef cpu64}
{$define cpu32}
{$endif}
{$endif}
{$ifdef win32}
{$define windows}
{$endif}
{$ifdef win64}
{$define windows}
{$endif}
{$ifdef wince}
{$define windows}
{$endif}
{$rangechecks off}
{$extendedsyntax on}
{$hints off}
{$j+}
uses SysUtils,Math;
type TBesenNumber=double;
PBesenDoubleBytes=^TBesenDoubleBytes;
TBesenDoubleBytes=array[0..sizeof(double)-1] of byte;
const BesenDoubleZero:TBesenNumber=0.0;
{$ifdef FPC_BIG_ENDIAN}
BesenDoubleNaN:TBesenDoubleBytes=($7f,$ff,$ff,$ff,$ff,$ff,$ff,$ff);
BesenDoubleInfPos:TBesenDoubleBytes=($7f,$f0,$00,$00,$00,$00,$00,$00);
BesenDoubleInfNeg:TBesenDoubleBytes=($ff,$f0,$00,$00,$00,$00,$00,$00);
BesenDoubleMax:TBesenDoubleBytes=($7f,$ef,$ff,$ff,$ff,$ff,$ff,$ff);
BesenDoubleMin:TBesenDoubleBytes=($00,$00,$00,$00,$00,$00,$00,$01);
{$else}
BesenDoubleNaN:TBesenDoubleBytes=($ff,$ff,$ff,$ff,$ff,$ff,$ff,$7f);
BesenDoubleInfPos:TBesenDoubleBytes=($00,$00,$00,$00,$00,$00,$f0,$7f);
BesenDoubleInfNeg:TBesenDoubleBytes=($00,$00,$00,$00,$00,$00,$f0,$ff);
BesenDoubleMax:TBesenDoubleBytes=($ff,$ff,$ff,$ff,$ff,$ff,$ef,$7f);
BesenDoubleMin:TBesenDoubleBytes=($01,$00,$00,$00,$00,$00,$00,$00);
{$endif}
function BesenIsNaN(const AValue:TBesenNumber):boolean; {$ifdef caninline}inline;{$endif}
begin
result:=(int64(pointer(@AValue)^)=int64(pointer(@BesenDoubleNaN)^)) or IsNaN(AValue);
end;
function BesenIsInfinite(const AValue:TBesenNumber):boolean; {$ifdef caninline}inline;{$endif}
begin
result:=(int64(pointer(@AValue)^)=int64(pointer(@BesenDoubleInfPos)^)) or (int64(pointer(@AValue)^)=int64(pointer(@BesenDoubleInfNeg)^)) or IsInfinite(AValue);
end;
function BesenIsFinite(const AValue:TBesenNumber):boolean; {$ifdef caninline}inline;{$endif}
begin
result:=not (BesenIsNaN(AValue) or BesenIsInfinite(AValue));
end;
procedure BesenTestProc;
var x:double;
begin
x:=8;
if BesenIsFinite(x) then begin // Here will raise the "Internal error 2006111510" at positon with BesenIsFinite (on every other positon in the real big source code of my EcmaScript 5th edition implementation, where BesenIsFinite is used)
end
else
halt(1);
end;
begin
BesenTestProc;
end.