diff options
| -rw-r--r-- | src/libraries.adb | 155 |
1 files changed, 80 insertions, 75 deletions
diff --git a/src/libraries.adb b/src/libraries.adb index c1d06c7eb..5e009d344 100644 --- a/src/libraries.adb +++ b/src/libraries.adb @@ -1082,98 +1082,103 @@ package body Libraries is -- Try to find a design unit with the same name in the work library. Id := Get_Hash_Id_For_Unit (Unit); - Design_Unit := Unit_Hash_Table (Id); - Prev_Design_Unit := Null_Iir; - while Design_Unit /= Null_Iir loop - Design_File := Get_Design_File (Design_Unit); - Library_Unit := Get_Library_Unit (Design_Unit); - if Get_Identifier (Design_Unit) = Unit_Id - and then Get_Library (Design_File) = Work_Library - and then Is_Same_Library_Unit (New_Library_Unit, Library_Unit) - then - -- LIBRARY_UNIT and UNIT designate the same design unit. - Mark_Unit_Obsolete (Design_Unit); + declare + Design_Unit, Prev_Design_Unit : Iir_Design_Unit; + Next_Design_Unit : Iir_Design_Unit; + begin + Design_Unit := Unit_Hash_Table (Id); + Prev_Design_Unit := Null_Iir; + while Design_Unit /= Null_Iir loop + Next_Design_Unit := Get_Hash_Chain (Design_Unit); + Design_File := Get_Design_File (Design_Unit); + Library_Unit := Get_Library_Unit (Design_Unit); + if Get_Identifier (Design_Unit) = Unit_Id + and then Get_Library (Design_File) = Work_Library + and then Is_Same_Library_Unit (New_Library_Unit, Library_Unit) + then + -- LIBRARY_UNIT and UNIT designate the same design unit. + Mark_Unit_Obsolete (Design_Unit); - -- Remove the old one from the hash table. - declare - Next_Design : Iir; - begin + -- Remove the old one from the hash table. -- Remove DESIGN_UNIT from the unit_hash. - Next_Design := Get_Hash_Chain (Design_Unit); if Prev_Design_Unit = Null_Iir then - Unit_Hash_Table (Id) := Next_Design; + Unit_Hash_Table (Id) := Next_Design_Unit; else - Set_Hash_Chain (Prev_Design_Unit, Next_Design); + Set_Hash_Chain (Prev_Design_Unit, Next_Design_Unit); end if; - end; - -- Remove DESIGN_UNIT from the design_file. - -- If KEEP_OBSOLETE is True, units that are obsoleted by units - -- in the same design file are kept. This allows to process - -- (pretty print, xrefs, ...) all units of a design file. - -- But still remove units that are replaced (if a file was - -- already in the library). - if not Keep_Obsolete - or else Get_Date_State (Design_Unit) = Date_Disk - then - Remove_Unit_From_File (Design_Unit, Design_File); + -- Remove DESIGN_UNIT from the design_file. + -- If KEEP_OBSOLETE is True, units that are obsoleted by units + -- in the same design file are kept. This allows to process + -- (pretty print, xrefs, ...) all units of a design file. + -- But still remove units that are replaced (if a file was + -- already in the library). + if not Keep_Obsolete + or else Get_Date_State (Design_Unit) = Date_Disk + then + Remove_Unit_From_File (Design_Unit, Design_File); - -- Put removed units in a list so that they are still - -- referenced. - Set_Chain (Design_Unit, Obsoleted_Design_Units); - Obsoleted_Design_Units := Design_Unit; - end if; + -- Put removed units in a list so that they are still + -- referenced. + Set_Chain (Design_Unit, Obsoleted_Design_Units); + Obsoleted_Design_Units := Design_Unit; + end if; - -- UNIT *must* replace library_unit if they don't belong - -- to the same file. - if Get_Design_File_Filename (Design_File) = File_Name - and then Get_Design_File_Directory (Design_File) = Dir_Name - then - -- In the same file. - if Get_Date_State (Design_Unit) = Date_Analyze then - -- Warns only if we are not re-analyzing the file. - if Is_Warning_Enabled (Warnid_Library) then - Warning_Msg_Sem - (Warnid_Library, +Unit, - "redefinition of a library unit in " - & "same design file:"); - Warning_Msg_Sem - (Warnid_Library, +Unit, "%n defined at %l is now %n", - (+Library_Unit, +Library_Unit, +New_Library_Unit)); - end if; - else - -- Free the stub corresponding to the unit. This is the - -- common case when a unit is reanalyzed after a change. - if not Keep_Obsolete then - Free_Design_Unit (Design_Unit); + -- UNIT *must* replace library_unit if they don't belong + -- to the same file. + if Get_Design_File_Filename (Design_File) = File_Name + and then Get_Design_File_Directory (Design_File) = Dir_Name + then + -- In the same file. + if Get_Date_State (Design_Unit) = Date_Analyze then + -- Warns only if we are not re-analyzing the file. + if Is_Warning_Enabled (Warnid_Library) then + Warning_Msg_Sem + (Warnid_Library, +Unit, + "redefinition of a library unit in " + & "same design file:"); + Warning_Msg_Sem + (Warnid_Library, +Unit, "%n defined at %l is now %n", + (+Library_Unit, +Library_Unit, +New_Library_Unit)); + end if; + else + -- Free the stub corresponding to the unit. This is the + -- common case when a unit is reanalyzed after a change. + if not Keep_Obsolete then + Free_Design_Unit (Design_Unit); + end if; end if; - end if; - -- Note: the current design unit should not be freed if - -- in use; unfortunatly, this is not obvious to check. - else - if Is_Warning_Enabled (Warnid_Library) then - if Get_Kind (Library_Unit) /= Get_Kind (New_Library_Unit) + -- Note: the current design unit should not be freed if + -- in use; unfortunatly, this is not obvious to check. + else + if Is_Warning_Enabled (Warnid_Library) + and then Get_Kind (Library_Unit) in Iir_Kinds_Primary_Unit then + if Get_Kind (Library_Unit) /= Get_Kind (New_Library_Unit) + then + Warning_Msg_Sem + (Warnid_Library, +Unit, + "changing definition of a library unit:"); + Warning_Msg_Sem + (Warnid_Library, +Unit, + "%n is now %n", (+Library_Unit, +New_Library_Unit)); + end if; Warning_Msg_Sem (Warnid_Library, +Unit, - "changing definition of a library unit:"); - Warning_Msg_Sem - (Warnid_Library, +Unit, - "%n is now %n", (+Library_Unit, +New_Library_Unit)); + "%n was also defined in file %i", + (+Library_Unit, + +Get_Design_File_Filename (Design_File))); end if; - Warning_Msg_Sem - (Warnid_Library, +Unit, - "%n was also defined in file %i", - (+Library_Unit, +Get_Design_File_Filename (Design_File))); end if; + -- Continue to search as there can be several units with the + -- same name (like package and package body). end if; - exit; - else + Prev_Design_Unit := Design_Unit; - Design_Unit := Get_Hash_Chain (Design_Unit); - end if; - end loop; + Design_Unit := Next_Design_Unit; + end loop; + end; -- Try to find the design file in the library. -- First try the last one found. |