Index: nx64flw.pas
===================================================================
--- nx64flw.pas	(revision 41795)
+++ nx64flw.pas	(working copy)
@@ -223,6 +223,7 @@
     endtrylabel,
     finallylabel,
     endfinallylabel,
+    templabel,
     oldexitlabel: tasmlabel;
     oldflowcontrol: tflowcontrol;
     catch_frame: boolean;
@@ -244,6 +245,7 @@
     oldflowcontrol:=flowcontrol;
     flowcontrol:=[fc_inflowcontrol];
 
+    templabel:=nil;
     current_asmdata.getjumplabel(trylabel);
     current_asmdata.getjumplabel(endtrylabel);
     current_asmdata.getjumplabel(finallylabel);
@@ -284,20 +286,19 @@
           exit;
       end;
 
-    { If the immediately preceding instruction is CALL,
-      its return address must not end up outside the scope, so pad with NOP. }
+    { finallylabel is only used in implicit frames as an exit point from nested try..finally
+      statements, if any. To prevent finalizer from being executed twice, it must come before
+      endtrylabel (bug #34772) }
     if catch_frame then
-      cg.a_jmp_always(current_asmdata.CurrAsmList,finallylabel)
-    else
-      emit_nop;
-
-    cg.a_label(current_asmdata.CurrAsmList,endtrylabel);
-
-    { Handle the except block first, so endtrylabel serves both
-      as end of scope and as unwind target. This way it is possible to
-      encode everything into a single scope record. }
-    if catch_frame then
       begin
+        current_asmdata.getjumplabel(templabel);
+        cg.a_label(current_asmdata.CurrAsmList, finallylabel);
+        { jump over exception handler }
+        cg.a_jmp_always(current_asmdata.CurrAsmList,templabel);
+        { Handle the except block first, so endtrylabel serves both
+          as end of scope and as unwind target. This way it is possible to
+          encode everything into a single scope record. }
+        cg.a_label(current_asmdata.CurrAsmList,endtrylabel);
         if (current_procinfo.procdef.proccalloption=pocall_safecall) then
           begin
             handle_safecall_exception;
@@ -305,10 +306,18 @@
           end
         else
           InternalError(2014031601);
+        cg.a_label(current_asmdata.CurrAsmList,templabel);
+      end
+    else
+      begin
+        { same as emit_nop but using finallylabel instead of dummy }
+        cg.a_label(current_asmdata.CurrAsmList,finallylabel);
+        finallylabel.increfs;
+        current_asmdata.CurrAsmList.concat(Taicpu.op_none(A_NOP,S_NO));
+        cg.a_label(current_asmdata.CurrAsmList,endtrylabel);
       end;
 
     flowcontrol:=[fc_inflowcontrol];
-    cg.a_label(current_asmdata.CurrAsmList,finallylabel);
     { generate finally code as a separate procedure }
     if not implicitframe then
       tcgprocinfo(current_procinfo).generate_exceptfilter(finalizepi);

{ %OPT=-gh }
{$mode objfpc}{$h+}
 uses
   Classes;

procedure Foo(a: array of integer);
begin
  try
    writeln(a[0]);
    if a[0] = 1 then exit;
    writeln(a[0]);
  finally
    writeln(a[0]);
  end;
end;

procedure Bar(a: array of integer); safecall;
begin
  try
    writeln(a[0]);
    if a[0] = 1 then exit;
    writeln(a[0]);
  finally
    writeln(a[0]);
  end;
end;

var
  memmgr, newmemmgr: TMemoryManager;
  FreeMemCalls: Longint;
  

function HookFreeMem(ptr: Pointer): ptruint;
begin
  Inc(FreeMemCalls);
  result := memmgr.FreeMem(ptr);
end;

begin
  GetMemoryManager(memmgr);
  newmemmgr := memmgr;
  newmemmgr.FreeMem := @HookFreeMem;
  SetMemoryManager(newmemmgr);

  FreeMemCalls:=0;
  foo([1]);
  if FreeMemCalls<>1 then halt(1);
  bar([1]);
  if FreeMemCalls<>2 then halt(2);
end.

Index: compiler/ncgflw.pas
===================================================================
--- compiler/ncgflw.pas	(revision 41898)
+++ compiler/ncgflw.pas	(working copy)
@@ -424,7 +424,10 @@
            secondpass(left);
 
          if (fc_unwind_exit in flowcontrol) then
-           hlcg.g_local_unwind(current_asmdata.CurrAsmList,current_procinfo.CurrExitLabel)
+           { Use TrueExitLabel, not CurrExitLabel, because if there's an implicit finally
+             block, this will also be inside the unwinding information, and jumping to
+             CurrExitLabel might call the implicit finally block a second time. [Kit] [Issue #34772] }
+           hlcg.g_local_unwind(current_asmdata.CurrAsmList,current_procinfo.TrueExitLabel)
          else
            hlcg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrExitLabel);
        end;
Index: compiler/procinfo.pas
===================================================================
--- compiler/procinfo.pas	(revision 41898)
+++ compiler/procinfo.pas	(working copy)
@@ -117,6 +117,9 @@
           { label to leave the sub routine }
           CurrExitLabel : tasmlabel;
 
+          { True exit label (used as the exit point for stack unwinding on some platforms) }
+          TrueExitLabel : tasmlabel;
+
           { label for nested exits }
           nestedexitlabel : tlabelsym;
 
@@ -215,6 +218,7 @@
         reference_reset(save_regs_ref,sizeof(aint),[]);
         { labels }
         current_asmdata.getjumplabel(CurrExitLabel);
+        TrueExitLabel := CurrExitLabel; { This label doesn't change }
         current_asmdata.getjumplabel(CurrGOTLabel);
         CurrBreakLabel:=nil;
         CurrContinueLabel:=nil;
Index: compiler/x86_64/nx64flw.pas
===================================================================
--- compiler/x86_64/nx64flw.pas	(revision 41898)
+++ compiler/x86_64/nx64flw.pas	(working copy)
@@ -472,7 +472,10 @@
         cg.a_label(current_asmdata.CurrAsmList,exitexceptlabel);
         cg.g_call(current_asmdata.CurrAsmList,'FPC_DONEEXCEPTION');
         if (fc_unwind_exit in oldflowcontrol) then
-          cg.g_local_unwind(current_asmdata.CurrAsmList,oldCurrExitLabel)
+          { Use TrueExitLabel, not oldCurrExitLabel, because if there's an implicit finally
+            block, this will also be inside the unwinding information, and jumping to
+            oldCurrExitLabel might call the implicit finally block a second time. [Kit] [Issue #34772] }
+          cg.g_local_unwind(current_asmdata.CurrAsmList,current_procinfo.TrueExitLabel)
         else
           cg.a_jmp_always(current_asmdata.CurrAsmList,oldCurrExitLabel);
       end;

program tw34772;

{$mode objfpc}{$H+}
{$WARN 5058 off : Variable "$1" does not seem to be initialized}

uses
  Classes, SysUtils;


procedure Test1(a: array of Integer);
begin
  WriteLn('Test1 - Start ', a[0]);
  if a[0] = 1 then exit;
  if a[0] = 2 then raise EAbort.Create('Test');
  WriteLn('Test1 - End ', a[0]);
end;


procedure Test2(a: array of Integer);
var
  Test: Pointer;
begin
  GetMem(Test, 4);
  try
    WriteLn('Test2 - Start ', a[0]);
    if a[0] = 1 then exit;
    if a[0] = 2 then raise EAbort.Create('Test');
    WriteLn('Test2 - End ', a[0]);
  finally
    FreeMem(Test);
    WriteLn('Test2 - Finally ', a[0]);
  end;
end;


procedure Test3(a: array of Integer);
begin
  try
    WriteLn('Test3 - Start ', a[0]);
    if a[0] = 1 then exit;
    if a[0] = 2 then raise EAbort.Create('Test');
    WriteLn('Test3 - End ', a[0]);
  except
    on E: Exception do
      begin
        if E.ClassType <> EAbort then raise; { Unexpected exception }
        WriteLn('Test3 - Except ', a[0]);
      end;
  end;
end;


procedure Test4(a: array of Integer);
var
  Test: Pointer;
begin
  GetMem(Test, 4);
  try
    try
      WriteLn('Test4 - Start ', a[0]);
      if a[0] = 1 then exit;
      if a[0] = 2 then raise EAbort.Create('Test');
      WriteLn('Test4 - End ', a[0]);
    except
      on E: Exception do
        begin
          if E.ClassType <> EAbort then raise; { Unexpected exception }
          WriteLn('Test4 - Except ', a[0]);
        end;
    end;
  finally
    FreeMem(Test);
    WriteLn('Test4 - Finally ', a[0]);
  end;
end;


procedure Test5(a: array of Integer); safecall;
begin
  WriteLn('Test5 - Start ', a[0]);
  if a[0] = 1 then exit;
  if a[0] = 2 then raise EAbort.Create('Test');
  WriteLn('Test5 - End ', a[0]);
end;


procedure Test6(a: array of Integer); safecall;
var
  Test: Pointer;
begin
  GetMem(Test, 4);
  try
    WriteLn('Test6 - Start ', a[0]);
    if a[0] = 1 then exit;
    if a[0] = 2 then raise EAbort.Create('Test');
    WriteLn('Test6 - End ', a[0]);
  finally
    FreeMem(Test);
    WriteLn('Test6 - Finally ', a[0]);
  end;
end;


procedure Test7(a: array of Integer); safecall;
begin
  try
    WriteLn('Test7 - Start ', a[0]);
    if a[0] = 1 then exit;
    if a[0] = 2 then raise EAbort.Create('Test');
    WriteLn('Test7 - End ', a[0]);
  except
    on E: Exception do
      begin
        if E.ClassType <> EAbort then raise; { Unexpected exception }
        WriteLn('Test7 - Except ', a[0]);
      end;
  end;
end;


procedure Test8(a: array of Integer); safecall;
var
  Test: Pointer;
begin
  GetMem(Test, 4);
  try
    try
      WriteLn('Test8 - Start ', a[0]);
      if a[0] = 1 then exit;
      if a[0] = 2 then raise EAbort.Create('Test');
      WriteLn('Test8 - End ', a[0]);
    except
      on E: Exception do
        begin
          if E.ClassType <> EAbort then raise; { Unexpected exception }
          WriteLn('Test8 - Except ', a[0]);
        end;
    end;
  finally
    FreeMem(Test);
    WriteLn('Test8 - Finally ', a[0]);
  end;
end;


function Test9(a: array of Integer): Boolean;
var
  Test: Pointer;
begin
  Result := True;
  GetMem(Test, 4);
  try
    WriteLn('Test9 - Start ', a[0]);
    if a[0] = 1 then exit;
    if a[0] = 2 then raise EAbort.Create('Test');
    WriteLn('Test9 - End ', a[0]);
  finally
    FreeMem(Test);
    WriteLn('Test9 - Finally ', a[0]);
    if a[0] = 0 then Result := False;
  end;

  Result := True;

end;


procedure Test10(a: array of Integer);
var
  Test, Test2: Pointer;
begin
  GetMem(Test, 4);
  try
    GetMem(Test2, 4);
    try
      WriteLn('Test10 - Start ', a[0]);
      if a[0] = 1 then exit;
      if a[0] = 2 then raise EAbort.Create('Test');
      WriteLn('Test10 - End ', a[0]);
    finally
      FreeMem(Test2);
      WriteLn('Test10 - Finally A ', a[0]);
    end;
  finally
    FreeMem(Test);
    WriteLn('Test10 - Finally B ', a[0]);
  end;
end;


procedure Test11(a: array of Integer); safecall;
var
  Test, Test2: Pointer;
begin
  GetMem(Test, 4);
  try
    GetMem(Test2, 4);
    try
      WriteLn('Test11 - Start ', a[0]);
      if a[0] = 1 then exit;
      if a[0] = 2 then raise EAbort.Create('Test');
      WriteLn('Test11 - End ', a[0]);
    finally
      FreeMem(Test2);
      WriteLn('Test11 - Finally A ', a[0]);
    end;
  finally
    FreeMem(Test);
    WriteLn('Test11 - Finally B ', a[0]);
  end;
end;


procedure Test12(a: Integer); safecall;
var
  Test, Test2: Pointer;
begin
  GetMem(Test, 4);
  try
    GetMem(Test2, 4);
    try
      WriteLn('Test12 - Start ', a);
      if a = 1 then exit;
      if a = 2 then raise EAbort.Create('Test');
      WriteLn('Test12 - End ', a);
    finally
      FreeMem(Test2);
      WriteLn('Test12 - Finally A ', a);
    end;
  finally
    FreeMem(Test);
    WriteLn('Test12 - Finally B ', a);
  end;
end;


var
  X, TestCount: Integer;
  ReferenceCount: LongInt;
  MemMgr, NewMemMgr: TMemoryManager;
  Fail: Boolean;

function HookGetMem(Size: PtrUInt): Pointer;
  begin
    Inc(ReferenceCount);
    Result := MemMgr.GetMem(Size);
  end;

function HookReAllocMem(var p: Pointer; Size: PtrUInt): Pointer;
  begin
    if p = nil then
      Inc(ReferenceCount);

    Result := MemMgr.ReAllocMem(p, Size);

    { If ReAllocMem(nil, 0) is called, ReferenceCount is incremented then
      decremented, reflecting the null operation }
    if Size = 0 then
      Dec(ReferenceCount);
  end;

function HookFreeMem(ptr: Pointer): PtrUInt;
  begin
    Dec(ReferenceCount);
    Result := MemMgr.FreeMem(ptr);
  end;

function HookFreeMemSize(ptr: Pointer; Size: PtrUInt): PtrUInt;
  begin
    Dec(ReferenceCount);
    Result := MemMgr.FreeMemSize(ptr, Size);
  end;

procedure PostTestAnalysis;
  begin
    Inc(TestCount);
    if ReferenceCount <> 0 then
      begin
        WriteLn('FAIL - Reference count = ', ReferenceCount);
        Fail := True;
      end;
  end;

procedure CheckTestCount;
  begin
    if TestCount <> 3 then
      begin
        Fail := True;
        WriteLn('FAIL - Only ', TestCount, ' sub-tests were run for this test');
      end;
  end;

begin
  { Set up hooks to track memory leaks }
  GetMemoryManager(MemMgr);
  NewMemMgr := MemMgr;
  NewMemMgr.GetMem := @HookGetMem;
  NewMemMgr.ReAllocMem := @HookReAllocMem;
  NewMemMgr.FreeMem := @HookFreeMem;
  NewMemMgr.FreeMemSize := @HookFreeMemSize;
  SetMemoryManager(NewMemMgr);

  { Test parameters
    [0] = Run to end of procedure
    [1] = Exit prematurely
    [2] = raise exception
  }

  { Test1 - implicit try..finally }
  TestCount := 0;
  for X := 0 to 2 do
    begin
      ReferenceCount := 0;
      try
        Test1([X]);
      except
        on E: Exception do
          if E.ClassType <> EAbort then
            begin
              { Unexpected exception }
              WriteLn('FAIL - Exception ', E.ClassName, ' raised: "', E.Message, '"');
              Fail := True;
              Continue;
            end;
      end;

      PostTestAnalysis;
    end;

  CheckTestCount;

  { Test2 - implicit + explicit try..finally }
  TestCount := 0;
  for X := 0 to 2 do
    begin
      ReferenceCount := 0;
      try
        Test2([X]);
      except
        on E: Exception do
          if E.ClassType <> EAbort then
            begin
              { Unexpected exception }
              WriteLn('FAIL - Exception ', E.ClassName, ' raised: "', E.Message, '"');
              Fail := True;
              Continue;
            end;
      end;

      PostTestAnalysis;
    end;

  CheckTestCount;

  { Test3 - implicit try..finally and explicit try..except }
  TestCount := 0;
  for X := 0 to 2 do
    begin
      ReferenceCount := 0;
      try
        Test3([X]);
      except
        { Exceptions should be caught }
        on E: Exception do
          begin
            WriteLn('FAIL - Exception ', E.ClassName, ' raised: "', E.Message, '"');
            Fail := True;
            Continue;
          end;
      end;

      PostTestAnalysis;
    end;

  CheckTestCount;

  { Test4 - implicit + explicit try..finally and explicit try..except }
  TestCount := 0;
  for X := 0 to 2 do
    begin
      ReferenceCount := 0;
      try
        Test4([X]);
      except
        { Exceptions should be caught }
        on E: Exception do
          begin
            WriteLn('FAIL - Exception ', E.ClassName, ' raised: "', E.Message, '"');
            Fail := True;
            Continue;
          end;
      end;

      PostTestAnalysis;
    end;

  CheckTestCount;

  { Test5 - implicit try..finally with safecall }
  TestCount := 0;
  for X := 0 to 2 do
    begin
      ReferenceCount := 0;
      try
        Test5([X]);
      except
        { Everything gets wrapped into a ESafecallException }
      end;

      PostTestAnalysis;
    end;

  CheckTestCount;

  { Test6 - implicit + explicit try..finally with safecall }
  TestCount := 0;
  for X := 0 to 2 do
    begin
      ReferenceCount := 0;
      try
        Test6([X]);
      except
        { Everything gets wrapped into a ESafecallException }
      end;

      PostTestAnalysis;
    end;

  CheckTestCount;

  { Test7 - implicit try..finally and explicit try..except with safecall }
  TestCount := 0;
  for X := 0 to 2 do
    begin
      ReferenceCount := 0;
      try
        Test7([X]);
      except
        { Everything gets wrapped into a ESafecallException }
      end;

      PostTestAnalysis;
    end;

  CheckTestCount;

  { Test8 - implicit + explicit try..finally and explicit try..except with safecall }
  TestCount := 0;
  for X := 0 to 2 do
    begin
      ReferenceCount := 0;
      try
        Test8([X]);
      except
        { Everything gets wrapped into a ESafecallException }
      end;

      PostTestAnalysis;
    end;

  CheckTestCount;

  { Test9 - implicit + explicit try..finally with code following }
  TestCount := 0;
  for X := 0 to 2 do
    begin
      ReferenceCount := 0;
      try
        if not Test9([X]) then
          begin
            WriteLn('FAIL -  Code following finally block wasn''t executed');
            Fail := True;
            Continue;
          end;
      except
        on E: Exception do
          if E.ClassType <> EAbort then
            begin
              { Unexpected exception }
              WriteLn('FAIL - Exception ', E.ClassName, ' raised: "', E.Message, '"');
              Fail := True;
              Continue;
            end;
      end;

      PostTestAnalysis;
    end;

  CheckTestCount;

  { Test10 - implicit + 2 * explicit try..finally }
  TestCount := 0;
  for X := 0 to 2 do
    begin
      ReferenceCount := 0;
      try
        Test10([X]);
      except
        on E: Exception do
          if E.ClassType <> EAbort then
            begin
              { Unexpected exception }
              WriteLn('FAIL - Exception ', E.ClassName, ' raised: "', E.Message, '"');
              Fail := True;
              Continue;
            end;
      end;

      PostTestAnalysis;
    end;

  CheckTestCount;

  { Test11 - implicit + 2 * explicit try..finally with safecall }
  TestCount := 0;
  for X := 0 to 2 do
    begin
      ReferenceCount := 0;
      try
        Test11([X]);
      except
        { Everything gets wrapped into a ESafecallException }
      end;

      PostTestAnalysis;
    end;

  CheckTestCount;

  { Test12 - 2 * explicit try..finally with safecall }
  TestCount := 0;
  for X := 0 to 2 do
    begin
      ReferenceCount := 0;
      try
        Test12(X);
      except
        { Everything gets wrapped into a ESafecallException }
      end;

      PostTestAnalysis;
    end;

  CheckTestCount;

  if Fail then
    Halt(1)
  else
    WriteLn('ok');
end.