Browse Source

--- Merging r40180 into '.':
U compiler/ninl.pas
--- Recording mergeinfo for merge of r40180 into '.':
U .
--- Merging r40216 into '.':
U compiler/htypechk.pas
G compiler/ninl.pas
U tests/tbf/tb0258.pp
A tests/tbf/tb0259.pp
A tests/tbf/tb0260.pp
A tests/tbs/tb0653.pp
--- Recording mergeinfo for merge of r40216 into '.':
G .
--- Merging r40217 into '.':
U compiler/systems/t_bsd.pas
--- Recording mergeinfo for merge of r40217 into '.':
G .
--- Merging r40218 into '.':
G compiler/systems/t_bsd.pas
--- Recording mergeinfo for merge of r40218 into '.':
G .

git-svn-id: branches/fixes_3_2@44000 -

Jonas Maebe 5 years ago
parent
commit
3129605195
8 changed files with 162 additions and 12 deletions
  1. 3 0
      .gitattributes
  2. 15 2
      compiler/htypechk.pas
  3. 1 1
      compiler/ninl.pas
  4. 4 4
      compiler/systems/t_bsd.pas
  5. 18 5
      tests/tbf/tb0258.pp
  6. 30 0
      tests/tbf/tb0259.pp
  7. 27 0
      tests/tbf/tb0260.pp
  8. 64 0
      tests/tbs/tb0653.pp

+ 3 - 0
.gitattributes

@@ -11088,6 +11088,8 @@ tests/tbf/tb0256.pp svneol=native#text/pascal
 tests/tbf/tb0257a.pp svneol=native#text/pascal
 tests/tbf/tb0257b.pp svneol=native#text/pascal
 tests/tbf/tb0258.pp svneol=native#text/pascal
+tests/tbf/tb0259.pp svneol=native#text/plain
+tests/tbf/tb0260.pp svneol=native#text/plain
 tests/tbf/tb0261.pp svneol=native#text/pascal
 tests/tbf/tb0262.pp svneol=native#text/pascal
 tests/tbf/tb0263.pp svneol=native#text/pascal
@@ -11754,6 +11756,7 @@ tests/tbs/tb0648.pp svneol=native#text/pascal
 tests/tbs/tb0649.pp -text svneol=native#text/pascal
 tests/tbs/tb0650.pp svneol=native#text/pascal
 tests/tbs/tb0651.pp svneol=native#text/pascal
+tests/tbs/tb0653.pp svneol=native#text/plain
 tests/tbs/tb0654.pp svneol=native#text/plain
 tests/tbs/tb0655.pp svneol=native#text/pascal
 tests/tbs/tb0656.pp svneol=native#text/pascal

+ 15 - 2
compiler/htypechk.pas

@@ -183,7 +183,7 @@ interface
 
     { sets varsym varstate field correctly }
     type
-      tvarstateflag = (vsf_must_be_valid,vsf_use_hints);
+      tvarstateflag = (vsf_must_be_valid,vsf_use_hints,vsf_use_hint_for_string_result);
       tvarstateflags = set of tvarstateflag;
     procedure set_varstate(p:tnode;newstate:tvarstate;varstateflags:tvarstateflags);
 
@@ -1300,7 +1300,20 @@ implementation
                                begin
                                  if (vo_is_funcret in hsym.varoptions) then
                                    begin
-                                     if (vsf_use_hints in varstateflags) then
+                                     { An uninitialized function Result of a managed type needs special handling.
+                                       When passing it as a var parameter a warning need to be emitted, since a user
+                                       may expect Result to be empty (nil) by default as it happens with local vars
+                                       of a managed type. But this is not true for Result and may lead to serious issues.
+
+                                       The only exception is SetLength(Result, ?) for a string Result. A user always
+                                       expects undefined contents of the string after calling SetLength(). In such
+                                       case a hint need to be emitted.
+                                     }
+                                     if is_managed_type(hsym.vardef) then
+                                       if not ( is_string(hsym.vardef) and (vsf_use_hint_for_string_result in varstateflags) ) then
+                                         exclude(varstateflags,vsf_use_hints);
+
+                                     if vsf_use_hints in varstateflags then
                                        begin
                                          if is_managed_type(hsym.vardef) then
                                            CGMessagePos(p.fileinfo,sym_h_managed_function_result_uninitialized)

+ 1 - 1
compiler/ninl.pas

@@ -1741,7 +1741,7 @@ implementation
         { last param must be var }
         destppn:=ppn.left;
         valid_for_var(destppn,true);
-        set_varstate(destppn,vs_written,[vsf_must_be_valid]);
+        set_varstate(destppn,vs_written,[vsf_must_be_valid,vsf_use_hints,vsf_use_hint_for_string_result]);
         { first param must be a string or dynamic array ...}
         isarray:=is_dynamic_array(destppn.resultdef);
         if not((destppn.resultdef.typ=stringdef) or

+ 4 - 4
compiler/systems/t_bsd.pas

@@ -459,14 +459,14 @@ Function TLinkerBSD.GetDarwinPrtobjName(isdll: boolean): TCmdStr;
 var
   startupfile: TCmdStr;
 begin
+  result:='';
+
   startupfile:=GetDarwinCrt1ObjName(isdll);
   if startupfile<>'' then
     begin
      if not librarysearchpath.FindFile(startupfile,false,result) then
-       result:='/usr/lib/'+startupfile
-    end
-  else
-    result:='';
+       result:='/usr/lib/'+startupfile;
+    end;
   result:=maybequoted(result);
 end;
 

+ 18 - 5
tests/tbf/tb0258.pp

@@ -1,13 +1,26 @@
 { %fail% }
 { %opt=-Sew -vw -O- }
 
-procedure p;
-var
-  a : array of longint;
+{
+  Test for correct emitting of warnings/hints for uninitialized variables of management types
+  See also tbs/tb0653.pp, tbf/tb0259.pp, tbf/tb0260.pp
+}
+
+// This code must issue warnings "Function result variable of a managed type does not seem to be initialized".
+
+{$mode objfpc}
+
+type
+  TLongArray = array of longint;
+
+function f: TLongArray;
 begin
-  setlength(a,100);
+  // Warning for the dyn array Result, since contents of the Result after calling SetLength()
+  // is expected to be zeroed, but instead it is undefined.
+  setlength(Result,100);
+  Result[2]:=1;
 end;
 
 begin
+  f;
 end.
-

+ 30 - 0
tests/tbf/tb0259.pp

@@ -0,0 +1,30 @@
+{ %fail% }
+{ %opt=-Sew -vw -O- }
+
+{
+  Test for correct emitting of warnings/hints for uninitialized variables of management types
+  See also tbf/tb0258.pp
+}
+
+// This code must issue warnings "Function result variable of a managed type does not seem to be initialized".
+
+{$mode objfpc}
+
+type
+  TLongArray = array of longint;
+
+procedure fvar(var a: TLongArray);
+begin
+  setlength(a,100);
+  a[2]:=1;
+end;
+
+function f: TLongArray;
+begin
+  // Warning for the dyn array Result, since initial contents of the Result is undefined.
+  fvar(Result);
+end;
+
+begin
+  f;
+end.

+ 27 - 0
tests/tbf/tb0260.pp

@@ -0,0 +1,27 @@
+{ %fail% }
+{ %opt=-Sew -vw -O- }
+
+{
+  Test for correct emitting of warnings/hints for uninitialized variables of management types
+  See also tbf/tb0258.pp
+}
+
+// This code must issue warnings "Function result variable of a managed type does not seem to be initialized".
+
+{$mode objfpc}
+
+procedure fvar(var a: ansistring);
+begin
+  setlength(a,100);
+  a[2]:='a';
+end;
+
+function f: ansistring;
+begin
+  // Warning for the ansistring Result, since initial contents of the Result is undefined.
+  fvar(Result);
+end;
+
+begin
+  f;
+end.

+ 64 - 0
tests/tbs/tb0653.pp

@@ -0,0 +1,64 @@
+{ %norun }
+{ %opt=-Sewn -vwn -O- }
+
+{
+  Test for correct emitting of warnings/hints for uninitialized variables of management types
+  See also tbf/tb0258.pp
+}
+
+// Only hints about uninitialized managed variables must be issued for this code
+
+{$mode objfpc}
+
+type
+  TLongArray = array of longint;
+
+procedure p;
+var
+  a : TLongArray;
+  s: ansistring;
+begin
+  setlength(a,100);  // hint for local var
+  setlength(s,100);  // hint for local var
+  a[1]:=1;
+  writeln(a[1]);
+  s[1]:='a';
+  writeln(s[1]);
+end;
+
+procedure svar(var s: ansistring; len: longint);
+begin
+  setlength(s,len);
+end;
+
+procedure avar(var a: TLongArray; len: longint);
+begin
+  setlength(a,len);
+end;
+
+procedure p2;
+var
+  a : TLongArray;
+  s: ansistring;
+begin
+  avar(a,100);  // hint for local var
+  svar(s,100);  // hint for local var
+  a[1]:=1;
+  writeln(a[1]);
+  s[1]:='a';
+  writeln(s[1]);
+end;
+
+function f2: ansistring;
+begin
+  // Hint for the ansistring Result, since all contents of the Result
+  // after calling SetLength() is expected to be undefined.
+  setlength(Result,1);
+  Result[1]:='a';
+end;
+
+begin
+  p;
+  p2;
+  f2;
+end.