Forráskód Böngészése

* set nf_write flag correctly for subscript nodes, resolves issue #28713

git-svn-id: trunk@32602 -
florian 9 éve
szülő
commit
cad29a4e19
4 módosított fájl, 67 hozzáadás és 0 törlés
  1. 2 0
      .gitattributes
  2. 4 0
      compiler/nmem.pas
  3. 30 0
      tests/webtbs/tw28713.pp
  4. 31 0
      tests/webtbs/tw28713b.pp

+ 2 - 0
.gitattributes

@@ -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

+ 4 - 0
compiler/nmem.pas

@@ -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 - 0
tests/webtbs/tw28713.pp

@@ -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 - 0
tests/webtbs/tw28713b.pp

@@ -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.