paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 18:09:27 +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
headerflags:=headerflags or uf_fpu_emulation;
{$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 }
ppufile:=tcompilerppufile.create(ppufilename);
if not ppufile.createfile then
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) }
writeextraheader;
@ -1689,14 +1711,15 @@ var
indirect_crc:=ppufile.indirect_crc;
{$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),
' interface_crc=$',hexstr(ppufile.interface_crc,8),
' indirect_crc=$',hexstr(ppufile.indirect_crc,8),
' implementation_crc_size=',ppufile.implementation_read_crc_index,
' interface_crc_size=',ppufile.interface_read_crc_index,
' indirect_crc_size=',ppufile.indirect_read_crc_index);
close(CRCFile);
' indirect_crc_size=',ppufile.indirect_read_crc_index,
' defsgeneration=',defsgeneration);
close(ppufile.CRCFile);
{$endif Test_Double_checksum_write}
ppufile.closefile;
@ -1707,13 +1730,6 @@ var
procedure tppumodule.getppucrc;
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 }
ppufile:=tcompilerppufile.create(ppufilename);
@ -1721,6 +1737,14 @@ var
if not ppufile.createfile then
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 }
if assigned(namespace) then
begin
@ -1776,14 +1800,25 @@ var
ppufile.writeentry(ibendimplementation);
{$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),
' interface_crc=$',hexstr(ppufile.interface_crc,8),
' indirect_crc=$',hexstr(ppufile.indirect_crc,8),
' implementation_crc_size=',ppufile.implementation_write_crc_index,
' interface_crc_size=',ppufile.interface_write_crc_index,
' indirect_crc_size=',ppufile.indirect_write_crc_index);
close(CRCFile);
' indirect_crc_size=',ppufile.indirect_write_crc_index,
' 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}
{ 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);
{$ifdef DEBUG_UNIT_CRC_CHANGES}
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
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
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}
recompile_reason:=rr_crcchanged;
do_compile:=true;
@ -1893,9 +1928,9 @@ var
Message2(unit_u_recompile_crc_change,realmodulename^,pu.u.ppufilename+' {impl}',@queuecomment);
{$ifdef DEBUG_UNIT_CRC_CHANGES}
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
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}
recompile_reason:=rr_crcchanged;
do_compile:=true;
@ -1949,11 +1984,11 @@ var
begin
{$ifdef DEBUG_UNIT_CRC_CHANGES}
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
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
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}
result:=true;
exit;

72
compiler/ppu.pas
View File

@ -33,8 +33,6 @@ interface
{ define INTFPPU}
{$ifdef Test_Double_checksum}
var
CRCFile : text;
const
CRC_array_Size = 200000;
type
@ -132,6 +130,7 @@ type
interface_crc_array,
indirect_crc_array,
implementation_crc_array : pcrc_array;
CRCFile : text;
private
{$endif def Test_Double_checksum}
protected
@ -178,6 +177,20 @@ implementation
{$endif def Test_Double_checksum}
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;
type ppureal_bytes=array[0..sizeof(d)-1] of byte;
@ -200,11 +213,20 @@ begin
crc_only:=false;
{$ifdef Test_Double_checksum}
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
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
new(implementation_crc_array);
begin
new(implementation_crc_array);
fillchar(implementation_crc_array^,sizeof(implementation_crc_array),#$ff);
end;
{$endif Test_Double_checksum}
end;
@ -381,7 +403,7 @@ begin
begin
implementation_crc_array^[implementation_write_crc_index]:=crc;
{$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;
for ind:=0 to len-1 do
Write(CRCFile,' ',hexstr(pb[ind],2));
@ -392,16 +414,16 @@ begin
end
else
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
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}
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
else
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}
end;
inc(implementation_read_crc_index);
@ -415,7 +437,7 @@ begin
begin
interface_crc_array^[interface_write_crc_index]:=interface_crc;
{$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;
for ind:=0 to len-1 do
Write(CRCFile,' ',hexstr(pb[ind],2));
@ -426,16 +448,16 @@ begin
end
else
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
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}
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
else
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}
end;
inc(interface_read_crc_index);
@ -452,7 +474,7 @@ begin
begin
indirect_crc_array^[indirect_write_crc_index]:=indirect_crc;
{$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;
for ind:=0 to len-1 do
Write(CRCFile,' ',hexstr(pb[ind],2));
@ -463,16 +485,16 @@ begin
end
else
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
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}
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
else
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}
end;
inc(indirect_read_crc_index);
@ -499,6 +521,16 @@ end;
procedure tppufile.resetfile;
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;
interface_crc:=0;
indirect_crc:=0;