+2017-12-15 Eric Botcazou <ebotcazou@adacore.com>
+
+ * exp_aggr.adb (Aggr_Assignment_OK_For_Backend): Use Component_Size of
+ the innermost array instead of Esize of its component type to exclude
+ inappropriate array types, including packed array types.
+
+2017-12-15 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_prag.adb (Analyze_Input_Item): Allow concurrent types to appear
+ within the input list of Initializes. Remove the uses of Input_OK.
+
+2017-12-15 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_ch4.adb (Expand_N_In): Do not replace a membership test on a
+ scalar type with a validity test when the membership appears in a
+ predicate expression, to prevent a spurious error when predicate is
+ specified static.
+ * sem_ch13.adb (Build_Predicate_Functions): Add warning if a static
+ predicate, after constant-folding, reduces to True and is this
+ redundant.
+ * par-ch4.adb: Typo fixes and minor reformattings.
+
+2017-12-15 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_elab.adb (Ensure_Prior_Elaboration_Static): Mark the generated
+ with clause as being implicit for an instantiation in order to
+ circumvent an issue with 'W' and 'Z' line encodings in ALI files.
+
+2017-12-15 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_util.adb (Is_Potentially_Unevaluated): Detect further cases of
+ misuse of 'Old that appear within an expression that is potentially
+ unevaluated, when the prefix of the attribute does not statically
+ designate an object (e.g. a function call).
+
+2017-12-15 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch6.adb (Conformking_Types): Two incomplete types are conforming
+ when one of them is used as a generic actual, but only within an
+ instantiation.
+ * einfo.ads: Clarify use of flag Used_As_Generic_Actual.
+
+2017-12-15 Justin Squirek <squirek@adacore.com>
+
+ * sem_attr.adb (Resolve_Attribute): Modify check for aliased view on
+ prefix to use the prefix's original node to avoid looking at expanded
+ conversions for certain array types.
+
+2017-12-15 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_res.adb (Resolve_Membership_Op): Add warning on a membership
+ operation on a scalar type for which there is a user-defined equality
+ operator.
+
+2017-12-15 Yannick Moy <moy@adacore.com>
+
+ * doc/gnat_rm/implementation_defined_pragmas.rst: Add Ghost assertion
+ policy.
+
2017-12-15 Hristian Kirtchev <kirtchev@adacore.com>
* sem_prag.adb (Analyze_Initialization_Item): Remove the specialized
Assume |
Contract_Cases |
Debug |
+ Ghost |
Invariant |
Invariant'Class |
Loop_Invariant |
-- Used_As_Generic_Actual (Flag222)
-- Defined in all entities, set if the entity is used as an argument to
--- a generic instantiation. Used to tune certain warning messages.
+-- a generic instantiation. Used to tune certain warning messages, and
+-- in checking type conformance within an instantiation that involves
+-- incomplete formal and actual types.
-- Uses_Lock_Free (Flag188)
-- Defined in protected type entities. Set to True when the Lock Free
-- 1. N consists of a single OTHERS choice, possibly recursively
- -- 2. The array type is not packed
+ -- 2. The array type has no null ranges (the purpose of this is to
+ -- avoid a bogus warning for an out-of-range value).
-- 3. The array type has no atomic components
- -- 4. The array type has no null ranges (the purpose of this is to
- -- avoid a bogus warning for an out-of-range value).
+ -- 4. The component type is elementary
- -- 5. The component type is elementary
+ -- 5. The component size is a multiple of Storage_Unit
-- 6. The component size is Storage_Unit or the value is of the form
-- M * (1 + A**1 + A**2 + .. A**(K-1)) where A = 2**(Storage_Unit)
Expr : Node_Id := N;
Low : Node_Id;
High : Node_Id;
+ Csiz : Uint;
Remainder : Uint;
Value : Uint;
Nunits : Nat;
return False;
end if;
- if Present (Packed_Array_Impl_Type (Ctyp)) then
- return False;
- end if;
-
- if Has_Atomic_Components (Ctyp) then
- return False;
- end if;
-
Index := First_Index (Ctyp);
while Present (Index) loop
Get_Index_Bounds (Index, Low, High);
Expr := Expression (First (Component_Associations (Expr)));
end loop;
+ if Has_Atomic_Components (Ctyp) then
+ return False;
+ end if;
+
+ Csiz := Component_Size (Ctyp);
Ctyp := Component_Type (Ctyp);
if Is_Atomic_Or_VFA (Ctyp) then
return False;
end if;
- -- All elementary types are supported
+ -- Access types need to be dealt with specially
- if not Is_Elementary_Type (Ctyp) then
- return False;
- end if;
+ if Is_Access_Type (Ctyp) then
- -- However access types need to be dealt with specially
+ -- Component_Size is not set by Layout_Type if the component
+ -- type is an access type ???
- if Is_Access_Type (Ctyp) then
+ Csiz := Esize (Ctyp);
-- Fat pointers are rejected as they are not really elementary
-- for the backend.
- if Esize (Ctyp) /= System_Address_Size then
+ if Csiz /= System_Address_Size then
return False;
end if;
if Nkind (Expr) /= N_Null and then not Is_Entity_Name (Expr) then
return False;
end if;
+
+ -- Scalar types are OK if their size is a multiple of Storage_Unit
+
+ elsif Is_Scalar_Type (Ctyp) then
+
+ if Csiz mod System_Storage_Unit /= 0 then
+ return False;
+ end if;
+
+ -- Composite types are rejected
+
+ else
+ return False;
end if;
-- The expression needs to be analyzed if True is returned
Analyze_And_Resolve (Expr, Ctyp);
- -- The back end uses the Esize as the precision of the type
-
- Nunits := UI_To_Int (Esize (Ctyp)) / System_Storage_Unit;
+ Nunits := UI_To_Int (Csiz) / System_Storage_Unit;
if Nunits = 1 then
return True;
-- have a test in the generic that makes sense with some types
-- and not with other types.
- and then not In_Instance
+ -- Similarly, do not rewrite membership as a validity check if
+ -- within the predicate function for the type.
+
then
- Substitute_Valid_Check;
- goto Leave;
+ if In_Instance
+ or else (Ekind (Current_Scope) = E_Function
+ and then Is_Predicate_Function (Current_Scope))
+ then
+ null;
+
+ else
+ Substitute_Valid_Check;
+ goto Leave;
+ end if;
end if;
-- If we have an explicit range, do a bit of optimization based on
@copying
@quotation
-GNAT Reference Manual , Nov 09, 2017
+GNAT Reference Manual , Dec 15, 2017
AdaCore
Assume |
Contract_Cases |
Debug |
+ Ghost |
Invariant |
Invariant'Class |
Loop_Invariant |
-- case of a name which can be extended in the normal manner.
-- This case is handled by LP_State_Name or LP_State_Expr.
- -- (Ada2020) : the expression can be a reduction_expression_
- -- psarameter, i.e. a box or < Simple_Expression >
+ -- (Ada 2020): the expression can be a reduction_expression_
+ -- parameter, i.e. a box or < Simple_Expression >.
-- Note: if and case expressions (without an extra level of
-- parentheses) are permitted in this context).
end if;
-- Here we have an expression after all, which may be a reduction
- -- expression with a binary operator
+ -- expression with a binary operator.
if Token = Tok_Less then
Scan; -- past <
Node1 := P_Name;
return Node1;
- -- Ada2020: reduction expression parameter
+ -- Ada 2020: reduction expression parameter
when Tok_Less =>
Scan; -- past <
and then not (Nkind (P) = N_Selected_Component
and then
Is_Overloadable (Entity (Selector_Name (P))))
- and then not Is_Aliased_View (P)
+ and then not Is_Aliased_View (Original_Node (P))
and then not In_Instance
and then not In_Inlined_Body
and then Comes_From_Source (N)
then
return True;
+ elsif Is_Entity_Name (Expr)
+ and then Entity (Expr) = Standard_True
+ then
+ Error_Msg_N ("predicate is redundant (always True)?", Expr);
+ return True;
+
-- That's an exhaustive list of tests, all other cases are not
-- predicate-static, so we return False.
and then Parent (Loop_Par) /= N
then
-- The parser cannot distinguish between a loop specification
- -- and an iterator specification. If after pre-analysis the
+ -- and an iterator specification. If after preanalysis the
-- proper form has been recognized, rewrite the expression to
-- reflect the right kind. This is needed for proper ASIS
-- navigation. If expansion is enabled, the transformation is
and then Parent (Loop_Par) /= N
then
-- The parser cannot distinguish between a loop specification
- -- and an iterator specification. If after pre-analysis the
+ -- and an iterator specification. If after preanalysis the
-- proper form has been recognized, rewrite the expression to
-- reflect the right kind. This is needed for proper ASIS
-- navigation. If expansion is enabled, the transformation is
return True;
-- In Ada 2012, incomplete types (including limited views) can appear
- -- as actuals in instantiations.
+ -- as actuals in instantiations, where they are conformant to the
+ -- corresponding incomplete formal.
elsif Is_Incomplete_Type (Type_1)
and then Is_Incomplete_Type (Type_2)
+ and then In_Instance
and then (Used_As_Generic_Actual (Type_1)
or else Used_As_Generic_Actual (Type_2))
then
Set_Implicit_With (Clause);
Set_Library_Unit (Clause, Unit_Cunit);
+ -- The following is a kludge to satisfy a GPRbuild requirement. In
+ -- general, internal with clauses should be encoded on a 'Z' line in
+ -- ALI files, but due to an old bug, they are encoded as source with
+ -- clauses on a 'W' line. As a result, these "semi-implicit" clauses
+ -- introduce spurious build dependencies in GPRbuild. The only way to
+ -- eliminate this effect is to mark the implicit clauses as generated
+ -- for an instantiation.
+
+ Set_Implicit_With_From_Instantiation (Clause);
+
Append_To (Items, Clause);
end if;
procedure Analyze_Input_Item (Input : Node_Id) is
Input_Id : Entity_Id;
- Input_OK : Boolean := True;
begin
-- Null input list
E_In_Parameter,
E_In_Out_Parameter,
E_Out_Parameter,
+ E_Protected_Type,
+ E_Task_Type,
E_Variable)
then
-- The input cannot denote states or objects declared
null;
else
- Input_OK := False;
Error_Msg_Name_1 := Chars (Pack_Id);
SPARK_Msg_NE
("input item & cannot denote a visible object or "
& "state of package %", Input, Input_Id);
+ return;
end if;
end if;
-- (SPARK RM 7.1.5(5)).
if Contains (Inputs_Seen, Input_Id) then
- Input_OK := False;
SPARK_Msg_N ("duplicate input item", Input);
+ return;
end if;
- -- Input is legal, add it to the list of processed inputs
+ -- At this point it is known that the input is legal. Add
+ -- it to the list of processed inputs.
- if Input_OK then
- Append_New_Elmt (Input_Id, Inputs_Seen);
+ Append_New_Elmt (Input_Id, Inputs_Seen);
- if Ekind (Input_Id) = E_Abstract_State then
- Append_New_Elmt (Input_Id, States_Seen);
- end if;
+ if Ekind (Input_Id) = E_Abstract_State then
+ Append_New_Elmt (Input_Id, States_Seen);
+ end if;
- if Ekind_In (Input_Id, E_Abstract_State,
- E_Constant,
- E_Variable)
- and then Present (Encapsulating_State (Input_Id))
- then
- Append_New_Elmt (Input_Id, Constits_Seen);
- end if;
+ if Ekind_In (Input_Id, E_Abstract_State,
+ E_Constant,
+ E_Variable)
+ and then Present (Encapsulating_State (Input_Id))
+ then
+ Append_New_Elmt (Input_Id, Constits_Seen);
end if;
-- The input references something that is not a state or an
end loop;
end;
end if;
+
+ -- RM 4.5.2 (28.1/3) specifies that for types other than records or
+ -- limited types, evaluation of a membership test uses the predefined
+ -- equality for the type. This may be confusing to users, and the
+ -- following warning appears useful for the most common case.
+
+ if Is_Scalar_Type (Ltyp)
+ and then Present (Get_User_Defined_Eq (Ltyp))
+ then
+ Error_Msg_NE
+ ("membership test on& uses predefined equality?", N, Ltyp);
+ Error_Msg_N
+ ("\even if user-defined equality exists (RM 4.5.2 (28.1/3)?", N);
+ end if;
+
end Resolve_Set_Membership;
-- Start of processing for Resolve_Membership_Op
begin
Expr := N;
- Par := Parent (N);
+ Par := N;
-- A postcondition whose expression is a short-circuit is broken down
-- into individual aspects for better exception reporting. The original
-- short-circuit expression is rewritten as the second operand, and an
-- occurrence of 'Old in that operand is potentially unevaluated.
- -- See Sem_ch13.adb for details of this transformation.
+ -- See sem_ch13.adb for details of this transformation. The reference
+ -- to 'Old may appear within an expression, so we must look for the
+ -- enclosing pragma argument in the tree that contains the reference.
- if Nkind (Original_Node (Par)) = N_And_Then then
- return True;
- end if;
+ while Present (Par)
+ and then Nkind (Par) /= N_Pragma_Argument_Association
+ loop
+ if Nkind (Original_Node (Par)) = N_And_Then then
+ return True;
+ end if;
+
+ Par := Parent (Par);
+ end loop;
+
+ -- Other cases; 'Old appears within other expression (not the top-level
+ -- conjunct in a postcondition) with a potentially unevaluated operand.
+
+ Par := Parent (Expr);
while not Nkind_In (Par, N_If_Expression,
N_Case_Expression,
+2017-12-15 Justin Squirek <squirek@adacore.com>
+
+ * gnat.dg/aliasing4.adb: New testcase.
+
+2017-12-15 Ed Schonberg <schonberg@adacore.com>
+
+ * gnat.dg/incomplete6.adb, gnat.dg/incomplete6.ads: New testcase.
+
+2017-12-15 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * gnat.dg/initializes.ads, gnat.dg/initializes.adb: New testcase.
+
+2017-12-15 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gnat.dg/component_size.adb: New testcase.
+
2017-12-15 Richard Biener <rguenther@suse.de>
PR lto/83388
--- /dev/null
+-- { dg-do run }
+
+procedure Component_Size is
+
+ C_Unsigned_Long_Size : constant := 32;
+ type T_Unsigned_Long is range 0 .. (2 ** 31) - 1;
+ for T_Unsigned_Long'Size use C_Unsigned_Long_Size;
+
+ C_Unsigned_Byte_Size : constant := 8;
+ type T_Unsigned_Byte is range 0 .. (2 ** 8) - 1;
+ for T_Unsigned_Byte'Size use C_Unsigned_Byte_Size;
+
+ type T_Unsigned_Byte_Without_Size_Repr is range 0 .. (2 ** 8) - 1;
+
+ C_Nb_Data : constant T_Unsigned_Long := 9;
+ subtype T_Nb_Data is T_Unsigned_Long range 1 .. C_Nb_Data;
+
+ type T_Wrong_Id is array (T_Nb_Data) of T_Unsigned_Byte;
+ for T_Wrong_Id'Component_Size use C_Unsigned_Long_Size;
+
+ type T_Correct_Id is array (T_Nb_Data) of T_Unsigned_Byte_Without_Size_Repr;
+ for T_Correct_Id'Component_Size use C_Unsigned_Long_Size;
+
+ C_Value : constant := 1;
+
+ C_Wrong_Id : constant T_Wrong_Id := T_Wrong_Id'(others => C_Value);
+ C_Correct_Id : constant T_Correct_Id := T_Correct_Id'(others => C_Value);
+
+begin
+ if C_Correct_Id /= T_Correct_Id'(others => C_Value) then
+ raise Program_Error;
+ end if;
+
+ if C_Wrong_Id /= T_Wrong_Id'(others => C_Value) then
+ raise Program_Error;
+ end if;
+end;
--- /dev/null
+-- { dg-do compile }
+
+package body Incomplete6 is
+
+ function "=" (Left, Right : Vint) return Boolean is
+ begin
+ return Left.Value = Right.Value;
+ end;
+
+ function "=" (Left, Right : Vfloat) return Boolean is
+ begin
+ return Left.Value = Right.Value;
+ end;
+
+end;
--- /dev/null
+with Ada.Unchecked_Conversion;
+
+package Incomplete6 is
+
+ type Vint;
+ function "=" (Left, Right : Vint) return Boolean;
+
+ type Vint is record
+ Value : Integer;
+ end record;
+
+ function To_Integer is new
+ Ada.Unchecked_Conversion(Source => Vint, Target => Integer);
+
+ type Vfloat;
+ function "=" (Left, Right : in Vfloat) return Boolean;
+
+ type Vfloat is record
+ Value : Float;
+ end record;
+
+end;
--- /dev/null
+-- { dg-do compile }
+
+package body Initializes is
+ protected body PO is
+ procedure Proc is
+ package Inner with Initializes => (Y => PO) is -- OK
+ Y : Boolean := X;
+ end Inner;
+
+ procedure Nested with Global => PO is -- OK
+ begin
+ null;
+ end Nested;
+ begin
+ Nested;
+ end Proc;
+ end PO;
+
+ protected body PT is
+ procedure Proc is
+ package Inner with Initializes => (Y => PT) is -- OK
+ Y : Boolean := X;
+ end Inner;
+
+ procedure Nested with Global => PT is -- OK
+ begin
+ null;
+ end Nested;
+ begin
+ Nested;
+ end Proc;
+ end PT;
+end Initializes;
--- /dev/null
+package Initializes is
+ protected PO is
+ procedure Proc;
+ private
+ X : Boolean := True;
+ end PO;
+
+ protected type PT is
+ procedure Proc;
+ private
+ X : Boolean := True;
+ end PT;
+end Initializes;
projects / gcc.git / commitdiff