mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-07 05:59:50 +01: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/tw2865.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw28650.pp svneol=native#text/pascal
|
tests/webtbs/tw28650.pp svneol=native#text/pascal
|
||||||
tests/webtbs/tw28674.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/tw28718a.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw28718b.pp svneol=native#text/plain
|
tests/webtbs/tw28718b.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw28718c.pp svneol=native#text/plain
|
tests/webtbs/tw28718c.pp svneol=native#text/plain
|
||||||
|
|||||||
@ -800,6 +800,10 @@ implementation
|
|||||||
procedure Tsubscriptnode.mark_write;
|
procedure Tsubscriptnode.mark_write;
|
||||||
begin
|
begin
|
||||||
include(flags,nf_write);
|
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;
|
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