---------------------------------------------------- ---------------------------- -- -- -- OCARINA COMPONENTS -- -- -- -- O C A R I N A . A N A L Y Z E R . M E S S A G E S -- -- -- -- B o d y -- -- -- -- Copyright (C) 2004-2007, GET-Telecom Paris. -- -- -- -- Ocarina is free software; you can redistribute it and/or modify -- -- it under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. Ocarina is distributed in the hope that it will be -- -- useful, but WITHOUT ANY WARRANTY; without even the implied warranty of -- -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -- -- Public License for more details. You should have received a copy of the -- -- GNU General Public License distributed with Ocarina; see file COPYING. -- -- If not, write to the Free Software Foundation, 51 Franklin Street, Fifth -- -- Floor, Boston, MA 02111-1301, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- -- Ocarina is maintained by the Ocarina team -- -- (ocarina-users@listes.enst.fr) -- -- -- ------------------------------------------------------------------------------ with Namet; with Output; with Ocarina.Entities; with Ocarina.Entities.Properties; with Ocarina.Debug; package body Ocarina.Analyzer.Messages is procedure Display_Location_And_Node_Kind (Loc : location; Kind : Ocarina.Nodes.node_kind); function Image (Category : component_category) return String; -- Return component category image ----------------------- -- Display_Node_Link -- ----------------------- procedure Display_Node_Link (Node1 : node_id; Node2 : node_id) is use Output; use Ocarina.Nodes; begin if D_Analyzer then Set_Standard_Error; Write_Str ("ANL: "); if Present (Node1) then Write_Str (Image (Loc (Node1))); else Write_Str ("no loc"); end if; Write_Str (" -> "); if Present (Node2) then Write_Line (Image (Loc (Node2))); else Write_Line ("no loc"); end if; Set_Standard_Output; end if; end Display_Node_Link; ---------------------------- -- Display_Analyzer_Error -- ---------------------------- procedure Display_Analyzer_Error (Node1 : node_id; Message1 : String; Node2 : node_id := No_Node; Message2 : String := ""; Message0 : String := ""; Loc : location := No_Location) is use Debug; use Namet; use Ocarina.Nodes; use Output; use Ocarina.Entities; begin Set_Standard_Error; if Loc /= No_Location then Write_Str (Image (Loc) & ": "); else Write_Str (Image (Ocarina.Nodes.Loc (Node1)) & ": "); end if; if Message0 /= "" then Write_Str (" (" & Message0 & ") "); end if; if Present (Node1) then if Get_Entity_Category (Node1) /= ec_undefined then Write_Name (Get_Name_Of_Entity (Node1, Get_Display_Name => True)); elsif Kind (Node1) = k_entity_reference then Write_Name (Get_Name_Of_Entity_Reference (Node1, Get_Display_Name => True)); end if; Write_Str (" (" & Image (Kind (Node1)) & ") "); end if; Write_Str (Message1); if Present (Node2) then if Get_Entity_Category (Node2) /= ec_undefined then Write_Name (Get_Name_Of_Entity (Node2, Get_Display_Name => True)); elsif Kind (Node2) = k_entity_reference then Write_Name (Get_Name_Of_Entity_Reference (Node2, Get_Display_Name => True)); end if; Write_Str (" (" & Image (Kind (Node2)) & ") "); end if; Write_Line (Message2); Set_Standard_Output; end Display_Analyzer_Error; ------------------------------- -- Display_No_Parent_Package -- ------------------------------- procedure Display_No_Parent_Package (Loc : location; Parent_Name : name_id) is use Namet; use Output; begin Set_Standard_Error; Write_Str (Image (Loc)); Write_Str (": Parent package '"); Write_Name (Parent_Name); Write_Line ("' undefined"); Set_Standard_Output; end Display_No_Parent_Package; ---------------------------------- -- Display_Conflict_Declaration -- ---------------------------------- procedure Display_Conflict_Declaration (Loc1 : location; Kind : Ocarina.Nodes.node_kind; Name : name_id; Loc2 : location) is use Namet; use Output; begin Set_Standard_Error; Display_Location_And_Node_Kind (Loc1, Kind); Write_Str (" '"); Write_Name (Name); Write_Str ("' conflicts with declaration at "); Write_Line (Image (Loc2)); Set_Standard_Output; end Display_Conflict_Declaration; ---------------------------------- -- Display_Conflict_Declaration -- ---------------------------------- procedure Display_Conflict_Declaration (Ident1 : node_id; Ident2 : node_id) is use Namet; use Output; use Ocarina.Nodes; begin Set_Standard_Error; Display_Location_And_Node_Kind (Loc (Ident1), Kind (Corresponding_Entity (Ident1))); Write_Str (" '"); Write_Name (Display_Name (Ident1)); Write_Str ("' conflicts with declaration "); Write_Str (Debug.Image (Kind (Corresponding_Entity (Ident2)))); Write_Str (" '"); Write_Name (Display_Name (Ident2)); Write_Str ("' at "); Write_Line (Image (Loc (Ident2))); Set_Standard_Output; end Display_Conflict_Declaration; ------------------------------------ -- Display_Location_And_Node_Kind -- ------------------------------------ procedure Display_Location_And_Node_Kind (Loc : location; Kind : Ocarina.Nodes.node_kind) is use Output; use Debug; begin Write_Str (Image (Loc)); Write_Str (": "); Write_Str (Debug.Image (Kind)); end Display_Location_And_Node_Kind; ---------------------------- -- Display_Undefined_Item -- ---------------------------- procedure Display_Undefined_Item (Loc : location; Kind : Ocarina.Nodes.node_kind; Name : name_id) is use Namet; use Output; begin Set_Standard_Error; Display_Location_And_Node_Kind (Loc, Kind); Write_Str (" '"); Write_Name (Name); Write_Line ("' is undefined or not visible"); Set_Standard_Output; end Display_Undefined_Item; ---------------------------- -- Display_Undefined_Item -- ---------------------------- procedure Display_Undefined_Item (Kind : Ocarina.Nodes.node_kind; Item : node_id) is use Ocarina.Nodes; use Output; use Namet; begin Set_Standard_Error; Display_Location_And_Node_Kind (Loc (Item), Kind); Write_Str (" '"); Write_Str (Get_Name_String (Display_Name (Item))); Write_Line ("' is undefined or not visible"); Set_Standard_Output; end Display_Undefined_Item; ------------------------------------------- -- Display_Unexpected_Component_Category -- ------------------------------------------- procedure Display_Unexpected_Component_Category (Expected_Cat : component_category; Found_Cat : component_category; Item : node_id; Loc : location) is use Ocarina.Nodes; use Output; use Namet; begin Set_Standard_Error; Write_Str (Image (Ocarina.Nodes.Loc (Item))); Write_Str (": expected component category "); Write_Str (Image (Expected_Cat)); Write_Str (", found "); Write_Str (Image (Found_Cat)); Write_Str (" '"); Write_Str (Get_Name_String (Display_Name (Item))); Write_Str ("' defined at "); Write_Line (Image (Loc)); Set_Standard_Output; end Display_Unexpected_Component_Category; ----------------------------- -- Display_Unexpected_Type -- ----------------------------- procedure Display_Unexpected_Type (Expected_Type : Ocarina.Nodes.node_kind; Found_Type : Ocarina.Nodes.node_kind; Item : node_id; Loc : location) is use Ocarina.Nodes; use Output; use Namet; begin Set_Standard_Error; Write_Str (Image (Ocarina.Nodes.Loc (Item))); Write_Str (": expected type "); Write_Str (Debug.Image (Expected_Type)); Write_Str (", found type "); Write_Str (Debug.Image (Found_Type)); Write_Str (" '"); Write_Str (Get_Name_String (Display_Name (Item))); Write_Str ("' defined at "); Write_Line (Image (Loc)); Set_Standard_Output; end Display_Unexpected_Type; ----------- -- Image -- ----------- function Image (Category : component_category) return String is begin case Category is when cc_data => return "Data"; when cc_subprogram => return "Subprogram"; when cc_thread => return "Thread"; when cc_threadgroup => return "ThreadGroup"; when cc_process => return "Process"; when cc_memory => return "Memory"; when cc_processor => return "Processor"; when cc_bus => return "Bus"; when cc_device => return "Device"; when cc_system => return "System"; when cc_unknown => return "UNKNOWN"; end case; end Image; ------------------- -- Debug_Message -- ------------------- procedure Debug_Message (Location : String; Message : String) is use Output; begin if D_Analyzer then Set_Standard_Error; Write_Str ("ANL: "); Write_Str (Location & ": "); Write_Line (Message); Set_Standard_Output; end if; end Debug_Message; ------------------------------ -- Display_Cyclic_Extension -- ------------------------------ procedure Display_Cyclic_Extension (Cycling_Node : node_id) is use Output; use Ocarina.Nodes; pragma assert (Present (Cycling_Node)); begin Set_Standard_Error; Display_Location_And_Node_Kind (Loc (Cycling_Node), Kind (Cycling_Node)); Write_Line (" creates a circular extension "); Set_Standard_Output; end Display_Cyclic_Extension; ------------------------------ -- Display_Cyclic_Inversion -- ------------------------------ procedure Display_Cyclic_Inversion (Cycling_Node : node_id) is use Output; use Ocarina.Nodes; pragma assert (Present (Cycling_Node)); begin Set_Standard_Error; Display_Location_And_Node_Kind (Loc (Cycling_Node), Kind (Cycling_Node)); Write_Line (" creates a cycle in port group inversions"); Set_Standard_Output; end Display_Cyclic_Inversion; ---------------------------------- -- Display_Cyclic_Subcomponents -- ---------------------------------- procedure Display_Cyclic_Subcomponents (Cycling_Node : node_id) is use Output; use Ocarina.Nodes; pragma assert (Present (Cycling_Node)); begin Set_Standard_Error; Display_Location_And_Node_Kind (Loc (Cycling_Node), Kind (Cycling_Node)); Write_Line (" creates a cycle in subcomponent declarations"); Set_Standard_Output; end Display_Cyclic_Subcomponents; --------------------------------------- -- Display_Conflicting_Initial_Modes -- --------------------------------------- procedure Display_Conflicting_Initial_Modes (Initial_Mode : node_id; Existing_Initial_Mode : node_id) is use Output; use Ocarina.Nodes; pragma assert (Kind (Initial_Mode) = k_mode); pragma assert (Kind (Initial_Mode) = k_mode); begin Set_Standard_Error; Write_Str (Image (Loc (Initial_Mode))); Write_Str (": initial mode conflicts with another one at "); Write_Line (Image (Loc (Existing_Initial_Mode))); Set_Standard_Output; end Display_Conflicting_Initial_Modes; -------------------------------- -- Display_Link_To_Wrong_Node -- -------------------------------- procedure Display_Link_To_Wrong_Node (Node : node_id; Pointed_Node : node_id; Warning : Boolean := False) is use Ocarina.Nodes; use Namet; use Debug; use Output; use Ocarina.Entities; pragma assert (Present (Node)); begin Set_Standard_Error; Write_Str (Image (Ocarina.Nodes.Loc (Node)) & ": "); if Warning then Write_Str ("warning: "); end if; if Get_Entity_Category (Node) /= ec_undefined then Write_Name (Get_Name_Of_Entity (Node, Get_Display_Name => True)); elsif Kind (Node) = k_entity_reference then Write_Name (Get_Name_Of_Entity_Reference (Node, Get_Display_Name => True)); end if; Write_Str (" (" & Image (Kind (Node)) & ")"); if Present (Pointed_Node) then Write_Str (" points to "); if Get_Entity_Category (Pointed_Node) /= ec_undefined then Write_Name (Get_Name_Of_Entity (Pointed_Node, Get_Display_Name => True)); elsif Kind (Pointed_Node) = k_entity_reference then Write_Name (Get_Name_Of_Entity_Reference (Pointed_Node, Get_Display_Name => True)); end if; Write_Str (" (" & Image (Kind (Pointed_Node)) & ")"); Write_Str (", which is not of an adequate kind"); else Write_Str (" does not point to anything or to something unreachable"); end if; Write_Eol; Set_Standard_Output; end Display_Link_To_Wrong_Node; ----------------------------------------- -- Display_Incompatible_Property_Types -- ----------------------------------------- procedure Display_Incompatible_Property_Types (Property_Association : node_id; Property_Value : node_id; Property_Name : node_id) is use Output; use Ocarina.Nodes; use Ocarina.Entities; use Ocarina.Entities.Properties; pragma assert (Kind (Property_Name) = k_property_name_declaration); pragma assert (Present (Property_Value)); begin Set_Standard_Error; Write_Str (Image (Loc (Property_Value))); Write_Str (": when evaluating the value of "); Write_Str (Get_Name_Of_Entity (Property_Association)); Write_Str (", the value"); if Kind (Property_Value) /= k_property_value then Write_Str (" (" & property_type'image (Get_Type_Of_Property_Value (Property_Value)) & ")"); -- We only display the type if the property value is explicit end if; Write_Str (" is not conformant with declaration at "); Write_Str (Image (Loc (Property_Name))); Write_Line (" (" & property_type'image (Get_Type_Of_Property (Property_Name)) & ")"); Set_Standard_Output; end Display_Incompatible_Property_Types; ---------------------------------------- -- Display_Inconsistent_Property_Type -- ---------------------------------------- procedure Display_Inconsistent_Property_Type (Property_Type : node_id) is use Output; use Ocarina.Nodes; use Ocarina.Entities; use Ocarina.Entities.Properties; pragma assert (Present (Property_Type)); begin Set_Standard_Error; Write_Str (Image (Loc (Property_Type))); Write_Line (": property type is inconsistent"); Set_Standard_Output; end Display_Inconsistent_Property_Type; ---------------------------------------------- -- Display_Inconsistency_In_Property_Values -- ---------------------------------------------- procedure Display_Inconsistency_In_Property_Values (Property_Value1 : node_id; Property_Value2 : node_id; Reference_Property : node_id) is use Output; use Namet; use Ocarina.Nodes; use Ocarina.Debug; use Ocarina.Entities; use Ocarina.Entities.Properties; pragma assert (Present (Property_Value1)); pragma assert (Present (Property_Value2)); pragma assert (No (Reference_Property) or else Kind (Reference_Property) = k_property_association or else Kind (Reference_Property) = k_property_name_declaration or else Kind (Reference_Property) = k_property_type_declaration or else Kind (Reference_Property) = k_constant_property_declaration); begin Set_Standard_Error; Write_Str (Image (Loc (Reference_Property))); Write_Str (": when evaluating the value of "); Write_Name (Get_Name_Of_Entity (Reference_Property)); Write_Str (", the value at "); Write_Str (Image (Loc (Property_Value1))); Write_Str (" ("); if Kind (Property_Value1) = k_list_id then if First_Node (list_id (Property_Value1)) /= No_Node then Write_Str ("list of "); Write_Str (Image (Kind (First_Node (list_id (Property_Value1))))); else Write_Str ("list"); end if; else if Next_Node (Property_Value1) /= No_Node then Write_Str ("list of "); end if; Write_Str (Image (Kind (Property_Value1))); end if; Write_Str (") is inconsistent with " & "the other one declared at "); Write_Str (Image (Loc (Property_Value2))); Write_Str (" ("); if Kind (Property_Value2) = k_list_id then if First_Node (list_id (Property_Value2)) /= No_Node then Write_Str ("list of "); Write_Str (Image (Kind (First_Node (list_id (Property_Value2))))); else Write_Str ("list"); end if; else if Next_Node (Property_Value2) /= No_Node then Write_Str ("list of "); end if; Write_Str (Image (Kind (Property_Value2))); end if; Write_Line (")"); Set_Standard_Output; end Display_Inconsistency_In_Property_Values; --------------------------------------- -- Display_Property_List_Discrepancy -- --------------------------------------- procedure Display_Property_List_Discrepancy (Property_Association : node_id; Property_Name : node_id) is use Output; use Ocarina.Nodes; use Ocarina.Entities; use Ocarina.Entities.Properties; pragma assert (Kind (Property_Name) = k_property_name_declaration); pragma assert (Kind (Property_Association) = k_property_association); begin Set_Standard_Error; Write_Str (Image (Loc (Property_Association))); Write_Str (": "); Write_Str (Get_Name_Of_Entity (Property_Association)); if Type_Of_Property_Is_A_List (Property_Association) then Write_Str (" is a list while the corresponding property name at "); else Write_Str (" is not a list while the corresponding property name at "); end if; Write_Str (Image (Loc (Property_Name))); if Type_Of_Property_Is_A_List (Property_Name) then Write_Line (" is a list."); else Write_Line (" is not a list."); end if; Set_Standard_Output; end Display_Property_List_Discrepancy; ----------------------------------------- -- Display_Conversion_To_Property_List -- ----------------------------------------- procedure Display_Conversion_To_Property_List (Property_Association : node_id; Property_Name : node_id) is use Output; use Ocarina.Nodes; use Ocarina.Entities; use Ocarina.Entities.Properties; pragma assert (Kind (Property_Name) = k_property_name_declaration); pragma assert (Kind (Property_Association) = k_property_association); begin Set_Standard_Error; Write_Str (Image (Loc (Property_Association))); Write_Str (": Warning: "); Write_Str (Get_Name_Of_Entity (Property_Association)); Write_Str (" is not a list while the corresponding property name at "); Write_Str (Image (Loc (Property_Name))); Write_Line (" is a list."); Write_Str ("The value of "); Write_Str (Get_Name_Of_Entity (Property_Association)); Write_Line (" has been converted into a list."); Set_Standard_Output; end Display_Conversion_To_Property_List; ------------------------------------- -- Display_Property_Not_Applicable -- ------------------------------------- procedure Display_Property_Not_Applicable (Property_Association : node_id; Entity : node_id) is use Output; use Ocarina.Nodes; use Ocarina.Entities; use Ocarina.Entities.Properties; pragma assert (Kind (Property_Association) = k_property_association); pragma assert (Present (Entity)); begin Set_Standard_Error; Write_Str (Image (Loc (Property_Association))); Write_Str (": "); Write_Str (Get_Name_Of_Entity (Property_Association)); Write_Str (" cannot apply to "); Write_Line (Get_Name_Of_Entity (Entity)); Set_Standard_Output; end Display_Property_Not_Applicable; end Ocarina.Analyzer.Messages;