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> 2017-09-20 Alexandre Oliva <aoliva@redhat.com>
* gcc-interface/lang.opt (gant, gnatO, gnat): Add RejectNegative. * gcc-interface/lang.opt (gant, gnatO, gnat): Add RejectNegative.
......
...@@ -516,11 +516,13 @@ package body Exp_Ch3 is ...@@ -516,11 +516,13 @@ package body Exp_Ch3 is
--------------------------- ---------------------------
procedure Build_Array_Init_Proc (A_Type : Entity_Id; Nod : Node_Id) 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 : constant Entity_Id := Component_Type (A_Type);
Comp_Type_Simple : constant Boolean := Comp_Type_Simple : constant Boolean :=
Needs_Simple_Initialization Needs_Simple_Initialization
(Comp_Type, Consider_IS => (T => Comp_Type,
Consider_IS =>
not (Validity_Check_Copies and Is_Bit_Packed_Array (A_Type))); not (Validity_Check_Copies and Is_Bit_Packed_Array (A_Type)));
Body_Stmts : List_Id; Body_Stmts : List_Id;
Has_Default_Init : Boolean; Has_Default_Init : Boolean;
Index_List : List_Id; Index_List : List_Id;
...@@ -1800,6 +1802,7 @@ package body Exp_Ch3 is ...@@ -1800,6 +1802,7 @@ package body Exp_Ch3 is
function Replace_Discr_Ref (N : Node_Id) return Traverse_Result is function Replace_Discr_Ref (N : Node_Id) return Traverse_Result is
Val : Node_Id; Val : Node_Id;
begin begin
if Is_Entity_Name (N) if Is_Entity_Name (N)
and then Present (Entity (N)) and then Present (Entity (N))
...@@ -1807,10 +1810,11 @@ package body Exp_Ch3 is ...@@ -1807,10 +1810,11 @@ package body Exp_Ch3 is
and then Present (Discriminal_Link (Entity (N))) and then Present (Discriminal_Link (Entity (N)))
then then
Val := Val :=
Make_Selected_Component (N_Loc, Make_Selected_Component (N_Loc,
Prefix => New_Copy_Tree (Lhs), Prefix => New_Copy_Tree (Lhs),
Selector_Name => New_Occurrence_Of Selector_Name =>
(Discriminal_Link (Entity (N)), N_Loc)); New_Occurrence_Of (Discriminal_Link (Entity (N)), N_Loc));
if Present (Val) then if Present (Val) then
Rewrite (N, New_Copy_Tree (Val)); Rewrite (N, New_Copy_Tree (Val));
end if; end if;
...@@ -1822,6 +1826,8 @@ package body Exp_Ch3 is ...@@ -1822,6 +1826,8 @@ package body Exp_Ch3 is
procedure Replace_Discriminant_References is procedure Replace_Discriminant_References is
new Traverse_Proc (Replace_Discr_Ref); new Traverse_Proc (Replace_Discr_Ref);
-- Start of processing for Build_Assignment
begin begin
Lhs := Lhs :=
Make_Selected_Component (N_Loc, Make_Selected_Component (N_Loc,
......
...@@ -75,10 +75,11 @@ package body Exp_Ch5 is ...@@ -75,10 +75,11 @@ package body Exp_Ch5 is
-- of formal container iterators. -- of formal container iterators.
function Convert_To_Iterable_Type function Convert_To_Iterable_Type
(Container : Entity_Id; Loc : Source_Ptr) return Node_Id; (Container : Entity_Id;
-- Returns New_Occurrence_Of (Container), possibly converted to an Loc : Source_Ptr) return Node_Id;
-- ancestor type, if the type of Container inherited the Iterable -- Returns New_Occurrence_Of (Container), possibly converted to an ancestor
-- aspect_specification from that ancestor. -- type, if the type of Container inherited the Iterable aspect from that
-- ancestor.
function Change_Of_Representation (N : Node_Id) return Boolean; function Change_Of_Representation (N : Node_Id) return Boolean;
-- Determine if the right-hand side of assignment N is a type conversion -- Determine if the right-hand side of assignment N is a type conversion
...@@ -243,16 +244,21 @@ package body Exp_Ch5 is ...@@ -243,16 +244,21 @@ package body Exp_Ch5 is
------------------------------ ------------------------------
function Convert_To_Iterable_Type function Convert_To_Iterable_Type
(Container : Entity_Id; Loc : Source_Ptr) return Node_Id (Container : Entity_Id;
Loc : Source_Ptr) return Node_Id
is is
Typ : constant Entity_Id := Base_Type (Etype (Container)); Typ : constant Entity_Id := Base_Type (Etype (Container));
Aspect : constant Node_Id := Find_Aspect (Typ, Aspect_Iterable); Aspect : constant Node_Id := Find_Aspect (Typ, Aspect_Iterable);
Result : Node_Id := New_Occurrence_Of (Container, Loc); Result : Node_Id;
begin begin
Result := New_Occurrence_Of (Container, Loc);
if Entity (Aspect) /= Typ then if Entity (Aspect) /= Typ then
Result := Make_Type_Conversion (Loc, Result :=
Subtype_Mark => New_Occurrence_Of (Entity (Aspect), Loc), Make_Type_Conversion (Loc,
Expression => Result); Subtype_Mark => New_Occurrence_Of (Entity (Aspect), Loc),
Expression => Result);
end if; end if;
return Result; return Result;
......
...@@ -11089,7 +11089,7 @@ package body Sem_Attr is ...@@ -11089,7 +11089,7 @@ package body Sem_Attr is
and then Is_Overloadable (Entity (P))) and then Is_Overloadable (Entity (P)))
and then not (Nkind (P) = N_Selected_Component and then not (Nkind (P) = N_Selected_Component
and then and then
Is_Overloadable (Entity (Selector_Name (P)))) Is_Overloadable (Entity (Selector_Name (P))))
and then not Is_Aliased_View (P) and then not Is_Aliased_View (P)
and then not In_Instance and then not In_Instance
and then not In_Inlined_Body and then not In_Inlined_Body
......
...@@ -15132,7 +15132,9 @@ package body Sem_Ch12 is ...@@ -15132,7 +15132,9 @@ package body Sem_Ch12 is
Nam := Make_Identifier (Loc, Chars (Typ)); Nam := Make_Identifier (Loc, Chars (Typ));
if Is_Immediately_Visible (Scope (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 then
Nam := Nam :=
Make_Selected_Component (Loc, Make_Selected_Component (Loc,
......
...@@ -5094,8 +5094,8 @@ package body Sem_Ch13 is ...@@ -5094,8 +5094,8 @@ package body Sem_Ch13 is
or else Is_Array_Type (Etype (U_Ent))) or else Is_Array_Type (Etype (U_Ent)))
and then (Is_Record_Type (Etype (O_Ent)) and then (Is_Record_Type (Etype (O_Ent))
or else Is_Array_Type (Etype (O_Ent))) or else Is_Array_Type (Etype (O_Ent)))
and then Reverse_Storage_Order (Etype (U_Ent)) and then Reverse_Storage_Order (Etype (U_Ent)) /=
/= Reverse_Storage_Order (Etype (O_Ent)) Reverse_Storage_Order (Etype (O_Ent))
then then
Set_Treat_As_Volatile (U_Ent); Set_Treat_As_Volatile (U_Ent);
end if; end if;
......
...@@ -3931,16 +3931,14 @@ package body Sem_Ch4 is ...@@ -3931,16 +3931,14 @@ package body Sem_Ch4 is
Find_Type (Mark); Find_Type (Mark);
T := Entity (Mark); T := Entity (Mark);
if Nkind_In if Nkind_In (Enclosing_Declaration (N), N_Formal_Type_Declaration,
(Enclosing_Declaration (N), N_Full_Type_Declaration,
N_Formal_Type_Declaration, N_Incomplete_Type_Declaration,
N_Full_Type_Declaration, N_Protected_Type_Declaration,
N_Incomplete_Type_Declaration, N_Private_Extension_Declaration,
N_Protected_Type_Declaration, N_Private_Type_Declaration,
N_Private_Extension_Declaration, N_Subtype_Declaration,
N_Private_Type_Declaration, N_Task_Type_Declaration)
N_Subtype_Declaration,
N_Task_Type_Declaration)
and then T = Defining_Identifier (Enclosing_Declaration (N)) and then T = Defining_Identifier (Enclosing_Declaration (N))
then then
Error_Msg_N ("current instance not allowed", Mark); Error_Msg_N ("current instance not allowed", Mark);
...@@ -8562,11 +8560,11 @@ package body Sem_Ch4 is ...@@ -8562,11 +8560,11 @@ package body Sem_Ch4 is
elsif Is_Access_Type (Formal_Type) elsif Is_Access_Type (Formal_Type)
and then not Is_Access_Type (Etype (Obj)) and then not Is_Access_Type (Etype (Obj))
and then (not Has_Implicit_Dereference (Etype (Obj)) and then
or else (not Has_Implicit_Dereference (Etype (Obj))
not Is_Access_Type or else
(Designated_Type not Is_Access_Type (Designated_Type (Etype
(Etype (Get_Reference_Discriminant (Etype (Obj)))))) (Get_Reference_Discriminant (Etype (Obj))))))
then then
-- A special case: A.all'Access is illegal if A is an access to a -- 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. -- 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