浏览代码

Merged revisions 7100 via svnmerge from
http://svn.freepascal.org/svn/fpc/trunk

r7100 (florian)
* properly release open array value parameters on x86-64 or if they contain automated types, resolves #8664

git-svn-id: branches/fixes_2_2@7101 -

florian 18 年之前
父节点
当前提交
f28f12af00
共有 5 个文件被更改,包括 38 次插入24 次删除
  1. 1 0
      .gitattributes
  2. 12 0
      compiler/i386/cgcpu.pas
  3. 11 11
      compiler/ncgutil.pas
  4. 1 13
      compiler/x86/cgx86.pas
  5. 13 0
      tests/webtbs/tw8664.pp

+ 1 - 0
.gitattributes

@@ -8043,6 +8043,7 @@ tests/webtbs/tw8434.pp svneol=native#text/plain
 tests/webtbs/tw8462.pp svneol=native#text/plain
 tests/webtbs/tw8513.pp svneol=native#text/plain
 tests/webtbs/tw8573.pp svneol=native#text/plain
+tests/webtbs/tw8664.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain
 tests/webtbs/uw0555.pp svneol=native#text/plain

+ 12 - 0
compiler/i386/cgcpu.pas

@@ -46,6 +46,7 @@ unit cgcpu;
 
         procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean);override;
         procedure g_copyvaluepara_openarray(list : TAsmList;const ref:treference;const lenloc:tlocation;elesize:aint;destreg:tregister);override;
+        procedure g_releasevaluepara_openarray(list : TAsmList;const l:tlocation);override;
 
         procedure g_exception_reason_save(list : TAsmList; const href : treference);override;
         procedure g_exception_reason_save_const(list : TAsmList; const href : treference; a: aint);override;
@@ -444,6 +445,17 @@ unit cgcpu;
       end;
 
 
+    procedure tcg386.g_releasevaluepara_openarray(list : TAsmList;const l:tlocation);
+      begin
+        if use_fixed_stack then
+          begin
+            inherited g_releasevaluepara_openarray(list,l);
+            exit;
+          end;
+        { Nothing to release }
+      end;
+
+
     procedure tcg386.g_exception_reason_save(list : TAsmList; const href : treference);
       begin
         if not use_fixed_stack then

+ 11 - 11
compiler/ncgutil.pas

@@ -1222,17 +1222,17 @@ implementation
               location_get_data_ref(list,tparavarsym(p).localloc,href,is_open_array(tparavarsym(p).vardef));
               cg.g_decrrefcount(list,tparavarsym(p).vardef,href);
             end;
-         end
-        else
-         if (tparavarsym(p).varspez=vs_value) and
-            (is_open_array(tparavarsym(p).vardef) or
-             is_array_of_const(tparavarsym(p).vardef)) then
-           begin
-             { cdecl functions don't have a high pointer so it is not possible to generate
-               a local copy }
-             if not(current_procinfo.procdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
-               cg.g_releasevaluepara_openarray(list,tparavarsym(p).localloc);
-           end;
+         end;
+        { open arrays can contain elements requiring init/final code, so the else has been removed here }
+        if (tparavarsym(p).varspez=vs_value) and
+           (is_open_array(tparavarsym(p).vardef) or
+            is_array_of_const(tparavarsym(p).vardef)) then
+          begin
+            { cdecl functions don't have a high pointer so it is not possible to generate
+              a local copy }
+            if not(current_procinfo.procdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
+              cg.g_releasevaluepara_openarray(list,tparavarsym(p).localloc);
+          end;
       end;
 
 

+ 1 - 13
compiler/x86/cgx86.pas

@@ -102,7 +102,6 @@ unit cgx86;
         procedure g_concatcopy(list : TAsmList;const source,dest : treference;len : aint);override;
 
         { entry/exit code helpers }
-        procedure g_releasevaluepara_openarray(list : TAsmList;const l:tlocation);override;
         procedure g_profilecode(list : TAsmList);override;
         procedure g_stackpointer_alloc(list : TAsmList;localsize : longint);override;
         procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean);override;
@@ -491,7 +490,7 @@ unit cgx86;
               end;
             OS_F80 :
               begin
-                  op:=A_FSTP; 
+                  op:=A_FSTP;
                   s:=S_FX;
                end;
             OS_C64 :
@@ -1713,17 +1712,6 @@ unit cgx86;
                               Entry/Exit Code Helpers
 ****************************************************************************}
 
-    procedure tcgx86.g_releasevaluepara_openarray(list : TAsmList;const l:tlocation);
-      begin
-        if (use_fixed_stack) then
-          begin
-            inherited g_releasevaluepara_openarray(list,l);
-            exit;
-          end;
-        { Nothing to release }
-      end;
-
-
     procedure tcgx86.g_profilecode(list : TAsmList);
 
       var

+ 13 - 0
tests/webtbs/tw8664.pp

@@ -0,0 +1,13 @@
+{ %OPT=-gh }
+program project1;
+
+{$mode objfpc}{$H+}
+
+procedure TLResourceListAdd(Values: array of string);
+begin
+end;
+
+
+begin
+  TLResourceListAdd(['Value1']);
+end.