mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-11-04 10:39:40 +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/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