mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-06 16:16:03 +02:00
* don't generate implicit exception frames for pure assembler routines, resolves #20075
git-svn-id: trunk@19341 -
This commit is contained in:
parent
f35aa5db26
commit
c6a0cafdb0
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -11873,6 +11873,7 @@ tests/webtbs/tw20035a.pp svneol=native#text/pascal
|
|||||||
tests/webtbs/tw20035b.pp svneol=native#text/pascal
|
tests/webtbs/tw20035b.pp svneol=native#text/pascal
|
||||||
tests/webtbs/tw20035c.pp svneol=native#text/pascal
|
tests/webtbs/tw20035c.pp svneol=native#text/pascal
|
||||||
tests/webtbs/tw2004.pp svneol=native#text/plain
|
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/tw20093.pp svneol=native#text/pascal
|
||||||
tests/webtbs/tw20093a.pp svneol=native#text/pascal
|
tests/webtbs/tw20093a.pp svneol=native#text/pascal
|
||||||
tests/webtbs/tw20119.pp -text svneol=native#test/pascal
|
tests/webtbs/tw20119.pp -text svneol=native#test/pascal
|
||||||
|
@ -716,7 +716,8 @@ implementation
|
|||||||
if (cs_implicit_exceptions in current_settings.moduleswitches) and
|
if (cs_implicit_exceptions in current_settings.moduleswitches) and
|
||||||
(pi_needs_implicit_finally in flags) and
|
(pi_needs_implicit_finally in flags) and
|
||||||
{ but it's useless in init/final code of units }
|
{ 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
|
begin
|
||||||
{ Generate special exception block only needed when
|
{ Generate special exception block only needed when
|
||||||
implicit finaly is used }
|
implicit finaly is used }
|
||||||
@ -1212,6 +1213,7 @@ implementation
|
|||||||
if (cs_implicit_exceptions in current_settings.moduleswitches) and
|
if (cs_implicit_exceptions in current_settings.moduleswitches) and
|
||||||
not(procdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) and
|
not(procdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) and
|
||||||
(pi_needs_implicit_finally in flags) and
|
(pi_needs_implicit_finally in flags) and
|
||||||
|
not(po_assembler in procdef.procoptions) and
|
||||||
not(pi_has_implicit_finally in flags) then
|
not(pi_has_implicit_finally in flags) then
|
||||||
internalerror(200405231);
|
internalerror(200405231);
|
||||||
|
|
||||||
|
58
tests/webtbs/tw20075.pp
Normal file
58
tests/webtbs/tw20075.pp
Normal 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.
|
||||||
|
|
Loading…
Reference in New Issue
Block a user