2014-07-29 Ed Schonberg <schonberg@adacore.com>

	* sem_ch4.adb (Complete_Object_Operation): If the type of the
	candidate subprogram is a limited view, use non-limited view
	when available.

2014-07-29  Robert Dewar  <dewar@adacore.com>

	* sem_ch13.adb: Minor change in RM reference.
	* sem_mech.ads: Minor reformatting.
	* einfo.ads: Minor comment fix.
	* types.ads: Minor correction to range given for Mechanism_Type.
	* exp_ch6.adb (Add_Invariant_And_Predicate_Checks): Do not
	check predicate on way out for OUT or IN OUT parameters.
	* par-ch3.adb (P_Constraint_Opt): Handle missing RANGE keyword
	better (P_Range_Constraint): Corresponding fix.
	* checks.ads: Minor comment clarification.

2014-07-29  Gary Dismukes  <dismukes@adacore.com>

	* sem_ch8.adb (Analyze_Object_Renaming): Set the Is_Volatile
	and Treat_As_Volatile flags based on whether the renamed object
	is a volatile object.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@213170 138bc75d-0d04-0410-961f-82ee72b054a4

10 files changed, 132 insertions, 101 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 07ac917b9f2..218c225cbcc 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,27 @@
+2014-07-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch4.adb (Complete_Object_Operation): If the type of the
+	candidate subprogram is a limited view, use non-limited view
+	when available.
+
+2014-07-29  Robert Dewar  <dewar@adacore.com>
+
+	* sem_ch13.adb: Minor change in RM reference.
+	* sem_mech.ads: Minor reformatting.
+	* einfo.ads: Minor comment fix.
+	* types.ads: Minor correction to range given for Mechanism_Type.
+	* exp_ch6.adb (Add_Invariant_And_Predicate_Checks): Do not
+	check predicate on way out for OUT or IN OUT parameters.
+	* par-ch3.adb (P_Constraint_Opt): Handle missing RANGE keyword
+	better (P_Range_Constraint): Corresponding fix.
+	* checks.ads: Minor comment clarification.
+
+2014-07-29  Gary Dismukes  <dismukes@adacore.com>
+
+	* sem_ch8.adb (Analyze_Object_Renaming): Set the Is_Volatile
+	and Treat_As_Volatile flags based on whether the renamed object
+	is a volatile object.
+
 2014-07-29  Olivier Hainque  <hainque@adacore.com>
 
 	* g-debpoo.adb
diff --git a/gcc/ada/checks.ads b/gcc/ada/checks.ads
index 7244e3c6a66..07fdc5dc3c8 100644
--- a/gcc/ada/checks.ads
+++ b/gcc/ada/checks.ads
@@ -245,8 +245,7 @@ package Checks is
 
    procedure Apply_Predicate_Check (N : Node_Id; Typ : Entity_Id);
    --  N is an expression to which a predicate check may need to be applied
-   --  for Typ, if Typ has a predicate function. The check is applied only
-   --  if the type of N does not match Typ.
+   --  for Typ, if Typ has a predicate function.
 
    procedure Apply_Type_Conversion_Checks (N : Node_Id);
    --  N is an N_Type_Conversion node. A type conversion actually involves
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 4117252280d..6065d19ba94 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -3172,9 +3172,9 @@ package Einfo is
 --    Mechanism (Uint8) (returned as Mechanism_Type)
 --       Defined in functions and non-generic formal parameters. Indicates
 --       the mechanism to be used for the function return or for the formal
---       parameter. See separate section on passing mechanisms. This field
---       is also set (to the default value of zero) in a subprogram body
---       entity but not used in this context.
+--       parameter. See full description in the spec of Sem_Mech. This field
+--       is also set (to the default value of zero = Default_Mechanism) in a
+--       subprogram body entity but not used in this context.
 
 --    Modulus (Uint17) [base type only]
 --       Defined in modular types. Contains the modulus. For the binary case,
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index a1d080abe58..9344e40aad8 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -8248,10 +8248,6 @@ package body Exp_Ch6 is
          --  subprogram Subp_Id must appear visible from the point of view of
          --  the type.
 
-         function Predicate_Checks_OK (Typ : Entity_Id) return Boolean;
-         --  Determine whether type Typ can benefit from predicate checks. To
-         --  qualify, the type must have at least one checked predicate.
-
          ---------------------------------
          -- Add_Invariant_Access_Checks --
          ---------------------------------
@@ -8414,57 +8410,6 @@ package body Exp_Ch6 is
                 and then Has_Public_Visibility_Of_Subprogram;
          end Invariant_Checks_OK;
 
-         -------------------------
-         -- Predicate_Checks_OK --
-         -------------------------
-
-         function Predicate_Checks_OK (Typ : Entity_Id) return Boolean is
-            function Has_Checked_Predicate return Boolean;
-            --  Determine whether type Typ has or inherits at least one
-            --  predicate aspect or pragma, for which the applicable policy is
-            --  Checked.
-
-            ---------------------------
-            -- Has_Checked_Predicate --
-            ---------------------------
-
-            function Has_Checked_Predicate return Boolean is
-               Anc  : Entity_Id;
-               Pred : Node_Id;
-
-            begin
-               --  Climb the ancestor type chain staring from the input. This
-               --  is done because the input type may lack aspect/pragma
-               --  predicate and simply inherit those from its ancestor.
-
-               --  Note that predicate pragmas correspond to all three cases
-               --  of predicate aspects (Predicate, Dynamic_Predicate, and
-               --  Static_Predicate), so this routine checks for all three
-               --  cases.
-
-               Anc := Typ;
-               while Present (Anc) loop
-                  Pred := Get_Pragma (Anc, Pragma_Predicate);
-
-                  if Present (Pred) and then not Is_Ignored (Pred) then
-                     return True;
-                  end if;
-
-                  Anc := Nearest_Ancestor (Anc);
-               end loop;
-
-               return False;
-            end Has_Checked_Predicate;
-
-         --  Start of processing for Predicate_Checks_OK
-
-         begin
-            return
-              Has_Predicates (Typ)
-                and then Present (Predicate_Function (Typ))
-                and then Has_Checked_Predicate;
-         end Predicate_Checks_OK;
-
          --  Local variables
 
          Loc : constant Source_Ptr := Sloc (N);
@@ -8529,12 +8474,11 @@ package body Exp_Ch6 is
 
                Add_Invariant_Access_Checks (Formal);
 
-               if Predicate_Checks_OK (Typ) then
-                  Append_Enabled_Item
-                    (Item => Make_Predicate_Check
-                                (Typ, New_Occurrence_Of (Formal, Loc)),
-                     List => Stmts);
-               end if;
+               --  Note: we used to add predicate checks for OUT and IN OUT
+               --  formals here, but that was misguided, since such checks are
+               --  performed on the caller side, based on the predicate of the
+               --  actual, rather than the predicate of the formal.
+
             end if;
 
             Next_Formal (Formal);
diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb
index e9524fa4de7..3d6161b2165 100644
--- a/gcc/ada/par-ch3.adb
+++ b/gcc/ada/par-ch3.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, 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- --
@@ -1217,19 +1217,13 @@ package body Ch3 is
 
    function P_Constraint_Opt return Node_Id is
    begin
-      if Token = Tok_Range
-        or else Bad_Spelling_Of (Tok_Range)
-      then
+      if Token = Tok_Range or else Bad_Spelling_Of (Tok_Range) then
          return P_Range_Constraint;
 
-      elsif Token = Tok_Digits
-        or else Bad_Spelling_Of (Tok_Digits)
-      then
+      elsif Token = Tok_Digits or else Bad_Spelling_Of (Tok_Digits) then
          return P_Digits_Constraint;
 
-      elsif Token = Tok_Delta
-        or else Bad_Spelling_Of (Tok_Delta)
-      then
+      elsif Token = Tok_Delta or else Bad_Spelling_Of (Tok_Delta) then
          return P_Delta_Constraint;
 
       elsif Token = Tok_Left_Paren then
@@ -1239,6 +1233,31 @@ package body Ch3 is
          Ignore (Tok_In);
          return P_Constraint_Opt;
 
+      --  One more possibility is e.g. 1 .. 10 (i.e. missing RANGE keyword)
+
+      elsif Token = Tok_Identifier      or else
+            Token = Tok_Integer_Literal or else
+            Token = Tok_Real_Literal
+      then
+         declare
+            Scan_State : Saved_Scan_State;
+
+         begin
+            Save_Scan_State (Scan_State); -- at identifier or literal
+            Scan; -- past identifier or literal
+
+            if Token = Tok_Dot_Dot then
+               Restore_Scan_State (Scan_State);
+               Error_Msg_BC ("missing RANGE keyword");
+               return P_Range_Constraint;
+            else
+               Restore_Scan_State (Scan_State);
+               return Empty;
+            end if;
+         end;
+
+      --  Nothing worked, no constraint there
+
       else
          return Empty;
       end if;
@@ -2033,7 +2052,9 @@ package body Ch3 is
 
    --  RANGE_CONSTRAINT ::= range RANGE
 
-   --  The caller has checked that the initial token is RANGE
+   --  The caller has checked that the initial token is RANGE or some
+   --  misspelling of it, or it may be absent completely (and a message
+   --  has already been issued).
 
    --  Error recovery: cannot raise Error_Resync
 
@@ -2042,7 +2063,13 @@ package body Ch3 is
 
    begin
       Range_Node := New_Node (N_Range_Constraint, Token_Ptr);
-      Scan; -- past RANGE
+
+      --  Skip range keyword if present
+
+      if Token = Tok_Range or else Bad_Spelling_Of (Tok_Range) then
+         Scan; -- past RANGE
+      end if;
+
       Set_Range_Expression (Range_Node, P_Range);
       return Range_Node;
    end P_Range_Constraint;
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index f6a4be12f83..35f4f8a6fcb 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -8097,7 +8097,7 @@ package body Sem_Ch13 is
                if Has_Static_Predicate_Aspect (Typ) then
                   if Is_Scalar_Type (Typ) or else Is_String_Type (Typ) then
                      Error_Msg_F
-                       ("expression is not predicate-static (RM 4.3.2(16-22))",
+                       ("expression is not predicate-static (RM 3.2.4(16-22))",
                         EN);
                   else
                      Error_Msg_F
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 8ac94e92602..313f6f87d29 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -7542,6 +7542,18 @@ package body Sem_Ch4 is
             Save_Interps (Subprog, Node_To_Replace);
 
          else
+            --  The type of the subprogram may be a limited view obtained
+            --  transitively from another unit. If full view is available,
+            --  use it to analyze call.
+
+            declare
+               T : constant Entity_Id := Etype (Subprog);
+            begin
+               if From_Limited_With (T) then
+                  Set_Etype (Entity (Subprog), Available_View (T));
+               end if;
+            end;
+
             Analyze (Node_To_Replace);
 
             --  If the operation has been rewritten into a call, which may get
@@ -7587,7 +7599,7 @@ package body Sem_Ch4 is
             if Nkind (Parent (Op)) = N_Full_Type_Declaration then
                Error_Msg_N
                  ("\possible interpretation "
-                  & "( inherited, with implicit dereference) #", N);
+                  & "(inherited, with implicit dereference) #", N);
             else
                Error_Msg_N
                  ("\possible interpretation (with implicit dereference) #", N);
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 8643caee853..ccfc2084bf4 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -1245,17 +1245,17 @@ package body Sem_Ch8 is
 
       elsif Nkind (Original_Node (Nam)) = N_Function_Call
 
-            --  When expansion is disabled, attribute reference is not
-            --  rewritten as function call. Otherwise it may be rewritten
-            --  as a conversion, so check original node.
+        --  When expansion is disabled, attribute reference is not rewritten
+        --  as function call. Otherwise it may be rewritten as a conversion,
+        --  so check original node.
 
         or else (Nkind (Original_Node (Nam)) = N_Attribute_Reference
                   and then Is_Function_Attribute_Name
                              (Attribute_Name (Original_Node (Nam))))
 
-            --  Weird but legal, equivalent to renaming a function call.
-            --  Illegal if the literal is the result of constant-folding an
-            --  attribute reference that is not a function.
+        --  Weird but legal, equivalent to renaming a function call. Illegal
+        --  if the literal is the result of constant-folding an attribute
+        --  reference that is not a function.
 
         or else (Is_Entity_Name (Nam)
                   and then Ekind (Entity (Nam)) = E_Enumeration_Literal
@@ -1296,6 +1296,28 @@ package body Sem_Ch8 is
          Set_Is_True_Constant    (Id, True);
       end if;
 
+      --  The entity of the renaming declaration needs to reflect whether the
+      --  renamed object is volatile. Is_Volatile is set if the renamed object
+      --  is volatile in the RM legality sense.
+
+      Set_Is_Volatile (Id, Is_Volatile_Object (Nam));
+
+      --  Treat as volatile if we just set the Volatile flag
+
+      if Is_Volatile (Id)
+
+        --  Or if we are renaming an entity which was marked this way
+
+        --  Are there more cases, e.g. X(J) where X is Treat_As_Volatile ???
+
+        or else (Is_Entity_Name (Nam)
+                  and then Treat_As_Volatile (Entity (Nam)))
+      then
+         Set_Treat_As_Volatile (Id, True);
+      end if;
+
+      --  Now make the link to the renamed object
+
       Set_Renamed_Object (Id, Nam);
 
       --  Implementation-defined aspect specifications can appear in a renaming
diff --git a/gcc/ada/sem_mech.ads b/gcc/ada/sem_mech.ads
index 93f6080f1f4..3e74a2c2fa2 100644
--- a/gcc/ada/sem_mech.ads
+++ b/gcc/ada/sem_mech.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1996-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1996-2014, 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- --
@@ -36,7 +36,7 @@ package Sem_Mech is
    -------------------------------------------------
 
    --  For parameters passed to subprograms, and for function return values,
-   --  as passing mechanism is defined. The entity attribute Mechanism returns
+   --  a passing mechanism is defined. The entity attribute Mechanism returns
    --  an indication of the mechanism, and Set_Mechanism can be used to set
    --  the mechanism. At the program level, there are three ways to explicitly
    --  set the mechanism:
@@ -87,14 +87,14 @@ package Sem_Mech is
    --  special information) is determined by the backend in accordance with
    --  requirements imposed by the ABI as interpreted for Ada.
 
-   By_Descriptor      : constant Mechanism_Type := -3;
-   By_Descriptor_UBS  : constant Mechanism_Type := -4;
-   By_Descriptor_UBSB : constant Mechanism_Type := -5;
-   By_Descriptor_UBA  : constant Mechanism_Type := -6;
-   By_Descriptor_S    : constant Mechanism_Type := -7;
-   By_Descriptor_SB   : constant Mechanism_Type := -8;
-   By_Descriptor_A    : constant Mechanism_Type := -9;
-   By_Descriptor_NCA  : constant Mechanism_Type := -10;
+   By_Descriptor            : constant Mechanism_Type := -3;
+   By_Descriptor_UBS        : constant Mechanism_Type := -4;
+   By_Descriptor_UBSB       : constant Mechanism_Type := -5;
+   By_Descriptor_UBA        : constant Mechanism_Type := -6;
+   By_Descriptor_S          : constant Mechanism_Type := -7;
+   By_Descriptor_SB         : constant Mechanism_Type := -8;
+   By_Descriptor_A          : constant Mechanism_Type := -9;
+   By_Descriptor_NCA        : constant Mechanism_Type := -10;
    By_Short_Descriptor      : constant Mechanism_Type := -11;
    By_Short_Descriptor_UBS  : constant Mechanism_Type := -12;
    By_Short_Descriptor_UBSB : constant Mechanism_Type := -13;
@@ -115,10 +115,13 @@ package Sem_Mech is
    --     A      contiguous array
    --     NCA    non-contiguous array
    --
-   --  Note: the form with no suffix is used if the Import/Export pragma
-   --  uses the simple form of the mechanism name where no descriptor
-   --  type is supplied. In this case the back end assigns a descriptor
-   --  type based on the Ada type in accordance with the OpenVMS ABI.
+   --  Note: the form with no suffix is used if the Import/Export pragma uses
+   --  the simple form of the mechanism name (no descriptor type is supplied).
+   --  In this case the back end assigns a descriptor type based on the Ada
+   --  type in accordance with the OpenVMS ABI.
+
+   pragma Assert (Mechanism_Type'First = -18);
+   --  Check definition in types is right!
 
    subtype Descriptor_Codes is Mechanism_Type
      range By_Short_Descriptor_NCA .. By_Descriptor;
diff --git a/gcc/ada/types.ads b/gcc/ada/types.ads
index c54097b2c48..061dfc26c68 100644
--- a/gcc/ada/types.ads
+++ b/gcc/ada/types.ads
@@ -795,7 +795,7 @@ package Types is
    --  mechanism. See specification of Sem_Mech for full details. The following
    --  subtype is used to represent values of this type:
 
-   subtype Mechanism_Type is Int range -18 .. Int'Last;
+   subtype Mechanism_Type is Int range -18 .. 0;
    --  Type used to represent a mechanism value. This is a subtype rather than
    --  a type to avoid some annoying processing problems with certain routines
    --  in Einfo (processing them to create the corresponding C).