* ensure that managed out-parameters are processed before any other

parameters:
   1) since they are finalised on the caller side, if that same value
      is passed as a value parameter as well and its reference count
      was 1, then the value parameter will contain an invalid pointer
   2) since finalisation involves a call, for optimal code generation
      purposes they should also be evaluated first
    (mantis #28279, #28390)

git-svn-id: trunk@31201 -

.gitattributes

@@ -14524,6 +14524,7 @@ tests/webtbs/tw2812.pp svneol=native#text/plain
 tests/webtbs/tw2815.pp svneol=native#text/plain
 tests/webtbs/tw2817.pp svneol=native#text/plain
 tests/webtbs/tw28271.pp svneol=native#text/pascal
+tests/webtbs/tw28279.pp svneol=native#text/plain
 tests/webtbs/tw2829.pp svneol=native#text/plain
 tests/webtbs/tw2830.pp svneol=native#text/plain
 tests/webtbs/tw28313.pp -text svneol=native#text/plain

compiler/ncal.pas

@@ -3768,11 +3768,12 @@ implementation
             hpnext:=tcallparanode(hpcurr.right);
             { pull in at the correct place.
               Used order:
-                1. LOC_REFERENCE with smallest offset (i386 only)
-                2. LOC_REFERENCE with least complexity (non-i386 only)
-                3. LOC_REFERENCE with most complexity (non-i386 only)
-                4. LOC_REGISTER with most complexity
-                5. LOC_REGISTER with least complexity
+                1. vs_out for a reference-counted type
+                2. LOC_REFERENCE with smallest offset (i386 only)
+                3. LOC_REFERENCE with least complexity (non-i386 only)
+                4. LOC_REFERENCE with most complexity (non-i386 only)
+                5. LOC_REGISTER with most complexity
+                6. LOC_REGISTER with least complexity
               For the moment we only look at the first parameter field. Combining it
               with multiple parameter fields will make things a lot complexer (PFV)
 
@@ -3802,8 +3803,18 @@ implementation
               them from keeping on chasing eachother's tail }
             while assigned(hp) do
               begin
+                { ensure that out parameters are finalised before other
+                  parameters are processed, so that in case it has a reference
+                  count of one and is also passed as a value parameter, the
+                  value parameter does not get passed a pointer to a freed
+                  memory block }
+                if (hpcurr.parasym.varspez=vs_out) and
+                   is_managed_type(hpcurr.parasym.vardef) then
+                  break;
                 if paramanager.use_fixed_stack and
-                   hpcurr.contains_stack_tainting_call_cached then
+                   hpcurr.contains_stack_tainting_call_cached and
+                   not((hp.parasym.varspez=vs_out) and
+                       is_managed_type(hp.parasym.vardef)) then
                   break;
                 case currloc of
                   LOC_REFERENCE :

tests/webtbs/tw28279.pp

@@ -0,0 +1,58 @@
+{$mode objfpc}
+
+program Project1;
+
+var
+  value_para_must_be_empty: boolean;
+
+procedure Foo1(a: AnsiString; out b: AnsiString);
+begin
+  WriteLn(length(a));  WriteLn(length(b));
+  if value_para_must_be_empty and
+     (a<>'') then
+    halt(2);
+  if b<>'' then
+    halt(3);
+  b := 'a';
+end;
+
+procedure Foo2(out a: AnsiString; b: AnsiString);
+begin
+  WriteLn(length(a));  WriteLn(length(b));
+  if a<>'' then
+    halt(4);
+  if value_para_must_be_empty and
+     (b<>'') then
+    halt(5);
+  b := 'a';
+end;
+
+var s1: AnsiString;
+
+function f: ansistring;
+begin
+  { the s1 parameter must be finalised first to prevent accidental use of
+    the finalised value }
+  if s1<>'' then
+    halt(1);
+  f:='a';
+  f:=f+'b';
+end;
+
+const x: AnsiString = 'abcde';
+begin
+  value_para_must_be_empty:=true;
+
+  s1 := copy(x,2,3)+'x';
+  Foo1(s1,s1);
+
+  s1 := copy(x,2,3)+'x';
+  Foo2(s1,s1);
+
+  value_para_must_be_empty:=false;
+  s1 := copy(x,2,3)+'x';
+  Foo1(f,s1);
+
+  s1 := copy(x,2,3)+'x';
+  Foo2(s1,f);
+end.