exp_ch6.adb (Process_Contract_Cases_For): Update the call to Expand_Pragma_Contract_Cases.

2015-05-26  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch6.adb (Process_Contract_Cases_For): Update the call to
	Expand_Pragma_Contract_Cases.
	* exp_prag.ads, exp_prag.adb (Expand_Contract_Cases): Rename to
	Expand_Pragma_Contract_Cases.
	* sem_ch13.adb (Add_Invariants): Use the original aspect name
	when creating the arguments of pragma Check. This ensures that
	'Class is properly recognized and handled.

From-SVN: r223671

5 files changed, 422 insertions, 417 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 540e11e..f1c76f6 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,13 @@
+2015-05-26  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch6.adb (Process_Contract_Cases_For): Update the call to
+	Expand_Pragma_Contract_Cases.
+	* exp_prag.ads, exp_prag.adb (Expand_Contract_Cases): Rename to
+	Expand_Pragma_Contract_Cases.
+	* sem_ch13.adb (Add_Invariants): Use the original aspect name
+	when creating the arguments of pragma Check. This ensures that
+	'Class is properly recognized and handled.
+
 2015-05-26  Arnaud Charlet  <charlet@adacore.com>
 
 	* gnat1drv.adb: Minor adjustments.
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 78bd94c..0162641 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -1856,7 +1856,7 @@ package body Exp_Ch6 is
                   and then
                     Nkind (Parent (Subp)) = N_Private_Extension_Declaration
                then
-                  if  Comes_From_Source (N) and then Is_Public_Subp then
+                  if Comes_From_Source (N) and then Is_Public_Subp then
                      Append_To (Post_Call, Make_Invariant_Call (Actual));
                   end if;
 
@@ -7292,7 +7292,7 @@ package body Exp_Ch6 is
                Prag := Contract_Test_Cases (Items);
                while Present (Prag) loop
                   if Pragma_Name (Prag) = Name_Contract_Cases then
-                     Expand_Contract_Cases
+                     Expand_Pragma_Contract_Cases
                        (CCs     => Prag,
                         Subp_Id => Subp_Id,
                         Decls   => Declarations (N),
diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb
index 16096a4..2df57f4 100644
--- a/gcc/ada/exp_prag.adb
+++ b/gcc/ada/exp_prag.adb
@@ -156,9 +156,399 @@ package body Exp_Prag is
       end if;
    end Arg3;
 
-   ---------------------------
-   -- Expand_Contract_Cases --
-   ---------------------------
+   ---------------------
+   -- Expand_N_Pragma --
+   ---------------------
+
+   procedure Expand_N_Pragma (N : Node_Id) is
+      Pname : constant Name_Id := Pragma_Name (N);
+
+   begin
+      --  Rewrite pragma ignored by Ignore_Pragma to null statement, so that
+      --  the back end or the expander here does not get over-enthusiastic and
+      --  start processing such a pragma!
+
+      if Get_Name_Table_Boolean3 (Pname) then
+         Rewrite (N, Make_Null_Statement (Sloc (N)));
+         return;
+      end if;
+
+      --  Note: we may have a pragma whose Pragma_Identifier field is not a
+      --  recognized pragma, and we must ignore it at this stage.
+
+      if Is_Pragma_Name (Pname) then
+         case Get_Pragma_Id (Pname) is
+
+            --  Pragmas requiring special expander action
+
+            when Pragma_Abort_Defer =>
+               Expand_Pragma_Abort_Defer (N);
+
+            when Pragma_Check =>
+               Expand_Pragma_Check (N);
+
+            when Pragma_Common_Object =>
+               Expand_Pragma_Common_Object (N);
+
+            when Pragma_Import =>
+               Expand_Pragma_Import_Or_Interface (N);
+
+            when Pragma_Inspection_Point =>
+               Expand_Pragma_Inspection_Point (N);
+
+            when Pragma_Interface =>
+               Expand_Pragma_Import_Or_Interface (N);
+
+            when Pragma_Interrupt_Priority =>
+               Expand_Pragma_Interrupt_Priority (N);
+
+            when Pragma_Loop_Variant =>
+               Expand_Pragma_Loop_Variant (N);
+
+            when Pragma_Psect_Object =>
+               Expand_Pragma_Psect_Object (N);
+
+            when Pragma_Relative_Deadline =>
+               Expand_Pragma_Relative_Deadline (N);
+
+            when Pragma_Suppress_Initialization =>
+               Expand_Pragma_Suppress_Initialization (N);
+
+            --  All other pragmas need no expander action
+
+            when others => null;
+         end case;
+      end if;
+
+   end Expand_N_Pragma;
+
+   -------------------------------
+   -- Expand_Pragma_Abort_Defer --
+   -------------------------------
+
+   --  An Abort_Defer pragma appears as the first statement in a handled
+   --  statement sequence (right after the begin). It defers aborts for
+   --  the entire statement sequence, but not for any declarations or
+   --  handlers (if any) associated with this statement sequence.
+
+   --  The transformation is to transform
+
+   --    pragma Abort_Defer;
+   --    statements;
+
+   --  into
+
+   --    begin
+   --       Abort_Defer.all;
+   --       statements
+   --    exception
+   --       when all others =>
+   --          Abort_Undefer.all;
+   --          raise;
+   --    at end
+   --       Abort_Undefer_Direct;
+   --    end;
+
+   procedure Expand_Pragma_Abort_Defer (N : Node_Id) is
+      Loc  : constant Source_Ptr := Sloc (N);
+      Stm  : Node_Id;
+      Stms : List_Id;
+      HSS  : Node_Id;
+      Blk  : constant Entity_Id :=
+               New_Internal_Entity (E_Block, Current_Scope, Sloc (N), 'B');
+      AUD : constant Entity_Id := RTE (RE_Abort_Undefer_Direct);
+
+   begin
+      Stms := New_List (Build_Runtime_Call (Loc, RE_Abort_Defer));
+      loop
+         Stm := Remove_Next (N);
+         exit when No (Stm);
+         Append (Stm, Stms);
+      end loop;
+
+      HSS :=
+        Make_Handled_Sequence_Of_Statements (Loc,
+          Statements  => Stms,
+          At_End_Proc => New_Occurrence_Of (AUD, Loc));
+
+      --  Present the Abort_Undefer_Direct function to the backend so that it
+      --  can inline the call to the function.
+
+      Add_Inlined_Body (AUD, N);
+
+      Rewrite (N,
+        Make_Block_Statement (Loc,
+          Handled_Statement_Sequence => HSS));
+
+      Set_Scope (Blk, Current_Scope);
+      Set_Etype (Blk, Standard_Void_Type);
+      Set_Identifier (N, New_Occurrence_Of (Blk, Sloc (N)));
+      Expand_At_End_Handler (HSS, Blk);
+      Analyze (N);
+   end Expand_Pragma_Abort_Defer;
+
+   --------------------------
+   -- Expand_Pragma_Check --
+   --------------------------
+
+   procedure Expand_Pragma_Check (N : Node_Id) is
+      Cond : constant Node_Id := Arg2 (N);
+      Nam  : constant Name_Id := Chars (Arg1 (N));
+      Msg  : Node_Id;
+
+      Loc : constant Source_Ptr := Sloc (First_Node (Cond));
+      --  Source location used in the case of a failed assertion: point to the
+      --  failing condition, not Loc. Note that the source location of the
+      --  expression is not usually the best choice here, because it points to
+      --  the location of the topmost tree node, which may be an operator in
+      --  the middle of the source text of the expression. For example, it gets
+      --  located on the last AND keyword in a chain of boolean expressiond
+      --  AND'ed together. It is best to put the message on the first character
+      --  of the condition, which is the effect of the First_Node call here.
+      --  This source location is used to build the default exception message,
+      --  and also as the sloc of the call to the runtime subprogram raising
+      --  Assert_Failure, so that coverage analysis tools can relate the
+      --  call to the failed check.
+
+   begin
+      --  Nothing to do if pragma is ignored
+
+      if Is_Ignored (N) then
+         return;
+      end if;
+
+      --  Since this check is active, we rewrite the pragma into a
+      --  corresponding if statement, and then analyze the statement
+
+      --  The normal case expansion transforms:
+
+      --    pragma Check (name, condition [,message]);
+
+      --  into
+
+      --    if not condition then
+      --       System.Assertions.Raise_Assert_Failure (Str);
+      --    end if;
+
+      --  where Str is the message if one is present, or the default of
+      --  name failed at file:line if no message is given (the "name failed
+      --  at" is omitted for name = Assertion, since it is redundant, given
+      --  that the name of the exception is Assert_Failure.)
+
+      --  Also, instead of "XXX failed at", we generate slightly
+      --  different messages for some of the contract assertions (see
+      --  code below for details).
+
+      --  An alternative expansion is used when the No_Exception_Propagation
+      --  restriction is active and there is a local Assert_Failure handler.
+      --  This is not a common combination of circumstances, but it occurs in
+      --  the context of Aunit and the zero footprint profile. In this case we
+      --  generate:
+
+      --    if not condition then
+      --       raise Assert_Failure;
+      --    end if;
+
+      --  This will then be transformed into a goto, and the local handler will
+      --  be able to handle the assert error (which would not be the case if a
+      --  call is made to the Raise_Assert_Failure procedure).
+
+      --  We also generate the direct raise if the Suppress_Exception_Locations
+      --  is active, since we don't want to generate messages in this case.
+
+      --  Note that the reason we do not always generate a direct raise is that
+      --  the form in which the procedure is called allows for more efficient
+      --  breakpointing of assertion errors.
+
+      --  Generate the appropriate if statement. Note that we consider this to
+      --  be an explicit conditional in the source, not an implicit if, so we
+      --  do not call Make_Implicit_If_Statement.
+
+      --  Case where we generate a direct raise
+
+      if ((Debug_Flag_Dot_G
+            or else Restriction_Active (No_Exception_Propagation))
+           and then Present (Find_Local_Handler (RTE (RE_Assert_Failure), N)))
+        or else (Opt.Exception_Locations_Suppressed and then No (Arg3 (N)))
+      then
+         Rewrite (N,
+           Make_If_Statement (Loc,
+             Condition       => Make_Op_Not (Loc, Right_Opnd => Cond),
+             Then_Statements => New_List (
+               Make_Raise_Statement (Loc,
+                 Name => New_Occurrence_Of (RTE (RE_Assert_Failure), Loc)))));
+
+      --  Case where we call the procedure
+
+      else
+         --  If we have a message given, use it
+
+         if Present (Arg3 (N)) then
+            Msg := Get_Pragma_Arg (Arg3 (N));
+
+         --  Here we have no string, so prepare one
+
+         else
+            declare
+               Loc_Str : constant String := Build_Location_String (Loc);
+
+            begin
+               Name_Len := 0;
+
+               --  For Assert, we just use the location
+
+               if Nam = Name_Assert then
+                  null;
+
+               --  For predicate, we generate the string "predicate failed at
+               --  yyy". We prefer all lower case for predicate.
+
+               elsif Nam = Name_Predicate then
+                  Add_Str_To_Name_Buffer ("predicate failed at ");
+
+               --  For special case of Precondition/Postcondition the string is
+               --  "failed xx from yy" where xx is precondition/postcondition
+               --  in all lower case. The reason for this different wording is
+               --  that the failure is not at the point of occurrence of the
+               --  pragma, unlike the other Check cases.
+
+               elsif Nam_In (Nam, Name_Precondition, Name_Postcondition) then
+                  Get_Name_String (Nam);
+                  Insert_Str_In_Name_Buffer ("failed ", 1);
+                  Add_Str_To_Name_Buffer (" from ");
+
+               --  For special case of Invariant, the string is "failed
+               --  invariant from yy", to be consistent with the string that is
+               --  generated for the aspect case (the code later on checks for
+               --  this specific string to modify it in some cases, so this is
+               --  functionally important).
+
+               elsif Nam = Name_Invariant then
+                  Add_Str_To_Name_Buffer ("failed invariant from ");
+
+               --  For all other checks, the string is "xxx failed at yyy"
+               --  where xxx is the check name with current source file casing.
+
+               else
+                  Get_Name_String (Nam);
+                  Set_Casing (Identifier_Casing (Current_Source_File));
+                  Add_Str_To_Name_Buffer (" failed at ");
+               end if;
+
+               --  In all cases, add location string
+
+               Add_Str_To_Name_Buffer (Loc_Str);
+
+               --  Build the message
+
+               Msg := Make_String_Literal (Loc, Name_Buffer (1 .. Name_Len));
+            end;
+         end if;
+
+         --  Now rewrite as an if statement
+
+         Rewrite (N,
+           Make_If_Statement (Loc,
+             Condition       => Make_Op_Not (Loc, Right_Opnd => Cond),
+             Then_Statements => New_List (
+               Make_Procedure_Call_Statement (Loc,
+                 Name                   =>
+                   New_Occurrence_Of (RTE (RE_Raise_Assert_Failure), Loc),
+                 Parameter_Associations => New_List (Relocate_Node (Msg))))));
+      end if;
+
+      Analyze (N);
+
+      --  If new condition is always false, give a warning
+
+      if Warn_On_Assertion_Failure
+        and then Nkind (N) = N_Procedure_Call_Statement
+        and then Is_RTE (Entity (Name (N)), RE_Raise_Assert_Failure)
+      then
+         --  If original condition was a Standard.False, we assume that this is
+         --  indeed intended to raise assert error and no warning is required.
+
+         if Is_Entity_Name (Original_Node (Cond))
+           and then Entity (Original_Node (Cond)) = Standard_False
+         then
+            return;
+
+         elsif Nam = Name_Assert then
+            Error_Msg_N ("?A?assertion will fail at run time", N);
+         else
+
+            Error_Msg_N ("?A?check will fail at run time", N);
+         end if;
+      end if;
+   end Expand_Pragma_Check;
+
+   ---------------------------------
+   -- Expand_Pragma_Common_Object --
+   ---------------------------------
+
+   --  Use a machine attribute to replicate semantic effect in DEC Ada
+
+   --    pragma Machine_Attribute (intern_name, "common_object", extern_name);
+
+   --  For now we do nothing with the size attribute ???
+
+   --  Note: Psect_Object shares this processing
+
+   procedure Expand_Pragma_Common_Object (N : Node_Id) is
+      Loc : constant Source_Ptr := Sloc (N);
+
+      Internal : constant Node_Id := Arg1 (N);
+      External : constant Node_Id := Arg2 (N);
+
+      Psect : Node_Id;
+      --  Psect value upper cased as string literal
+
+      Iloc : constant Source_Ptr := Sloc (Internal);
+      Eloc : constant Source_Ptr := Sloc (External);
+      Ploc : Source_Ptr;
+
+   begin
+      --  Acquire Psect value and fold to upper case
+
+      if Present (External) then
+         if Nkind (External) = N_String_Literal then
+            String_To_Name_Buffer (Strval (External));
+         else
+            Get_Name_String (Chars (External));
+         end if;
+
+         Set_All_Upper_Case;
+
+         Psect :=
+           Make_String_Literal (Eloc, Strval => String_From_Name_Buffer);
+
+      else
+         Get_Name_String (Chars (Internal));
+         Set_All_Upper_Case;
+         Psect :=
+           Make_String_Literal (Iloc, Strval => String_From_Name_Buffer);
+      end if;
+
+      Ploc := Sloc (Psect);
+
+      --  Insert the pragma
+
+      Insert_After_And_Analyze (N,
+        Make_Pragma (Loc,
+          Chars                        => Name_Machine_Attribute,
+          Pragma_Argument_Associations => New_List (
+            Make_Pragma_Argument_Association (Iloc,
+              Expression => New_Copy_Tree (Internal)),
+            Make_Pragma_Argument_Association (Eloc,
+              Expression =>
+                Make_String_Literal (Sloc => Ploc, Strval => "common_object")),
+            Make_Pragma_Argument_Association (Ploc,
+              Expression => New_Copy_Tree (Psect)))));
+   end Expand_Pragma_Common_Object;
+
+   ----------------------------------
+   -- Expand_Pragma_Contract_Cases --
+   ----------------------------------
 
    --  Pragma Contract_Cases is expanded in the following manner:
 
@@ -237,7 +627,7 @@ package body Exp_Prag is
    --       . . .
    --    end S;
 
-   procedure Expand_Contract_Cases
+   procedure Expand_Pragma_Contract_Cases
      (CCs     : Node_Id;
       Subp_Id : Entity_Id;
       Decls   : List_Id;
@@ -594,7 +984,7 @@ package body Exp_Prag is
       Others_Flag   : Entity_Id := Empty;
       Post_Case     : Node_Id;
 
-   --  Start of processing for Expand_Contract_Cases
+   --  Start of processing for Expand_Pragma_Contract_Cases
 
    begin
       --  Do nothing if pragma is not enabled. If pragma is disabled, it has
@@ -833,404 +1223,14 @@ package body Exp_Prag is
       end if;
 
       Append_To (Stmts, Conseq_Checks);
-   end Expand_Contract_Cases;
-
-   ---------------------
-   -- Expand_N_Pragma --
-   ---------------------
-
-   procedure Expand_N_Pragma (N : Node_Id) is
-      Pname : constant Name_Id := Pragma_Name (N);
-
-   begin
-      --  Rewrite pragma ignored by Ignore_Pragma to null statement, so that/
-      --  back end or the expander here does not get over-enthusiastic and
-      --  start processing such a pragma!
-
-      if Get_Name_Table_Boolean3 (Pname) then
-         Rewrite (N, Make_Null_Statement (Sloc (N)));
-         return;
-      end if;
-
-      --  Note: we may have a pragma whose Pragma_Identifier field is not a
-      --  recognized pragma, and we must ignore it at this stage.
-
-      if Is_Pragma_Name (Pname) then
-         case Get_Pragma_Id (Pname) is
-
-            --  Pragmas requiring special expander action
-
-            when Pragma_Abort_Defer =>
-               Expand_Pragma_Abort_Defer (N);
-
-            when Pragma_Check =>
-               Expand_Pragma_Check (N);
-
-            when Pragma_Common_Object =>
-               Expand_Pragma_Common_Object (N);
-
-            when Pragma_Import =>
-               Expand_Pragma_Import_Or_Interface (N);
-
-            when Pragma_Inspection_Point =>
-               Expand_Pragma_Inspection_Point (N);
-
-            when Pragma_Interface =>
-               Expand_Pragma_Import_Or_Interface (N);
-
-            when Pragma_Interrupt_Priority =>
-               Expand_Pragma_Interrupt_Priority (N);
-
-            when Pragma_Loop_Variant =>
-               Expand_Pragma_Loop_Variant (N);
-
-            when Pragma_Psect_Object =>
-               Expand_Pragma_Psect_Object (N);
-
-            when Pragma_Relative_Deadline =>
-               Expand_Pragma_Relative_Deadline (N);
-
-            when Pragma_Suppress_Initialization =>
-               Expand_Pragma_Suppress_Initialization (N);
-
-            --  All other pragmas need no expander action
-
-            when others => null;
-         end case;
-      end if;
-
-   end Expand_N_Pragma;
-
-   -------------------------------
-   -- Expand_Pragma_Abort_Defer --
-   -------------------------------
-
-   --  An Abort_Defer pragma appears as the first statement in a handled
-   --  statement sequence (right after the begin). It defers aborts for
-   --  the entire statement sequence, but not for any declarations or
-   --  handlers (if any) associated with this statement sequence.
-
-   --  The transformation is to transform
-
-   --    pragma Abort_Defer;
-   --    statements;
-
-   --  into
-
-   --    begin
-   --       Abort_Defer.all;
-   --       statements
-   --    exception
-   --       when all others =>
-   --          Abort_Undefer.all;
-   --          raise;
-   --    at end
-   --       Abort_Undefer_Direct;
-   --    end;
-
-   procedure Expand_Pragma_Abort_Defer (N : Node_Id) is
-      Loc  : constant Source_Ptr := Sloc (N);
-      Stm  : Node_Id;
-      Stms : List_Id;
-      HSS  : Node_Id;
-      Blk  : constant Entity_Id :=
-               New_Internal_Entity (E_Block, Current_Scope, Sloc (N), 'B');
-      AUD : constant Entity_Id := RTE (RE_Abort_Undefer_Direct);
-
-   begin
-      Stms := New_List (Build_Runtime_Call (Loc, RE_Abort_Defer));
-      loop
-         Stm := Remove_Next (N);
-         exit when No (Stm);
-         Append (Stm, Stms);
-      end loop;
-
-      HSS :=
-        Make_Handled_Sequence_Of_Statements (Loc,
-          Statements  => Stms,
-          At_End_Proc => New_Occurrence_Of (AUD, Loc));
-
-      --  Present the Abort_Undefer_Direct function to the backend so that it
-      --  can inline the call to the function.
-
-      Add_Inlined_Body (AUD, N);
-
-      Rewrite (N,
-        Make_Block_Statement (Loc,
-          Handled_Statement_Sequence => HSS));
-
-      Set_Scope (Blk, Current_Scope);
-      Set_Etype (Blk, Standard_Void_Type);
-      Set_Identifier (N, New_Occurrence_Of (Blk, Sloc (N)));
-      Expand_At_End_Handler (HSS, Blk);
-      Analyze (N);
-   end Expand_Pragma_Abort_Defer;
-
-   --------------------------
-   -- Expand_Pragma_Check --
-   --------------------------
-
-   procedure Expand_Pragma_Check (N : Node_Id) is
-      Cond : constant Node_Id := Arg2 (N);
-      Nam  : constant Name_Id := Chars (Arg1 (N));
-      Msg  : Node_Id;
-
-      Loc : constant Source_Ptr := Sloc (First_Node (Cond));
-      --  Source location used in the case of a failed assertion: point to the
-      --  failing condition, not Loc. Note that the source location of the
-      --  expression is not usually the best choice here, because it points to
-      --  the location of the topmost tree node, which may be an operator in
-      --  the middle of the source text of the expression. For example, it gets
-      --  located on the last AND keyword in a chain of boolean expressiond
-      --  AND'ed together. It is best to put the message on the first character
-      --  of the condition, which is the effect of the First_Node call here.
-      --  This source location is used to build the default exception message,
-      --  and also as the sloc of the call to the runtime subprogram raising
-      --  Assert_Failure, so that coverage analysis tools can relate the
-      --  call to the failed check.
-
-   begin
-      --  Nothing to do if pragma is ignored
-
-      if Is_Ignored (N) then
-         return;
-      end if;
-
-      --  Since this check is active, we rewrite the pragma into a
-      --  corresponding if statement, and then analyze the statement
-
-      --  The normal case expansion transforms:
-
-      --    pragma Check (name, condition [,message]);
-
-      --  into
-
-      --    if not condition then
-      --       System.Assertions.Raise_Assert_Failure (Str);
-      --    end if;
-
-      --  where Str is the message if one is present, or the default of
-      --  name failed at file:line if no message is given (the "name failed
-      --  at" is omitted for name = Assertion, since it is redundant, given
-      --  that the name of the exception is Assert_Failure.)
-
-      --  Also, instead of "XXX failed at", we generate slightly
-      --  different messages for some of the contract assertions (see
-      --  code below for details).
-
-      --  An alternative expansion is used when the No_Exception_Propagation
-      --  restriction is active and there is a local Assert_Failure handler.
-      --  This is not a common combination of circumstances, but it occurs in
-      --  the context of Aunit and the zero footprint profile. In this case we
-      --  generate:
-
-      --    if not condition then
-      --       raise Assert_Failure;
-      --    end if;
-
-      --  This will then be transformed into a goto, and the local handler will
-      --  be able to handle the assert error (which would not be the case if a
-      --  call is made to the Raise_Assert_Failure procedure).
-
-      --  We also generate the direct raise if the Suppress_Exception_Locations
-      --  is active, since we don't want to generate messages in this case.
-
-      --  Note that the reason we do not always generate a direct raise is that
-      --  the form in which the procedure is called allows for more efficient
-      --  breakpointing of assertion errors.
-
-      --  Generate the appropriate if statement. Note that we consider this to
-      --  be an explicit conditional in the source, not an implicit if, so we
-      --  do not call Make_Implicit_If_Statement.
-
-      --  Case where we generate a direct raise
-
-      if ((Debug_Flag_Dot_G
-             or else Restriction_Active (No_Exception_Propagation))
-           and then Present (Find_Local_Handler (RTE (RE_Assert_Failure), N)))
-        or else (Opt.Exception_Locations_Suppressed and then No (Arg3 (N)))
-      then
-         Rewrite (N,
-           Make_If_Statement (Loc,
-             Condition       => Make_Op_Not (Loc, Right_Opnd => Cond),
-             Then_Statements => New_List (
-               Make_Raise_Statement (Loc,
-                 Name => New_Occurrence_Of (RTE (RE_Assert_Failure), Loc)))));
-
-      --  Case where we call the procedure
-
-      else
-         --  If we have a message given, use it
-
-         if Present (Arg3 (N)) then
-            Msg := Get_Pragma_Arg (Arg3 (N));
-
-         --  Here we have no string, so prepare one
-
-         else
-            declare
-               Loc_Str : constant String := Build_Location_String (Loc);
-
-            begin
-               Name_Len := 0;
-
-               --  For Assert, we just use the location
-
-               if Nam = Name_Assert then
-                  null;
-
-               --  For predicate, we generate the string "predicate failed
-               --  at yyy". We prefer all lower case for predicate.
-
-               elsif Nam = Name_Predicate then
-                  Add_Str_To_Name_Buffer ("predicate failed at ");
-
-               --  For special case of Precondition/Postcondition the string is
-               --  "failed xx from yy" where xx is precondition/postcondition
-               --  in all lower case. The reason for this different wording is
-               --  that the failure is not at the point of occurrence of the
-               --  pragma, unlike the other Check cases.
-
-               elsif Nam_In (Nam, Name_Precondition, Name_Postcondition) then
-                  Get_Name_String (Nam);
-                  Insert_Str_In_Name_Buffer ("failed ", 1);
-                  Add_Str_To_Name_Buffer (" from ");
-
-               --  For special case of Invariant, the string is "failed
-               --  invariant from yy", to be consistent with the string that is
-               --  generated for the aspect case (the code later on checks for
-               --  this specific string to modify it in some cases, so this is
-               --  functionally important).
-
-               elsif Nam = Name_Invariant then
-                  Add_Str_To_Name_Buffer ("failed invariant from ");
-
-               --  For all other checks, the string is "xxx failed at yyy"
-               --  where xxx is the check name with current source file casing.
-
-               else
-                  Get_Name_String (Nam);
-                  Set_Casing (Identifier_Casing (Current_Source_File));
-                  Add_Str_To_Name_Buffer (" failed at ");
-               end if;
-
-               --  In all cases, add location string
-
-               Add_Str_To_Name_Buffer (Loc_Str);
-
-               --  Build the message
-
-               Msg := Make_String_Literal (Loc, Name_Buffer (1 .. Name_Len));
-            end;
-         end if;
-
-         --  Now rewrite as an if statement
-
-         Rewrite (N,
-           Make_If_Statement (Loc,
-             Condition       => Make_Op_Not (Loc, Right_Opnd => Cond),
-             Then_Statements => New_List (
-               Make_Procedure_Call_Statement (Loc,
-                 Name                   =>
-                   New_Occurrence_Of (RTE (RE_Raise_Assert_Failure), Loc),
-                 Parameter_Associations => New_List (Relocate_Node (Msg))))));
-      end if;
-
-      Analyze (N);
-
-      --  If new condition is always false, give a warning
-
-      if Warn_On_Assertion_Failure
-        and then Nkind (N) = N_Procedure_Call_Statement
-        and then Is_RTE (Entity (Name (N)), RE_Raise_Assert_Failure)
-      then
-         --  If original condition was a Standard.False, we assume that this is
-         --  indeed intended to raise assert error and no warning is required.
-
-         if Is_Entity_Name (Original_Node (Cond))
-           and then Entity (Original_Node (Cond)) = Standard_False
-         then
-            return;
-
-         elsif Nam = Name_Assert then
-            Error_Msg_N ("?A?assertion will fail at run time", N);
-         else
-
-            Error_Msg_N ("?A?check will fail at run time", N);
-         end if;
-      end if;
-   end Expand_Pragma_Check;
-
-   ---------------------------------
-   -- Expand_Pragma_Common_Object --
-   ---------------------------------
-
-   --  Use a machine attribute to replicate semantic effect in DEC Ada
-
-   --    pragma Machine_Attribute (intern_name, "common_object", extern_name);
-
-   --  For now we do nothing with the size attribute ???
-
-   --  Note: Psect_Object shares this processing
-
-   procedure Expand_Pragma_Common_Object (N : Node_Id) is
-      Loc : constant Source_Ptr := Sloc (N);
-
-      Internal : constant Node_Id := Arg1 (N);
-      External : constant Node_Id := Arg2 (N);
-
-      Psect : Node_Id;
-      --  Psect value upper cased as string literal
-
-      Iloc : constant Source_Ptr := Sloc (Internal);
-      Eloc : constant Source_Ptr := Sloc (External);
-      Ploc : Source_Ptr;
-
-   begin
-      --  Acquire Psect value and fold to upper case
-
-      if Present (External) then
-         if Nkind (External) = N_String_Literal then
-            String_To_Name_Buffer (Strval (External));
-         else
-            Get_Name_String (Chars (External));
-         end if;
-
-         Set_All_Upper_Case;
-
-         Psect :=
-           Make_String_Literal (Eloc, Strval => String_From_Name_Buffer);
-
-      else
-         Get_Name_String (Chars (Internal));
-         Set_All_Upper_Case;
-         Psect :=
-           Make_String_Literal (Iloc, Strval => String_From_Name_Buffer);
-      end if;
-
-      Ploc := Sloc (Psect);
-
-      --  Insert the pragma
-
-      Insert_After_And_Analyze (N,
-        Make_Pragma (Loc,
-          Chars                        => Name_Machine_Attribute,
-          Pragma_Argument_Associations => New_List (
-            Make_Pragma_Argument_Association (Iloc,
-              Expression => New_Copy_Tree (Internal)),
-            Make_Pragma_Argument_Association (Eloc,
-              Expression =>
-                Make_String_Literal (Sloc => Ploc, Strval => "common_object")),
-            Make_Pragma_Argument_Association (Ploc,
-              Expression => New_Copy_Tree (Psect)))));
-   end Expand_Pragma_Common_Object;
+   end Expand_Pragma_Contract_Cases;
 
    ---------------------------------------
    -- Expand_Pragma_Import_Or_Interface --
    ---------------------------------------
 
    procedure Expand_Pragma_Import_Or_Interface (N : Node_Id) is
-      Def_Id    : Entity_Id;
+      Def_Id : Entity_Id;
 
    begin
       --  In Relaxed_RM_Semantics, support old Ada 83 style:
@@ -1391,7 +1391,6 @@ package body Exp_Prag is
           Pragma_Argument_Associations => New_List (
             Make_Pragma_Argument_Association (Loc,
               Expression => Make_Identifier (Loc, Name_Initial_Condition)),
-
             Make_Pragma_Argument_Association (Loc,
               Expression => New_Copy_Tree (Expr))));
 
@@ -1450,7 +1449,6 @@ package body Exp_Prag is
       --  Are there other pragmas that may require this ???
 
       Assoc := First (Pragma_Argument_Associations (N));
-
       while Present (Assoc) loop
          Expand (Expression (Assoc));
          Next (Assoc);
@@ -1465,14 +1463,13 @@ package body Exp_Prag is
 
    procedure Expand_Pragma_Interrupt_Priority (N : Node_Id) is
       Loc : constant Source_Ptr := Sloc (N);
-
    begin
       if No (Pragma_Argument_Associations (N)) then
          Set_Pragma_Argument_Associations (N, New_List (
            Make_Pragma_Argument_Association (Loc,
              Expression =>
                Make_Attribute_Reference (Loc,
-                 Prefix =>
+                 Prefix         =>
                    New_Occurrence_Of (RTE (RE_Interrupt_Priority), Loc),
                  Attribute_Name => Name_Last))));
       end if;
@@ -1531,10 +1528,10 @@ package body Exp_Prag is
 
       Last_Var : constant Node_Id := Last (Pragma_Argument_Associations (N));
 
-      Curr_Assign : List_Id             := No_List;
-      Flag_Id     : Entity_Id           := Empty;
-      If_Stmt     : Node_Id             := Empty;
-      Old_Assign  : List_Id             := No_List;
+      Curr_Assign : List_Id   := No_List;
+      Flag_Id     : Entity_Id := Empty;
+      If_Stmt     : Node_Id   := Empty;
+      Old_Assign  : List_Id   := No_List;
       Loop_Scop   : Entity_Id;
       Loop_Stmt   : Node_Id;
       Variant     : Node_Id;
@@ -1857,8 +1854,9 @@ package body Exp_Prag is
                     Left_Opnd  =>
                       Make_Function_Call (Loc,
                         New_Occurrence_Of (RTE (RO_RT_To_Duration), Loc),
-                        New_List (Make_Function_Call (Loc,
-                          New_Occurrence_Of (RTE (RE_Clock), Loc)))),
+                        New_List
+                          (Make_Function_Call
+                             (Loc, New_Occurrence_Of (RTE (RE_Clock), Loc)))),
                     Right_Opnd  =>
                       Unchecked_Convert_To (Standard_Duration, Arg1 (N)))))));
 
diff --git a/gcc/ada/exp_prag.ads b/gcc/ada/exp_prag.ads
index d1ddfea..48d1c2f 100644
--- a/gcc/ada/exp_prag.ads
+++ b/gcc/ada/exp_prag.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2015, 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- --
@@ -31,7 +31,7 @@ package Exp_Prag is
 
    procedure Expand_N_Pragma (N : Node_Id);
 
-   procedure Expand_Contract_Cases
+   procedure Expand_Pragma_Contract_Cases
      (CCs     : Node_Id;
       Subp_Id : Entity_Id;
       Decls   : List_Id;
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 29153d7..f7dadef 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -8045,13 +8045,10 @@ package body Sem_Ch13 is
                   end;
                end if;
 
-               --  Get name to be used for Check pragma
+               --  Get name to be used for Check pragma. Using the original
+               --  name ensures that 'Class case is properly handled.
 
-               if not From_Aspect_Specification (Ritem) then
-                  Nam := Name_Invariant;
-               else
-                  Nam := Chars (Identifier (Corresponding_Aspect (Ritem)));
-               end if;
+               Nam := Original_Aspect_Pragma_Name (Ritem);
 
                --  Build first two arguments for Check pragma