paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-08 08:28:09 +02:00
Code Issues Packages Projects Releases Wiki Activity

* don't make a deep copy of records (and in the future, objects) in with-

Browse Source 
statements on the JVM target (mantis #24089)

git-svn-id: trunk@23945 -
This commit is contained in:
Jonas Maebe 2013-03-20 16:23:25 +00:00
parent 376bd046aa
commit e621bff943
5 changed files with 79 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -10531,6 +10531,7 @@ tests/test/jvm/tvarpara.pp svneol=native#text/plain
tests/test/jvm/tvirtclmeth.pp svneol=native#text/plain
tests/test/jvm/tw20212.pp svneol=native#text/plain
tests/test/jvm/tw22807.pp svneol=native#text/plain
tests/test/jvm/tw24089.pp svneol=native#text/plain
tests/test/jvm/twith.pp svneol=native#text/plain
tests/test/jvm/uenum.pp svneol=native#text/plain
tests/test/jvm/unsupported.pp svneol=native#text/plain

13
compiler/pstatmnt.pas
View File

@ -633,8 +633,17 @@ implementation
typecheckpass(p);
end;
{ several object types have implicit dereferencing }
hasimplicitderef:=is_implicit_pointer_object_type(p.resultdef) or
(p.resultdef.typ = classrefdef);
{ is_implicit_pointer_object_type() returns true for records
on the JVM target because they are implemented as classes
there, but we definitely have to take their address here
since otherwise a deep copy is made and changes are made to
this copy rather than to the original one }
hasimplicitderef:=
(is_implicit_pointer_object_type(p.resultdef) or
(p.resultdef.typ=classrefdef)) and
not((target_info.system in systems_jvm) and
((p.resultdef.typ=recorddef) or
is_object(p.resultdef)));
if hasimplicitderef then
hdef:=p.resultdef
else

4
tests/test/jvm/testall.bat
View File

@ -258,3 +258,7 @@ ppcjvm -O2 -g -B -CTautogetterprefix=Get tprop4.pp
if %errorlevel% neq 0 exit /b %errorlevel%
java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. -Sa tprop4
if %errorlevel% neq 0 exit /b %errorlevel%
ppcjvm -O2 -g -B tw24089
if %errorlevel% neq 0 exit /b %errorlevel%
java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. -Sa tw24089
if %errorlevel% neq 0 exit /b %errorlevel%

2
tests/test/jvm/testall.sh
View File

@ -144,4 +144,6 @@ java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/$RTLDIR:. ttincdec
$PPC -O2 -g -B -CTautogetterprefix=Get tprop3
$PPC -O2 -g -B -CTautogetterprefix=Get tprop4
java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/$RTLDIR:. tprop4
$PPC -O2 -g -B -Sa tw24089
java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/$RTLDIR:. tw24089

61
tests/test/jvm/tw24089.pp Normal file
View File

@ -0,0 +1,61 @@
program tw24089;
{ %VERSION=1.1 }
{$ifdef fpc}
{$mode objfpc}
{$endif}
{$ifdef cpujvm}
uses
{$ifdef java}jdk15{$else}androidr14{$endif};
{$macro on}
{$define writeln:=jlsystem.fout.println}
{$define write:=jlsystem.fout.println}
{$endif}
type
TRec1tw24089 = record
a: integer;
end;
TRec2tw24089 = record
i: integer;
Rec1: TRec1tw24089;
end;
TMyClasstw24089 = class
protected
Data: TRec2tw24089;
public
procedure Test;
end;
procedure TMyClasstw24089.Test;
var
LocData: TRec2tw24089;
begin
{
with LocData do
Rec1.a := 1;
writeln(LocData.Rec1.a); // success it shows 1
LocData.Rec1.a := 2;
writeln(LocData.Rec1.a); // success it shows 2
}
with Data do
Rec1.a := 3;
writeln(Data.Rec1.a); // !!FAIL!!, it shows 0
if Data.Rec1.a <> 3 then
halt(1);
{
Data.Rec1.a := 4;
writeln(Data.Rec1.a); // success it shows 4
}
end;
begin
with TMyClasstw24089.Create do
Test;
end.