mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-11 09:59:35 +01: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/tw2602.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw26069.pp svneol=native#text/plain
|
tests/webtbs/tw26069.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw2607.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/tw26123.pp svneol=native#text/pascal
|
||||||
tests/webtbs/tw26162.pp svneol=native#text/pascal
|
tests/webtbs/tw26162.pp svneol=native#text/pascal
|
||||||
tests/webtbs/tw26177.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,
|
paramanager.push_addr_param(parasym.varspez,parasym.vardef,
|
||||||
aktcallnode.procdefinition.proccalloption));
|
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
|
if pushaddr then
|
||||||
push_addr_para
|
push_addr_para
|
||||||
else
|
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