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

* Improve Test_Double_checksum with Test_Double_checksum_write CRC testing code.

Browse Source 
Pass the three checksum arrays from ppufile to module owner,
    to be able to check that the checksums computed at the time pf ppu writing
    are compatible with the ones computed at interface level.

git-svn-id: trunk@47626 -
This commit is contained in:
pierre 2020-11-28 18:32:46 +00:00
parent 82957ec5a3
commit 8e13adad4c
2 changed files with 116 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

93
compiler/fppu.pas
View File

@ -1516,19 +1516,41 @@ var
if (cs_fp_emulation in current_settings.moduleswitches) then if (cs_fp_emulation in current_settings.moduleswitches) then
headerflags:=headerflags or uf_fpu_emulation; headerflags:=headerflags or uf_fpu_emulation;
{$endif cpufpemu} {$endif cpufpemu}
{$ifdef Test_Double_checksum_write}
if FileExists(ppufilename+'.IMP',false) then
RenameFile(ppufilename+'.IMP',ppufilename+'.IMP-old');
Assign(CRCFile,ppufilename+'.IMP');
Rewrite(CRCFile);
Writeln(CRCFile,'CRC in writeppu method of implementation of ',ppufilename);
{$endif def Test_Double_checksum_write}
{ create new ppufile } { create new ppufile }
ppufile:=tcompilerppufile.create(ppufilename); ppufile:=tcompilerppufile.create(ppufilename);
if not ppufile.createfile then if not ppufile.createfile then
Message(unit_f_ppu_cannot_write); Message(unit_f_ppu_cannot_write);
{$ifdef Test_Double_checksum_write}
{ Re-use the values collected in .INT part }
if assigned(interface_crc_array) then
begin
ppufile.implementation_write_crc_index:=implementation_write_crc_index;
ppufile.interface_write_crc_index:=interface_write_crc_index;
ppufile.indirect_write_crc_index:=indirect_write_crc_index;
if assigned(ppufile.interface_crc_array) then
begin
dispose(ppufile.interface_crc_array);
ppufile.interface_crc_array:=interface_crc_array;
end;
if assigned(ppufile.implementation_crc_array) then
begin
dispose(ppufile.implementation_crc_array);
ppufile.implementation_crc_array:=implementation_crc_array;
end;
if assigned(ppufile.indirect_crc_array) then
begin
dispose(ppufile.indirect_crc_array);
ppufile.indirect_crc_array:=indirect_crc_array;
end;
end;
if FileExists(ppufilename+'.IMP',false) then
RenameFile(ppufilename+'.IMP',ppufilename+'.IMP-old');
Assign(ppufile.CRCFile,ppufilename+'.IMP');
Rewrite(ppufile.CRCFile);
Writeln(ppufile.CRCFile,'CRC in writeppu method of implementation of ',ppufilename,' defsgeneration=',defsgeneration);
{$endif def Test_Double_checksum_write}
{ extra header (sub version, module flags) } { extra header (sub version, module flags) }
writeextraheader; writeextraheader;
@ -1689,14 +1711,15 @@ var
indirect_crc:=ppufile.indirect_crc; indirect_crc:=ppufile.indirect_crc;
{$ifdef Test_Double_checksum_write} {$ifdef Test_Double_checksum_write}
Writeln(CRCFile,'End of implementation CRC in writeppu method of ',ppufilename, Writeln(ppufile.CRCFile,'End of implementation CRC in writeppu method of ',ppufilename,
' implementation_crc=$',hexstr(ppufile.crc,8), ' implementation_crc=$',hexstr(ppufile.crc,8),
' interface_crc=$',hexstr(ppufile.interface_crc,8), ' interface_crc=$',hexstr(ppufile.interface_crc,8),
' indirect_crc=$',hexstr(ppufile.indirect_crc,8), ' indirect_crc=$',hexstr(ppufile.indirect_crc,8),
' implementation_crc_size=',ppufile.implementation_read_crc_index, ' implementation_crc_size=',ppufile.implementation_read_crc_index,
' interface_crc_size=',ppufile.interface_read_crc_index, ' interface_crc_size=',ppufile.interface_read_crc_index,
' indirect_crc_size=',ppufile.indirect_read_crc_index); ' indirect_crc_size=',ppufile.indirect_read_crc_index,
close(CRCFile); ' defsgeneration=',defsgeneration);
close(ppufile.CRCFile);
{$endif Test_Double_checksum_write} {$endif Test_Double_checksum_write}
ppufile.closefile; ppufile.closefile;
@ -1707,13 +1730,6 @@ var
procedure tppumodule.getppucrc; procedure tppumodule.getppucrc;
begin begin
{$ifdef Test_Double_checksum_write}
if FileExists(ppufilename+'.INT',false) then
RenameFile(ppufilename+'.INT',ppufilename+'.INT-old');
Assign(CRCFile,ppufilename+'.INT');
Rewrite(CRCFile);
Writeln(CRCFile,'CRC of getppucrc of ',ppufilename);
{$endif def Test_Double_checksum_write}
{ create new ppufile } { create new ppufile }
ppufile:=tcompilerppufile.create(ppufilename); ppufile:=tcompilerppufile.create(ppufilename);
@ -1721,6 +1737,14 @@ var
if not ppufile.createfile then if not ppufile.createfile then
Message(unit_f_ppu_cannot_write); Message(unit_f_ppu_cannot_write);
{$ifdef Test_Double_checksum_write}
if FileExists(ppufilename+'.INT',false) then
RenameFile(ppufilename+'.INT',ppufilename+'.INT-old');
Assign(ppufile.CRCFile,ppufilename+'.INT');
Rewrite(ppufile.CRCFile);
Writeln(ppufile.CRCFile,'CRC of getppucrc of ',ppufilename,
' defsgeneration=',defsgeneration);
{$endif def Test_Double_checksum_write}
{ first the (JVM) namespace } { first the (JVM) namespace }
if assigned(namespace) then if assigned(namespace) then
begin begin
@ -1776,14 +1800,25 @@ var
ppufile.writeentry(ibendimplementation); ppufile.writeentry(ibendimplementation);
{$ifdef Test_Double_checksum_write} {$ifdef Test_Double_checksum_write}
Writeln(CRCFile,'End of CRC of getppucrc of ',ppufilename, Writeln(ppufile.CRCFile,'End of CRC of getppucrc of ',ppufilename,
' implementation_crc=$',hexstr(ppufile.crc,8), ' implementation_crc=$',hexstr(ppufile.crc,8),
' interface_crc=$',hexstr(ppufile.interface_crc,8), ' interface_crc=$',hexstr(ppufile.interface_crc,8),
' indirect_crc=$',hexstr(ppufile.indirect_crc,8), ' indirect_crc=$',hexstr(ppufile.indirect_crc,8),
' implementation_crc_size=',ppufile.implementation_write_crc_index, ' implementation_crc_size=',ppufile.implementation_write_crc_index,
' interface_crc_size=',ppufile.interface_write_crc_index, ' interface_crc_size=',ppufile.interface_write_crc_index,
' indirect_crc_size=',ppufile.indirect_write_crc_index); ' indirect_crc_size=',ppufile.indirect_write_crc_index,
close(CRCFile); ' defsgeneration=',defsgeneration);
close(ppufile.CRCFile);
{ Remember the values generated in .INT part }
implementation_write_crc_index:=ppufile.implementation_write_crc_index;
interface_write_crc_index:=ppufile.interface_write_crc_index;
indirect_write_crc_index:=ppufile.indirect_write_crc_index;
interface_crc_array:=ppufile.interface_crc_array;
ppufile.interface_crc_array:=nil;
implementation_crc_array:=ppufile.implementation_crc_array;
ppufile.implementation_crc_array:=nil;
indirect_crc_array:=ppufile.indirect_crc_array;
ppufile.indirect_crc_array:=nil;
{$endif Test_Double_checksum_write} {$endif Test_Double_checksum_write}
{ create and write header, this will only be used { create and write header, this will only be used
@ -1837,11 +1872,11 @@ var
Message2(unit_u_recompile_crc_change,realmodulename^,pu.u.ppufilename,@queuecomment); Message2(unit_u_recompile_crc_change,realmodulename^,pu.u.ppufilename,@queuecomment);
{$ifdef DEBUG_UNIT_CRC_CHANGES} {$ifdef DEBUG_UNIT_CRC_CHANGES}
if (pu.u.interface_crc<>pu.interface_checksum) then if (pu.u.interface_crc<>pu.interface_checksum) then
writeln(' intfcrc change: ',hexstr(pu.u.interface_crc,8),' <> ',hexstr(pu.interface_checksum,8)) Comment(V_Normal,' intfcrc change: '+hexstr(pu.u.interface_crc,8)+' for '+pu.u.ppufilename+' <> '+hexstr(pu.interface_checksum,8)+' in unit '+realmodulename^)
else if (pu.u.indirect_crc<>pu.indirect_checksum) then else if (pu.u.indirect_crc<>pu.indirect_checksum) then
writeln(' indcrc change: ',hexstr(pu.u.indirect_crc,8),' <> ',hexstr(pu.indirect_checksum,8)) Comment(V_Normal,' indcrc change: '+hexstr(pu.u.indirect_crc,8)+' for '+pu.u.ppufilename+' <> '+hexstr(pu.indirect_checksum,8)+' in unit '+realmodulename^)
else else
writeln(' implcrc change: ',hexstr(pu.u.crc,8),' in ' ,pu.u.ppufilename,' <> ',hexstr(pu.checksum,8),' in ',realmodulename^); Comment(V_Normal,' implcrc change: '+hexstr(pu.u.crc,8)+' for '+pu.u.ppufilename+' <> '+hexstr(pu.checksum,8)+' in unit '+realmodulename^);
{$endif DEBUG_UNIT_CRC_CHANGES} {$endif DEBUG_UNIT_CRC_CHANGES}
recompile_reason:=rr_crcchanged; recompile_reason:=rr_crcchanged;
do_compile:=true; do_compile:=true;
@ -1893,9 +1928,9 @@ var
Message2(unit_u_recompile_crc_change,realmodulename^,pu.u.ppufilename+' {impl}',@queuecomment); Message2(unit_u_recompile_crc_change,realmodulename^,pu.u.ppufilename+' {impl}',@queuecomment);
{$ifdef DEBUG_UNIT_CRC_CHANGES} {$ifdef DEBUG_UNIT_CRC_CHANGES}
if (pu.u.interface_crc<>pu.interface_checksum) then if (pu.u.interface_crc<>pu.interface_checksum) then
writeln(' intfcrc change (2): ',hexstr(pu.u.interface_crc,8),' <> ',hexstr(pu.interface_checksum,8)) Comment(V_Normal,' intfcrc change (2): '+hexstr(pu.u.interface_crc,8)+' for '+pu.u.ppufilename+' <> '+hexstr(pu.interface_checksum,8)+' in unit '+realmodulename^)
else if (pu.u.indirect_crc<>pu.indirect_checksum) then else if (pu.u.indirect_crc<>pu.indirect_checksum) then
writeln(' indcrc change (2): ',hexstr(pu.u.indirect_crc,8),' <> ',hexstr(pu.indirect_checksum,8)); Comment(V_Normal,' indcrc change (2): '+hexstr(pu.u.indirect_crc,8)+' for '+pu.u.ppufilename+' <> '+hexstr(pu.indirect_checksum,8)+' in unit '+realmodulename^);
{$endif DEBUG_UNIT_CRC_CHANGES} {$endif DEBUG_UNIT_CRC_CHANGES}
recompile_reason:=rr_crcchanged; recompile_reason:=rr_crcchanged;
do_compile:=true; do_compile:=true;
@ -1949,11 +1984,11 @@ var
begin begin
{$ifdef DEBUG_UNIT_CRC_CHANGES} {$ifdef DEBUG_UNIT_CRC_CHANGES}
if (pu.u.interface_crc<>pu.interface_checksum) then if (pu.u.interface_crc<>pu.interface_checksum) then
writeln(' intfcrc change (3): ',hexstr(pu.u.interface_crc,8),' <> ',hexstr(pu.interface_checksum,8)) Comment(V_Normal,' intfcrc change (3): '+hexstr(pu.u.interface_crc,8)+' for '+pu.u.ppufilename+' <> '+hexstr(pu.interface_checksum,8)+' in unit '+realmodulename^)
else if (pu.u.indirect_crc<>pu.indirect_checksum) then else if (pu.u.indirect_crc<>pu.indirect_checksum) then
writeln(' indcrc change (3): ',hexstr(pu.u.indirect_crc,8),' <> ',hexstr(pu.indirect_checksum,8)) Comment(V_Normal,' indcrc change (3): '+hexstr(pu.u.indirect_crc,8)+' for '+pu.u.ppufilename+' <> '+hexstr(pu.indirect_checksum,8)+' in unit '+realmodulename^)
else else
writeln(' implcrc change (3): ',hexstr(pu.u.crc,8),' <> ',hexstr(pu.checksum,8)); Comment(V_Normal,' implcrc change (3): '+hexstr(pu.u.crc,8)+' for '+pu.u.ppufilename+' <> '+hexstr(pu.checksum,8)+' in unit '+realmodulename^);
{$endif DEBUG_UNIT_CRC_CHANGES} {$endif DEBUG_UNIT_CRC_CHANGES}
result:=true; result:=true;
exit; exit;

72
compiler/ppu.pas
View File

@ -33,8 +33,6 @@ interface
{ define INTFPPU} { define INTFPPU}
{$ifdef Test_Double_checksum} {$ifdef Test_Double_checksum}
var
CRCFile : text;
const const
CRC_array_Size = 200000; CRC_array_Size = 200000;
type type
@ -132,6 +130,7 @@ type
interface_crc_array, interface_crc_array,
indirect_crc_array, indirect_crc_array,
implementation_crc_array : pcrc_array; implementation_crc_array : pcrc_array;
CRCFile : text;
private private
{$endif def Test_Double_checksum} {$endif def Test_Double_checksum}
protected protected
@ -178,6 +177,20 @@ implementation
{$endif def Test_Double_checksum} {$endif def Test_Double_checksum}
fpccrc; fpccrc;
{$ifdef Test_Double_checksum}
{$ifdef TEST_CRC_ERROR}
const
CRC_Interface_Change_Message_Level=V_Error;
CRC_Implementation_Change_Message_Level=V_Error;
CRC_Indirect_Change_Message_Level=V_Error;
{$else : not TEST_CRC_ERROR}
const
CRC_Interface_Change_Message_Level=V_Warning;
CRC_Implementation_Change_Message_Level=V_Note;
CRC_Indirect_Change_Message_Level=V_Note;
{$endif : not TEST_CRC_ERROR}
{$endif Test_Double_checksum}
function swapendian_ppureal(d:ppureal):ppureal; function swapendian_ppureal(d:ppureal):ppureal;
type ppureal_bytes=array[0..sizeof(d)-1] of byte; type ppureal_bytes=array[0..sizeof(d)-1] of byte;
@ -200,11 +213,20 @@ begin
crc_only:=false; crc_only:=false;
{$ifdef Test_Double_checksum} {$ifdef Test_Double_checksum}
if not assigned(interface_crc_array) then if not assigned(interface_crc_array) then
new(interface_crc_array); begin
new(interface_crc_array);
fillchar(interface_crc_array^,sizeof(interface_crc_array),#$ff);
end;
if not assigned(indirect_crc_array) then if not assigned(indirect_crc_array) then
new(indirect_crc_array); begin
new(indirect_crc_array);
fillchar(indirect_crc_array^,sizeof(indirect_crc_array),#$ff);
end;
if not assigned(implementation_crc_array) then if not assigned(implementation_crc_array) then
new(implementation_crc_array); begin
new(implementation_crc_array);
fillchar(implementation_crc_array^,sizeof(implementation_crc_array),#$ff);
end;
{$endif Test_Double_checksum} {$endif Test_Double_checksum}
end; end;
@ -381,7 +403,7 @@ begin
begin begin
implementation_crc_array^[implementation_write_crc_index]:=crc; implementation_crc_array^[implementation_write_crc_index]:=crc;
{$ifdef Test_Double_checksum_write} {$ifdef Test_Double_checksum_write}
Write(CRCFile,'implementation_crc ',implementation_write_crc_index,' $',hexstr(crc,8),' ',len); Write(CRCFile,'imp_crc ',implementation_write_crc_index:6,' $',hexstr(crc,8),' ',len);
pb:=@b; pb:=@b;
for ind:=0 to len-1 do for ind:=0 to len-1 do
Write(CRCFile,' ',hexstr(pb[ind],2)); Write(CRCFile,' ',hexstr(pb[ind],2));
@ -392,16 +414,16 @@ begin
end end
else else
begin begin
if (implementation_read_crc_index<crc_array_size) and (implementation_read_crc_index<implementation_write_crc_index) and if (implementation_read_crc_index<crc_array_size) and
(implementation_crc_array^[implementation_read_crc_index]<>crc) then (implementation_crc_array^[implementation_read_crc_index]<>crc) then
begin begin
Do_comment(V_Note,'implementation CRC changed at index '+tostr(implementation_read_crc_index)); do_comment(CRC_implementation_Change_Message_Level,'implementation CRC changed at index '+tostr(implementation_read_crc_index));
{$ifdef Test_Double_checksum_write} {$ifdef Test_Double_checksum_write}
Writeln(CRCFile,'!!!',implementation_read_crc_index,' $',hexstr(implementation_crc_array^[implementation_read_crc_index],8)); Writeln(CRCFile,'!!!imp_crc ',implementation_read_crc_index:5,'$',hexstr(crc,8),'<>$',hexstr(implementation_crc_array^[implementation_read_crc_index],8));
end end
else else
begin begin
Writeln(CRCFile,'implementation_crc ',implementation_read_crc_index,' OK'); Writeln(CRCFile,'imp_crc ',implementation_read_crc_index:5,' OK');
{$endif Test_Double_checksum_write} {$endif Test_Double_checksum_write}
end; end;
inc(implementation_read_crc_index); inc(implementation_read_crc_index);
@ -415,7 +437,7 @@ begin
begin begin
interface_crc_array^[interface_write_crc_index]:=interface_crc; interface_crc_array^[interface_write_crc_index]:=interface_crc;
{$ifdef Test_Double_checksum_write} {$ifdef Test_Double_checksum_write}
Write(CRCFile,'interface_crc ',interface_write_crc_index,' $',hexstr(interface_crc,8),' ',len); Write(CRCFile,'int_crc ',interface_write_crc_index:5,' $',hexstr(interface_crc,8),' ',len);
pb:=@b; pb:=@b;
for ind:=0 to len-1 do for ind:=0 to len-1 do
Write(CRCFile,' ',hexstr(pb[ind],2)); Write(CRCFile,' ',hexstr(pb[ind],2));
@ -426,16 +448,16 @@ begin
end end
else else
begin begin
if (interface_read_crc_index<crc_array_size) and (interface_read_crc_index<interface_write_crc_index) and if (interface_read_crc_index<crc_array_size) and
(interface_crc_array^[interface_read_crc_index]<>interface_crc) then (interface_crc_array^[interface_read_crc_index]<>interface_crc) then
begin begin
Do_comment(V_warning,'interface CRC changed at index '+tostr(interface_read_crc_index)); do_comment(CRC_Interface_Change_Message_Level,'interface CRC changed at index '+tostr(interface_read_crc_index));
{$ifdef Test_Double_checksum_write} {$ifdef Test_Double_checksum_write}
Writeln(CRCFile,'!!!',interface_read_crc_index,' $',hexstr(interface_crc_array^[interface_read_crc_index],8)); Writeln(CRCFile,'!!!int_crc ',interface_read_crc_index:5,'$',hexstr(interface_crc,8),'<>$',hexstr(interface_crc_array^[interface_read_crc_index],8));
end end
else else
begin begin
Writeln(CRCFile,'interface_crc ',interface_read_crc_index,' OK'); Writeln(CRCFile,'int_crc ',interface_read_crc_index:5,' OK');
{$endif Test_Double_checksum_write} {$endif Test_Double_checksum_write}
end; end;
inc(interface_read_crc_index); inc(interface_read_crc_index);
@ -452,7 +474,7 @@ begin
begin begin
indirect_crc_array^[indirect_write_crc_index]:=indirect_crc; indirect_crc_array^[indirect_write_crc_index]:=indirect_crc;
{$ifdef Test_Double_checksum_write} {$ifdef Test_Double_checksum_write}
Write(CRCFile,'indirect_crc ',indirect_write_crc_index,' $',hexstr(indirect_crc,8),' ',len); Write(CRCFile,'ind_crc ',indirect_write_crc_index:5,' $',hexstr(indirect_crc,8),' ',len);
pb:=@b; pb:=@b;
for ind:=0 to len-1 do for ind:=0 to len-1 do
Write(CRCFile,' ',hexstr(pb[ind],2)); Write(CRCFile,' ',hexstr(pb[ind],2));
@ -463,16 +485,16 @@ begin
end end
else else
begin begin
if (indirect_read_crc_index<crc_array_size) and (indirect_read_crc_index<indirect_write_crc_index) and if (indirect_read_crc_index<crc_array_size) and
(indirect_crc_array^[indirect_read_crc_index]<>indirect_crc) then (indirect_crc_array^[indirect_read_crc_index]<>indirect_crc) then
begin begin
Do_comment(V_note,'Indirect CRC changed at index '+tostr(indirect_read_crc_index)); do_comment(CRC_Indirect_Change_Message_Level,'Indirect CRC changed at index '+tostr(indirect_read_crc_index));
{$ifdef Test_Double_checksum_write} {$ifdef Test_Double_checksum_write}
Writeln(CRCFile,'!!!',indirect_read_crc_index,' $',hexstr(indirect_crc_array^[indirect_read_crc_index],8)); Writeln(CRCFile,'!!!ind_crc ',indirect_read_crc_index:5,'$',hexstr(indirect_crc,8),'<>$',hexstr(indirect_crc_array^[indirect_read_crc_index],8));
end end
else else
begin begin
Writeln(CRCFile,'indirect_crc ',indirect_read_crc_index,' OK'); Writeln(CRCFile,'ind_crc ',indirect_read_crc_index:5,' OK');
{$endif Test_Double_checksum_write} {$endif Test_Double_checksum_write}
end; end;
inc(indirect_read_crc_index); inc(indirect_read_crc_index);
@ -499,6 +521,16 @@ end;
procedure tppufile.resetfile; procedure tppufile.resetfile;
begin begin
{$ifdef Test_Double_checksum_write}
if (crc<>0) or (interface_crc<>0) or (indirect_crc<>0) then
Writeln(CRCFile,'!!! tppufile.reset called',
' implementation_crc=$',hexstr(crc,8),
' interface_crc=$',hexstr(interface_crc,8),
' indirect_crc=$',hexstr(indirect_crc,8),
' implementation_crc_size=',implementation_write_crc_index,
' interface_crc_size=',interface_write_crc_index,
' indirect_crc_size=',indirect_write_crc_index);
{$endif Test_Double_checksum_write}
crc:=0; crc:=0;
interface_crc:=0; interface_crc:=0;
indirect_crc:=0; indirect_crc:=0;