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

* don't generate implicit exception frames for pure assembler routines, resolves #20075

Browse Source 
git-svn-id: trunk@19341 -
This commit is contained in:
florian 2011-10-03 20:09:07 +00:00
parent f35aa5db26
commit c6a0cafdb0
3 changed files with 62 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -11873,6 +11873,7 @@ tests/webtbs/tw20035a.pp svneol=native#text/pascal
tests/webtbs/tw20035b.pp svneol=native#text/pascal
tests/webtbs/tw20035c.pp svneol=native#text/pascal
tests/webtbs/tw2004.pp svneol=native#text/plain
tests/webtbs/tw20075.pp svneol=native#text/pascal
tests/webtbs/tw20093.pp svneol=native#text/pascal
tests/webtbs/tw20093a.pp svneol=native#text/pascal
tests/webtbs/tw20119.pp -text svneol=native#test/pascal

4
compiler/psub.pas
View File

@ -716,7 +716,8 @@ implementation
if (cs_implicit_exceptions in current_settings.moduleswitches) and
(pi_needs_implicit_finally in flags) and
{ but it's useless in init/final code of units }
not(procdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) then
not(procdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) and
not(po_assembler in procdef.procoptions) then
begin
{ Generate special exception block only needed when
implicit finaly is used }
@ -1212,6 +1213,7 @@ implementation
if (cs_implicit_exceptions in current_settings.moduleswitches) and
not(procdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) and
(pi_needs_implicit_finally in flags) and
not(po_assembler in procdef.procoptions) and
not(pi_has_implicit_finally in flags) then
internalerror(200405231);

58
tests/webtbs/tw20075.pp Normal file
View File

@ -0,0 +1,58 @@
program tw20075;
{$mode delphi}
uses
Classes;
type
TNodeArray = array of Pointer;
{ TTest }
TTest = class
function GetCount(TheArray: TNodeArray; Count: Integer): Integer;
function GetCountNoExceptions(TheArray: TNodeArray; Count: Integer): Integer;
end;
function TTest.GetCount(TheArray: TNodeArray; Count: Integer): Integer; assembler;
asm
MOV EAX, EDX
end;
{$IMPLICITEXCEPTIONS OFF}
function TTest.GetCountNoExceptions(TheArray: TNodeArray; Count: Integer): Integer; assembler;
asm
MOV EAX, EDX
end;
{$IMPLICITEXCEPTIONS ON}
var
T: TTest;
N: TNodeArray;
I, R: Integer;
begin
T := TTest.Create;
I := 10;
SetLength(N, I);
R := T.GetCount(N, I);
if R <> I then
begin
WriteLn('Normal: R <> I / R = ', R);
halt(1);
end
else
WriteLn('Normal: R = I = ', R);
R := T.GetCountNoExceptions(N, I);
if R <> I then
begin
WriteLn('WithoutException: R <> I / R = ', R);
halt(1);
end
else
WriteLn('WithoutException: R = I = ', R);
T.Destroy;
writeln('ok');
end.