* force advanced records into memory when they are used as self, resolves #26075

git-svn-id: trunk@29139 -
This commit is contained in:
florian 2014-11-23 22:05:40 +00:00
parent 016666c70f
commit 854fa1d4b9
4 changed files with 76 additions and 0 deletions

2
.gitattributes vendored
View File

@ -14079,6 +14079,8 @@ tests/webtbs/tw25959.pp svneol=native#text/pascal
tests/webtbs/tw2602.pp svneol=native#text/plain
tests/webtbs/tw26069.pp svneol=native#text/plain
tests/webtbs/tw2607.pp svneol=native#text/plain
tests/webtbs/tw26075.pp svneol=native#text/pascal
tests/webtbs/tw26075b.pp svneol=native#text/pascal
tests/webtbs/tw26123.pp svneol=native#text/pascal
tests/webtbs/tw26162.pp svneol=native#text/pascal
tests/webtbs/tw26177.pp svneol=native#text/pascal

View File

@ -325,6 +325,10 @@ implementation
paramanager.push_addr_param(parasym.varspez,parasym.vardef,
aktcallnode.procdefinition.proccalloption));
{ objects or advanced records could be located in registers if they are the result of a type case, see e.g. webtbs\tw26075.pp }
if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
hlcg.location_force_mem(current_asmdata.CurrAsmList,left.location,left.resultdef);
if pushaddr then
push_addr_para
else

35
tests/webtbs/tw26075.pp Normal file
View File

@ -0,0 +1,35 @@
program fpc_advrec_bug;
{$mode delphi}
{$optimization off}
Uses TypInfo;
Type
PTypeInfoRec = Record
FValue : PTypeInfo;
Function QualifiedName : String;
End;
Function PTypeInfoRec.QualifiedName : String;
Begin
Result := '';
End;
function Test : Pointer;
Begin
Result := nil;
End;
Var
p : PTypeInfo;
begin
PTypeInfoRec(p).QualifiedName; // OK
PTypeInfoRec(Test).QualifiedName; // OK
PTypeInfoRec(TypeInfo(String)).QualifiedName; // Internal error 200304235
end.

35
tests/webtbs/tw26075b.pp Normal file
View File

@ -0,0 +1,35 @@
program fpc_advrec_bug;
{$mode delphi}
{$optimization off}
Uses TypInfo;
Type
PTypeInfoRec = object
FValue : PTypeInfo;
Function QualifiedName : String;
End;
Function PTypeInfoRec.QualifiedName : String;
Begin
Result := '';
End;
function Test : Pointer;
Begin
Result := nil;
End;
Var
p : PTypeInfo;
begin
PTypeInfoRec(p).QualifiedName; // OK
PTypeInfoRec(Test).QualifiedName; // OK
PTypeInfoRec(TypeInfo(String)).QualifiedName; // Internal error 200304235
end.