+2017-01-13 Javier Miranda <miranda@adacore.com>
+
+ * sem_ch6.adb (Cloned_Expression): New subprogram.
+ (Freeze_Expr_Types): Complete previous patch since the expression
+ of an expression-function may have iterators and loops with
+ defining identifiers which, as part of the preanalysis of the
+ expression, may be left decorated with itypes that will not be
+ available in the tree passed to the backend.
+
+2017-01-13 Ed Schonberg <schonberg@adacore.com>
+
+ * checks.adb (Apply_Type_Conversion_Checks): Optimize a type
+ conversion to Integer of an expression that is an attribute
+ reference 'Pos on an enumeration type.
+
+2017-01-13 Bob Duff <duff@adacore.com>
+
+ * atree.ads: Minor comment fix.
+
2017-01-13 Justin Squirek <squirek@adacore.com>
* sem_ch6.adb (Check_Aggregate_Accessibility): Ignore function
------------------
-- The following variables denote the count of errors of various kinds
- -- detected in the tree. Note that these might be more logically located
- -- in Err_Vars, but we put it to deal with licensing issues (we need this
- -- to have the GPL exception licensing, since Check_Error_Detected can
- -- be called from units with this licensing).
+ -- detected in the tree. Note that these might be more logically located in
+ -- Err_Vars, but we put it here to deal with licensing issues (we need this
+ -- to have the GPL exception licensing, since Check_Error_Detected can be
+ -- called from units with this licensing).
Serious_Errors_Detected : Nat := 0;
-- This is a count of errors that are serious enough to stop expansion,
In_Subrange_Of (Expr_Type, Target_Base, Fixed_Int => Conv_OK)
and then not Float_To_Int
then
- Activate_Overflow_Check (N);
+ -- A small optimization : the attribute 'Pos applied to an
+ -- enumeration type has a known range, even though its type
+ -- is Universal_Integer. so in numeric conversions it is
+ -- usually within range of of the target integer type. Use the
+ -- static bounds of the base types to check.
+
+ if Nkind (Expr) = N_Attribute_Reference
+ and then Attribute_Name (Expr) = Name_Pos
+ and then Is_Enumeration_Type (Etype (Prefix (Expr)))
+ and then Is_Integer_Type (Target_Type)
+ then
+ declare
+ Enum_T : constant Entity_Id :=
+ Root_Type (Etype (Prefix (Expr)));
+ Int_T : constant Entity_Id := Base_Type (Target_Type);
+ Last_I : constant Uint :=
+ Intval (High_Bound (Scalar_Range (Int_T)));
+ Last_E : Uint;
+
+ begin
+ -- Character types have no explicit literals, we use
+ -- the known number of characters in the type.
+
+ if Root_Type (Enum_T) = Standard_Character then
+ Last_E := UI_From_Int (255);
+
+ elsif Enum_T = Standard_Wide_Character
+ or else Enum_T = Standard_Wide_Wide_Character
+ then
+ Last_E := UI_From_Int (65535);
+
+ else
+ Last_E := Enumeration_Pos
+ (Entity (High_Bound (Scalar_Range (Enum_T))));
+ end if;
+
+ if Last_E <= Last_I then
+ null;
+
+ else
+ Activate_Overflow_Check (N);
+ end if;
+ end;
+
+ else
+ Activate_Overflow_Check (N);
+ end if;
end if;
if not Range_Checks_Suppressed (Target_Type)
-----------------------
procedure Freeze_Expr_Types (Spec_Id : Entity_Id) is
+ function Cloned_Expression return Node_Id;
+ -- Build a duplicate of the expression of the return statement that
+ -- has no defining entities shared with the original expression.
+
function Freeze_Type_Refs (Node : Node_Id) return Traverse_Result;
-- Freeze all types referenced in the subtree rooted at Node
+ -----------------------
+ -- Cloned_Expression --
+ -----------------------
+
+ function Cloned_Expression return Node_Id is
+ function Clone_Id (Node : Node_Id) return Traverse_Result;
+ -- Tree traversal routine that clones the defining identifier of
+ -- iterator and loop parameter specification nodes.
+
+ ----------------
+ -- Check_Node --
+ ----------------
+
+ function Clone_Id (Node : Node_Id) return Traverse_Result is
+ begin
+ if Nkind_In (Node, N_Iterator_Specification,
+ N_Loop_Parameter_Specification)
+ then
+ Set_Defining_Identifier (Node,
+ New_Copy (Defining_Identifier (Node)));
+ end if;
+
+ return OK;
+ end Clone_Id;
+
+ -------------------
+ -- Clone_Def_Ids --
+ -------------------
+
+ procedure Clone_Def_Ids is new Traverse_Proc (Clone_Id);
+
+ -- Local variables
+
+ Return_Stmt : constant Node_Id :=
+ First
+ (Statements (Handled_Statement_Sequence (N)));
+ Dup_Expr : Node_Id;
+
+ -- Start of processing for Cloned_Expression
+
+ begin
+ pragma Assert (Nkind (Return_Stmt) = N_Simple_Return_Statement);
+
+ -- We must duplicate the expression with semantic information to
+ -- inherit the decoration of global entities in generic instances.
+
+ Dup_Expr := New_Copy_Tree (Expression (Return_Stmt));
+
+ -- Replace the defining identifier of iterators and loop param
+ -- specifications by a clone to ensure that the cloned expression
+ -- and the original expression don't have shared identifiers;
+ -- otherwise, as part of the preanalysis of the expression, these
+ -- shared identifiers may be left decorated with itypes which
+ -- will not be available in the tree passed to the backend.
+
+ Clone_Def_Ids (Dup_Expr);
+
+ return Dup_Expr;
+ end Cloned_Expression;
+
----------------------
-- Freeze_Type_Refs --
----------------------
-- Local variables
- Return_Stmt : constant Node_Id :=
- First (Statements (Handled_Statement_Sequence (N)));
- Dup_Expr : constant Node_Id :=
- New_Copy_Tree (Expression (Return_Stmt));
-
Saved_First_Entity : constant Entity_Id := First_Entity (Spec_Id);
Saved_Last_Entity : constant Entity_Id := Last_Entity (Spec_Id);
+ Dup_Expr : constant Node_Id := Cloned_Expression;
-- Start of processing for Freeze_Expr_Types
begin
- pragma Assert (Nkind (Return_Stmt) = N_Simple_Return_Statement);
-
-- Preanalyze a duplicate of the expression to have available the
-- minimum decoration needed to locate referenced unfrozen types
-- without adding any decoration to the function expression. This
Set_First_Entity (Spec_Id, Saved_First_Entity);
Set_Last_Entity (Spec_Id, Saved_Last_Entity);
+ if Present (Last_Entity (Spec_Id)) then
+ Set_Next_Entity (Last_Entity (Spec_Id), Empty);
+ end if;
+
-- Freeze all types referenced in the expression
Freeze_References (Dup_Expr);
projects / gcc.git / commitdiff