Bladeren bron

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

git-svn-id: trunk@19341 -
florian 14 jaren geleden
bovenliggende
commit
c6a0cafdb0
3 gewijzigde bestanden met toevoegingen van 62 en 1 verwijderingen
  1. 1 0
      .gitattributes
  2. 3 1
      compiler/psub.pas
  3. 58 0
      tests/webtbs/tw20075.pp

+ 1 - 0
.gitattributes

@@ -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

+ 3 - 1
compiler/psub.pas

@@ -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 - 0
tests/webtbs/tw20075.pp

@@ -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.
+