[multiple changes]
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. From-SVN: r213170
This commit is contained in:
parent
f8c79ade9e
commit
28e18b4f56
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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,
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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).
|
||||
|
|
Loading…
Reference in New Issue