+2018-12-03 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * checks.adb, exp_aggr.adb, exp_attr.adb, exp_ch3.adb,
+ exp_util.adb, exp_util.ads, repinfo.adb, sem_attr.adb,
+ sem_ch3.adb, sem_res.adb, sem_util.adb: Minor reformatting.
+
2018-12-03 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Complete_Private_Subtype): Enhance comment.
Typ := Actual_Subtype (Entity (N));
end if;
- null;
else
Typ := Underlying_Type (Base_Type (Typ));
end if;
declare
P : constant Entity_Id :=
- Cunit_Entity (Current_Sem_Unit);
+ Cunit_Entity (Current_Sem_Unit);
begin
-- Check if duplication is always OK and, if so,
-- also needs to be static, because we do some legality checks (e.g.
-- for Thread_Local_Storage) after this transformation.
- when Attribute_Ref | Attribute_To_Address => To_Address : declare
- Is_Static : constant Boolean := Is_Static_Expression (N);
- begin
- Rewrite (N,
- Unchecked_Convert_To (RTE (RE_Address),
- Relocate_Node (First (Exprs))));
- Set_Is_Static_Expression (N, Is_Static);
- Analyze_And_Resolve (N, RTE (RE_Address));
- end To_Address;
+ when Attribute_Ref
+ | Attribute_To_Address
+ =>
+ To_Address : declare
+ Is_Static : constant Boolean := Is_Static_Expression (N);
+
+ begin
+ Rewrite (N,
+ Unchecked_Convert_To (RTE (RE_Address),
+ Relocate_Node (First (Exprs))));
+ Set_Is_Static_Expression (N, Is_Static);
+
+ Analyze_And_Resolve (N, RTE (RE_Address));
+ end To_Address;
------------
-- To_Any --
if Is_Delayed_Aggregate (Expr_Q) then
- -- An aggregate that must be built in place is not resolved
- -- and expanded until the enclosing construct is expanded.
- -- This will happen when the aggregqte is limited and the
- -- declared object has a following address clause.
+ -- An aggregate that must be built in place is not resolved and
+ -- expanded until the enclosing construct is expanded. This will
+ -- happen when the aggregqte is limited and the declared object
+ -- has a following address clause.
if Is_Limited_Type (Typ) and then not Analyzed (Expr) then
Resolve (Expr, Typ);
-- See also Silly_Boolean_Array_Not_Test
procedure Silly_Boolean_Array_Xor_Test
- (N : Node_Id; R : Node_Id; T : Entity_Id) is
+ (N : Node_Id;
+ R : Node_Id;
+ T : Entity_Id)
+ is
Loc : constant Source_Ptr := Sloc (N);
CT : constant Entity_Id := Component_Type (T);
Make_Raise_Constraint_Error (Loc,
Condition =>
Make_And_Then (Loc,
- Left_Opnd =>
+ Left_Opnd =>
Make_And_Then (Loc,
- Left_Opnd =>
+ Left_Opnd =>
Convert_To (Standard_Boolean,
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (CT, Loc),
Attribute_Name => Name_Last))),
Right_Opnd => Make_Non_Empty_Check (Loc, R)),
- Reason => CE_Range_Check_Failed));
+ Reason => CE_Range_Check_Failed));
end Silly_Boolean_Array_Xor_Test;
--------------------------
-- that a Constraint_Error exception be raised (RM 4.5.6(6)).
procedure Silly_Boolean_Array_Xor_Test
- (N : Node_Id; R : Node_Id; T : Entity_Id);
+ (N : Node_Id;
+ R : Node_Id;
+ T : Entity_Id);
-- N is the node for a boolean array XOR operation, T is the type of the
-- array, and R is a copy of the right operand of N, required to prevent
-- scope anomalies when unnesting is in effect. This routine deals with
-- the current entity. Set True when a new entity is processed, and false
-- when the blank line is output.
- -------------------------------
- -- Set of Relevant Entities --
- -------------------------------
+ ------------------------------
+ -- Set of Relevant Entities --
+ ------------------------------
Relevant_Entities_Size : constant := 4093;
-- Number of headers in hash table
Analyze_And_Resolve (N, Standard_Boolean);
Static := True;
- Set_Is_Static_Expression (N, True);
+ Set_Is_Static_Expression (N);
end Atomic_Always_Lock_Free;
---------
Analyze_And_Resolve (N, Standard_Boolean);
Static := True;
- Set_Is_Static_Expression (N, True);
+ Set_Is_Static_Expression (N);
end Lock_Free;
----------
and then Nkind (E) = N_Aggregate
and then
((Present (Following_Address_Clause (N))
- and then not Ignore_Rep_Clauses)
+ and then not Ignore_Rep_Clauses)
or else Delayed_Aspect_Present)
then
Set_Etype (E, T);
- -- If the aggregate is limited it will be built in place,
- -- and its expansion is deferred until the object declaration
- -- is expanded.
+ -- If the aggregate is limited it will be built in place, and its
+ -- expansion is deferred until the object declaration is expanded.
if Is_Limited_Type (T) then
Set_Expansion_Delayed (E);
end if;
else
-
-- If the expression is a formal that is a "subprogram pointer"
-- this is illegal in accessibility terms (see RM 3.10.2 (13.1/2)
-- and AARM 3.10.2 (13.b/2)). Add an explicit conversion to force
Set_Current_Value (Id, E);
end if;
- elsif Is_Scalar_Type (T)
- and then Is_OK_Static_Expression (E)
- then
+ elsif Is_Scalar_Type (T) and then Is_OK_Static_Expression (E) then
Set_Is_Known_Valid (Id);
-- If it is a constant initialized with a valid nonstatic entity,
---------------------------
procedure Resolve_If_Expression (N : Node_Id; Typ : Entity_Id) is
- Condition : constant Node_Id := First (Expressions (N));
- Then_Expr : Node_Id;
- Else_Expr : Node_Id;
-
procedure Apply_Check (Expr : Node_Id);
- -- When a dependent expression is of a subtype different from the
- -- context subtype, then insert a qualification to ensure the
- -- generation of a constraint check. This was previously done only
- -- for scalar types.
+ -- When a dependent expression is of a subtype different from
+ -- the context subtype, then insert a qualification to ensure
+ -- the generation of a constraint check. This was previously
+ -- done only for scalar types.
-----------------
-- Apply_Check --
-----------------
procedure Apply_Check (Expr : Node_Id) is
- Loc : constant Source_Ptr := Sloc (Expr);
- Expr_Type : constant Entity_Id := Etype (Expr);
- begin
+ Expr_Typ : constant Entity_Id := Etype (Expr);
+ Loc : constant Source_Ptr := Sloc (Expr);
- if Expr_Type /= Typ
- and then not Is_Tagged_Type (Typ)
- and then not Is_Access_Type (Typ)
- and then Is_Constrained (Typ)
- and then not Inside_A_Generic
+ begin
+ if Expr_Typ /= Typ
+ and then not Is_Tagged_Type (Typ)
+ and then not Is_Access_Type (Typ)
+ and then Is_Constrained (Typ)
+ and then not Inside_A_Generic
then
Rewrite (Expr,
- Make_Qualified_Expression (Loc,
- Subtype_Mark => New_Occurrence_Of (Typ, Loc),
- Expression => Relocate_Node (Expr)));
+ Make_Qualified_Expression (Loc,
+ Subtype_Mark => New_Occurrence_Of (Typ, Loc),
+ Expression => Relocate_Node (Expr)));
+
Analyze_And_Resolve (Expr, Typ);
end if;
end Apply_Check;
+ -- Local variables
+
+ Condition : constant Node_Id := First (Expressions (N));
+ Else_Expr : Node_Id;
+ Then_Expr : Node_Id;
+
+ -- Start of processing for Resolve_If_Expression
+
begin
-- Defend against malformed expressions
-- Check for prefix being an aliased component???
null;
-
end if;
-- A heap object is constrained by its initial value
projects / platform / upstream / gcc.git / commitdiff