[multiple changes]

2013-04-25  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch6.adb: Add with and use clause for Stringt.
	(Expand_Contract_Cases): Moved from sem_ch6. Add formal parameters
	Decls and Stmts along with comments on their usage.
	* exp_ch6.ads (Expand_Contract_Cases): Moved from sem_ch6.
	* sem_ch6.adb (Expand_Contract_Cases): Moved to exp_ch6.
	(Process_Contract_Cases): Update the call to Expand_Contract_Cases.

2013-04-25  Ed Schonberg  <schonberg@adacore.com>

	* gnat_rm.texi: Minor editing, to clarify use of dimension aspects.
	* sem_util.adb (Is_OK_Variable_For_Out_Formal): Reject an
	aggregate for a packed type, which may be converted into an
	unchecked conversion of an object.

From-SVN: r198292

6 files changed, 551 insertions, 486 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index fb5818b..1071a70 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,19 @@
+2013-04-25  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch6.adb: Add with and use clause for Stringt.
+	(Expand_Contract_Cases): Moved from sem_ch6. Add formal parameters
+	Decls and Stmts along with comments on their usage.
+	* exp_ch6.ads (Expand_Contract_Cases): Moved from sem_ch6.
+	* sem_ch6.adb (Expand_Contract_Cases): Moved to exp_ch6.
+	(Process_Contract_Cases): Update the call to Expand_Contract_Cases.
+
+2013-04-25  Ed Schonberg  <schonberg@adacore.com>
+
+	* gnat_rm.texi: Minor editing, to clarify use of dimension aspects.
+	* sem_util.adb (Is_OK_Variable_For_Out_Formal): Reject an
+	aggregate for a packed type, which may be converted into an
+	unchecked conversion of an object.
+
 2013-04-25  Robert Dewar  <dewar@adacore.com>
 
 	* sem_prag.adb: Minor code reorganization (correct misspelling
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index cfcbb69..34f61c8 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -74,6 +74,7 @@ with Sinfo;    use Sinfo;
 with Sinput;   use Sinput;
 with Snames;   use Snames;
 with Stand;    use Stand;
+with Stringt;  use Stringt;
 with Targparm; use Targparm;
 with Tbuild;   use Tbuild;
 with Uintp;    use Uintp;
@@ -4117,6 +4118,476 @@ package body Exp_Ch6 is
       end if;
    end Expand_Call;
 
+   ---------------------------
+   -- Expand_Contract_Cases --
+   ---------------------------
+
+   --  Pragma Contract_Cases is expanded in the following manner:
+
+   --    subprogram S is
+   --       Flag_1   : Boolean := False;
+   --       . . .
+   --       Flag_N   : Boolean := False;
+   --       Flag_N+1 : Boolean := False;  --  when "others" present
+   --       Count    : Natural := 0;
+
+   --       <preconditions (if any)>
+
+   --       if Case_Guard_1 then
+   --          Flag_1 := True;
+   --          Count  := Count + 1;
+   --       end if;
+   --       . . .
+   --       if Case_Guard_N then
+   --          Flag_N := True;
+   --          Count  := Count + 1;
+   --       end if;
+
+   --       if Count = 0 then
+   --          raise Assertion_Error with "xxx contract cases incomplete";
+   --            <or>
+   --          Flag_N+1 := True;  --  when "others" present
+
+   --       elsif Count > 1 then
+   --          declare
+   --             Str0 : constant String :=
+   --                      "contract cases overlap for subprogram ABC";
+   --             Str1 : constant String :=
+   --                      (if Flag_1 then
+   --                         Str0 & "case guard at xxx evaluates to True"
+   --                       else Str0);
+   --             StrN : constant String :=
+   --                      (if Flag_N then
+   --                         StrN-1 & "case guard at xxx evaluates to True"
+   --                       else StrN-1);
+   --          begin
+   --             raise Assertion_Error with StrN;
+   --          end;
+   --       end if;
+
+   --       procedure _Postconditions is
+   --       begin
+   --          <postconditions (if any)>
+
+   --          if Flag_1 and then not Consequence_1 then
+   --             raise Assertion_Error with "failed contract case at xxx";
+   --          end if;
+   --          . . .
+   --          if Flag_N[+1] and then not Consequence_N[+1] then
+   --             raise Assertion_Error with "failed contract case at xxx";
+   --          end if;
+   --       end _Postconditions;
+   --    begin
+   --       . . .
+   --    end S;
+
+   procedure Expand_Contract_Cases
+     (CCs     : Node_Id;
+      Subp_Id : Entity_Id;
+      Decls   : List_Id;
+      Stmts   : in out List_Id)
+   is
+      Loc : constant Source_Ptr := Sloc (CCs);
+
+      procedure Case_Guard_Error
+        (Decls     : List_Id;
+         Flag      : Entity_Id;
+         Error_Loc : Source_Ptr;
+         Msg       : in out Entity_Id);
+      --  Given a declarative list Decls, status flag Flag, the location of the
+      --  error and a string Msg, construct the following check:
+      --    Msg : constant String :=
+      --            (if Flag then
+      --                Msg & "case guard at Error_Loc evaluates to True"
+      --             else Msg);
+      --  The resulting code is added to Decls
+
+      procedure Consequence_Error
+        (Checks : in out Node_Id;
+         Flag   : Entity_Id;
+         Conseq : Node_Id);
+      --  Given an if statement Checks, status flag Flag and a consequence
+      --  Conseq, construct the following check:
+      --    [els]if Flag and then not Conseq then
+      --       raise Assertion_Error
+      --         with "failed contract case at Sloc (Conseq)";
+      --    [end if;]
+      --  The resulting code is added to Checks
+
+      function Declaration_Of (Id : Entity_Id) return Node_Id;
+      --  Given the entity Id of a boolean flag, generate:
+      --    Id : Boolean := False;
+
+      function Increment (Id : Entity_Id) return Node_Id;
+      --  Given the entity Id of a numerical variable, generate:
+      --    Id := Id + 1;
+
+      function Set (Id : Entity_Id) return Node_Id;
+      --  Given the entity Id of a boolean variable, generate:
+      --    Id := True;
+
+      ----------------------
+      -- Case_Guard_Error --
+      ----------------------
+
+      procedure Case_Guard_Error
+        (Decls     : List_Id;
+         Flag      : Entity_Id;
+         Error_Loc : Source_Ptr;
+         Msg       : in out Entity_Id)
+      is
+         New_Line : constant Character := Character'Val (10);
+         New_Msg  : constant Entity_Id := Make_Temporary (Loc, 'S');
+
+      begin
+         Start_String;
+         Store_String_Char  (New_Line);
+         Store_String_Chars ("  case guard at ");
+         Store_String_Chars (Build_Location_String (Error_Loc));
+         Store_String_Chars (" evaluates to True");
+
+         --  Generate:
+         --    New_Msg : constant String :=
+         --      (if Flag then
+         --          Msg & "case guard at Error_Loc evaluates to True"
+         --       else Msg);
+
+         Append_To (Decls,
+           Make_Object_Declaration (Loc,
+             Defining_Identifier => New_Msg,
+             Constant_Present    => True,
+             Object_Definition   => New_Reference_To (Standard_String, Loc),
+             Expression          =>
+               Make_If_Expression (Loc,
+                 Expressions => New_List (
+                   New_Reference_To (Flag, Loc),
+
+                   Make_Op_Concat (Loc,
+                     Left_Opnd  => New_Reference_To (Msg, Loc),
+                     Right_Opnd => Make_String_Literal (Loc, End_String)),
+
+                   New_Reference_To (Msg, Loc)))));
+
+         Msg := New_Msg;
+      end Case_Guard_Error;
+
+      -----------------------
+      -- Consequence_Error --
+      -----------------------
+
+      procedure Consequence_Error
+        (Checks : in out Node_Id;
+         Flag   : Entity_Id;
+         Conseq : Node_Id)
+      is
+         Cond  : Node_Id;
+         Error : Node_Id;
+
+      begin
+         --  Generate:
+         --    Flag and then not Conseq
+
+         Cond :=
+           Make_And_Then (Loc,
+             Left_Opnd  => New_Reference_To (Flag, Loc),
+             Right_Opnd =>
+               Make_Op_Not (Loc,
+                 Right_Opnd => Relocate_Node (Conseq)));
+
+         --  Generate:
+         --    raise Assertion_Error
+         --      with "failed contract case at Sloc (Conseq)";
+
+         Start_String;
+         Store_String_Chars ("failed contract case at ");
+         Store_String_Chars (Build_Location_String (Sloc (Conseq)));
+
+         Error :=
+           Make_Procedure_Call_Statement (Loc,
+             Name                   =>
+               New_Reference_To (RTE (RE_Raise_Assert_Failure), Loc),
+             Parameter_Associations => New_List (
+               Make_String_Literal (Loc, End_String)));
+
+         if No (Checks) then
+            Checks :=
+              Make_If_Statement (Loc,
+                Condition       => Cond,
+                Then_Statements => New_List (Error));
+
+         else
+            if No (Elsif_Parts (Checks)) then
+               Set_Elsif_Parts (Checks, New_List);
+            end if;
+
+            Append_To (Elsif_Parts (Checks),
+              Make_Elsif_Part (Loc,
+                Condition       => Cond,
+                Then_Statements => New_List (Error)));
+         end if;
+      end Consequence_Error;
+
+      --------------------
+      -- Declaration_Of --
+      --------------------
+
+      function Declaration_Of (Id : Entity_Id) return Node_Id is
+      begin
+         return
+           Make_Object_Declaration (Loc,
+             Defining_Identifier => Id,
+             Object_Definition   => New_Reference_To (Standard_Boolean, Loc),
+             Expression          => New_Reference_To (Standard_False, Loc));
+      end Declaration_Of;
+
+      ---------------
+      -- Increment --
+      ---------------
+
+      function Increment (Id : Entity_Id) return Node_Id is
+      begin
+         return
+           Make_Assignment_Statement (Loc,
+             Name       => New_Reference_To (Id, Loc),
+             Expression =>
+               Make_Op_Add (Loc,
+                 Left_Opnd  => New_Reference_To (Id, Loc),
+                 Right_Opnd => Make_Integer_Literal (Loc, 1)));
+      end Increment;
+
+      ---------
+      -- Set --
+      ---------
+
+      function Set (Id : Entity_Id) return Node_Id is
+      begin
+         return
+           Make_Assignment_Statement (Loc,
+             Name       => New_Reference_To (Id, Loc),
+             Expression => New_Reference_To (Standard_True, Loc));
+      end Set;
+
+      --  Local variables
+
+      Aggr          : constant Node_Id :=
+                        Expression (First
+                          (Pragma_Argument_Associations (CCs)));
+      Case_Guard    : Node_Id;
+      CG_Checks     : Node_Id;
+      CG_Stmts      : List_Id;
+      Conseq        : Node_Id;
+      Conseq_Checks : Node_Id := Empty;
+      Count         : Entity_Id;
+      Error_Decls   : List_Id;
+      Flag          : Entity_Id;
+      Msg_Str       : Entity_Id;
+      Multiple_PCs  : Boolean;
+      Others_Flag   : Entity_Id := Empty;
+      Post_Case     : Node_Id;
+
+   --  Start of processing for Expand_Contract_Cases
+
+   begin
+      --  Do nothing if pragma is not enabled. If pragma is disabled, it has
+      --  already been rewritten as a Null statement.
+
+      if Is_Ignored (CCs) then
+         return;
+
+      --  Guard against malformed contract cases
+
+      elsif Nkind (Aggr) /= N_Aggregate then
+         return;
+      end if;
+
+      Multiple_PCs := List_Length (Component_Associations (Aggr)) > 1;
+
+      --  Create the counter which tracks the number of case guards that
+      --  evaluate to True.
+
+      --    Count : Natural := 0;
+
+      Count := Make_Temporary (Loc, 'C');
+
+      Prepend_To (Decls,
+        Make_Object_Declaration (Loc,
+          Defining_Identifier => Count,
+          Object_Definition   => New_Reference_To (Standard_Natural, Loc),
+          Expression          => Make_Integer_Literal (Loc, 0)));
+
+      --  Create the base error message for multiple overlapping case guards
+
+      --    Msg_Str : constant String :=
+      --                "contract cases overlap for subprogram Subp_Id";
+
+      if Multiple_PCs then
+         Msg_Str := Make_Temporary (Loc, 'S');
+
+         Start_String;
+         Store_String_Chars ("contract cases overlap for subprogram ");
+         Store_String_Chars (Get_Name_String (Chars (Subp_Id)));
+
+         Error_Decls := New_List (
+           Make_Object_Declaration (Loc,
+             Defining_Identifier => Msg_Str,
+             Constant_Present    => True,
+             Object_Definition   => New_Reference_To (Standard_String, Loc),
+             Expression          => Make_String_Literal (Loc, End_String)));
+      end if;
+
+      --  Process individual post cases
+
+      Post_Case := First (Component_Associations (Aggr));
+      while Present (Post_Case) loop
+         Case_Guard := First (Choices (Post_Case));
+         Conseq     := Expression (Post_Case);
+
+         --  The "others" choice requires special processing
+
+         if Nkind (Case_Guard) = N_Others_Choice then
+            Others_Flag := Make_Temporary (Loc, 'F');
+            Prepend_To (Decls, Declaration_Of (Others_Flag));
+
+            --  Check possible overlap between a case guard and "others"
+
+            if Multiple_PCs and Exception_Extra_Info then
+               Case_Guard_Error
+                 (Decls     => Error_Decls,
+                  Flag      => Others_Flag,
+                  Error_Loc => Sloc (Case_Guard),
+                  Msg       => Msg_Str);
+            end if;
+
+            --  Check the corresponding consequence of "others"
+
+            Consequence_Error
+              (Checks => Conseq_Checks,
+               Flag   => Others_Flag,
+               Conseq => Conseq);
+
+         --  Regular post case
+
+         else
+            --  Create the flag which tracks the state of its associated case
+            --  guard.
+
+            Flag := Make_Temporary (Loc, 'F');
+            Prepend_To (Decls, Declaration_Of (Flag));
+
+            --  The flag is set when the case guard is evaluated to True
+            --    if Case_Guard then
+            --       Flag  := True;
+            --       Count := Count + 1;
+            --    end if;
+
+            Append_To (Decls,
+              Make_If_Statement (Loc,
+                Condition       => Relocate_Node (Case_Guard),
+                Then_Statements => New_List (
+                  Set (Flag),
+                  Increment (Count))));
+
+            --  Check whether this case guard overlaps with another one
+
+            if Multiple_PCs and Exception_Extra_Info then
+               Case_Guard_Error
+                 (Decls     => Error_Decls,
+                  Flag      => Flag,
+                  Error_Loc => Sloc (Case_Guard),
+                  Msg       => Msg_Str);
+            end if;
+
+            --  The corresponding consequence of the case guard which evaluated
+            --  to True must hold on exit from the subprogram.
+
+            Consequence_Error
+              (Checks => Conseq_Checks,
+               Flag   => Flag,
+               Conseq => Conseq);
+         end if;
+
+         Next (Post_Case);
+      end loop;
+
+      --  Raise Assertion_Error when none of the case guards evaluate to True.
+      --  The only exception is when we have "others", in which case there is
+      --  no error because "others" acts as a default True.
+
+      --  Generate:
+      --    Flag := True;
+
+      if Present (Others_Flag) then
+         CG_Stmts := New_List (Set (Others_Flag));
+
+      --  Generate:
+      --    raise Assertion_Error with "xxx contract cases incomplete";
+
+      else
+         Start_String;
+         Store_String_Chars (Build_Location_String (Loc));
+         Store_String_Chars (" contract cases incomplete");
+
+         CG_Stmts := New_List (
+           Make_Procedure_Call_Statement (Loc,
+             Name                   =>
+               New_Reference_To (RTE (RE_Raise_Assert_Failure), Loc),
+             Parameter_Associations => New_List (
+               Make_String_Literal (Loc, End_String))));
+      end if;
+
+      CG_Checks :=
+        Make_If_Statement (Loc,
+          Condition       =>
+            Make_Op_Eq (Loc,
+              Left_Opnd  => New_Reference_To (Count, Loc),
+              Right_Opnd => Make_Integer_Literal (Loc, 0)),
+          Then_Statements => CG_Stmts);
+
+      --  Detect a possible failure due to several case guards evaluating to
+      --  True.
+
+      --  Generate:
+      --    elsif Count > 0 then
+      --       declare
+      --          <Error_Decls>
+      --       begin
+      --          raise Assertion_Error with <Msg_Str>;
+      --    end if;
+
+      if Multiple_PCs then
+         Set_Elsif_Parts (CG_Checks, New_List (
+           Make_Elsif_Part (Loc,
+             Condition       =>
+               Make_Op_Gt (Loc,
+                 Left_Opnd  => New_Reference_To (Count, Loc),
+                 Right_Opnd => Make_Integer_Literal (Loc, 1)),
+
+             Then_Statements => New_List (
+               Make_Block_Statement (Loc,
+                 Declarations               => Error_Decls,
+                 Handled_Statement_Sequence =>
+                   Make_Handled_Sequence_Of_Statements (Loc,
+                     Statements => New_List (
+                       Make_Procedure_Call_Statement (Loc,
+                         Name                   =>
+                           New_Reference_To
+                             (RTE (RE_Raise_Assert_Failure), Loc),
+                         Parameter_Associations => New_List (
+                           New_Reference_To (Msg_Str, Loc))))))))));
+      end if;
+
+      Append_To (Decls, CG_Checks);
+
+      --  Raise Assertion_Error when the corresponding consequence of a case
+      --  guard that evaluated to True fails.
+
+      if No (Stmts) then
+         Stmts := New_List;
+      end if;
+
+      Append_To (Stmts, Conseq_Checks);
+   end Expand_Contract_Cases;
+
    -------------------------------
    -- Expand_Ctrl_Function_Call --
    -------------------------------
diff --git a/gcc/ada/exp_ch6.ads b/gcc/ada/exp_ch6.ads
index 0f65a5b..f9829f5 100644
--- a/gcc/ada/exp_ch6.ads
+++ b/gcc/ada/exp_ch6.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, 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,17 @@ package Exp_Ch6 is
    --  This procedure contains common processing for Expand_N_Function_Call,
    --  Expand_N_Procedure_Statement, and Expand_N_Entry_Call.
 
+   procedure Expand_Contract_Cases
+     (CCs     : Node_Id;
+      Subp_Id : Entity_Id;
+      Decls   : List_Id;
+      Stmts   : in out List_Id);
+   --  Given pragma Contract_Cases CCs, create the circuitry needed to evaluate
+   --  case guards and trigger consequence expressions. Subp_Id is the related
+   --  subprogram for which the pragma applies. Decls are the declarations of
+   --  Subp_Id's body. All generated code is added to list Stmts. If Stmts is
+   --  empty, a new list is created.
+
    procedure Freeze_Subprogram (N : Node_Id);
    --  generate the appropriate expansions related to Subprogram freeze
    --  nodes (e.g. the filling of the corresponding Dispatch Table for
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 6d51c8f..5c1a547 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -992,6 +992,7 @@ consideration, the use of these pragmas should be minimized.
 * Pragma Optimize_Alignment::
 * Pragma Ordered::
 * Pragma Overflow_Mode::
+* Pragma Overriding_Renamings::
 * Pragma Partition_Elaboration_Policy::
 * Pragma Passive::
 * Pragma Persistent_BSS::
@@ -4698,6 +4699,25 @@ overflow checking, but does not affect the overflow mode.
 The pragma @code{Unsuppress (Overflow_Check)} unsuppresses (enables)
 overflow checking, but does not affect the overflow mode.
 
+@node Pragma Overriding_Renamings
+@unnumberedsec Pragma Overriding_Renamings
+@findex Overriding_Renamings
+@cindex Rational profile
+@noindent
+Syntax:
+
+@smallexample @c ada
+pragma Overriding_Renamings;
+@end smallexample
+
+@noindent
+
+This is a GNAT pragma to simplify porting legacy code accepted by the Rational
+Ada compiler. In the presence of this pragma, a renaming declaration that
+renames an inherited operation declared in the same scope is legal, even though
+RM 8.3 (15) stipulates that an overridden operation is not visible within the
+declaration of the overriding operation.
+
 @node Pragma Partition_Elaboration_Policy
 @unnumberedsec Pragma Partition_Elaboration_Policy
 @findex Partition_Elaboration_Policy
@@ -5205,6 +5225,7 @@ The Rational profile is intended to facilitate porting legacy code that
 compiles with the Rational APEX compiler, even when the code includes non-
 conforming Ada constructs.  The profile enables the following three pragmas:
 
+
 @itemize @bullet
 @item pragma Implicit_Packing
 @item pragma Overriding_Renamings
@@ -6814,9 +6835,9 @@ This aspect is equivalent to pragma @code{Depends}.
 @unnumberedsec Aspect Dimension
 @findex Dimension
 @noindent
-The @code{Dimension} aspect is used to define a system of
-dimensions that will be used in subsequent subtype declarations with
-@code{Dimension} aspects that reference this system. The syntax is:
+The @code{Dimension} aspect is used to specify the dimensions of a given
+subtype of a dimensioned numeric type. The aspect also specifies a symbol
+used when doing formatted output of dimensioned quantities. The syntax is:
 
 @smallexample @c ada
 with Dimension =>
@@ -6833,9 +6854,13 @@ RATIONAL ::= [-] NUMERIC_LITERAL [/ NUMERIC_LITERAL]
 @end smallexample
 
 @noindent
-This aspect can only be applied to a subtype where the parent type has
-a @code{Dimension_Systen} aspect. It specifies which units apply to
-the subtype, and the corresponding powers. For examples of the usage
+This aspect can only be applied to a subtype whose parent type has
+a @code{Dimension_Systen} aspect. The aspect must specify values for
+all dimensions of the system. The rational values are the powers of the
+corresponding dimensions that are used by the compiler to verify that
+physical (numeric) computations are dimensionally consistent. For example,
+the computation of a force must result in dimensions (L => 1, M => 1, T => -2).
+For further examples of the usage
 of this aspect, see package @code{System.Dim.Mks}.
 Note that when the dimensioned type is an integer type, then any
 dimension value must be an integer literal.
@@ -6864,15 +6889,19 @@ This aspect is applied to a type, which must be a numeric derived type
 will represent values within the dimension system. Each @code{DIMENSION}
 corresponds to one particular dimension. A maximum of 7 dimensions may
 be specified. @code{Unit_Name} is the name of the dimension (for example
-@code{Meter}). @code{Unit_Symbol} is the short hand used for quantities
+@code{Meter}). @code{Unit_Symbol} is the shorthand used for quantities
 of this dimension (for example 'm' for Meter). @code{Dim_Symbol} gives
 the identification within the dimension system (typically this is a
-single letter, e.g. 'L' standing for length for unit name Meter).
+single letter, e.g. 'L' standing for length for unit name Meter). The
+Unit_Smbol is used in formatted output of dimensioned quantities. The
+Dim_Symbol is used in error messages when numeric operations have
+inconsistent dimensions.
 
-Although the implementation allows multiple different dimension systems
-to be defined using this aspect, in practice, nearly all usage of the
-dimension system will use the standard definition in the run-time
-package @code{System.Dim.Mks}:
+GNAT provides the standard definition of the International MKS system in
+the run-time package @code{System.Dim.Mks}. You can easily define
+similar packages for cgs units or British units, and define conversion factors
+between values in different systems. The MKS system is characterized by the
+following aspect:
 
 @smallexample @c ada
    type Mks_Type is new Long_Long_Float
@@ -6888,9 +6917,7 @@ package @code{System.Dim.Mks}:
 @end smallexample
 
 @noindent
-which correspond to the standard 7-unit dimension system typically
-used in physical calculations. See section
-"Performing Dimensionality Analysis in GNAT" in the GNAT Users
+See section "Performing Dimensionality Analysis in GNAT" in the GNAT Users
 Guide for detailed examples of use of the dimension system.
 
 @node Aspect Favor_Top_Level
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 680f11e..0e56e16 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -11228,11 +11228,6 @@ package body Sem_Ch6 is
       --  under the same visibility conditions as for other invariant checks,
       --  the type invariant must be applied to the returned value.
 
-      procedure Expand_Contract_Cases (CCs : Node_Id; Subp_Id : Entity_Id);
-      --  Given pragma Contract_Cases CCs, create the circuitry needed to
-      --  evaluate case guards and trigger consequence expressions. Subp_Id
-      --  denotes the related subprogram.
-
       function Grab_PPC (Pspec : Entity_Id := Empty) return Node_Id;
       --  Prag contains an analyzed precondition or postcondition pragma. This
       --  function copies the pragma, changes it to the corresponding Check
@@ -11324,468 +11319,6 @@ package body Sem_Ch6 is
          end if;
       end Check_Access_Invariants;
 
-      ---------------------------
-      -- Expand_Contract_Cases --
-      ---------------------------
-
-      --  Pragma Contract_Cases is expanded in the following manner:
-
-      --    subprogram S is
-      --       Flag_1   : Boolean := False;
-      --       . . .
-      --       Flag_N   : Boolean := False;
-      --       Flag_N+1 : Boolean := False;  --  when "others" present
-      --       Count    : Natural := 0;
-
-      --       <preconditions (if any)>
-
-      --       if Case_Guard_1 then
-      --          Flag_1 := True;
-      --          Count  := Count + 1;
-      --       end if;
-      --       . . .
-      --       if Case_Guard_N then
-      --          Flag_N := True;
-      --          Count  := Count + 1;
-      --       end if;
-
-      --       if Count = 0 then
-      --          raise Assertion_Error with "xxx contract cases incomplete";
-      --            <or>
-      --          Flag_N+1 := True;  --  when "others" present
-
-      --       elsif Count > 1 then
-      --          declare
-      --             Str0 : constant String :=
-      --                      "contract cases overlap for subprogram ABC";
-      --             Str1 : constant String :=
-      --                      (if Flag_1 then
-      --                         Str0 & "case guard at xxx evaluates to True"
-      --                       else Str0);
-      --             StrN : constant String :=
-      --                      (if Flag_N then
-      --                         StrN-1 & "case guard at xxx evaluates to True"
-      --                       else StrN-1);
-      --          begin
-      --             raise Assertion_Error with StrN;
-      --          end;
-      --       end if;
-
-      --       procedure _Postconditions is
-      --       begin
-      --          <postconditions (if any)>
-
-      --          if Flag_1 and then not Consequence_1 then
-      --             raise Assertion_Error with "failed contract case at xxx";
-      --          end if;
-      --          . . .
-      --          if Flag_N[+1] and then not Consequence_N[+1] then
-      --             raise Assertion_Error with "failed contract case at xxx";
-      --          end if;
-      --       end _Postconditions;
-      --    begin
-      --       . . .
-      --    end S;
-
-      procedure Expand_Contract_Cases (CCs : Node_Id; Subp_Id : Entity_Id) is
-         Loc : constant Source_Ptr := Sloc (CCs);
-
-         procedure Case_Guard_Error
-           (Decls     : List_Id;
-            Flag      : Entity_Id;
-            Error_Loc : Source_Ptr;
-            Msg       : in out Entity_Id);
-         --  Given a declarative list Decls, status flag Flag, the location of
-         --  the error and a string Msg, construct the following check:
-         --    Msg : constant String :=
-         --            (if Flag then
-         --                Msg & "case guard at Error_Loc evaluates to True"
-         --             else Msg);
-         --  The resulting code is added to Decls
-
-         procedure Consequence_Error
-           (Checks : in out Node_Id;
-            Flag   : Entity_Id;
-            Conseq : Node_Id);
-         --  Given an if statement Checks, status flag Flag and a consequence
-         --  Conseq, construct the following check:
-         --    [els]if Flag and then not Conseq then
-         --       raise Assertion_Error
-         --         with "failed contract case at Sloc (Conseq)";
-         --    [end if;]
-         --  The resulting code is added to Checks
-
-         function Declaration_Of (Id : Entity_Id) return Node_Id;
-         --  Given the entity Id of a boolean flag, generate:
-         --    Id : Boolean := False;
-
-         function Increment (Id : Entity_Id) return Node_Id;
-         --  Given the entity Id of a numerical variable, generate:
-         --    Id := Id + 1;
-
-         function Set (Id : Entity_Id) return Node_Id;
-         --  Given the entity Id of a boolean variable, generate:
-         --    Id := True;
-
-         ----------------------
-         -- Case_Guard_Error --
-         ----------------------
-
-         procedure Case_Guard_Error
-           (Decls     : List_Id;
-            Flag      : Entity_Id;
-            Error_Loc : Source_Ptr;
-            Msg       : in out Entity_Id)
-         is
-            New_Line : constant Character := Character'Val (10);
-            New_Msg  : constant Entity_Id := Make_Temporary (Loc, 'S');
-
-         begin
-            Start_String;
-            Store_String_Char  (New_Line);
-            Store_String_Chars ("  case guard at ");
-            Store_String_Chars (Build_Location_String (Error_Loc));
-            Store_String_Chars (" evaluates to True");
-
-            --  Generate:
-            --    New_Msg : constant String :=
-            --      (if Flag then
-            --          Msg & "case guard at Error_Loc evaluates to True"
-            --       else Msg);
-
-            Append_To (Decls,
-              Make_Object_Declaration (Loc,
-                Defining_Identifier => New_Msg,
-                Constant_Present    => True,
-                Object_Definition   => New_Reference_To (Standard_String, Loc),
-                Expression          =>
-                  Make_If_Expression (Loc,
-                    Expressions => New_List (
-                      New_Reference_To (Flag, Loc),
-
-                      Make_Op_Concat (Loc,
-                        Left_Opnd  => New_Reference_To (Msg, Loc),
-                        Right_Opnd => Make_String_Literal (Loc, End_String)),
-
-                      New_Reference_To (Msg, Loc)))));
-
-            Msg := New_Msg;
-         end Case_Guard_Error;
-
-         -----------------------
-         -- Consequence_Error --
-         -----------------------
-
-         procedure Consequence_Error
-           (Checks : in out Node_Id;
-            Flag   : Entity_Id;
-            Conseq : Node_Id)
-         is
-            Cond  : Node_Id;
-            Error : Node_Id;
-
-         begin
-            --  Generate:
-            --    Flag and then not Conseq
-
-            Cond :=
-              Make_And_Then (Loc,
-                Left_Opnd  => New_Reference_To (Flag, Loc),
-                Right_Opnd =>
-                  Make_Op_Not (Loc,
-                    Right_Opnd => Relocate_Node (Conseq)));
-
-            --  Generate:
-            --    raise Assertion_Error
-            --      with "failed contract case at Sloc (Conseq)";
-
-            Start_String;
-            Store_String_Chars ("failed contract case at ");
-            Store_String_Chars (Build_Location_String (Sloc (Conseq)));
-
-            Error :=
-              Make_Procedure_Call_Statement (Loc,
-                Name                   =>
-                  New_Reference_To (RTE (RE_Raise_Assert_Failure), Loc),
-                Parameter_Associations => New_List (
-                  Make_String_Literal (Loc, End_String)));
-
-            if No (Checks) then
-               Checks :=
-                 Make_If_Statement (Loc,
-                   Condition       => Cond,
-                   Then_Statements => New_List (Error));
-
-            else
-               if No (Elsif_Parts (Checks)) then
-                  Set_Elsif_Parts (Checks, New_List);
-               end if;
-
-               Append_To (Elsif_Parts (Checks),
-                 Make_Elsif_Part (Loc,
-                   Condition       => Cond,
-                   Then_Statements => New_List (Error)));
-            end if;
-         end Consequence_Error;
-
-         --------------------
-         -- Declaration_Of --
-         --------------------
-
-         function Declaration_Of (Id : Entity_Id) return Node_Id is
-         begin
-            return
-              Make_Object_Declaration (Loc,
-                Defining_Identifier => Id,
-                Object_Definition   =>
-                  New_Reference_To (Standard_Boolean, Loc),
-                Expression          =>
-                  New_Reference_To (Standard_False, Loc));
-         end Declaration_Of;
-
-         ---------------
-         -- Increment --
-         ---------------
-
-         function Increment (Id : Entity_Id) return Node_Id is
-         begin
-            return
-              Make_Assignment_Statement (Loc,
-                Name       => New_Reference_To (Id, Loc),
-                Expression =>
-                  Make_Op_Add (Loc,
-                    Left_Opnd  => New_Reference_To (Id, Loc),
-                    Right_Opnd => Make_Integer_Literal (Loc, 1)));
-         end Increment;
-
-         ---------
-         -- Set --
-         ---------
-
-         function Set (Id : Entity_Id) return Node_Id is
-         begin
-            return
-              Make_Assignment_Statement (Loc,
-                Name       => New_Reference_To (Id, Loc),
-                Expression => New_Reference_To (Standard_True, Loc));
-         end Set;
-
-         --  Local variables
-
-         Aggr          : constant Node_Id :=
-                           Expression (First
-                             (Pragma_Argument_Associations (CCs)));
-         Decls         : constant List_Id := Declarations (N);
-         Case_Guard    : Node_Id;
-         CG_Checks     : Node_Id;
-         CG_Stmts      : List_Id;
-         Conseq        : Node_Id;
-         Conseq_Checks : Node_Id := Empty;
-         Count         : Entity_Id;
-         Error_Decls   : List_Id;
-         Flag          : Entity_Id;
-         Msg_Str       : Entity_Id;
-         Multiple_PCs  : Boolean;
-         Others_Flag   : Entity_Id := Empty;
-         Post_Case     : Node_Id;
-
-      --  Start of processing for Expand_Contract_Cases
-
-      begin
-         --  Do nothing if pragma is not enabled. If pragma is disabled, it has
-         --  already been rewritten as a Null statement.
-
-         if Is_Ignored (CCs) then
-            return;
-
-         --  Guard against malformed contract cases
-
-         elsif Nkind (Aggr) /= N_Aggregate then
-            return;
-         end if;
-
-         Multiple_PCs := List_Length (Component_Associations (Aggr)) > 1;
-
-         --  Create the counter which tracks the number of case guards that
-         --  evaluate to True.
-
-         --    Count : Natural := 0;
-
-         Count := Make_Temporary (Loc, 'C');
-
-         Prepend_To (Decls,
-           Make_Object_Declaration (Loc,
-             Defining_Identifier => Count,
-             Object_Definition   => New_Reference_To (Standard_Natural, Loc),
-             Expression          => Make_Integer_Literal (Loc, 0)));
-
-         --  Create the base error message for multiple overlapping case
-         --  guards.
-
-         --    Msg_Str : constant String :=
-         --                "contract cases overlap for subprogram Subp_Id";
-
-         if Multiple_PCs then
-            Msg_Str := Make_Temporary (Loc, 'S');
-
-            Start_String;
-            Store_String_Chars ("contract cases overlap for subprogram ");
-            Store_String_Chars (Get_Name_String (Chars (Subp_Id)));
-
-            Error_Decls := New_List (
-              Make_Object_Declaration (Loc,
-                Defining_Identifier => Msg_Str,
-                Constant_Present    => True,
-                Object_Definition   => New_Reference_To (Standard_String, Loc),
-                Expression          => Make_String_Literal (Loc, End_String)));
-         end if;
-
-         --  Process individual post cases
-
-         Post_Case := First (Component_Associations (Aggr));
-         while Present (Post_Case) loop
-            Case_Guard := First (Choices (Post_Case));
-            Conseq     := Expression (Post_Case);
-
-            --  The "others" choice requires special processing
-
-            if Nkind (Case_Guard) = N_Others_Choice then
-               Others_Flag := Make_Temporary (Loc, 'F');
-               Prepend_To (Decls, Declaration_Of (Others_Flag));
-
-               --  Check possible overlap between a case guard and "others"
-
-               if Multiple_PCs and Exception_Extra_Info then
-                  Case_Guard_Error
-                    (Decls     => Error_Decls,
-                     Flag      => Others_Flag,
-                     Error_Loc => Sloc (Case_Guard),
-                     Msg       => Msg_Str);
-               end if;
-
-               --  Check the corresponding consequence of "others"
-
-               Consequence_Error
-                 (Checks => Conseq_Checks,
-                  Flag   => Others_Flag,
-                  Conseq => Conseq);
-
-            --  Regular post case
-
-            else
-               --  Create the flag which tracks the state of its associated
-               --  case guard.
-
-               Flag := Make_Temporary (Loc, 'F');
-               Prepend_To (Decls, Declaration_Of (Flag));
-
-               --  The flag is set when the case guard is evaluated to True
-               --    if Case_Guard then
-               --       Flag  := True;
-               --       Count := Count + 1;
-               --    end if;
-
-               Append_To (Decls,
-                 Make_If_Statement (Loc,
-                   Condition       => Relocate_Node (Case_Guard),
-                   Then_Statements => New_List (
-                     Set (Flag),
-                     Increment (Count))));
-
-               --  Check whether this case guard overlaps with another one
-
-               if Multiple_PCs and Exception_Extra_Info then
-                  Case_Guard_Error
-                    (Decls     => Error_Decls,
-                     Flag      => Flag,
-                     Error_Loc => Sloc (Case_Guard),
-                     Msg       => Msg_Str);
-               end if;
-
-               --  The corresponding consequence of the case guard which
-               --  evaluated to True must hold on exit from the subprogram.
-
-               Consequence_Error (Conseq_Checks, Flag, Conseq);
-            end if;
-
-            Next (Post_Case);
-         end loop;
-
-         --  Raise Assertion_Error when none of the case guards evaluate to
-         --  True. The only exception is when we have "others", in which case
-         --  there is no error because "others" acts as a default True.
-
-         --  Generate:
-         --    Flag := True;
-
-         if Present (Others_Flag) then
-            CG_Stmts := New_List (Set (Others_Flag));
-
-         --  Generate:
-         --    raise Assertion_Error with "xxx contract cases incomplete";
-
-         else
-            Start_String;
-            Store_String_Chars (Build_Location_String (Loc));
-            Store_String_Chars (" contract cases incomplete");
-
-            CG_Stmts := New_List (
-              Make_Procedure_Call_Statement (Loc,
-                Name                   =>
-                  New_Reference_To (RTE (RE_Raise_Assert_Failure), Loc),
-                Parameter_Associations => New_List (
-                  Make_String_Literal (Loc, End_String))));
-         end if;
-
-         CG_Checks :=
-           Make_If_Statement (Loc,
-             Condition       =>
-               Make_Op_Eq (Loc,
-                 Left_Opnd  => New_Reference_To (Count, Loc),
-                 Right_Opnd => Make_Integer_Literal (Loc, 0)),
-             Then_Statements => CG_Stmts);
-
-         --  Detect a possible failure due to several case guards evaluating to
-         --  True.
-
-         --  Generate:
-         --    elsif Count > 0 then
-         --       declare
-         --          <Error_Decls>
-         --       begin
-         --          raise Assertion_Error with <Msg_Str>;
-         --    end if;
-
-         if Multiple_PCs then
-            Set_Elsif_Parts (CG_Checks, New_List (
-              Make_Elsif_Part (Loc,
-                Condition       =>
-                  Make_Op_Gt (Loc,
-                    Left_Opnd  => New_Reference_To (Count, Loc),
-                    Right_Opnd => Make_Integer_Literal (Loc, 1)),
-
-                Then_Statements => New_List (
-                  Make_Block_Statement (Loc,
-                    Declarations               => Error_Decls,
-                    Handled_Statement_Sequence =>
-                      Make_Handled_Sequence_Of_Statements (Loc,
-                        Statements => New_List (
-                          Make_Procedure_Call_Statement (Loc,
-                            Name                   =>
-                              New_Reference_To
-                                (RTE (RE_Raise_Assert_Failure), Loc),
-                            Parameter_Associations => New_List (
-                              New_Reference_To (Msg_Str, Loc))))))))));
-         end if;
-
-         Append_To (Decls, CG_Checks);
-
-         --  Raise Assertion_Error when the corresponding consequence of a case
-         --  guard that evaluated to True fails.
-
-         Append_Enabled_Item (Conseq_Checks, Plist);
-      end Expand_Contract_Cases;
-
       --------------
       -- Grab_PPC --
       --------------
@@ -12288,7 +11821,11 @@ package body Sem_Ch6 is
                Prag := Contract_Test_Cases (Contract (Spec));
                loop
                   if Pragma_Name (Prag) = Name_Contract_Cases then
-                     Expand_Contract_Cases (Prag, Spec_Id);
+                     Expand_Contract_Cases
+                       (CCs     => Prag,
+                        Subp_Id => Spec_Id,
+                        Decls   => Declarations (N),
+                        Stmts   => Plist);
                   end if;
 
                   Prag := Next_Pragma (Prag);
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 9bc7926..653a6ba 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -8909,10 +8909,13 @@ package body Sem_Util is
       --  parameters in cases where code generation is unaffected. We tell
       --  source unchecked conversions by seeing if they are rewrites of an
       --  original Unchecked_Conversion function call, or of an explicit
-      --  conversion of a function call.
+      --  conversion of a function call or an aggregate (as may happen in the
+      --  expansion of a packed array aggregate).
 
       elsif Nkind (AV) = N_Unchecked_Type_Conversion then
-         if Nkind (Original_Node (AV)) = N_Function_Call then
+         if Nkind_In (Original_Node (AV),
+                        N_Function_Call, N_Aggregate)
+         then
             return False;
 
          elsif Comes_From_Source (AV)