Преглед на файлове

--- Merging r29590 into '.':
U compiler/psub.pas
A tests/tbs/tb0609.pp
--- Merging r29691 into '.':
U rtl/inc/system.inc

# revisions: 29590,29691

git-svn-id: branches/fixes_3_0@29770 -

marco преди 10 години
родител
ревизия
154caf1283
променени са 4 файла, в които са добавени 47 реда и са изтрити 3 реда
  1. 1 0
      .gitattributes
  2. 5 1
      compiler/psub.pas
  3. 2 2
      rtl/inc/system.inc
  4. 39 0
      tests/tbs/tb0609.pp

+ 1 - 0
.gitattributes

@@ -10349,6 +10349,7 @@ tests/tbs/tb0605.pp svneol=native#text/pascal
 tests/tbs/tb0606.pp svneol=native#text/pascal
 tests/tbs/tb0607.pp svneol=native#text/plain
 tests/tbs/tb0608.pp svneol=native#text/pascal
+tests/tbs/tb0609.pp svneol=native#text/plain
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/tbs0594.pp svneol=native#text/pascal
 tests/tbs/ub0060.pp svneol=native#text/plain

+ 5 - 1
compiler/psub.pas

@@ -262,7 +262,10 @@ implementation
         if (tsym(p).typ=paravarsym) then
           begin
             if tparavarsym(p).needs_finalization then
-              include(current_procinfo.flags,pi_needs_implicit_finally);
+              begin
+                include(current_procinfo.flags,pi_needs_implicit_finally);
+                include(current_procinfo.flags,pi_do_call);
+              end;
             if (tparavarsym(p).varspez in [vs_value,vs_out]) and
                (cs_create_pic in current_settings.moduleswitches) and
                (tf_pic_uses_got in target_info.flags) and
@@ -281,6 +284,7 @@ implementation
            is_managed_type(tlocalvarsym(p).vardef) then
           begin
             include(current_procinfo.flags,pi_needs_implicit_finally);
+            include(current_procinfo.flags,pi_do_call);
             if is_rtti_managed_type(tlocalvarsym(p).vardef) and
               (cs_create_pic in current_settings.moduleswitches) and
               (tf_pic_uses_got in target_info.flags) then

+ 2 - 2
rtl/inc/system.inc

@@ -1081,14 +1081,14 @@ begin
   while (i<count) and (curr_frame>prev_frame) and
      (curr_frame<StackTop) do
     begin
-      prev_frame:=curr_frame;
-      get_caller_stackinfo(curr_frame,curr_addr);
       if (curr_addr=nil) or
          (curr_frame=nil) then
         break;
       if (i>=0) then
         frames[i]:=curr_addr;
       inc(i);
+      prev_frame:=curr_frame;
+      get_caller_stackinfo(curr_frame,curr_addr);
     end;
   if i<0 then
     result:=0

+ 39 - 0
tests/tbs/tb0609.pp

@@ -0,0 +1,39 @@
+{ %norun }
+{$mode objfpc}{$h+}
+{$implicitexceptions off}
+
+{ Test compilation of leaf function with managed parameter/local and implicit exceptions disabled. }
+type
+  TCodeTreeNodeDesc = word;
+
+  TCodeTreeNode = class
+    Parent: TCodeTreeNode;
+    Desc: TCodeTreeNodeDesc;
+    function GetNodeOfTypes(Descriptors: array of TCodeTreeNodeDesc): TCodeTreeNode;
+  end;
+
+
+function TCodeTreeNode.GetNodeOfTypes(Descriptors: array of TCodeTreeNodeDesc
+  ): TCodeTreeNode;
+var
+  i: Integer;
+begin
+  Result:=Self;
+  while (Result<>nil) do begin
+    for i:=Low(Descriptors) to High(Descriptors) do
+      if Result.Desc=Descriptors[i] then exit;
+    Result:=Result.Parent;
+  end;
+end;
+
+
+procedure test;
+var
+  s: string;
+begin
+  pointer(s):=nil;
+end;  
+
+
+begin
+end.