Ver código fonte

* Set pi_do_call flag explicitly when procedure has a parameter or local var that require finalization. Normally it is set by implicit try..finally node, but this node is absent when compiling in {$implicitexceptions off} mode. This may cause internal errors in pass 2 if pi_do_call has not been set by other means.
Fixes IE when compiling Lazarus for MIPS target.
+ Test.

git-svn-id: trunk@29590 -

sergei 10 anos atrás
pai
commit
adeb8c93e9
3 arquivos alterados com 45 adições e 1 exclusões
  1. 1 0
      .gitattributes
  2. 5 1
      compiler/psub.pas
  3. 39 0
      tests/tbs/tb0609.pp

+ 1 - 0
.gitattributes

@@ -10351,6 +10351,7 @@ tests/tbs/tb0605.pp svneol=native#text/pascal
 tests/tbs/tb0606.pp svneol=native#text/pascal
 tests/tbs/tb0606.pp svneol=native#text/pascal
 tests/tbs/tb0607.pp svneol=native#text/plain
 tests/tbs/tb0607.pp svneol=native#text/plain
 tests/tbs/tb0608.pp svneol=native#text/pascal
 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/tb205.pp svneol=native#text/plain
 tests/tbs/tbs0594.pp svneol=native#text/pascal
 tests/tbs/tbs0594.pp svneol=native#text/pascal
 tests/tbs/ub0060.pp svneol=native#text/plain
 tests/tbs/ub0060.pp svneol=native#text/plain

+ 5 - 1
compiler/psub.pas

@@ -268,7 +268,10 @@ implementation
         if (tsym(p).typ=paravarsym) then
         if (tsym(p).typ=paravarsym) then
           begin
           begin
             if tparavarsym(p).needs_finalization then
             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
             if (tparavarsym(p).varspez in [vs_value,vs_out]) and
                (cs_create_pic in current_settings.moduleswitches) and
                (cs_create_pic in current_settings.moduleswitches) and
                (tf_pic_uses_got in target_info.flags) and
                (tf_pic_uses_got in target_info.flags) and
@@ -287,6 +290,7 @@ implementation
            is_managed_type(tlocalvarsym(p).vardef) then
            is_managed_type(tlocalvarsym(p).vardef) then
           begin
           begin
             include(current_procinfo.flags,pi_needs_implicit_finally);
             include(current_procinfo.flags,pi_needs_implicit_finally);
+            include(current_procinfo.flags,pi_do_call);
             if is_rtti_managed_type(tlocalvarsym(p).vardef) and
             if is_rtti_managed_type(tlocalvarsym(p).vardef) and
               (cs_create_pic in current_settings.moduleswitches) and
               (cs_create_pic in current_settings.moduleswitches) and
               (tf_pic_uses_got in target_info.flags) then
               (tf_pic_uses_got in target_info.flags) then

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