+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
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
-- 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,
-- 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 --
---------------------------------
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);
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);
-- --
-- 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- --
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
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;
-- 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
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;
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
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
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);
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
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
-- --
-- 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- --
-------------------------------------------------
-- 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:
-- 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;
-- 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;
-- 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).
projects / platform / upstream / linaro-gcc.git / commitdiff