mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-17 10:19:28 +02:00
* set nf_write flag correctly for subscript nodes, resolves issue #28713
git-svn-id: trunk@32602 -
This commit is contained in:
parent
60070169bb
commit
cad29a4e19
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -14857,6 +14857,8 @@ tests/webtbs/tw28632.pp -text svneol=native#text/plain
|
||||
tests/webtbs/tw2865.pp svneol=native#text/plain
|
||||
tests/webtbs/tw28650.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw28674.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw28713.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw28713b.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw28718a.pp svneol=native#text/plain
|
||||
tests/webtbs/tw28718b.pp svneol=native#text/plain
|
||||
tests/webtbs/tw28718c.pp svneol=native#text/plain
|
||||
|
@ -800,6 +800,10 @@ implementation
|
||||
procedure Tsubscriptnode.mark_write;
|
||||
begin
|
||||
include(flags,nf_write);
|
||||
{ if an element of a record is written, then the whole record is changed/it is written to it,
|
||||
for data types being implicit pointers this does not apply as the object itself does not change }
|
||||
if not(is_implicit_pointer_object_type(left.resultdef)) then
|
||||
left.mark_write;
|
||||
end;
|
||||
|
||||
|
||||
|
30
tests/webtbs/tw28713.pp
Normal file
30
tests/webtbs/tw28713.pp
Normal file
@ -0,0 +1,30 @@
|
||||
{ %OPT=-O3 }
|
||||
// Compiled with option -O3 for Win32-I386
|
||||
|
||||
type
|
||||
PWordArray = ^TWordArray;
|
||||
TWordArray = array [0..1023]of Word;
|
||||
|
||||
WordRec = packed record
|
||||
LoByte,HiByte:Byte
|
||||
end;
|
||||
|
||||
var
|
||||
Buffer:TWordArray;
|
||||
OldMousePos:LongInt = 0;
|
||||
ScreenBuffer:Pointer = @Buffer;
|
||||
|
||||
procedure Show(ScreenBuffer:Pointer);
|
||||
begin
|
||||
WordRec(PWordArray(ScreenBuffer)^[OldMousePos]).HiByte:=(not
|
||||
WordRec(PWordArray(ScreenBuffer)^[OldMousePos]).HiByte)and $7F
|
||||
// he forgets to write the result into the array
|
||||
end;
|
||||
|
||||
begin
|
||||
Buffer[0]:=$0000;
|
||||
Show(ScreenBuffer);
|
||||
if Buffer[0]<>$7F00 then
|
||||
halt(1);
|
||||
writeln('ok');
|
||||
end.
|
31
tests/webtbs/tw28713b.pp
Normal file
31
tests/webtbs/tw28713b.pp
Normal file
@ -0,0 +1,31 @@
|
||||
{ %OPT=-O3 }
|
||||
{$mode objfpc}
|
||||
// Compiled with option -O3 for Win32-I386
|
||||
|
||||
type
|
||||
PWordArray = ^TWordArray;
|
||||
TWordArray = array [0..1023]of LongWord;
|
||||
|
||||
TMyclass = class
|
||||
LoByte,HiByte:Byte
|
||||
end;
|
||||
|
||||
var
|
||||
Buffer:TWordArray;
|
||||
OldMousePos:LongInt = 0;
|
||||
ScreenBuffer:Pointer = @Buffer;
|
||||
|
||||
procedure Show(ScreenBuffer:Pointer);
|
||||
begin
|
||||
TMyClass(PWordArray(ScreenBuffer)^[OldMousePos]).HiByte:=(not
|
||||
TMyClass(PWordArray(ScreenBuffer)^[OldMousePos]).HiByte)and $7F
|
||||
// he forgets to write the result into the array
|
||||
end;
|
||||
|
||||
begin
|
||||
TMyClass(Buffer[0]):=TMyClass.Create;
|
||||
Show(ScreenBuffer);
|
||||
if TMyClass(Buffer[0]).HiByte<>$7F then
|
||||
halt(1);
|
||||
writeln('ok');
|
||||
end.
|
Loading…
Reference in New Issue
Block a user