+2017-09-08 Bob Duff <duff@adacore.com>
+
+ * par-prag.adb, sem_prag.adb, snames.ads-tmpl: Implement pragma
+ Ada_2020, along the same lines as the other Ada version pragmas.
+
+2017-09-08 Gary Dismukes <dismukes@adacore.com>
+
+ * sem_ch12.adb: Minor typo fixes and reformatting.
+
+2017-09-08 Yannick Moy <moy@adacore.com>
+
+ * sem_aggr.adb (Resolve_Record_Aggregate):
+ Rewrite bounds of aggregate subexpressions which may depend on
+ discriminants of the enclosing aggregate.
+
+2017-09-08 Yannick Moy <moy@adacore.com>
+
+ * sem_ch5.adb: Prevent assertion failure on illegal code.
+
+2017-09-08 Yannick Moy <moy@adacore.com>
+
+ * lib-xref-spark_specific.adb (Add_SPARK_Xrefs.Is_SPARK_Scope): Avoid
+ calling Renamed_Entity on an entity which cannot be a renaming.
+
+2017-09-08 Eric Botcazou <ebotcazou@adacore.com>
+
+ * exp_aggr.adb: Add with & use clause for Urealp.
+ (Aggr_Assignment_OK_For_Backend): Accept (almost all)
+ elementary types instead of just discrete types.
+ * sem_eval.adb (Expr_Value): Deal with N_Null for access types.
+ * gcc-interface/trans.c (gnat_to_gnu) <N_Assignment_Statement>:
+ Be prepared for the FP zero value in the memset case. Add small
+ guard.
+
+2017-09-08 Eric Botcazou <ebotcazou@adacore.com>
+
+ * s-htable.adb (Static_HTable.Reset): Use aggregate instead
+ of loop.
+
2017-09-08 Hristian Kirtchev <kirtchev@adacore.com>
* exp_aggr.adb (Expand_Array_Aggregate): Use New_Copy_Tree instead
with Stringt; use Stringt;
with Tbuild; use Tbuild;
with Uintp; use Uintp;
+with Urealp; use Urealp;
package body Exp_Aggr is
-- 4. The array type has no null ranges (the purpose of this is to
-- avoid a bogus warning for an out-of-range value).
- -- 5. The component type is discrete
+ -- 5. The component type is elementary
-- 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)
return False;
end if;
- if not Is_Discrete_Type (Ctyp) then
+ -- All elementary types are supported except for fat pointers
+ -- because they are not really elementary for the backend.
+
+ if not Is_Elementary_Type (Ctyp)
+ or else (Is_Access_Type (Ctyp)
+ and then Esize (Ctyp) /= System_Address_Size)
+ then
return False;
end if;
return False;
end if;
+ -- The only supported value for floating point is 0.0
+
+ if Is_Floating_Point_Type (Ctyp) then
+ return Expr_Value_R (Expr) = Ureal_0;
+ end if;
+
+ -- For other types, we can look into the value as an integer
+
Value := Expr_Value (Expr);
if Has_Biased_Representation (Ctyp) then
/* Or else, use memset when the conditions are met. */
else if (use_memset_p)
{
- tree value = fold_convert (integer_type_node, gnu_rhs);
+ tree value
+ = real_zerop (gnu_rhs)
+ ? integer_zero_node
+ : fold_convert (integer_type_node, gnu_rhs);
tree to = gnu_lhs;
tree type = TREE_TYPE (to);
tree size
= SUBSTITUTE_PLACEHOLDER_IN_EXPR (TYPE_SIZE_UNIT (type), to);
tree to_ptr = build_fold_addr_expr (to);
tree t = builtin_decl_explicit (BUILT_IN_MEMSET);
- if (TREE_CODE (value) == INTEGER_CST)
+ if (TREE_CODE (value) == INTEGER_CST && !integer_zerop (value))
{
tree mask
= build_int_cst (integer_type_node,
--------------------
function Is_SPARK_Scope (E : Entity_Id) return Boolean is
+ Can_Be_Renamed : constant Boolean :=
+ Present (E)
+ and then (Is_Subprogram_Or_Entry (E)
+ or else Ekind (E) = E_Package);
begin
return Present (E)
and then not Is_Generic_Unit (E)
- and then Renamed_Entity (E) = Empty
+ and then (not Can_Be_Renamed or else Renamed_Entity (E) = Empty)
and then Get_Scope_Num (E) /= No_Scope;
end Is_SPARK_Scope;
case Prag_Id is
+ -- Ada version pragmas must be processed at parse time, because we want
+ -- to set the Ada version properly at parse time to recognize the
+ -- appropriate Ada version syntax. However, pragma Ada_2005 and higher
+ -- have an optional argument; it is only the zero argument form that
+ -- must be processed at parse time.
+
------------
-- Ada_83 --
------------
- -- This pragma must be processed at parse time, since we want to set
- -- the Ada version properly at parse time to recognize the appropriate
- -- Ada version syntax.
-
when Pragma_Ada_83 =>
if not Latest_Ada_Only then
Ada_Version := Ada_83;
-- Ada_95 --
------------
- -- This pragma must be processed at parse time, since we want to set
- -- the Ada version properly at parse time to recognize the appropriate
- -- Ada version syntax.
-
when Pragma_Ada_95 =>
if not Latest_Ada_Only then
Ada_Version := Ada_95;
-- Ada_05/Ada_2005 --
---------------------
- -- These pragmas must be processed at parse time, since we want to set
- -- the Ada version properly at parse time to recognize the appropriate
- -- Ada version syntax. However, it is only the zero argument form that
- -- must be processed at parse time.
-
when Pragma_Ada_05
| Pragma_Ada_2005
=>
-- Ada_12/Ada_2012 --
---------------------
- -- These pragmas must be processed at parse time, since we want to set
- -- the Ada version properly at parse time to recognize the appropriate
- -- Ada version syntax. However, it is only the zero argument form that
- -- must be processed at parse time.
-
when Pragma_Ada_12
| Pragma_Ada_2012
=>
Ada_Version_Pragma := Pragma_Node;
end if;
+ --------------
+ -- Ada_2020 --
+ --------------
+
+ when Pragma_Ada_2020 =>
+ if Arg_Count = 0 then
+ Ada_Version := Ada_2020;
+ Ada_Version_Explicit := Ada_2020;
+ Ada_Version_Pragma := Pragma_Node;
+ end if;
+
---------------------------
-- Compiler_Unit_Warning --
---------------------------
-- --
-- B o d y --
-- --
--- Copyright (C) 1995-2016, AdaCore --
+-- Copyright (C) 1995-2017, AdaCore --
-- --
-- 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- --
procedure Reset is
begin
- for J in Table'Range loop
- Table (J) := Null_Ptr;
- end loop;
+ -- Use an aggregate for efficient reasons
+
+ Table := (others => Null_Ptr);
end Reset;
---------
-- Parent pointer of Expr is not set then Expr was produced with a
-- New_Copy_Tree or some such.
+ procedure Rewrite_Range (Root_Type : Entity_Id; Rge : Node_Id);
+ -- Rewrite a range node Rge when its bounds refer to non-stored
+ -- discriminants from Root_Type, to replace them with the stored
+ -- discriminant values. This is required in GNATprove mode, and is
+ -- adopted in all modes to avoid special-casing GNATprove mode.
+
---------------------
-- Add_Association --
---------------------
Add_Association (New_C, New_Expr, New_Assoc_List);
end Resolve_Aggr_Expr;
+ -------------------
+ -- Rewrite_Range --
+ -------------------
+
+ procedure Rewrite_Range (Root_Type : Entity_Id; Rge : Node_Id) is
+
+ procedure Rewrite_Bound
+ (Bound : Node_Id;
+ Disc : Entity_Id;
+ Expr_Disc : Node_Id);
+ -- Rewrite a bound of the range Bound, when it is equal to the
+ -- non-stored discriminant Disc, into the stored discriminant
+ -- value Expr_Disc.
+
+ -------------------
+ -- Rewrite_Bound --
+ -------------------
+
+ procedure Rewrite_Bound
+ (Bound : Node_Id;
+ Disc : Entity_Id;
+ Expr_Disc : Node_Id)
+ is
+ begin
+ if Nkind (Bound) = N_Identifier
+ and then Entity (Bound) = Disc
+ then
+ Rewrite (Bound, New_Copy_Tree (Expr_Disc));
+ end if;
+ end Rewrite_Bound;
+
+ ---------------------
+ -- Local Variables --
+ ---------------------
+
+ Low, High : Node_Id;
+ Disc : Entity_Id;
+ Expr_Disc : Elmt_Id;
+
+ -- Start of processing for Rewrite_Range
+
+ begin
+ if Has_Discriminants (Root_Type)
+ and then Nkind (Rge) = N_Range
+ then
+ Low := Low_Bound (Rge);
+ High := High_Bound (Rge);
+
+ Disc := First_Discriminant (Root_Type);
+ Expr_Disc :=
+ First_Elmt (Stored_Constraint (Etype (N)));
+ while Present (Disc) loop
+ Rewrite_Bound (Low, Disc, Node (Expr_Disc));
+ Rewrite_Bound (High, Disc, Node (Expr_Disc));
+ Next_Discriminant (Disc);
+ Next_Elmt (Expr_Disc);
+ end loop;
+ end if;
+ end Rewrite_Range;
+
-- Local variables
Components : constant Elist_Id := New_Elmt_List;
New_Scope => Current_Scope,
New_Sloc => Sloc (N));
+ -- As the type of the copied default expression may refer
+ -- to discriminants of the record type declaration, these
+ -- non-stored discriminants need to be rewritten into stored
+ -- discriminant values for the aggregate. This is required
+ -- in GNATprove mode, and is adopted in all modes to avoid
+ -- special-casing GNATprove mode.
+
+ if Is_Array_Type (Etype (Expr)) then
+ declare
+ -- Root record type whose discriminants may be used
+ -- as bounds in range nodes.
+ Root_Type : constant Entity_Id := Scope (Component);
+ Index : Node_Id;
+
+ begin
+ -- Rewrite the range nodes occurring in the indexes
+ -- and their types.
+
+ Index := First_Index (Etype (Expr));
+ while Present (Index) loop
+ Rewrite_Range (Root_Type, Index);
+ Rewrite_Range
+ (Root_Type, Scalar_Range (Etype (Index)));
+ Next_Index (Index);
+ end loop;
+
+ -- Rewrite the range nodes occurring as aggregate
+ -- bounds.
+
+ if Nkind (Expr) = N_Aggregate
+ and then Present (Aggregate_Bounds (Expr))
+ then
+ Rewrite_Range (Root_Type, Aggregate_Bounds (Expr));
+ end if;
+ end;
+ end if;
+
Add_Association
(Component => Component,
Expr => Expr,
Formal_P := Next_Entity (E);
-- If the instance is within an enclosing instance body
- -- there is no need to vertify the legqlity of current
- -- formsl psckages because they were legal in the generic
- -- body. This optimixation may be applicable elsewhere,
- -- and it also removes spurious errors that may arise with
+ -- there is no need to verify the legality of current formal
+ -- packages because they were legal in the generic body.
+ -- This optimization may be applicable elsewhere, and it
+ -- also removes spurious errors that may arise with
-- on-the-fly inlining and confusion between private and
-- full views.
& "iteration", Discrete_Subtype_Definition (N),
T, Suggest_Static => True);
- elsif Inside_A_Generic and then Is_Generic_Formal (T) then
+ elsif Inside_A_Generic
+ and then Is_Generic_Formal (T)
+ and then Is_Discrete_Type (T)
+ then
Set_No_Dynamic_Predicate_On_Actual (T);
end if;
end Check_Predicate_Use;
pragma Assert (Is_Fixed_Point_Type (Underlying_Type (Etype (N))));
Val := Corresponding_Integer_Value (N);
+ -- The NULL access value
+
+ elsif Kind = N_Null then
+ pragma Assert (Is_Access_Type (Underlying_Type (Etype (N))));
+ Val := Uint_0;
+
-- Otherwise must be character literal
else
-- The one argument form is used for managing the transition from Ada
-- 2005 to Ada 2012 in the run-time library. If an entity is marked
- -- as Ada_201 only, then referencing the entity in any pre-Ada_2012
+ -- as Ada_2012 only, then referencing the entity in any pre-Ada_2012
-- mode will generate a warning. In addition, in any pre-Ada_2012
-- mode, a preference rule is established which does not choose
-- such an entity unless it is unambiguously specified. This avoids
end if;
end;
+ --------------
+ -- Ada_2020 --
+ --------------
+
+ -- pragma Ada_2020;
+
+ -- Note: this pragma also has some specific processing in Par.Prag
+ -- because we want to set the Ada 2020 version mode during parsing.
+
+ when Pragma_Ada_2020 =>
+ GNAT_Pragma;
+
+ Check_Arg_Count (0);
+
+ Check_Valid_Configuration_Pragma;
+
+ -- Now set appropriate Ada mode
+
+ Ada_Version := Ada_2020;
+ Ada_Version_Explicit := Ada_2020;
+ Ada_Version_Pragma := N;
+
----------------------
-- All_Calls_Remote --
----------------------
Pragma_Ada_2005 => -1,
Pragma_Ada_12 => -1,
Pragma_Ada_2012 => -1,
+ Pragma_Ada_2020 => -1,
Pragma_All_Calls_Remote => -1,
Pragma_Allow_Integer_Address => -1,
Pragma_Annotate => 93,
Name_Ada_2005 : constant Name_Id := N + $; -- GNAT
Name_Ada_12 : constant Name_Id := N + $; -- GNAT
Name_Ada_2012 : constant Name_Id := N + $; -- GNAT
+ Name_Ada_2020 : constant Name_Id := N + $; -- GNAT
Name_Allow_Integer_Address : constant Name_Id := N + $; -- GNAT
Name_Annotate : constant Name_Id := N + $; -- GNAT
Name_Assertion_Policy : constant Name_Id := N + $; -- Ada 05
Pragma_Ada_2005,
Pragma_Ada_12,
Pragma_Ada_2012,
+ Pragma_Ada_2020,
+ -- Note that there is no Pragma_Ada_20. Pragma_Ada_05/12 are for
+ -- compatibility reasons only; the full year names are preferred.
Pragma_Allow_Integer_Address,
Pragma_Annotate,
Pragma_Assertion_Policy,
git://gcc.gnu.org / gcc.git / commitdiff