------------------------------------------------------- ------------------------- -- -- -- OCARINA COMPONENTS -- -- -- -- O C A R I N A . A A D L . P A R S E R _ E R R O R S -- -- -- -- B o d y -- -- -- -- Copyright (C) 2004-2006, 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 Ada.Characters.Handling; with Locations; with Charset; with Namet; with Output; with Ocarina.AADL.Lexer; package body Ocarina.AADL.Parser_Errors is use Output; use Ocarina.AADL.Lexer; use Locations; use Namet; use Charset; procedure Display_Parsing_Code (Code : parsing_code); pragma inline (Display_Parsing_Code); -- Display corresponding string of given parsing code -------------------------- -- Display_Parsing_Code -- -------------------------- procedure Display_Parsing_Code (Code : parsing_code) is begin Write_Str (Image (Token_Location)); Write_Str (": parsing "); Write_Str (Image (Code)); Write_Str (", "); end Display_Parsing_Code; --------------------------- -- Display_Parsing_Error -- --------------------------- procedure Display_Parsing_Error (Code : parsing_code) is begin Set_Standard_Error; Display_Parsing_Code (Code); Write_Str ("unexpected "); Write_Line (Current_Token_Image); Set_Standard_Output; end Display_Parsing_Error; --------------------------- -- Display_Parsing_Error -- --------------------------- procedure Display_Parsing_Error (Code : parsing_code; Identifier : name_id) is begin Set_Standard_Error; Display_Parsing_Code (Code); Write_Str ("identifier '"); Write_Name (Identifier); Write_Str ("' is expected, found "); Write_Line (Current_Token_Image); Set_Standard_Output; end Display_Parsing_Error; --------------------------- -- Display_Parsing_Error -- --------------------------- procedure Display_Parsing_Error (Code : parsing_code; Expected_Token : token_type) is begin Set_Standard_Error; Display_Parsing_Code (Code); if Expected_Token = t_identifier then Write_Str ("an identifier"); else Write_Str ("token "); Write_Str (Quoted_Image (Expected_Token)); end if; Write_Str (" is expected, found "); Write_Line (Current_Token_Image); Set_Standard_Output; end Display_Parsing_Error; --------------------------- -- Display_Parsing_Error -- --------------------------- procedure Display_Parsing_Error (Code : parsing_code; Expected_Tokens : token_list_type) is Index : Integer; begin Set_Standard_Error; Display_Parsing_Code (Code); Write_Str ("token "); Index := Expected_Tokens'first; while Index < Expected_Tokens'last loop Write_Str (Quoted_Image (Expected_Tokens (Index))); Write_Str (" or "); Index := Index + 1; end loop; Write_Str (Quoted_Image (Expected_Tokens (Index))); Write_Str (" is expected, found "); Write_Line (Current_Token_Image); Set_Standard_Output; end Display_Parsing_Error; --------------------------- -- Display_Parsing_Error -- --------------------------- procedure Display_Parsing_Error (Code : parsing_code; Error_Msg : error_message_code) is begin Set_Standard_Error; Display_Parsing_Code (Code); Write_Line (Image (Error_Msg)); Set_Standard_Output; end Display_Parsing_Error; ----------- -- Image -- ----------- function Image (Code : parsing_code) return String is S : String := parsing_code'image (Code); Capital : Boolean := False; begin case Code is when pc_aadl_declaration => return "AADL_Declaration"; when pc_aadl_specification => return "AADL_Specification"; when pc_items_list => return "list of items"; when pc_mode_or_mode_transition => return "Mode or Mode_Transition"; when pc_port_spec_or_port_group_spec => return "Port_Spec or Port_Group_Spec"; when pc_port_refinement_or_port_group_refinement => return "Port_Refinement or Port_Group_Refinement"; when pc_property_association_or_contained_property_association => return "Property_Association or Contained_Property_Association"; when others => To_Lower (S); for I in S'range loop if S (I) = '_' then Capital := True; else if Capital then S (I) := Ada.Characters.Handling.To_Upper (S (I)); end if; Capital := False; end if; end loop; return S (4 .. S'last); end case; end Image; ----------- -- Image -- ----------- function Image (Code : error_message_code) return String is S : String := error_message_code'image (Code); begin case Code is when emc_access_property_association_is_not_allowed => return "Access_Property_Association is not allowed"; when emc_contained_property_association_is_not_allowed => return "Contained_Property_Association is not allowed"; when others => To_Lower (S); for I in S'range loop if S (I) = '_' then S (I) := ' '; end if; end loop; return S (5 .. S'last); end case; end Image; end Ocarina.AADL.Parser_Errors;