Commit aa11d1dd by Pierre-Marie de Rodat

[multiple changes]

2017-09-25  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb (Save_References_In_Aggregate): Small correction to
	previous change.

2017-09-25  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch5.adb, sem_ch4.adb, sem_ch13.adb, sem_attr.adb, exp_ch3.adb:
	Minor reformatting.

From-SVN: r253135
parent 625f7ba6
2017-09-25 Ed Schonberg <schonberg@adacore.com>
* sem_ch12.adb (Save_References_In_Aggregate): Small correction to
previous change.
2017-09-25 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch5.adb, sem_ch4.adb, sem_ch13.adb, sem_attr.adb, exp_ch3.adb:
Minor reformatting.
2017-09-20 Alexandre Oliva <aoliva@redhat.com>
* gcc-interface/lang.opt (gant, gnatO, gnat): Add RejectNegative.
......
......@@ -516,11 +516,13 @@ package body Exp_Ch3 is
---------------------------
procedure Build_Array_Init_Proc (A_Type : Entity_Id; Nod : Node_Id) is
Comp_Type : constant Entity_Id := Component_Type (A_Type);
Comp_Type_Simple : constant Boolean :=
Comp_Type : constant Entity_Id := Component_Type (A_Type);
Comp_Type_Simple : constant Boolean :=
Needs_Simple_Initialization
(Comp_Type, Consider_IS =>
(T => Comp_Type,
Consider_IS =>
not (Validity_Check_Copies and Is_Bit_Packed_Array (A_Type)));
Body_Stmts : List_Id;
Has_Default_Init : Boolean;
Index_List : List_Id;
......@@ -1800,6 +1802,7 @@ package body Exp_Ch3 is
function Replace_Discr_Ref (N : Node_Id) return Traverse_Result is
Val : Node_Id;
begin
if Is_Entity_Name (N)
and then Present (Entity (N))
......@@ -1807,10 +1810,11 @@ package body Exp_Ch3 is
and then Present (Discriminal_Link (Entity (N)))
then
Val :=
Make_Selected_Component (N_Loc,
Prefix => New_Copy_Tree (Lhs),
Selector_Name => New_Occurrence_Of
(Discriminal_Link (Entity (N)), N_Loc));
Make_Selected_Component (N_Loc,
Prefix => New_Copy_Tree (Lhs),
Selector_Name =>
New_Occurrence_Of (Discriminal_Link (Entity (N)), N_Loc));
if Present (Val) then
Rewrite (N, New_Copy_Tree (Val));
end if;
......@@ -1822,6 +1826,8 @@ package body Exp_Ch3 is
procedure Replace_Discriminant_References is
new Traverse_Proc (Replace_Discr_Ref);
-- Start of processing for Build_Assignment
begin
Lhs :=
Make_Selected_Component (N_Loc,
......
......@@ -75,10 +75,11 @@ package body Exp_Ch5 is
-- of formal container iterators.
function Convert_To_Iterable_Type
(Container : Entity_Id; Loc : Source_Ptr) return Node_Id;
-- Returns New_Occurrence_Of (Container), possibly converted to an
-- ancestor type, if the type of Container inherited the Iterable
-- aspect_specification from that ancestor.
(Container : Entity_Id;
Loc : Source_Ptr) return Node_Id;
-- Returns New_Occurrence_Of (Container), possibly converted to an ancestor
-- type, if the type of Container inherited the Iterable aspect from that
-- ancestor.
function Change_Of_Representation (N : Node_Id) return Boolean;
-- Determine if the right-hand side of assignment N is a type conversion
......@@ -243,16 +244,21 @@ package body Exp_Ch5 is
------------------------------
function Convert_To_Iterable_Type
(Container : Entity_Id; Loc : Source_Ptr) return Node_Id
(Container : Entity_Id;
Loc : Source_Ptr) return Node_Id
is
Typ : constant Entity_Id := Base_Type (Etype (Container));
Aspect : constant Node_Id := Find_Aspect (Typ, Aspect_Iterable);
Result : Node_Id := New_Occurrence_Of (Container, Loc);
Typ : constant Entity_Id := Base_Type (Etype (Container));
Aspect : constant Node_Id := Find_Aspect (Typ, Aspect_Iterable);
Result : Node_Id;
begin
Result := New_Occurrence_Of (Container, Loc);
if Entity (Aspect) /= Typ then
Result := Make_Type_Conversion (Loc,
Subtype_Mark => New_Occurrence_Of (Entity (Aspect), Loc),
Expression => Result);
Result :=
Make_Type_Conversion (Loc,
Subtype_Mark => New_Occurrence_Of (Entity (Aspect), Loc),
Expression => Result);
end if;
return Result;
......
......@@ -11089,7 +11089,7 @@ package body Sem_Attr is
and then Is_Overloadable (Entity (P)))
and then not (Nkind (P) = N_Selected_Component
and then
Is_Overloadable (Entity (Selector_Name (P))))
Is_Overloadable (Entity (Selector_Name (P))))
and then not Is_Aliased_View (P)
and then not In_Instance
and then not In_Inlined_Body
......
......@@ -15132,7 +15132,9 @@ package body Sem_Ch12 is
Nam := Make_Identifier (Loc, Chars (Typ));
if Is_Immediately_Visible (Scope (Typ))
and then Current_Entity (Scope (Typ)) = Scope (Typ)
and then
(not In_Open_Scopes (Scope (Typ))
or else Current_Entity (Scope (Typ)) = Scope (Typ))
then
Nam :=
Make_Selected_Component (Loc,
......
......@@ -5094,8 +5094,8 @@ package body Sem_Ch13 is
or else Is_Array_Type (Etype (U_Ent)))
and then (Is_Record_Type (Etype (O_Ent))
or else Is_Array_Type (Etype (O_Ent)))
and then Reverse_Storage_Order (Etype (U_Ent))
/= Reverse_Storage_Order (Etype (O_Ent))
and then Reverse_Storage_Order (Etype (U_Ent)) /=
Reverse_Storage_Order (Etype (O_Ent))
then
Set_Treat_As_Volatile (U_Ent);
end if;
......
......@@ -3931,16 +3931,14 @@ package body Sem_Ch4 is
Find_Type (Mark);
T := Entity (Mark);
if Nkind_In
(Enclosing_Declaration (N),
N_Formal_Type_Declaration,
N_Full_Type_Declaration,
N_Incomplete_Type_Declaration,
N_Protected_Type_Declaration,
N_Private_Extension_Declaration,
N_Private_Type_Declaration,
N_Subtype_Declaration,
N_Task_Type_Declaration)
if Nkind_In (Enclosing_Declaration (N), N_Formal_Type_Declaration,
N_Full_Type_Declaration,
N_Incomplete_Type_Declaration,
N_Protected_Type_Declaration,
N_Private_Extension_Declaration,
N_Private_Type_Declaration,
N_Subtype_Declaration,
N_Task_Type_Declaration)
and then T = Defining_Identifier (Enclosing_Declaration (N))
then
Error_Msg_N ("current instance not allowed", Mark);
......@@ -8562,11 +8560,11 @@ package body Sem_Ch4 is
elsif Is_Access_Type (Formal_Type)
and then not Is_Access_Type (Etype (Obj))
and then (not Has_Implicit_Dereference (Etype (Obj))
or else
not Is_Access_Type
(Designated_Type
(Etype (Get_Reference_Discriminant (Etype (Obj))))))
and then
(not Has_Implicit_Dereference (Etype (Obj))
or else
not Is_Access_Type (Designated_Type (Etype
(Get_Reference_Discriminant (Etype (Obj))))))
then
-- A special case: A.all'Access is illegal if A is an access to a
-- constant and the context requires an access to a variable.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment