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

* fix #40655: apply changes to packrecords, packenum and setalloc using the recordpending*() functions so that they are applied correctly in case of them being used directly after a {$POP}{$PUSH} sequence

Browse Source 
+ added test
This commit is contained in:
Sven/Sarah Barth 2024-02-20 23:51:29 +01:00
parent bccc0b195e
commit 5c890b59e3
3 changed files with 60 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
compiler/scandir.pas
View File

@ -1146,16 +1146,16 @@ unit scandir;
begin begin
hs:=current_scanner.readid; hs:=current_scanner.readid;
if (hs='NORMAL') or (hs='DEFAULT') then if (hs='NORMAL') or (hs='DEFAULT') then
current_settings.packenum:=4 recordpendingpackenum(4)
else else
Message1(scan_e_illegal_pack_enum, hs); Message1(scan_e_illegal_pack_enum, hs);
end end
else else
begin begin
case current_scanner.readval of case current_scanner.readval of
1 : current_settings.packenum:=1; 1 : recordpendingpackenum(1);
2 : current_settings.packenum:=2; 2 : recordpendingpackenum(2);
4 : current_settings.packenum:=4; 4 : recordpendingpackenum(4);
else else
Message1(scan_e_illegal_pack_enum, pattern); Message1(scan_e_illegal_pack_enum, pattern);
end; end;
@ -1184,22 +1184,22 @@ unit scandir;
hs:=current_scanner.readid; hs:=current_scanner.readid;
{ C has the special recordalignmax of C_alignment } { C has the special recordalignmax of C_alignment }
if (hs='C') then if (hs='C') then
current_settings.packrecords:=C_alignment recordpendingpackrecords(C_alignment)
else else
if (hs='NORMAL') or (hs='DEFAULT') then if (hs='NORMAL') or (hs='DEFAULT') then
current_settings.packrecords:=default_settings.packrecords recordpendingpackrecords(default_settings.packrecords)
else else
Message1(scan_e_illegal_pack_records,hs); Message1(scan_e_illegal_pack_records,hs);
end end
else else
begin begin
case current_scanner.readval of case current_scanner.readval of
1 : current_settings.packrecords:=1; 1 : recordpendingpackrecords(1);
2 : current_settings.packrecords:=2; 2 : recordpendingpackrecords(2);
4 : current_settings.packrecords:=4; 4 : recordpendingpackrecords(4);
8 : current_settings.packrecords:=8; 8 : recordpendingpackrecords(8);
16 : current_settings.packrecords:=16; 16 : recordpendingpackrecords(16);
32 : current_settings.packrecords:=32; 32 : recordpendingpackrecords(32);
else else
Message1(scan_e_illegal_pack_records,pattern); Message1(scan_e_illegal_pack_records,pattern);
end; end;
@ -1216,17 +1216,17 @@ unit scandir;
begin begin
hs:=current_scanner.readid; hs:=current_scanner.readid;
if (hs='FIXED') or (hs='DEFAULT') OR (hs='NORMAL') then if (hs='FIXED') or (hs='DEFAULT') OR (hs='NORMAL') then
current_settings.setalloc:=0 {Fixed mode, sets are 4 or 32 bytes} recordpendingsetalloc(0) {Fixed mode, sets are 4 or 32 bytes}
else else
Message(scan_e_only_packset); Message(scan_e_only_packset);
end end
else else
begin begin
case current_scanner.readval of case current_scanner.readval of
1 : current_settings.setalloc:=1; 1 : recordpendingsetalloc(1);
2 : current_settings.setalloc:=2; 2 : recordpendingsetalloc(2);
4 : current_settings.setalloc:=4; 4 : recordpendingsetalloc(4);
8 : current_settings.setalloc:=8; 8 : recordpendingsetalloc(8);
else else
Message(scan_e_only_packset); Message(scan_e_only_packset);
end; end;

10
compiler/switches.pas
View File

@ -174,10 +174,12 @@ begin
begin begin
case typesw of case typesw of
alignsw: alignsw:
if state='+' then begin
current_settings.packrecords:=4 if state='+' then
else recordpendingpackrecords(4)
current_settings.packrecords:=1; else
recordpendingpackrecords(1);
end;
optimizersw : optimizersw :
begin begin
if state='+' then if state='+' then

37
tests/webtbs/tw40655.pp Normal file
View File

@ -0,0 +1,37 @@
{ %NORUN }
program tw40655;
type
MIDITimeStamp = UInt64;
{$push}
{$packrecords 4}
MIDIPacket = record
timeStamp: MIDITimeStamp;
length: UInt16;
data: packed array [0..255] of Byte;
end;
MIDIPacketPtr = ^MIDIPacket;
{$pop}
{$push}
{$packrecords 4}
MIDIPacketList = record
numPackets: UInt32;
packet: array [0..0] of MIDIPacket;
end;
{$pop}
{$if SizeOf(MIDIPacket) <> 268}
{$message fatal 'Size of MIDIPacket is not 268'}
{$endif}
{$if SizeOf(MIDIPacketList) <> 272}
{$message fatal 'Size of MIDIPacketList is not 272'}
{$endif}
begin
end.