[multiple changes]

2014-08-04  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Analyze_Pragma): Ensure that an
	internally generated spec for a stand alone body is recognized
	as a proper context for pragma SPARK_Mode.

2014-08-04  Robert Dewar  <dewar@adacore.com>

	* erroutc.adb (Delete_Msg): Do not decrement Warnings_Treated_As_Errors.

2014-08-04  Arnaud Charlet  <charlet@adacore.com>

	* adabkend.adb (Scan_Back_End_Switches): Ignore extra -o
	when -gnatO has already been specified, for compatibility
	with gcc driver.
	(Scan_Compiler_Args): Do not call Set_Output_Object_File_Name in
	codepeer mode.
	* g-expect.ads: Fix typo.

2014-08-04  Thomas Quinot  <quinot@adacore.com>

	* exp_ch4.adb (Insert_Dereference_Action): the actual Size
	must account for the bounds template if the designated type is
	an unconstrained array.

From-SVN: r213579

gcc/ada/ChangeLog

 2014-08-04  Hristian Kirtchev  <kirtchev@adacore.com>
 
+	* sem_prag.adb (Analyze_Pragma): Ensure that an
+	internally generated spec for a stand alone body is recognized
+	as a proper context for pragma SPARK_Mode.
+
+2014-08-04  Robert Dewar  <dewar@adacore.com>
+
+	* erroutc.adb (Delete_Msg): Do not decrement Warnings_Treated_As_Errors.
+
+2014-08-04  Arnaud Charlet  <charlet@adacore.com>
+
+	* adabkend.adb (Scan_Back_End_Switches): Ignore extra -o
+	when -gnatO has already been specified, for compatibility
+	with gcc driver.
+	(Scan_Compiler_Args): Do not call Set_Output_Object_File_Name in
+	codepeer mode.
+	* g-expect.ads: Fix typo.
+
+2014-08-04  Thomas Quinot  <quinot@adacore.com>
+
+	* exp_ch4.adb (Insert_Dereference_Action): the actual Size
+	must account for the bounds template if the designated type is
+	an unconstrained array.
+
+2014-08-04  Hristian Kirtchev  <kirtchev@adacore.com>
+
 	* a-cfhama.adb, a-cfhase.adb, a-cforma.adb, a-cforse.adb Add
 	SPARK_Mode in the body.
 	* sem_ch7.adb (Analyze_Package_Body_Helper): Restore the original

gcc/ada/adabkend.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                     Copyright (C) 2001-2013, AdaCore                     --
+--                     Copyright (C) 2001-2014, AdaCore                     --
 --                                                                          --
 -- 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- --
@@ -108,7 +108,16 @@ package body Adabkend is
 
          elsif Switch_Chars (First .. Last) = "o" then
             if First = Last then
-               Opt.Output_File_Name_Present := True;
+               if Opt.Output_File_Name_Present then
+
+                  --  Ignore extra -o when -gnatO has already been specified
+
+                  Next_Arg := Next_Arg + 1;
+
+               else
+                  Opt.Output_File_Name_Present := True;
+               end if;
+
                return;
             else
                Fail ("invalid switch: " & Switch_Chars);
@@ -237,10 +246,11 @@ package body Adabkend is
 
                --  In GNATprove_Mode, such an object file is never written, and
                --  the call to Set_Output_Object_File_Name may fail (e.g. when
-               --  the object file name does not have the expected suffix). So
-               --  we skip that call when GNATprove_Mode is set.
+               --  the object file name does not have the expected suffix).
+               --  So we skip that call when GNATprove_Mode is set. Same for
+               --  CodePeer_Mode.
 
-               elsif GNATprove_Mode then
+               elsif GNATprove_Mode or CodePeer_Mode then
                   Output_File_Name_Seen := True;
 
                else

gcc/ada/erroutc.adb

@@ -141,10 +141,9 @@ package body Erroutc is
             if Errors.Table (D).Warn or else Errors.Table (D).Style then
                Warnings_Detected := Warnings_Detected - 1;
 
-               if Errors.Table (D).Warn_Err then
-                  Warnings_Treated_As_Errors :=
-                    Warnings_Treated_As_Errors - 1;
-               end if;
+               --  Note: we do not need to decrement Warnings_Treated_As_Errors
+               --  because this only gets incremented if we actually output the
+               --  message, which we won't do if we are deleting it here!
 
             else
                Total_Errors_Detected := Total_Errors_Detected - 1;

gcc/ada/exp_ch4.adb

@@ -11569,11 +11569,12 @@ package body Exp_Ch4 is
       Pool  : constant Entity_Id  := Associated_Storage_Pool (Typ);
       Pnod  : constant Node_Id    := Parent (N);
 
-      Addr  : Entity_Id;
-      Alig  : Entity_Id;
-      Deref : Node_Id;
-      Size  : Entity_Id;
-      Stmt  : Node_Id;
+      Addr      : Entity_Id;
+      Alig      : Entity_Id;
+      Deref     : Node_Id;
+      Size      : Entity_Id;
+      Size_Bits : Node_Id;
+      Stmt      : Node_Id;
 
    --  Start of processing for Insert_Dereference_Action
 
@@ -11624,23 +11625,36 @@ package body Exp_Ch4 is
           Prefix => Duplicate_Subexpr_Move_Checks (N));
       Set_Has_Dereference_Action (Deref);
 
-      Size := Make_Temporary (Loc, 'S');
+      Size_Bits :=
+        Make_Attribute_Reference (Loc,
+          Prefix         => Deref,
+          Attribute_Name => Name_Size);
 
+      --  Special case of an unconstrained array: need to add descriptor size
+
+      if Is_Array_Type (Desig)
+        and then not Is_Constrained (First_Subtype (Desig))
+      then
+         Size_Bits :=
+           Make_Op_Add (Loc,
+             Left_Opnd  =>
+               Make_Attribute_Reference (Loc,
+                 Prefix         =>
+                   New_Occurrence_Of (First_Subtype (Desig), Loc),
+                 Attribute_Name => Name_Descriptor_Size),
+             Right_Opnd => Size_Bits);
+      end if;
+
+      Size := Make_Temporary (Loc, 'S');
       Insert_Action (N,
         Make_Object_Declaration (Loc,
           Defining_Identifier => Size,
-
           Object_Definition   =>
             New_Occurrence_Of (RTE (RE_Storage_Count), Loc),
-
           Expression          =>
             Make_Op_Divide (Loc,
-              Left_Opnd   =>
-                Make_Attribute_Reference (Loc,
-                  Prefix         => Deref,
-                  Attribute_Name => Name_Size),
-               Right_Opnd =>
-                 Make_Integer_Literal (Loc, System_Storage_Unit))));
+              Left_Opnd  => Size_Bits,
+              Right_Opnd => Make_Integer_Literal (Loc, System_Storage_Unit))));
 
       --  Calculate the alignment of the dereferenced object. Generate:
       --    Alig : constant Storage_Count := <N>.all'Alignment;
@@ -11651,7 +11665,6 @@ package body Exp_Ch4 is
       Set_Has_Dereference_Action (Deref);
 
       Alig := Make_Temporary (Loc, 'A');
-
       Insert_Action (N,
         Make_Object_Declaration (Loc,
           Defining_Identifier => Alig,

gcc/ada/g-expect.ads

@@ -178,7 +178,7 @@ package GNAT.Expect is
    --  till Expect matches), but this is slower.
    --
    --  If Err_To_Out is True, then the standard error of the spawned process is
-   --  connected to the standard output. This is the only way to get the Except
+   --  connected to the standard output. This is the only way to get the Expect
    --  subprograms to also match on output on standard error.
    --
    --  Invalid_Process is raised if the process could not be spawned.

gcc/ada/sem_prag.adb

@@ -19304,12 +19304,9 @@ package body Sem_Prag is
                         raise Pragma_Exit;
                      end if;
 
-                  --  Skip internally generated code
-
-                  elsif not Comes_From_Source (Stmt) then
-                     null;
-
-                  --  The pragma applies to a [generic] subprogram declaration
+                  --  The pragma applies to a [generic] subprogram declaration.
+                  --  Note that this case covers an internally generated spec
+                  --  for a stand alone body.
 
                   --    [generic]
                   --    procedure Proc ...;
@@ -19329,6 +19326,11 @@ package body Sem_Prag is
                      Set_SPARK_Pragma_Inherited (Spec_Id, False);
                      return;
 
+                  --  Skip internally generated code
+
+                  elsif not Comes_From_Source (Stmt) then
+                     null;
+
                   --  Otherwise the pragma does not apply to a legal construct
                   --  or it does not appear at the top of a declarative or a
                   --  statement list. Issue an error and stop the analysis.