Skip to content

R
riscv-gcc-1
Commit bac5ba15 by Arnaud Charlet
Options

[multiple changes] 

2016-05-02  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch3.adb, exp_ch9.adb, einfo.adb, sem_ch4.adb, sem_ch6.adb: Minor
	reformatting.

2016-05-02  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch4.adb (Expand_N_Allocator): If the designated type
	is a private derived type with no discriminants, examine its
	underlying_full_view to determine whether the full view has
	defaulted discriminants, so their defaults can be used in the
	call to the initialization procedure for the designated object.

From-SVN: r235740
parent 42f11e4c
Showing with 123 additions and 90 deletions
gcc/ada/ChangeLog
2016-05-02 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch3.adb, exp_ch9.adb, einfo.adb, sem_ch4.adb, sem_ch6.adb: Minor
reformatting.
2016-05-02 Ed Schonberg <schonberg@adacore.com>
* exp_ch4.adb (Expand_N_Allocator): If the designated type
is a private derived type with no discriminants, examine its
underlying_full_view to determine whether the full view has
defaulted discriminants, so their defaults can be used in the
call to the initialization procedure for the designated object.
2016-05-02 Hristian Kirtchev <kirtchev@adacore.com>
* exp_prag.adb, comperr.adb: Minor reformatting.
2016-05-02 Ed Schonberg <schonberg@adacore.com>
......
gcc/ada/einfo.adb
......@@ -5908,7 +5908,7 @@ package body Einfo is
procedure Set_Original_Protected_Subprogram (Id : E; V : N) is
begin
pragma Assert (Ekind_In (Id, E_Procedure, E_Function));
pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
Set_Node41 (Id, V);
end Set_Original_Protected_Subprogram;
......
gcc/ada/exp_ch4.adb
......@@ -4503,12 +4503,25 @@ package body Exp_Ch4 is
Dis := True;
Typ := T;
elsif Is_Private_Type (T)
and then Present (Full_View (T))
and then Has_Discriminants (Full_View (T))
then
Dis := True;
Typ := Full_View (T);
-- Type may be a private type with no visible discriminants
-- in which case check full view if in scope, or the
-- underlying_full_view if dealing with a type whose full
-- view may be derived from a private type whose own full
-- view has discriminants.
elsif Is_Private_Type (T) then
if Present (Full_View (T))
and then Has_Discriminants (Full_View (T))
then
Dis := True;
Typ := Full_View (T);
elsif Present (Underlying_Full_View (T))
and then Has_Discriminants (Underlying_Full_View (T))
then
Dis := True;
Typ := Underlying_Full_View (T);
end if;
end if;
if Dis then
......
gcc/ada/exp_ch9.adb
......@@ -2558,9 +2558,9 @@ package body Exp_Ch9 is
end if;
return
Type_Conformant_Parameters (
Parameter_Specifications (Iface_Op_Spec),
Parameter_Specifications (Wrapper_Spec));
Type_Conformant_Parameters
(Parameter_Specifications (Iface_Op_Spec),
Parameter_Specifications (Wrapper_Spec));
end Overriding_Possible;
-----------------------
......@@ -2609,14 +2609,13 @@ package body Exp_Ch9 is
Append_To (New_Formals,
Make_Parameter_Specification (Loc,
Defining_Identifier =>
Defining_Identifier =>
Make_Defining_Identifier (Loc,
Chars => Chars
(Defining_Identifier (Formal))),
In_Present => In_Present (Formal),
Out_Present => Out_Present (Formal),
Null_Exclusion_Present => Null_Exclusion_Present (Formal),
Parameter_Type => Param_Type));
Chars => Chars (Defining_Identifier (Formal))),
In_Present => In_Present (Formal),
Out_Present => Out_Present (Formal),
Null_Exclusion_Present => Null_Exclusion_Present (Formal),
Parameter_Type => Param_Type));
Next (Formal);
end loop;
......@@ -2776,13 +2775,16 @@ package body Exp_Ch9 is
else
pragma Assert (Is_Private_Primitive_Subprogram (Subp_Id));
Obj_Param :=
Make_Parameter_Specification (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc, Name_uO),
In_Present => In_Present (Parent (First_Entity (Subp_Id))),
Out_Present => Ekind (Subp_Id) /= E_Function,
Parameter_Type => New_Occurrence_Of (Obj_Typ, Loc));
In_Present =>
In_Present (Parent (First_Entity (Subp_Id))),
Out_Present => Ekind (Subp_Id) /= E_Function,
Parameter_Type => New_Occurrence_Of (Obj_Typ, Loc));
Prepend_To (New_Formals, Obj_Param);
end if;
......@@ -4195,8 +4197,7 @@ package body Exp_Ch9 is
Unprotected_Mode => 'N');
begin
if Ekind (Defining_Unit_Name (Specification (N))) =
E_Subprogram_Body
if Ekind (Defining_Unit_Name (Specification (N))) = E_Subprogram_Body
then
Decl := Unit_Declaration_Node (Corresponding_Spec (N));
else
......@@ -4238,7 +4239,7 @@ package body Exp_Ch9 is
if Nkind (Specification (Decl)) = N_Procedure_Specification then
New_Spec :=
Make_Procedure_Specification (Loc,
Defining_Unit_Name => New_Id,
Defining_Unit_Name => New_Id,
Parameter_Specifications => New_Plist);
-- Create a new specification for the anonymous subprogram type
......@@ -4246,9 +4247,9 @@ package body Exp_Ch9 is
else
New_Spec :=
Make_Function_Specification (Loc,
Defining_Unit_Name => New_Id,
Defining_Unit_Name => New_Id,
Parameter_Specifications => New_Plist,
Result_Definition =>
Result_Definition =>
Copy_Result_Type (Result_Definition (Specification (Decl))));
Set_Return_Present (Defining_Unit_Name (New_Spec));
......@@ -9654,22 +9655,22 @@ package body Exp_Ch9 is
Present (Interfaces (Corresponding_Record_Type (Prot_Typ)))
then
declare
Found : Boolean := False;
Prim_Elmt : Elmt_Id;
Prim_Op : Node_Id;
Found : Boolean := False;
begin
Prim_Elmt :=
First_Elmt
(Primitive_Operations
(Corresponding_Record_Type (Prot_Typ)));
(Corresponding_Record_Type (Prot_Typ)));
while Present (Prim_Elmt) loop
Prim_Op := Node (Prim_Elmt);
if Is_Primitive_Wrapper (Prim_Op)
and then (Wrapped_Entity (Prim_Op))
= Defining_Entity (Specification (Comp))
and then Wrapped_Entity (Prim_Op) =
Defining_Entity (Specification (Comp))
then
Found := True;
exit;
......@@ -9684,6 +9685,7 @@ package body Exp_Ch9 is
Specification =>
Build_Protected_Sub_Specification
(Comp, Prot_Typ, Dispatching_Mode));
Insert_After (Current_Node, Sub);
Analyze (Sub);
......@@ -9740,19 +9742,19 @@ package body Exp_Ch9 is
Body_Arr :=
Make_Object_Declaration (Loc,
Defining_Identifier => Body_Id,
Aliased_Present => True,
Object_Definition =>
Aliased_Present => True,
Object_Definition =>
Make_Subtype_Indication (Loc,
Subtype_Mark =>
New_Occurrence_Of
(RTE (RE_Protected_Entry_Body_Array), Loc),
Constraint =>
Constraint =>
Make_Index_Or_Discriminant_Constraint (Loc,
Constraints => New_List (
Make_Range (Loc,
Make_Integer_Literal (Loc, 1),
Make_Integer_Literal (Loc, E_Count))))),
Expression => Entries_Aggr);
Expression => Entries_Aggr);
when System_Tasking_Protected_Objects_Single_Entry =>
Body_Arr :=
......@@ -9761,7 +9763,8 @@ package body Exp_Ch9 is
Aliased_Present => True,
Object_Definition =>
New_Occurrence_Of (RTE (RE_Entry_Body), Loc),
Expression => Remove_Head (Expressions (Entries_Aggr)));
Expression =>
Remove_Head (Expressions (Entries_Aggr)));
when others =>
raise Program_Error;
......
gcc/ada/sem_ch3.adb
......@@ -19828,8 +19828,8 @@ package body Sem_Ch3 is
(Subp_Id => Prim,
Obj_Typ => Conc_Typ,
Formals =>
Parameter_Specifications (
Parent (Prim))));
Parameter_Specifications
(Parent (Prim))));
Insert_After (Curr_Nod, Wrap_Spec);
Curr_Nod := Wrap_Spec;
......
gcc/ada/sem_ch4.adb
......@@ -9022,9 +9022,10 @@ package body Sem_Ch4 is
-- Exp_Ch9.Build_Selected_Name).
elsif Is_Protected_Type (Obj_Type) then
return Present (Original_Protected_Subprogram (Prim_Op))
and then Chars (Original_Protected_Subprogram (Prim_Op))
= Chars (Subprog);
return
Present (Original_Protected_Subprogram (Prim_Op))
and then Chars (Original_Protected_Subprogram (Prim_Op)) =
Chars (Subprog);
end if;
return False;
......
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