2011-08-25 Basile Starynkevitch <basile@starynkevitch.net>

	MELT branch merged with trunk rev 178073 using svnmerge.

2011-08-25  Basile Starynkevitch  <basile@starynkevitch.net>
	* gcc/melt-runtime.c (melt_linemap_compute_current_location): Use the
	linemap_position_for_column function for GCC 4.7 when merging with
	GCC trunk rev 178073.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/melt-branch@178087 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 43 insertions, 25 deletions

diff --git a/gcc/ada/par-ch10.adb b/gcc/ada/par-ch10.adb
index 37992b60059..08553dd0376 100644
--- a/gcc/ada/par-ch10.adb
+++ b/gcc/ada/par-ch10.adb
@@ -114,6 +114,7 @@ package body Ch10 is
       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
@@ -145,6 +146,10 @@ package body Ch10 is
 
       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;
@@ -179,6 +184,10 @@ package body Ch10 is
          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
@@ -301,7 +310,12 @@ package body Ch10 is
 
          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;
@@ -494,9 +508,7 @@ package body Ch10 is
 
       --  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;
@@ -512,10 +524,10 @@ package body Ch10 is
             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);
 
@@ -526,29 +538,35 @@ package body Ch10 is
             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