--- 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 -
This commit is contained in:
Jonas Maebe 2020-01-19 19:20:31 +00:00
parent b715259e5a
commit 3129605195
8 changed files with 162 additions and 12 deletions

3
.gitattributes vendored
View File

@ -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

View File

@ -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)

View File

@ -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

View File

@ -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;

View File

@ -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
tests/tbf/tb0259.pp Normal file
View File

@ -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
tests/tbf/tb0260.pp Normal file
View File

@ -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
tests/tbs/tb0653.pp Normal file
View File

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