浏览代码

* Managed types passed to out formal parameters must be completely cleaned (decrementing refcount is not enough) at caller side, because callee side doesn't know their actual type and cannot initialize them. Resolves #20962.

git-svn-id: trunk@19956 -
sergei 13 年之前
父节点
当前提交
b1cbf30a94
共有 3 个文件被更改,包括 37 次插入0 次删除
  1. 1 0
      .gitattributes
  2. 4 0
      compiler/ncgcal.pas
  3. 32 0
      tests/webtbs/tw20962.pp

+ 1 - 0
.gitattributes

@@ -12052,6 +12052,7 @@ tests/webtbs/tw20872c.pp svneol=native#text/pascal
 tests/webtbs/tw20874a.pp svneol=native#text/pascal
 tests/webtbs/tw20874a.pp svneol=native#text/pascal
 tests/webtbs/tw20874b.pp svneol=native#text/pascal
 tests/webtbs/tw20874b.pp svneol=native#text/pascal
 tests/webtbs/tw20889.pp svneol=native#text/pascal
 tests/webtbs/tw20889.pp svneol=native#text/pascal
+tests/webtbs/tw20962.pp svneol=native#text/plain
 tests/webtbs/tw20995a.pp svneol=native#text/pascal
 tests/webtbs/tw20995a.pp svneol=native#text/pascal
 tests/webtbs/tw20995b.pp svneol=native#text/pascal
 tests/webtbs/tw20995b.pp svneol=native#text/pascal
 tests/webtbs/tw2109.pp svneol=native#text/plain
 tests/webtbs/tw2109.pp svneol=native#text/plain

+ 4 - 0
compiler/ncgcal.pas

@@ -180,6 +180,10 @@ implementation
                            href,third.location,'FPC_DECREF_ARRAY');
                            href,third.location,'FPC_DECREF_ARRAY');
                        end;
                        end;
                    end
                    end
+                 else if (resultdef.typ=formaldef) then
+                   { stuff being passed to formal parameter has to be completely cleaned,
+                     because it cannot be initialized at callee side (bug #20962) }
+                   cg.g_finalize(current_asmdata.CurrAsmList,left.resultdef,href)
                  else
                  else
                    cg.g_decrrefcount(current_asmdata.CurrAsmList,left.resultdef,href);
                    cg.g_decrrefcount(current_asmdata.CurrAsmList,left.resultdef,href);
                end;
                end;

+ 32 - 0
tests/webtbs/tw20962.pp

@@ -0,0 +1,32 @@
+{ %opt=-gh }
+
+program outpar;
+{$ifdef FPC}{$mode objfpc}{$h+}{$endif}
+{$ifdef mswindows}{$apptype console}{$endif}
+uses
+ {$ifdef FPC}{$ifdef linux}cthreads,cwstring,{$endif}{$endif}
+ sysutils;
+{$ifndef FPC}
+type
+ sizeint = integer;
+{$endif}
+type 
+ pinteger = ^integer;
+procedure testproc(out str);
+begin
+ ansistring(str):= '';
+end;
+
+var
+ str1,str2: ansistring;
+
+begin
+ setlength(str1,5);
+ move('abcde',str1[1],5);
+ str2:= str1;
+ testproc(str2);
+ if pinteger(pchar(pointer(str1))-2*sizeof(sizeint))^ <> 1 then
+   Halt(1);
+ if str1<>'abcde' then
+   Halt(2);  
+end.