mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-04 08:58:28 +02:00
* force advanced records into memory when they are used as self, resolves #26075
git-svn-id: trunk@29139 -
This commit is contained in:
parent
016666c70f
commit
854fa1d4b9
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -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
|
||||
|
@ -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
35
tests/webtbs/tw26075.pp
Normal 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
35
tests/webtbs/tw26075b.pp
Normal 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.
|
Loading…
Reference in New Issue
Block a user