[multiple changes]

2012-07-17  Robert Dewar  <dewar@adacore.com>

	* exp_ch9.adb: Minor code reorganization.
	* exp_ch3.adb: Minor code improvement.

2012-07-17  Tristan Gingold  <gingold@adacore.com>

	* seh_init.c (__gnat_SEH_error_handler): Not compiled anymore
	on Windows 64 (+ SEH), as it is unused.

2012-07-17  Tristan Gingold  <gingold@adacore.com>

	* treepr.ads (psloc): Declare.
	* treepr.adb (psloc): New debug procedure to print a sloc.
	(Print_Sloc): New procedure, from ...
	(Print_Node_Subtree): ... this.  Call Print_Sloc.

2012-07-17  Javier Miranda  <miranda@adacore.com>

	* sem_prag.adb (CPP_Class): Transform obsolescent pragma CPP_Class into
	CPP convention automatically.

From-SVN: r189566

gcc/ada/ChangeLog

+2012-07-17  Robert Dewar  <dewar@adacore.com>
+
+	* exp_ch9.adb: Minor code reorganization.
+	* exp_ch3.adb: Minor code improvement.
+
+2012-07-17  Tristan Gingold  <gingold@adacore.com>
+
+	* seh_init.c (__gnat_SEH_error_handler): Not compiled anymore
+	on Windows 64 (+ SEH), as it is unused.
+
+2012-07-17  Tristan Gingold  <gingold@adacore.com>
+
+	* treepr.ads (psloc): Declare.
+	* treepr.adb (psloc): New debug procedure to print a sloc.
+	(Print_Sloc): New procedure, from ...
+	(Print_Node_Subtree): ... this.  Call Print_Sloc.
+
+2012-07-17  Javier Miranda  <miranda@adacore.com>
+
+	* sem_prag.adb (CPP_Class): Transform obsolescent pragma CPP_Class into
+	CPP convention automatically.
+
 2012-07-16  Tristan Gingold  <gingold@adacore.com>
 
 	* gcc-interface/decl.c (intrin_return_compatible_p): Map Address to

gcc/ada/exp_ch3.adb

@@ -3128,7 +3128,7 @@ package body Exp_Ch3 is
          --  to make it a valid Ada tree.
 
          if Is_Empty_List (Stmts) then
-            Append (New_Node (N_Null_Statement, Loc), Stmts);
+            Append (Make_Null_Statement (Loc), Stmts);
          end if;
 
          return Stmts;

gcc/ada/exp_ch9.adb

@@ -5486,7 +5486,7 @@ package body Exp_Ch9 is
    procedure Ensure_Statement_Present (Loc : Source_Ptr; Alt : Node_Id) is
    begin
       if Opt.Suppress_Control_Flow_Optimizations
-           and then Is_Empty_List (Statements (Alt))
+        and then Is_Empty_List (Statements (Alt))
       then
          Set_Statements (Alt, New_List (Make_Null_Statement (Loc)));
       end if;
@@ -7674,7 +7674,6 @@ package body Exp_Ch9 is
          if Present (Unpack) then
             Append_To (Conc_Typ_Stmts,
               Make_Implicit_If_Statement (N,
-
                 Condition =>
                   Make_Or_Else (Loc,
                     Left_Opnd =>
@@ -7684,6 +7683,7 @@ package body Exp_Ch9 is
                         Right_Opnd =>
                           New_Reference_To (RTE (
                             RE_POK_Protected_Entry), Loc)),
+
                     Right_Opnd =>
                       Make_Op_Eq (Loc,
                         Left_Opnd =>
@@ -7691,8 +7691,7 @@ package body Exp_Ch9 is
                         Right_Opnd =>
                           New_Reference_To (RTE (RE_POK_Task_Entry), Loc))),
 
-                 Then_Statements =>
-                   Unpack));
+                Then_Statements => Unpack));
          end if;
 
          --  Generate:
@@ -10299,31 +10298,29 @@ package body Exp_Ch9 is
          Index : Int;
          Proc  : Node_Id)
       is
-         Choices   : List_Id := No_List;
          Astmt     : constant Node_Id := Accept_Statement (Alt);
+         Choices   : List_Id;
          Alt_Stats : List_Id;
 
       begin
          Adjust_Condition (Condition (Alt));
-         Alt_Stats := No_List;
+         Choices := New_List (Make_Integer_Literal (Loc, Index));
 
-         if Present (Handled_Statement_Sequence (Astmt)) then
-            Choices := New_List (
-              Make_Integer_Literal (Loc, Index));
-
-            Alt_Stats := New_List (
-              Make_Procedure_Call_Statement (Sloc (Proc),
-                Name => New_Reference_To (
-                  Defining_Unit_Name (Specification (Proc)), Sloc (Proc))));
-         end if;
+         --  Accept with body
 
-         if No (Alt_Stats) then
-
-            --  Accept with no body, followed by trailing statements
+         if Present (Handled_Statement_Sequence (Astmt)) then
+            Alt_Stats :=
+              New_List (
+                Make_Procedure_Call_Statement (Sloc (Proc),
+                  Name =>
+                    New_Reference_To
+                      (Defining_Unit_Name (Specification (Proc)),
+                       Sloc (Proc))));
 
-            Choices := New_List (Make_Integer_Literal (Loc, Index));
+         --  Accept with no body (followed by trailing statements)
 
-            Alt_Stats := New_List;
+         else
+            Alt_Stats := Empty_List;
          end if;
 
          Ensure_Statement_Present (Sloc (Astmt), Alt);
@@ -10339,6 +10336,7 @@ package body Exp_Ch9 is
             Append_To (Trailing_List,
               Make_Goto_Statement (Loc,
                 Name => New_Copy (Identifier (End_Lab))));
+
          else
             Lab := End_Lab;
          end if;

gcc/ada/seh_init.c

@@ -169,9 +169,11 @@ __gnat_map_SEH (EXCEPTION_RECORD* ExceptionRecord, const char **msg)
     }
 }
 
+#if !(defined (_WIN64) && defined (__SEH__))
+
 EXCEPTION_DISPOSITION
 __gnat_SEH_error_handler (struct _EXCEPTION_RECORD* ExceptionRecord,
-			  void *EstablisherFrame,
+			  void *EstablisherFrame ATTRIBUTE_UNUSED,
 			  struct _CONTEXT* ContextRecord ATTRIBUTE_UNUSED,
 			  void *DispatcherContext ATTRIBUTE_UNUSED)
 {
@@ -182,14 +184,8 @@ __gnat_SEH_error_handler (struct _EXCEPTION_RECORD* ExceptionRecord,
 
   if (exception == NULL)
     {
-#if defined (_WIN64) && defined (__SEH__)
-      /* On Windows x64, do not transform other exception as they could
-	 be caught by user (when SEH is used to propagate exceptions).  */
-      return;
-#else
       exception = &program_error;
       msg = "unhandled signal";
-#endif
     }
 
 #if ! defined (_WIN64)
@@ -204,6 +200,7 @@ __gnat_SEH_error_handler (struct _EXCEPTION_RECORD* ExceptionRecord,
   Raise_From_Signal_Handler (exception, msg);
   return 0; /* This is never reached, avoid compiler warning  */
 }
+#endif /* !(defined (_WIN64) && defined (__SEH__)) */
 
 #if defined (_WIN64)
 /*  On x86_64 windows exception mechanism is no more based on a chained list

gcc/ada/sem_prag.adb

@@ -7665,6 +7665,19 @@ package body Sem_Prag is
                  ("'G'N'A'T pragma cpp'_class is now obsolete and has no " &
                   "effect; replace it by pragma import?", N);
             end if;
+
+            Check_Arg_Count (1);
+
+            Rewrite (N,
+              Make_Pragma (Loc,
+                Chars => Name_Import,
+                Pragma_Argument_Associations =>
+                  New_List (
+                    Make_Pragma_Argument_Association (Loc,
+                      Expression => Make_Identifier (Loc, Name_CPP)),
+                    New_Copy
+                      (First (Pragma_Argument_Associations (N))))));
+            Analyze (N);
          end CPP_Class;
 
          ---------------------

gcc/ada/treepr.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, 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- --
@@ -188,6 +188,9 @@ package body Treepr is
    --  level and the bars used to link list elements). In addition, for lines
    --  other than the first, an additional character Prefix_Char is output.
 
+   procedure Print_Sloc (Loc : Source_Ptr);
+   --  Print the human readable representation of Loc
+
    function Serial_Number (Id : Int) return Nat;
    --  Given a Node_Id, List_Id or Elist_Id, returns the previously assigned
    --  serial number, or zero if no serial number has yet been assigned.
@@ -887,7 +890,6 @@ package body Treepr is
       Field_To_Be_Printed : Boolean;
       Prefix_Str_Char     : String (Prefix_Str'First .. Prefix_Str'Last + 1);
 
-      Sfile : Source_File_Index;
       Fmt   : UI_Format;
 
    begin
@@ -933,20 +935,7 @@ package body Treepr is
          Print_Str (Prefix_Str_Char);
          Print_Str ("Sloc = ");
 
-         if Sloc (N) = Standard_Location then
-            Print_Str ("Standard_Location");
-
-         elsif Sloc (N) = Standard_ASCII_Location then
-            Print_Str ("Standard_ASCII_Location");
-
-         else
-            Sfile := Get_Source_File_Index (Sloc (N));
-            Print_Int (Int (Sloc (N)) - Int (Source_Text (Sfile)'First));
-            Write_Str ("  ");
-            Write_Location (Sloc (N));
-         end if;
-
-         Print_Eol;
+         Print_Sloc (Sloc (N));
       end if;
 
       --  Print Chars field if present
@@ -1397,6 +1386,30 @@ package body Treepr is
       Print_Term;
    end Print_Node_Subtree;
 
+   ----------------
+   -- Print_Sloc --
+   ----------------
+
+   procedure Print_Sloc (Loc : Source_Ptr) is
+      Sfile : Source_File_Index;
+
+   begin
+      if Loc = Standard_Location then
+         Print_Str ("Standard_Location");
+
+      elsif Loc = Standard_ASCII_Location then
+         Print_Str ("Standard_ASCII_Location");
+
+      else
+         Sfile := Get_Source_File_Index (Loc);
+         Print_Int (Int (Loc) - Int (Source_Text (Sfile)'First));
+         Write_Str ("  ");
+         Write_Location (Loc);
+      end if;
+
+      Print_Eol;
+   end Print_Sloc;
+
    ---------------
    -- Print_Str --
    ---------------
@@ -1524,6 +1537,16 @@ package body Treepr is
       Print_Node (N, Label, ' ');
    end Print_Tree_Node;
 
+   -----------
+   -- psloc --
+   -----------
+
+   procedure psloc (Loc : Source_Ptr) is
+   begin
+      Phase := Printing;
+      Print_Sloc (Loc);
+   end psloc;
+
    --------
    -- pt --
    --------

gcc/ada/treepr.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, 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- --
@@ -71,6 +71,10 @@ package Treepr is
    pragma Export (Ada, ppp);
    --  Same as Print_Node_Subtree
 
+   procedure psloc (Loc : Source_Ptr);
+   pragma Export (Ada, psloc);
+   --  Prints the sloc Loc
+
    --  The following are no longer needed; you can use pp or ppp instead
 
    procedure pe (E : Elist_Id);