diff options
| -rw-r--r-- | src/files_map.adb | 113 | ||||
| -rw-r--r-- | src/files_map.ads | 13 | ||||
| -rw-r--r-- | src/ghdldrv/ghdllocal.adb | 12 | ||||
| -rw-r--r-- | src/libraries.adb | 50 | ||||
| -rw-r--r-- | src/types.ads | 40 | ||||
| -rw-r--r-- | src/vhdl/disp_tree.adb | 6 | ||||
| -rw-r--r-- | src/vhdl/iirs.adb | 26 | ||||
| -rw-r--r-- | src/vhdl/iirs.adb.in | 6 | ||||
| -rw-r--r-- | src/vhdl/iirs.ads | 6 | ||||
| -rw-r--r-- | src/vhdl/nodes_meta.adb | 42 | ||||
| -rw-r--r-- | src/vhdl/nodes_meta.ads | 10 | ||||
| -rw-r--r-- | src/vhdl/sem_inst.adb | 3 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap2.adb | 3 | ||||
| -rwxr-xr-x | testsuite/gna/bug10/testsuite.sh | 2 |
14 files changed, 198 insertions, 134 deletions
diff --git a/src/files_map.adb b/src/files_map.adb index ece6e12..1b45d51 100644 --- a/src/files_map.adb +++ b/src/files_map.adb @@ -22,6 +22,7 @@ with Ada.Text_IO; use Ada.Text_IO; with Ada.Unchecked_Deallocation; with GNAT.Table; with GNAT.OS_Lib; +with GNAT.SHA1; with GNAT.Directory_Operations; with Name_Table; use Name_Table; with Str_Table; @@ -55,7 +56,7 @@ package body Files_Map is -- Length of the file, which is also the length of the buffer. File_Length: Natural; - Time_Stamp: Time_Stamp_Id; + Checksum : File_Checksum_Id; -- Current number of line in Lines_Table. Nbr_Lines: Natural; @@ -425,51 +426,6 @@ package body Files_Map is return Character'Val (Character'Pos ('0') + Val mod 10); end Digit_To_Char; - -- Format: YYYYMMDDHHmmsscc - -- Y: year, M: month, D: day, H: hour, m: minute, s: second, cc:100th sec - function Os_Time_To_Time_Stamp_Id (Time: GNAT.OS_Lib.OS_Time) - return Time_Stamp_Id - is - use GNAT.OS_Lib; - use Str_Table; - Res: Time_Stamp_Id; - Year: Year_Type; - Month: Month_Type; - Day: Day_Type; - Hour: Hour_Type; - Minute: Minute_Type; - Second: Second_Type; - begin - GM_Split (Time, Year, Month, Day, Hour, Minute, Second); - Res := Time_Stamp_Id (Create_String8); - Append_String8_Char (Digit_To_Char (Year / 1000)); - Append_String8_Char (Digit_To_Char (Year / 100)); - Append_String8_Char (Digit_To_Char (Year / 10)); - Append_String8_Char (Digit_To_Char (Year / 1)); - Append_String8_Char (Digit_To_Char (Month / 10)); - Append_String8_Char (Digit_To_Char (Month / 1)); - Append_String8_Char (Digit_To_Char (Day / 10)); - Append_String8_Char (Digit_To_Char (Day / 1)); - Append_String8_Char (Digit_To_Char (Hour / 10)); - Append_String8_Char (Digit_To_Char (Hour / 1)); - Append_String8_Char (Digit_To_Char (Minute / 10)); - Append_String8_Char (Digit_To_Char (Minute / 1)); - Append_String8_Char (Digit_To_Char (Second / 10)); - Append_String8_Char (Digit_To_Char (Second / 1)); - Append_String8_Char ('.'); - Append_String8_Char ('0'); - Append_String8_Char ('0'); - Append_String8_Char ('0'); - return Res; - end Os_Time_To_Time_Stamp_Id; - - function Get_File_Time_Stamp (FD : GNAT.OS_Lib.File_Descriptor) - return Time_Stamp_Id - is - begin - return Os_Time_To_Time_Stamp_Id (GNAT.OS_Lib.File_Time_Stamp (FD)); - end Get_File_Time_Stamp; - function Get_Os_Time_Stamp return Time_Stamp_Id is use Ada.Calendar; @@ -579,7 +535,7 @@ package body Files_Map is Last_Location => Next_Location, File_Name => Name, Directory => Directory, - Time_Stamp => Null_Time_Stamp, + Checksum => No_File_Checksum_Id, Source => null, File_Length => 0, Nbr_Lines => 0, @@ -650,7 +606,7 @@ package body Files_Map is declare Filename : String := Get_Pathname (Directory, Name, True); begin - if not Is_Regular_File(Filename) then + if not Is_Regular_File (Filename) then return No_Source_File_Entry; end if; Fd := Open_Read (Filename'Address, Binary); @@ -661,8 +617,6 @@ package body Files_Map is Res := Create_Source_File_Entry (Directory, Name); - Source_Files.Table (Res).Time_Stamp := Get_File_Time_Stamp (Fd); - Length := Source_Ptr (File_Length (Fd)); Buffer := @@ -674,14 +628,30 @@ package body Files_Map is Close (Fd); raise Internal_Error; end if; - Buffer (Length) := EOT; - Buffer (Length + 1) := EOT; + Buffer (Source_Ptr_Org + Length) := EOT; + Buffer (Source_Ptr_Org + Length + 1) := EOT; if Source_Files.Table (Res).First_Location /= Next_Location then -- Load_Source_File call must follow its Create_Source_File. raise Internal_Error; end if; + declare + use GNAT.SHA1; + use Str_Table; + + subtype Buffer_String is String (1 .. Buffer'Length - 2); + Buffer_Digest : constant Message_Digest := + Digest (Buffer_String + (Buffer (Source_Ptr_Org .. Source_Ptr_Org + Length - 1))); + begin + Source_Files.Table (Res).Checksum := + File_Checksum_Id (Create_String8); + for I in Buffer_Digest'Range loop + Append_String8_Char (Buffer_Digest (I)); + end loop; + end; + Source_Files.Table (Res).Last_Location := Next_Location + Location_Type (Length) + 1; Next_Location := Source_Files.Table (Res).Last_Location + 1; @@ -724,13 +694,12 @@ package body Files_Map is return Source_Files.Table (File).File_Name; end Get_File_Name; - -- Return the date of the file (last modification date) as a string. - function Get_File_Time_Stamp (File: Source_File_Entry) - return Time_Stamp_Id is + function Get_File_Checksum (File : Source_File_Entry) + return File_Checksum_Id is begin Check_File (File); - return Source_Files.Table (File).Time_Stamp; - end Get_File_Time_Stamp; + return Source_Files.Table (File).Checksum; + end Get_File_Checksum; function Get_Source_File_Directory (File : Source_File_Entry) return Name_Id is @@ -765,6 +734,21 @@ package body Files_Map is return True; end Is_Eq; + function Is_Eq (L, R : File_Checksum_Id) return Boolean + is + use Str_Table; + L_Str : constant String8_Id := String8_Id (L); + R_Str : constant String8_Id := String8_Id (R); + begin + for I in 1 .. Nat32 (File_Checksum_String'Length) loop + if Element_String8 (L_Str, I) /= Element_String8 (R_Str, I) then + return False; + end if; + end loop; + return True; + end Is_Eq; + + function Is_Gt (L : Time_Stamp_Id; R : Time_Stamp_Id) return Boolean is use Str_Table; @@ -792,6 +776,17 @@ package body Files_Map is end if; end Get_Time_Stamp_String; + function Get_File_Checksum_String (Checksum : File_Checksum_Id) + return String is + begin + if Checksum = No_File_Checksum_Id then + return "NO_CHECKSUM"; + else + return Str_Table.String_String8 + (String8_Id (Checksum), File_Checksum_String'Length); + end if; + end Get_File_Checksum_String; + function Image (Loc : Location_Type; Filename : Boolean := True) return string is @@ -848,8 +843,8 @@ package body Files_Map is Put (" dir:" & Image (F.Directory)); Put (" length:" & Natural'Image (F.File_Length)); New_Line; - if F.Time_Stamp /= Null_Time_Stamp then - Put (" time_stamp: " & Get_Time_Stamp_String (F.Time_Stamp)); + if F.Checksum /= No_File_Checksum_Id then + Put (" checksum: " & Get_File_Checksum_String (F.Checksum)); end if; Put (" nbr lines:" & Natural'Image (F.Nbr_Lines)); Put (" lines_table_max:" & Natural'Image (F.Lines_Table_Max)); diff --git a/src/files_map.ads b/src/files_map.ads index c48aebd..265e3d0 100644 --- a/src/files_map.ads +++ b/src/files_map.ads @@ -63,9 +63,16 @@ package Files_Map is function Is_Gt (L : Time_Stamp_Id; R : Time_Stamp_Id) return Boolean; function Get_Time_Stamp_String (Ts : Time_Stamp_Id) return String; - -- Return the date of the file (last modification date) as a string. - function Get_File_Time_Stamp (File : Source_File_Entry) - return Time_Stamp_Id; + -- Return the checksum of the content of FILE. + function Get_File_Checksum (File : Source_File_Entry) + return File_Checksum_Id; + + -- True if two file checksums are identical. + function Is_Eq (L, R : File_Checksum_Id) return Boolean; + + -- String image of CHECKSUM. + function Get_File_Checksum_String (Checksum : File_Checksum_Id) + return String; -- Return the current date of the system. function Get_Os_Time_Stamp return Time_Stamp_Id; diff --git a/src/ghdldrv/ghdllocal.adb b/src/ghdldrv/ghdllocal.adb index 6b2a53e..8e2eceb 100644 --- a/src/ghdldrv/ghdllocal.adb +++ b/src/ghdldrv/ghdllocal.adb @@ -1155,8 +1155,8 @@ package body Ghdllocal is if Fe = No_Source_File_Entry then -- FIXME: should remove all the design file from the library. null; - elsif Is_Eq (Get_File_Time_Stamp (Fe), - Get_File_Time_Stamp (File)) + elsif Is_Eq (Get_File_Checksum (Fe), + Get_File_Checksum (File)) then -- File has not been modified. -- Extract libraries. @@ -1283,8 +1283,8 @@ package body Ghdllocal is -- the library. null; else - if not Is_Eq (Get_File_Time_Stamp (Fe), - Get_File_Time_Stamp (File)) + if not Is_Eq (Get_File_Checksum (Fe), + Get_File_Checksum (File)) then -- FILE has been modified. Design_File := Libraries.Load_File (Fe); @@ -1359,8 +1359,8 @@ package body Ghdllocal is -- 2) file has been modified. Fe := Load_Source_File (Get_Design_File_Directory (File), Get_Design_File_Filename (File)); - if not Is_Eq (Get_File_Time_Stamp (Fe), - Get_File_Time_Stamp (File)) + if not Is_Eq (Get_File_Checksum (Fe), + Get_File_Checksum (File)) then if Flag_Verbose then Put_Line ("file " & Name_Table.Image (Get_File_Name (Fe)) diff --git a/src/libraries.adb b/src/libraries.adb index 39e5039..c620c00 100644 --- a/src/libraries.adb +++ b/src/libraries.adb @@ -272,10 +272,15 @@ package body Libraries is File : Source_File_Entry; + -- Report an error message and abort. + procedure Bad_Library_Format; + pragma No_Return (Bad_Library_Format); + procedure Bad_Library_Format is begin Error_Msg (Image (Files_Map.Get_File_Name (File)) & - ": bad library format"); + ": bad library format"); + raise Compilation_Error; end Bad_Library_Format; procedure Scan_Expect (Tok: Token_Type) is @@ -283,7 +288,6 @@ package body Libraries is Scan; if Current_Token /= Tok then Bad_Library_Format; - raise Compilation_Error; end if; end Scan_Expect; @@ -291,7 +295,6 @@ package body Libraries is begin if Current_String_Length /= Time_Stamp_String'Length then Bad_Library_Format; - raise Compilation_Error; end if; return Time_Stamp_Id (Current_String_Id); end Current_Time_Stamp; @@ -388,12 +391,10 @@ package body Libraries is or else Nam_Length /= 1 or else Nam_Buffer (1) /= 'v' then Bad_Library_Format; - raise Compilation_Error; end if; Scan_Expect (Tok_Integer); - if Current_Iir_Int64 not in 1 .. 3 then + if Current_Iir_Int64 /= 4 then Bad_Library_Format; - raise Compilation_Error; end if; Scan; @@ -415,16 +416,9 @@ package body Libraries is -- The filename is an absolute file. File_Dir := Null_Identifier; elsif Current_Token = Tok_String then - -- Be compatible with version 1: an empty directory for - -- an absolute filename. - if Current_String_Length = 0 then - File_Dir := Null_Identifier; - else - File_Dir := String_To_Name_Id; - end if; + File_Dir := String_To_Name_Id; else Bad_Library_Format; - raise Compilation_Error; end if; Set_Design_File_Directory (Design_File, File_Dir); @@ -441,7 +435,11 @@ package body Libraries is Set_Design_File_Chain (Library, Design_File); Scan_Expect (Tok_String); - Set_File_Time_Stamp (Design_File, Current_Time_Stamp); + if Current_String_Length /= File_Checksum_String'Length then + Bad_Library_Format; + end if; + Set_File_Checksum + (Design_File, File_Checksum_Id (Current_String_Id)); Scan_Expect (Tok_String); Set_Analysis_Time_Stamp (Design_File, Current_Time_Stamp); @@ -861,7 +859,7 @@ package body Libraries is New_Library_Unit: Iir; Unit_Id : Name_Id; Date: Date_Type; - New_Lib_Time_Stamp : Time_Stamp_Id; + New_Lib_Checksum : File_Checksum_Id; Id : Hash_Id; -- File name and dir name of DECL. @@ -901,7 +899,7 @@ package body Libraries is begin Files_Map.Location_To_File_Pos (Get_Location (New_Library_Unit), File, Pos); - New_Lib_Time_Stamp := Files_Map.Get_File_Time_Stamp (File); + New_Lib_Checksum := Files_Map.Get_File_Checksum (File); File_Name := Files_Map.Get_File_Name (File); Image (File_Name); if GNAT.OS_Lib.Is_Absolute_Path (Nam_Buffer (1 .. Nam_Length)) then @@ -1024,15 +1022,15 @@ package body Libraries is end if; if Design_File /= Null_Iir - and then not Files_Map.Is_Eq (New_Lib_Time_Stamp, - Get_File_Time_Stamp (Design_File)) + and then not Files_Map.Is_Eq (New_Lib_Checksum, + Get_File_Checksum (Design_File)) then -- FIXME: this test is not enough: what about reanalyzing -- unmodified files (this works only because the order is not -- changed). -- Design file is updated. -- Outdate all other units, overwrite the design_file. - Set_File_Time_Stamp (Design_File, New_Lib_Time_Stamp); + Set_File_Checksum (Design_File, New_Lib_Checksum); Design_Unit := Get_First_Design_Unit (Design_File); while Design_Unit /= Null_Iir loop if Design_Unit /= Unit then @@ -1060,7 +1058,7 @@ package body Libraries is Set_Design_File_Filename (Design_File, File_Name); Set_Design_File_Directory (Design_File, Dir_Name); - Set_File_Time_Stamp (Design_File, New_Lib_Time_Stamp); + Set_File_Checksum (Design_File, New_Lib_Checksum); Set_Parent (Design_File, Work_Library); Set_Chain (Design_File, Get_Design_File_Chain (Work_Library)); Set_Design_File_Chain (Work_Library, Design_File); @@ -1166,7 +1164,7 @@ package body Libraries is end if; -- Header: version. - WR ("v 3"); + WR ("v 4"); WR_LF; Design_File := Get_Design_File_Chain (Library); @@ -1199,8 +1197,8 @@ package body Libraries is Image (Get_Design_File_Filename (Design_File)); WR (Nam_Buffer (1 .. Nam_Length)); WR (""" """); - WR (Files_Map.Get_Time_Stamp_String - (Get_File_Time_Stamp (Design_File))); + WR (Files_Map.Get_File_Checksum_String + (Get_File_Checksum (Design_File))); WR (""" """); WR (Files_Map.Get_Time_Stamp_String (Get_Analysis_Time_Stamp (Design_File))); @@ -1488,8 +1486,8 @@ package body Libraries is Set_File (Fe); if not Files_Map.Is_Eq - (Files_Map.Get_File_Time_Stamp (Get_Current_Source_File), - Get_File_Time_Stamp (Design_File)) + (Files_Map.Get_File_Checksum (Get_Current_Source_File), + Get_File_Checksum (Design_File)) then Error_Msg_Sem ("file " & Image (Get_Design_File_Filename (Design_File)) diff --git a/src/types.ads b/src/types.ads index e15d00e..7717e5f 100644 --- a/src/types.ads +++ b/src/types.ads @@ -1,5 +1,5 @@ -- Common types. --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold +-- Copyright (C) 2002 - 2015 Tristan Gingold -- -- GHDL is free software; you can redistribute it and/or modify it under -- the terms of the GNU General Public License as published by the Free @@ -48,26 +48,34 @@ package Types is -- iir_index32 is aimed at containing an array index. type Iir_Index32 is new Nat32; - -- Useful type. + -- Useful types. type String_Acc is access String; type String_Cst is access constant String; type String_Acc_Array is array (Natural range <>) of String_Acc; - -- Type of a name table element. - -- The name table is defined in the name_table package. + -- The name table is defined in Name_Table package. This is an hash table + -- that associate a uniq Name_Id to a string. Name_Id are allocated in + -- increasing numbers, so it is possible to create a parallel table + -- indexed on Name_Id to associate additional data to the names. type Name_Id is new Nat32; - -- null entry in the name table. - -- It is sure that this entry is never allocated. + -- Null entry in the name table. + -- It is sure that this entry is never allocated. Null_Identifier: constant Name_Id := 0; + -- A String8_Id represents a string stored in a dedicated table. Contrary + -- to Name_Id, String8 aren't uniq: two different String8_Id can correspond + -- to a same String. The purpose of an integer number for string is to + -- have a 32 bit type to represent a string (contrary to pointers that + -- could be 32 or 64 bit - in general - or to an access type which can be + -- even wider in Ada). type String8_Id is new Nat32; for String8_Id'Size use 32; Null_String8 : constant String8_Id := 0; - -- Index type is the source file table. - -- This table is defined in the files_map package. + -- Index type is the source file table. + -- This table is defined in the files_map package. type Source_File_Entry is new Nat32; No_Source_File_Entry: constant Source_File_Entry := 0; @@ -92,7 +100,7 @@ package Types is for Location_Type'Size use 32; Location_Nil : constant Location_Type := 0; - -- Type of a file buffer. + -- Type of a file buffer. type File_Buffer is array (Source_Ptr range <>) of Character; type File_Buffer_Acc is access File_Buffer; @@ -102,8 +110,8 @@ package Types is -- PSL NFA type PSL_NFA is new Int32; - -- Indentation. - -- This is used by all packages that display vhdl code or informations. + -- Indentation. + -- This is used by all packages that display vhdl code or informations. Indentation : constant := 2; -- String representing a date/time (format is YYYYMMDDHHmmSS.sss). @@ -111,6 +119,16 @@ package Types is type Time_Stamp_Id is new String8_Id; Null_Time_Stamp : constant Time_Stamp_Id := 0; + -- In order to detect file changes, a checksum of the content is computed. + -- Currently SHA1 is used, but the cryptographic aspect is not a strong + -- requirement. + type File_Checksum_Id is new String8_Id; + No_File_Checksum_Id : constant File_Checksum_Id := 0; + + -- String image of a File_Hash_Id. SHA1 digests are 5 * 32 bytes long, so + -- the hexadecimal image is 40 characters. + subtype File_Checksum_String is String (1 .. 40); + -- Self-explaining: raised when an internal error (such as consistency) -- is detected. Internal_Error: exception; diff --git a/src/vhdl/disp_tree.adb b/src/vhdl/disp_tree.adb index 62fc3c4..34f31fe 100644 --- a/src/vhdl/disp_tree.adb +++ b/src/vhdl/disp_tree.adb @@ -289,6 +289,9 @@ package body Disp_Tree is function Image_Time_Stamp_Id (Id : Time_Stamp_Id) return String renames Files_Map.Get_Time_Stamp_String; + function Image_File_Checksum_Id (Id : File_Checksum_Id) return String + renames Files_Map.Get_File_Checksum_String; + function Image_Iir_Predefined_Functions (F : Iir_Predefined_Functions) return String is begin @@ -467,6 +470,9 @@ package body Disp_Tree is when Type_Time_Stamp_Id => Put_Line (Image_Time_Stamp_Id (Get_Time_Stamp_Id (N, F))); + when Type_File_Checksum_Id => + Put_Line (Image_File_Checksum_Id + (Get_File_Checksum_Id (N, F))); when Type_Token_Type => Put_Line (Image_Token_Type (Get_Token_Type (N, F))); when Type_Name_Id => diff --git a/src/vhdl/iirs.adb b/src/vhdl/iirs.adb index 99b8756..9d056d7 100644 --- a/src/vhdl/iirs.adb +++ b/src/vhdl/iirs.adb @@ -141,6 +141,12 @@ package body Iirs is function Iir_To_Time_Stamp_Id is new Ada.Unchecked_Conversion (Source => Iir, Target => Time_Stamp_Id); + function File_Checksum_Id_To_Iir is new Ada.Unchecked_Conversion + (Source => File_Checksum_Id, Target => Iir); + + function Iir_To_File_Checksum_Id is new Ada.Unchecked_Conversion + (Source => Iir, Target => File_Checksum_Id); + function Iir_To_Iir_List is new Ada.Unchecked_Conversion (Source => Iir, Target => Iir_List); function Iir_List_To_Iir is new Ada.Unchecked_Conversion @@ -536,21 +542,21 @@ package body Iirs is Set_Field1 (Design, Library); end Set_Library_Declaration; - function Get_File_Time_Stamp (Design : Iir) return Time_Stamp_Id is + function Get_File_Checksum (Design : Iir) return File_Checksum_Id is begin pragma Assert (Design /= Null_Iir); - pragma Assert (Has_File_Time_Stamp (Get_Kind (Design)), - "no field File_Time_Stamp"); - return Iir_To_Time_Stamp_Id (Get_Field4 (Design)); - end Get_File_Time_Stamp; + pragma Assert (Has_File_Checksum (Get_Kind (Design)), + "no field File_Checksum"); + return Iir_To_File_Checksum_Id (Get_Field4 (Design)); + end Get_File_Checksum; - procedure Set_File_Time_Stamp (Design : Iir; Stamp : Time_Stamp_Id) is + procedure Set_File_Checksum (Design : Iir; Checksum : File_Checksum_Id) is begin pragma Assert (Design /= Null_Iir); - pragma Assert (Has_File_Time_Stamp (Get_Kind (Design)), - "no field File_Time_Stamp"); - Set_Field4 (Design, Time_Stamp_Id_To_Iir (Stamp)); - end Set_File_Time_Stamp; + pragma Assert (Has_File_Checksum (Get_Kind (Design)), + "no field File_Checksum"); + Set_Field4 (Design, File_Checksum_Id_To_Iir (Checksum)); + end Set_File_Checksum; function Get_Analysis_Time_Stamp (Design : Iir) return Time_Stamp_Id is begin diff --git a/src/vhdl/iirs.adb.in b/src/vhdl/iirs.adb.in index 481a355..40c9d68 100644 --- a/src/vhdl/iirs.adb.in +++ b/src/vhdl/iirs.adb.in @@ -141,6 +141,12 @@ package body Iirs is function Iir_To_Time_Stamp_Id is new Ada.Unchecked_Conversion (Source => Iir, Target => Time_Stamp_Id); + function File_Checksum_Id_To_Iir is new Ada.Unchecked_Conversion + (Source => File_Checksum_Id, Target => Iir); + + function Iir_To_File_Checksum_Id is new Ada.Unchecked_Conversion + (Source => Iir, Target => File_Checksum_Id); + function Iir_To_Iir_List is new Ada.Unchecked_Conversion (Source => Iir, Target => Iir_List); function Iir_List_To_Iir is new Ada.Unchecked_Conversion diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads index 75db322..c8cc0f9 100644 --- a/src/vhdl/iirs.ads +++ b/src/vhdl/iirs.ads @@ -173,7 +173,7 @@ package Iirs is -- analysis and detecting obsolete units across libraries. -- Get/Set_Analysis_Time_Stamp (Field3) -- - -- Get/Set_File_Time_Stamp (Field4) + -- Get/Set_File_Checksum (Field4) -- -- Get the chain of unit contained in the file. This is a simply linked -- chain, but the tail is kept to speed-up appending operation. @@ -5006,8 +5006,8 @@ package Iirs is -- File time stamp is the system time of the file last modification. -- Field: Field4 (uc) - function Get_File_Time_Stamp (Design : Iir) return Time_Stamp_Id; - procedure Set_File_Time_Stamp (Design : Iir; Stamp : Time_Stamp_Id); + function Get_File_Checksum (Design : Iir) return File_Checksum_Id; + procedure Set_File_Checksum (Design : Iir; Checksum : File_Checksum_Id); -- Time stamp of the last analysis system time. -- Field: Field3 (uc) diff --git a/src/vhdl/nodes_meta.adb b/src/vhdl/nodes_meta.adb index 13422cb..514ed57 100644 --- a/src/vhdl/nodes_meta.adb +++ b/src/vhdl/nodes_meta.adb @@ -22,7 +22,7 @@ package body Nodes_Meta is Field_First_Design_Unit => Type_Iir, Field_Last_Design_Unit => Type_Iir, Field_Library_Declaration => Type_Iir, - Field_File_Time_Stamp => Type_Time_Stamp_Id, + Field_File_Checksum => Type_File_Checksum_Id, Field_Analysis_Time_Stamp => Type_Time_Stamp_Id, Field_Library => Type_Iir, Field_File_Dependence_List => Type_Iir_List, @@ -327,8 +327,8 @@ package body Nodes_Meta is return "last_design_unit"; when Field_Library_Declaration => return "library_declaration"; - when Field_File_Time_Stamp => - return "file_time_stamp"; + when Field_File_Checksum => + return "file_checksum"; when Field_Analysis_Time_Stamp => return "analysis_time_stamp"; when Field_Library => @@ -1407,7 +1407,7 @@ package body Nodes_Meta is return Attr_Ref; when Field_Library_Declaration => return Attr_Ref; - when Field_File_Time_Stamp => + when Field_File_Checksum => return Attr_None; when Field_Analysis_Time_Stamp => return Attr_None; @@ -2004,7 +2004,7 @@ package body Nodes_Meta is Field_Design_File_Directory, Field_Design_File_Filename, Field_Analysis_Time_Stamp, - Field_File_Time_Stamp, + Field_File_Checksum, Field_Elab_Flag, Field_File_Dependence_List, Field_Chain, @@ -4415,6 +4415,30 @@ package body Nodes_Meta is end case; end Set_Date_Type; + function Get_File_Checksum_Id + (N : Iir; F : Fields_Enum) return File_Checksum_Id is + begin + pragma Assert (Fields_Type (F) = Type_File_Checksum_Id); + case F is + when Field_File_Checksum => + return Get_File_Checksum (N); + when others => + raise Internal_Error; + end case; + end Get_File_Checksum_Id; + + procedure Set_File_Checksum_Id + (N : Iir; F : Fields_Enum; V: File_Checksum_Id) is + begin + pragma Assert (Fields_Type (F) = Type_File_Checksum_Id); + case F is + when Field_File_Checksum => + Set_File_Checksum (N, V); + when others => + raise Internal_Error; + end case; + end Set_File_Checksum_Id; + function Get_Iir (N : Iir; F : Fields_Enum) return Iir is begin @@ -5804,8 +5828,6 @@ package body Nodes_Meta is begin pragma Assert (Fields_Type (F) = Type_Time_Stamp_Id); case F is - when Field_File_Time_Stamp => - return Get_File_Time_Stamp (N); when Field_Analysis_Time_Stamp => return Get_Analysis_Time_Stamp (N); when others => @@ -5818,8 +5840,6 @@ package body Nodes_Meta is begin pragma Assert (Fields_Type (F) = Type_Time_Stamp_Id); case F is - when Field_File_Time_Stamp => - Set_File_Time_Stamp (N, V); when Field_Analysis_Time_Stamp => Set_Analysis_Time_Stamp (N, V); when others => @@ -5894,10 +5914,10 @@ package body Nodes_Meta is return K = Iir_Kind_Library_Clause; end Has_Library_Declaration; - function Has_File_Time_Stamp (K : Iir_Kind) return Boolean is + function Has_File_Checksum (K : Iir_Kind) return Boolean is begin return K = Iir_Kind_Design_File; - end Has_File_Time_Stamp; + end Has_File_Checksum; function Has_Analysis_Time_Stamp (K : Iir_Kind) return Boolean is begin diff --git a/src/vhdl/nodes_meta.ads b/src/vhdl/nodes_meta.ads index f1b874b..830ca25 100644 --- a/src/vhdl/nodes_meta.ads +++ b/src/vhdl/nodes_meta.ads @@ -28,6 +28,7 @@ package Nodes_Meta is Type_Boolean, Type_Date_State_Type, Type_Date_Type, + Type_File_Checksum_Id, Type_Iir, Type_Iir_All_Sensitized, Type_Iir_Constraint, @@ -61,7 +62,7 @@ package Nodes_Meta is Field_First_Design_Unit, Field_Last_Design_Unit, Field_Library_Declaration, - Field_File_Time_Stamp, + Field_File_Checksum, Field_Analysis_Time_Stamp, Field_Library, Field_File_Dependence_List, @@ -401,6 +402,11 @@ package Nodes_Meta is procedure Set_Date_Type (N : Iir; F : Fields_Enum; V: Date_Type); + function Get_File_Checksum_Id + (N : Iir; F : Fields_Enum) return File_Checksum_Id; + procedure Set_File_Checksum_Id + (N : Iir; F : Fields_Enum; V: File_Checksum_Id); + function Get_Iir (N : Iir; F : Fields_Enum) return Iir; procedure Set_Iir @@ -529,7 +535,7 @@ package Nodes_Meta is function Has_First_Design_Unit (K : Iir_Kind) return Boolean; function Has_Last_Design_Unit (K : Iir_Kind) return Boolean; function Has_Library_Declaration (K : Iir_Kind) return Boolean; - function Has_File_Time_Stamp (K : Iir_Kind) return Boolean; + function Has_File_Checksum (K : Iir_Kind) return Boolean; function Has_Analysis_Time_Stamp (K : Iir_Kind) return Boolean; function Has_Library (K : Iir_Kind) return Boolean; function Has_File_Dependence_List (K : Iir_Kind) return Boolean; diff --git a/src/vhdl/sem_inst.adb b/src/vhdl/sem_inst.adb index 4993c83..b60b34b 100644 --- a/src/vhdl/sem_inst.adb +++ b/src/vhdl/sem_inst.adb @@ -252,7 +252,8 @@ package body Sem_Inst is Set_Source_Ptr (Res, F, Get_Source_Ptr (N, F)); when Type_Date_Type | Type_Date_State_Type - | Type_Time_Stamp_Id => + | Type_Time_Stamp_Id + | Type_File_Checksum_Id => -- Can this happen ? raise Internal_Error; when Type_Base_Type => diff --git a/src/vhdl/translate/trans-chap2.adb b/src/vhdl/translate/trans-chap2.adb index 875e4a0..69ec3e5 100644 --- a/src/vhdl/translate/trans-chap2.adb +++ b/src/vhdl/translate/trans-chap2.adb @@ -1015,7 +1015,8 @@ package body Trans.Chap2 is raise Internal_Error; when Type_Date_Type | Type_Date_State_Type - | Type_Time_Stamp_Id => + | Type_Time_Stamp_Id + | Type_File_Checksum_Id => -- Can this happen ? raise Internal_Error; when Type_String8_Id diff --git a/testsuite/gna/bug10/testsuite.sh b/testsuite/gna/bug10/testsuite.sh index 32b9474..2c649ec 100755 --- a/testsuite/gna/bug10/testsuite.sh +++ b/testsuite/gna/bug10/testsuite.sh @@ -5,6 +5,6 @@ analyze FIFO.vhdl TestFIFO.vhdl elab_simulate testfifo --stop-time=4us -#clean +clean echo "Test successful" |