-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
Config_Pragmas : List_Id;
P : Node_Id;
SR_Present : Boolean;
+ No_Body : Boolean;
Cunit_Error_Flag : Boolean := False;
-- This flag is set True if we have to scan for a compilation unit
SR_Present := False;
+ -- If we see a pragma No_Body, remember not to complain about no body
+
+ No_Body := False;
+
if Token = Tok_Pragma then
Save_Scan_State (Scan_State);
Item := P_Pragma;
Save_Scan_State (Scan_State);
Item := P_Pragma;
+ if Item /= Error and then Pragma_Name (Item) = Name_No_Body then
+ No_Body := True;
+ end if;
+
if Item = Error
or else not Is_Configuration_Pragma_Name (Pragma_Name (Item))
then
else
if Operating_Mode = Check_Syntax and then Token = Tok_EOF then
- Error_Msg_SC ("?file contains no compilation units");
+
+ -- Do not complain if there is a pragma No_Body
+
+ if not No_Body then
+ Error_Msg_SC ("?file contains no compilation units");
+ end if;
else
Error_Msg_SC ("compilation unit expected");
Cunit_Error_Flag := True;
Get_Expected_Unit_Type
(File_Name (Current_Source_File)) = Expect_Body
then
- Error_Msg_BC ("keyword BODY expected here [see file name]");
+ Error_Msg_BC -- CODEFIX
+ ("keyword BODY expected here [see file name]");
Restore_Scan_State (Scan_State);
- Set_Unit (Comp_Unit_Node, P_Package (Pf_Pbod));
+ Set_Unit (Comp_Unit_Node, P_Package (Pf_Pbod_Pexp));
else
Restore_Scan_State (Scan_State);
- Set_Unit (Comp_Unit_Node, P_Package (Pf_Decl_Gins_Pbod_Rnam));
+ Set_Unit (Comp_Unit_Node, P_Package (Pf_Decl_Gins_Pbod_Rnam_Pexp));
end if;
elsif Token = Tok_Generic then
or else Token = Tok_Overriding
or else Token = Tok_Procedure
then
- Set_Unit (Comp_Unit_Node, P_Subprogram (Pf_Decl_Gins_Pbod_Rnam));
+ Set_Unit (Comp_Unit_Node, P_Subprogram (Pf_Decl_Gins_Pbod_Rnam_Pexp));
-- A little bit of an error recovery check here. If we just scanned
-- a subprogram declaration (as indicated by an SIS entry being
-- Otherwise we saved the semicolon position, so complain
else
- Error_Msg (""";"" should be IS", SIS_Semicolon_Sloc);
+ Error_Msg -- CODEFIX
+ (""";"" should be IS", SIS_Semicolon_Sloc);
end if;
Body_Node := Unit (Comp_Unit_Node);
-- Another error from which it is hard to recover
- if Nkind (Unit_Node) = N_Subprogram_Body_Stub
- or else Nkind (Unit_Node) = N_Package_Body_Stub
- then
+ if Nkind_In (Unit_Node, N_Subprogram_Body_Stub, N_Package_Body_Stub) then
Cunit_Error_Flag := True;
return Error;
end if;
Unit_Node := Specification (Unit_Node);
end if;
- if Nkind (Unit_Node) = N_Package_Declaration
- or else Nkind (Unit_Node) = N_Subprogram_Declaration
- or else Nkind (Unit_Node) = N_Subprogram_Body
- or else Nkind (Unit_Node) = N_Subprogram_Renaming_Declaration
+ if Nkind_In (Unit_Node, N_Package_Declaration,
+ N_Subprogram_Declaration,
+ N_Subprogram_Body,
+ N_Subprogram_Renaming_Declaration)
then
Unit_Node := Specification (Unit_Node);
end if;
end if;
- if Nkind (Unit_Node) = N_Task_Body
- or else Nkind (Unit_Node) = N_Protected_Body
- or else Nkind (Unit_Node) = N_Task_Type_Declaration
- or else Nkind (Unit_Node) = N_Protected_Type_Declaration
- or else Nkind (Unit_Node) = N_Single_Task_Declaration
- or else Nkind (Unit_Node) = N_Single_Protected_Declaration
+ if Nkind_In (Unit_Node, N_Task_Body,
+ N_Protected_Body,
+ N_Task_Type_Declaration,
+ N_Protected_Type_Declaration,
+ N_Single_Task_Declaration,
+ N_Single_Protected_Declaration)
then
Name_Node := Defining_Identifier (Unit_Node);
- elsif Nkind (Unit_Node) = N_Function_Instantiation
- or else Nkind (Unit_Node) = N_Function_Specification
- or else Nkind (Unit_Node) = N_Generic_Function_Renaming_Declaration
- or else Nkind (Unit_Node) = N_Generic_Package_Renaming_Declaration
- or else Nkind (Unit_Node) = N_Generic_Procedure_Renaming_Declaration
- or else Nkind (Unit_Node) = N_Package_Body
- or else Nkind (Unit_Node) = N_Package_Instantiation
- or else Nkind (Unit_Node) = N_Package_Renaming_Declaration
- or else Nkind (Unit_Node) = N_Package_Specification
- or else Nkind (Unit_Node) = N_Procedure_Instantiation
- or else Nkind (Unit_Node) = N_Procedure_Specification
+ elsif Nkind_In (Unit_Node, N_Function_Instantiation,
+ N_Function_Specification,
+ N_Generic_Function_Renaming_Declaration,
+ N_Generic_Package_Renaming_Declaration,
+ N_Generic_Procedure_Renaming_Declaration)
+ or else
+ Nkind_In (Unit_Node, N_Package_Body,
+ N_Package_Instantiation,
+ N_Package_Renaming_Declaration,
+ N_Package_Specification,
+ N_Procedure_Instantiation,
+ N_Procedure_Specification)
then
Name_Node := Defining_Unit_Name (Unit_Node);
+ elsif Nkind (Unit_Node) = N_Expression_Function then
+ Error_Msg_SP
+ ("expression function cannot be used as compilation unit");
+ return Comp_Unit_Node;
+
-- Anything else is a serious error, abandon scan
else
-- Check we did not with any child units
Item := First (Context_Items (Comp_Unit_Node));
-
while Present (Item) loop
if Nkind (Item) = N_With_Clause
and then Nkind (Name (Item)) /= N_Identifier
end if;
if Token /= Tok_With then
- Error_Msg_SC ("unexpected LIMITED ignored");
+ Error_Msg_SC -- CODEFIX
+ ("unexpected LIMITED ignored");
end if;
- if Ada_Version < Ada_05 then
+ if Ada_Version < Ada_2005 then
Error_Msg_SP ("LIMITED WITH is an Ada 2005 extension");
Error_Msg_SP
("\unit must be compiled with -gnat05 switch");
Restore_Scan_State (Scan_State); -- to PRIVATE
return Item_List;
- elsif Ada_Version < Ada_05 then
+ elsif Ada_Version < Ada_2005 then
Error_Msg_SP ("`PRIVATE WITH` is an Ada 2005 extension");
Error_Msg_SP
("\unit must be compiled with -gnat05 switch");
-- WITH TYPE is an obsolete GNAT specific extension
- Error_Msg_SP
- ("`WITH TYPE` is an obsolete 'G'N'A'T extension");
+ Error_Msg_SP ("`WITH TYPE` is an obsolete 'G'N'A'T extension");
Error_Msg_SP ("\use Ada 2005 `LIMITED WITH` clause instead");
Scan; -- past TYPE
-- place where such an "error" should be caught.
Set_Name (With_Node, P_Qualified_Simple_Name);
+ if Name (With_Node) = Error then
+ Remove (With_Node);
+ end if;
+
Set_First_Name (With_Node, First_Flag);
Set_Limited_Present (With_Node, Has_Limited);
Set_Private_Present (With_Node, Has_Private);
or else Token = Tok_Overriding
or else Token = Tok_Procedure
then
- Body_Node := P_Subprogram (Pf_Pbod);
+ Body_Node := P_Subprogram (Pf_Pbod_Pexp);
elsif Token = Tok_Package then
- Body_Node := P_Package (Pf_Pbod);
+ Body_Node := P_Package (Pf_Pbod_Pexp);
elsif Token = Tok_Protected then
Scan; -- past PROTECTED
OSDN Git Service
