paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-02 14:21:36 +01:00
Code Issues Packages Projects Releases Wiki Activity

- removed gotderef from valid_for_assign(), and return true at every place

Browse Source 
where it used to be set to true (dereferencing a pointer always means
    that regardless of what the pointer was, the resut is assignable)
    (mantis #22979)
   o also removed gotpointer, since it was only used in combination with
     gotderef

git-svn-id: trunk@35308 -
This commit is contained in:
Jonas Maebe 2017-01-15 16:32:51 +00:00
parent 99a1847e2f
commit 382bbc1201
3 changed files with 59 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -14864,6 +14864,7 @@ tests/webtbs/tw22936.pp svneol=native#text/pascal
tests/webtbs/tw2294.pp svneol=native#text/plain
tests/webtbs/tw2296.pp svneol=native#text/plain
tests/webtbs/tw22964.pp svneol=native#text/pascal
tests/webtbs/tw22979.pp svneol=native#text/plain
tests/webtbs/tw22992.pp svneol=native#text/pascal
tests/webtbs/tw2300.pp svneol=native#text/plain
tests/webtbs/tw2305.pp svneol=native#text/plain

85
compiler/htypechk.pas
View File

@ -1298,11 +1298,9 @@ implementation
gotstring,
gotsubscript,
gotrecord,
gotpointer,
gotvec,
gotclass,
gotdynarray,
gotderef,
gottypeconv : boolean;
fromdef,
todef : tdef;
@ -1313,7 +1311,7 @@ implementation
begin
result:=false;
{ allow p^:= constructions with p is const parameter }
if gotderef or gotdynarray or (Valid_Const in opts) or
if gotdynarray or (Valid_Const in opts) or
((hp.nodetype=loadn) and
(loadnf_isinternal_ignoreconst in tloadnode(hp).loadnodeflags)) then
result:=true
@ -1361,10 +1359,8 @@ implementation
result:=false;
gotsubscript:=false;
gotvec:=false;
gotderef:=false;
gotrecord:=false;
gotclass:=false;
gotpointer:=false;
gotdynarray:=false;
gotstring:=false;
gottypeconv:=false;
@ -1384,8 +1380,6 @@ implementation
begin
{ check return type }
case hp.resultdef.typ of
pointerdef :
gotpointer:=true;
objectdef :
gotclass:=is_implicit_pointer_object_type(hp.resultdef);
recorddef :
@ -1401,8 +1395,6 @@ implementation
temps like calls that return a structure and we
are assigning to a member }
if (valid_const in opts) or
{ if we got a deref, we won't modify the property itself }
(gotderef) or
{ same when we got a class and subscript (= deref) }
(gotclass and gotsubscript) or
{ indexing a dynamic array = dereference }
@ -1433,8 +1425,7 @@ implementation
{ 1. if it returns a pointer and we've found a deref,
2. if it returns a class and a subscription or with is found
3. if the address is needed of a field (subscriptn, vecn) }
if (gotpointer and gotderef) or
(gotstring and gotvec) or
if (gotstring and gotvec) or
(gotclass and gotsubscript) or
(
(gotvec and gotdynarray)
@ -1460,8 +1451,10 @@ implementation
end;
derefn :
begin
gotderef:=true;
hp:=tderefnode(hp).left;
{ dereference -> always valid }
valid_for_assign:=true;
mayberesettypeconvs;
exit;
end;
typeconvn :
begin
@ -1476,9 +1469,8 @@ implementation
todef:=hp.resultdef;
{ typeconversions on the assignment side must keep
left.location the same }
if not(gotderef or
((target_info.system in systems_jvm) and
(gotsubscript or gotvec))) then
if not((target_info.system in systems_jvm) and
(gotsubscript or gotvec)) then
begin
ttypeconvnode(hp).assignment_side:=true;
if not assigned(typeconvs) then
@ -1526,7 +1518,7 @@ implementation
end;
{ don't allow assignments to typeconvs that need special code }
if not(gotsubscript or gotvec or gotderef) and
if not(gotsubscript or gotvec) and
not(ttypeconvnode(hp).assign_allowed) then
begin
if report_errors then
@ -1535,8 +1527,6 @@ implementation
exit;
end;
case hp.resultdef.typ of
pointerdef :
gotpointer:=true;
objectdef :
gotclass:=is_implicit_pointer_object_type(hp.resultdef);
classrefdef :
@ -1546,7 +1536,11 @@ implementation
{ pointer -> array conversion is done then we need to see it
as a deref, because a ^ is then not required anymore }
if ttypeconvnode(hp).convtype=tc_pointer_2_array then
gotderef:=true;
begin
valid_for_assign:=true;
mayberesettypeconvs;
exit
end;
end;
end;
hp:=ttypeconvnode(hp).left;
@ -1592,7 +1586,7 @@ implementation
begin
{ asn can't be assigned directly, it returns the value in a register instead
of reference. }
if not(gotsubscript or gotderef or gotvec) then
if not(gotsubscript or gotvec) then
begin
if report_errors then
CGMessagePos(hp.fileinfo,errmsg);
@ -1632,7 +1626,6 @@ implementation
subscript operation (to a temp location, so the assignment
will happen to the temp and be lost) }
if not gotsubscript and
not gotderef and
not gotvec and
not tstoreddef(hp.resultdef).is_intregable then
make_not_regable(hp,[ra_addr_regable]);
@ -1650,7 +1643,11 @@ implementation
{ implicit pointer object types result in dereferencing }
hp:=tsubscriptnode(hp).left;
if is_implicit_pointer_object_type(hp.resultdef) then
gotderef:=true;
begin
valid_for_assign:=true;
mayberesettypeconvs;
exit
end;
end;
muln,
divn,
@ -1661,20 +1658,13 @@ implementation
subn,
addn :
begin
{ Allow operators on a pointer, or on an integer
if a pointer typecast and deref have been found }
if ((hp.resultdef.typ=pointerdef) or
(is_integer(hp.resultdef) and gotpointer)) and
gotderef then
result:=true
else
{ Temp strings are stored in memory, for compatibility with
delphi only }
if (m_delphi in current_settings.modeswitches) and
((valid_addr in opts) or
(valid_const in opts)) and
(hp.resultdef.typ=stringdef) then
result:=true
if (m_delphi in current_settings.modeswitches) and
((valid_addr in opts) or
(valid_const in opts)) and
(hp.resultdef.typ=stringdef) then
result:=true
else
if report_errors then
CGMessagePos(hp.fileinfo,type_e_variable_id_expected);
@ -1684,11 +1674,7 @@ implementation
niln,
pointerconstn :
begin
{ to support e.g. @tmypointer(0)^.data; see tests/tbs/tb0481 }
if gotderef then
result:=true
else
if report_errors then
if report_errors then
CGMessagePos(hp.fileinfo,type_e_no_assign_to_addr);
mayberesettypeconvs;
exit;
@ -1717,10 +1703,7 @@ implementation
end;
addrn :
begin
if gotderef then
result:=true
else
if report_errors then
if report_errors then
CGMessagePos(hp.fileinfo,type_e_no_assign_to_addr);
mayberesettypeconvs;
exit;
@ -1740,12 +1723,11 @@ implementation
if is_dynamic_array(hp.resultdef) and
gotvec then
begin
gotderef:=true;
gotpointer:=true;
valid_for_assign:=true;
mayberesettypeconvs;
exit;
end;
end;
pointerdef :
gotpointer:=true;
objectdef :
gotclass:=is_implicit_pointer_object_type(hp.resultdef);
recorddef, { handle record like class it needs a subscription }
@ -1754,11 +1736,9 @@ implementation
stringdef :
gotstring:=true;
end;
{ 1. if it returns a pointer and we've found a deref,
2. if it returns a class or record and a subscription or with is found
3. string is returned }
{ 1. string element is returned
2. if it returns a class or record and a subscription or with is found }
if (gotstring and gotvec) or
(gotpointer and gotderef) or
(gotclass and gotsubscript) then
result:=true
else
@ -1837,7 +1817,6 @@ implementation
begin
{ loop counter? }
if not(Valid_Const in opts) and
not gotderef and
(vo_is_loop_counter in tabstractvarsym(tloadnode(hp).symtableentry).varoptions) then
begin
if report_errors then

26
tests/webtbs/tw22979.pp Normal file
View File

@ -0,0 +1,26 @@
{ %norun }
{$mode objfpc}
type
TMyRecord = record
Data: pointer;
end;
TMyClass = class
private
FRef: TMyRecord;
public
property Ref: TMyRecord read FRef write FRef;
end;
var
MyClass1, MyClass2: TMyClass;
procedure test;
begin
Move(MyClass1.Ref.Data^, MyClass2.Ref.Data^, 1);
end;
begin
end.