[multiple changes]

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

	* a-exexpr.adb, freeze.adb, a-exexpr-gcc.adb, a-except-2005.adb,
	sem_eval.adb, s-fileio.adb: Minor reformatting.

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

	* sem_prag.adb (Analyze_Pragma): Remove support for obsolescent
	pragma CPP_Class.
	* sem_ch13.adb (Analyze_Freeze_Entity): Add missing error on Ada
	derivations of CPP types.  Found updating the tests affected by
	the removal of pragma CPP_Class.

2012-07-16  Thomas Quinot  <quinot@adacore.com>

	* back_end.adb: Minor reformatting.

2012-07-16  Thomas Quinot  <quinot@adacore.com>

	* exp_ch9.adb (Expand_N_Selective_Accept.Process_Accept_Alternative):
	Remove junk test that was always true. For the case of no statements
	following the ACCEPT, jump directly to End_Lab instead of
	introducing an intermediate jump.
	(Expand_N_Selective_Accept.Process_Delay_Alternative): Fix
	predicate testing for presence of statements following the DELAY.
	that was always true. For the case of no statements following
	the ACCEPT, jump directly to End_Lab instead of introducing an
	intermediate jump.
	(Expand_N_Selective_Accept): Fix incorrect insertion point for
	end label.

From-SVN: r189534

gcc/ada/ChangeLog

+2012-07-16  Robert Dewar  <dewar@adacore.com>
+
+	* a-exexpr.adb, freeze.adb, a-exexpr-gcc.adb, a-except-2005.adb,
+	sem_eval.adb, s-fileio.adb: Minor reformatting.
+
+2012-07-16  Javier Miranda  <miranda@adacore.com>
+
+	* sem_prag.adb (Analyze_Pragma): Remove support for obsolescent
+	pragma CPP_Class.
+	* sem_ch13.adb (Analyze_Freeze_Entity): Add missing error on Ada
+	derivations of CPP types.  Found updating the tests affected by
+	the removal of pragma CPP_Class.
+
+2012-07-16  Thomas Quinot  <quinot@adacore.com>
+
+	* back_end.adb: Minor reformatting.
+
+2012-07-16  Thomas Quinot  <quinot@adacore.com>
+
+	* exp_ch9.adb (Expand_N_Selective_Accept.Process_Accept_Alternative):
+	Remove junk test that was always true. For the case of no statements
+	following the ACCEPT, jump directly to End_Lab instead of
+	introducing an intermediate jump.
+	(Expand_N_Selective_Accept.Process_Delay_Alternative): Fix
+	predicate testing for presence of statements following the DELAY.
+	that was always true. For the case of no statements following
+	the ACCEPT, jump directly to End_Lab instead of introducing an
+	intermediate jump.
+	(Expand_N_Selective_Accept): Fix incorrect insertion point for
+	end label.
+
 2012-07-16  Thomas Quinot  <quinot@adacore.com>
 
 	* gnat_rm.texi: Minor documentation improvements.

gcc/ada/a-except-2005.adb

@@ -274,22 +274,21 @@ package body Ada.Exceptions is
 
    function Create_Occurrence_From_Signal_Handler
      (E : Exception_Id;
-      M : System.Address)
-     return EOA;
+      M : System.Address) return EOA;
    --  Create and build an exception occurrence using exception id E and
    --  nul-terminated message M.
 
    function Create_Machine_Occurrence_From_Signal_Handler
      (E : Exception_Id;
-      M : System.Address)
-     return System.Address;
+      M : System.Address) return System.Address;
    pragma Export (C, Create_Machine_Occurrence_From_Signal_Handler,
                   "__gnat_create_machine_occurrence_from_signal_handler");
    --  Create and build an exception occurrence using exception id E and
    --  nul-terminated message M. Return the machine occurrence.
 
    procedure Raise_Exception_No_Defer
-      (E : Exception_Id; Message : String := "");
+     (E       : Exception_Id;
+      Message : String := "");
    pragma Export
     (Ada, Raise_Exception_No_Defer,
      "ada__exceptions__raise_exception_no_defer");
@@ -1051,10 +1050,10 @@ package body Ada.Exceptions is
 
    function Create_Occurrence_From_Signal_Handler
      (E : Exception_Id;
-      M : System.Address)
-     return EOA
+      M : System.Address) return EOA
    is
       X : constant EOA := Exception_Propagation.Allocate_Occurrence;
+
    begin
       Exception_Data.Set_Exception_C_Msg (X, E, M);
 
@@ -1072,8 +1071,7 @@ package body Ada.Exceptions is
 
    function Create_Machine_Occurrence_From_Signal_Handler
      (E : Exception_Id;
-      M : System.Address)
-     return System.Address
+      M : System.Address) return System.Address
    is
    begin
       return Create_Occurrence_From_Signal_Handler (E, M).Machine_Occurrence;

gcc/ada/a-exexpr-gcc.adb

@@ -203,8 +203,7 @@ package body Exception_Propagation is
    --  directly from gigi.
 
    function Setup_Current_Excep
-     (GCC_Exception : not null GCC_Exception_Access)
-     return EOA;
+     (GCC_Exception : not null GCC_Exception_Access) return EOA;
    pragma Export (C, Setup_Current_Excep, "__gnat_setup_current_excep");
    --  Write Get_Current_Excep.all from GCC_Exception
 
@@ -344,8 +343,7 @@ package body Exception_Propagation is
    -------------------------
 
    function Setup_Current_Excep
-     (GCC_Exception : not null GCC_Exception_Access)
-     return EOA
+     (GCC_Exception : not null GCC_Exception_Access) return EOA
    is
       Excep : constant EOA := Get_Current_Excep.all;
 
@@ -427,6 +425,7 @@ package body Exception_Propagation is
      (GCC_Exception : not null GCC_Exception_Access)
    is
       Excep : EOA;
+
    begin
       --  Perform a standard raise first. If a regular handler is found, it
       --  will be entered after all the intermediate cleanups have run. If

gcc/ada/a-exexpr.adb

@@ -65,6 +65,7 @@ package body Exception_Propagation is
 
    procedure Propagate_Exception (Excep : EOA) is
       Jumpbuf_Ptr : constant Address := Get_Jmpbuf_Address.all;
+
    begin
       --  If the jump buffer pointer is non-null, transfer control using
       --  it. Otherwise announce an unhandled exception (note that this

gcc/ada/back_end.adb

@@ -237,7 +237,7 @@ package body Back_End is
             elsif Switch_Chars (First .. Last) = "fpreserve-control-flow" then
                Opt.Suppress_Control_Flow_Optimizations := True;
 
-            --  Back end switcg -fdump-scos, which exists primarily for C, is
+            --  Back end switch -fdump-scos, which exists primarily for C, is
             --  also accepted for Ada as a synonym of -gnateS.
 
             elsif Switch_Chars (First .. Last) = "fdump-scos" then

gcc/ada/freeze.adb

@@ -1041,8 +1041,9 @@ package body Freeze is
          Comp_Type := Etype (Comp);
          Comp_Def  := Component_Definition (Parent (Comp));
 
-         Comp_Byte_Aligned := Present (Component_Clause (Comp))
-           and then Normalized_First_Bit (Comp) mod System_Storage_Unit = 0;
+         Comp_Byte_Aligned :=
+           Present (Component_Clause (Comp))
+             and then Normalized_First_Bit (Comp) mod System_Storage_Unit = 0;
 
       --  Array case
 

gcc/ada/s-fileio.adb

@@ -626,7 +626,6 @@ package body System.File_IO is
          then
             Start := J + 1;
             Stop := Start - 1;
-
             while Form (Stop + 1) /= ASCII.NUL
               and then Form (Stop + 1) /= ','
             loop

gcc/ada/sem_ch13.adb

@@ -48,6 +48,7 @@ with Sem_Ch6;  use Sem_Ch6;
 with Sem_Ch8;  use Sem_Ch8;
 with Sem_Ch9;  use Sem_Ch9;
 with Sem_Dim;  use Sem_Dim;
+with Sem_Disp; use Sem_Disp;
 with Sem_Eval; use Sem_Eval;
 with Sem_Res;  use Sem_Res;
 with Sem_Type; use Sem_Type;
@@ -4322,6 +4323,46 @@ package body Sem_Ch13 is
          end;
       end if;
 
+      --  Check Ada derivation of CPP type
+
+      if Expander_Active
+        and then Tagged_Type_Expansion
+        and then Ekind (E) = E_Record_Type
+        and then Etype (E) /= E
+        and then Is_CPP_Class (Etype (E))
+        and then CPP_Num_Prims (Etype (E)) > 0
+        and then not Is_CPP_Class (E)
+        and then not Has_CPP_Constructors (Etype (E))
+      then
+         --  If the parent has C++ primitives but it has no constructor then
+         --  check that all the primitives are overridden in this derivation;
+         --  otherwise the constructor of the parent is needed to build the
+         --  dispatch table.
+
+         declare
+            Elmt : Elmt_Id;
+            Prim : Node_Id;
+
+         begin
+            Elmt := First_Elmt (Primitive_Operations (E));
+            while Present (Elmt) loop
+               Prim := Node (Elmt);
+
+               if not Is_Abstract_Subprogram (Prim)
+                 and then No (Interface_Alias (Prim))
+                 and then Find_Dispatching_Type (Ultimate_Alias (Prim)) /= E
+               then
+                  Error_Msg_Name_1 := Chars (Etype (E));
+                  Error_Msg_N
+                    ("'C'P'P constructor required for parent type %", E);
+                  exit;
+               end if;
+
+               Next_Elmt (Elmt);
+            end loop;
+         end;
+      end if;
+
       Inside_Freezing_Actions := Inside_Freezing_Actions - 1;
 
       --  If we have a type with predicates, build predicate function

gcc/ada/sem_eval.adb

@@ -218,12 +218,12 @@ package body Sem_Eval is
    --  If Fold and Stat are both set to False then this routine performs also
    --  the following extra actions:
    --
-   --    * If either operand is Any_Type then propagate it to result to
-   --      prevent cascaded errors.
+   --    If either operand is Any_Type then propagate it to result to
+   --    prevent cascaded errors.
    --
-   --    * If some operand raises constraint error, then replace the node N
-   --      with the raise constraint error node. This replacement inherits the
-   --      Is_Static_Expression flag from the operands.
+   --    If some operand raises constraint error, then replace the node N
+   --    with the raise constraint error node. This replacement inherits the
+   --    Is_Static_Expression flag from the operands.
 
    procedure Test_Expression_Is_Foldable
      (N    : Node_Id;

gcc/ada/sem_prag.adb

@@ -4690,6 +4690,12 @@ package body Sem_Prag is
                   Get_Pragma_Arg (Arg2));
             end if;
 
+            if Etype (Def_Id) /= Def_Id
+              and then not Is_CPP_Class (Root_Type (Def_Id))
+            then
+               Error_Msg_N ("root type must be a 'C'P'P type", Arg1);
+            end if;
+
             Set_Is_CPP_Class (Def_Id);
 
             --  Imported CPP types must not have discriminants (because C++
@@ -7651,108 +7657,13 @@ package body Sem_Prag is
          --  pragma CPP_Class ([Entity =>] local_NAME)
 
          when Pragma_CPP_Class => CPP_Class : declare
-            Arg : Node_Id;
-            Typ : Entity_Id;
-
          begin
-            if Warn_On_Obsolescent_Feature then
-               Error_Msg_N
-                 ("'G'N'A'T pragma cpp'_class is now obsolete; replace it" &
-                  " by pragma import?", N);
-            end if;
-
             GNAT_Pragma;
-            Check_Arg_Count (1);
-            Check_Optional_Identifier (Arg1, Name_Entity);
-            Check_Arg_Is_Local_Name (Arg1);
-
-            Arg := Get_Pragma_Arg (Arg1);
-            Analyze (Arg);
-
-            if Etype (Arg) = Any_Type then
-               return;
-            end if;
-
-            if not Is_Entity_Name (Arg)
-              or else not Is_Type (Entity (Arg))
-            then
-               Error_Pragma_Arg ("pragma% requires a type mark", Arg1);
-            end if;
-
-            Typ := Entity (Arg);
-
-            if not Is_Tagged_Type (Typ) then
-               Error_Pragma_Arg ("pragma% applicable to tagged types ", Arg1);
-            end if;
-
-            --  Types treated as CPP classes must be declared limited (note:
-            --  this used to be a warning but there is no real benefit to it
-            --  since we did effectively intend to treat the type as limited
-            --  anyway).
 
-            if not Is_Limited_Type (Typ) then
-               Error_Msg_N
-                 ("imported 'C'P'P type must be limited",
-                  Get_Pragma_Arg (Arg1));
-            end if;
-
-            Set_Is_CPP_Class (Typ);
-            Set_Convention (Typ, Convention_CPP);
-
-            --  Imported CPP types must not have discriminants (because C++
-            --  classes do not have discriminants).
-
-            if Has_Discriminants (Typ) then
+            if Warn_On_Obsolescent_Feature then
                Error_Msg_N
-                 ("imported 'C'P'P type cannot have discriminants",
-                  First (Discriminant_Specifications
-                          (Declaration_Node (Typ))));
-            end if;
-
-            --  Components of imported CPP types must not have default
-            --  expressions because the constructor (if any) is in the
-            --  C++ side.
-
-            if Is_Incomplete_Or_Private_Type (Typ)
-              and then No (Underlying_Type (Typ))
-            then
-               --  It should be an error to apply pragma CPP to a private
-               --  type if the underlying type is not visible (as it is
-               --  for any representation item). For now, for backward
-               --  compatibility we do nothing but we cannot check components
-               --  because they are not available at this stage. All this code
-               --  will be removed when we cleanup this obsolete GNAT pragma???
-
-               null;
-
-            else
-               declare
-                  Tdef  : constant Node_Id :=
-                            Type_Definition (Declaration_Node (Typ));
-                  Clist : Node_Id;
-                  Comp  : Node_Id;
-
-               begin
-                  if Nkind (Tdef) = N_Record_Definition then
-                     Clist := Component_List (Tdef);
-                  else
-                     pragma Assert (Nkind (Tdef) = N_Derived_Type_Definition);
-                     Clist := Component_List (Record_Extension_Part (Tdef));
-                  end if;
-
-                  if Present (Clist) then
-                     Comp := First (Component_Items (Clist));
-                     while Present (Comp) loop
-                        if Present (Expression (Comp)) then
-                           Error_Msg_N
-                             ("component of imported 'C'P'P type cannot have" &
-                              " default expression", Expression (Comp));
-                        end if;
-
-                        Next (Comp);
-                     end loop;
-                  end if;
-               end;
+                 ("'G'N'A'T pragma cpp'_class is now obsolete and has no " &
+                  "effect; replace it by pragma import?", N);
             end if;
          end CPP_Class;
 
@@ -7802,6 +7713,12 @@ package body Sem_Prag is
                                    and then
                                   Is_CPP_Class (Root_Type (Etype (Def_Id)))))
             then
+               if Scope (Def_Id) /= Scope (Etype (Def_Id)) then
+                  Error_Msg_N
+                    ("'C'P'P constructor must be defined in the scope of " &
+                     "its returned type", Arg1);
+               end if;
+
                if Arg_Count >= 2 then
                   Set_Imported (Def_Id);
                   Set_Is_Public (Def_Id);
@@ -7822,8 +7739,8 @@ package body Sem_Prag is
 
                if Is_Tagged_Type (Etype (Def_Id))
                  and then not Is_Class_Wide_Type (Etype (Def_Id))
+                 and then Is_Dispatching_Operation (Def_Id)
                then
-                  pragma Assert (Is_Dispatching_Operation (Def_Id));
                   Tag_Typ := Etype (Def_Id);
 
                   Elmt := First_Elmt (Primitive_Operations (Tag_Typ));