OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2017-04-25  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch3.adb, exp_util.adb, sem_prag.adb, freeze.adb, sem_util.adb:
	Minor reformatting.

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

	* scng.adb (Scan): Handle '@' appropriately.
	* sem_ch5.adb: Code cleanup.

From-SVN: r247142
This commit is contained in:
Arnaud Charlet 2017-04-25 10:19:33 +02:00
parent b536073728
commit b41c731f0a
8 changed files with 78 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
gcc/ada/ChangeLog
View File

@ -1,3 +1,13 @@
2017-04-25 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch3.adb, exp_util.adb, sem_prag.adb, freeze.adb, sem_util.adb:
Minor reformatting.
2017-04-25 Ed Schonberg <schonberg@adacore.com>
* scng.adb (Scan): Handle '@' appropriately.
* sem_ch5.adb: Code cleanup.
2017-04-25 Ed Schonberg <schonberg@adacore.com>
* freeze.adb (Check_Expression_Function): Do not check for the

5
gcc/ada/exp_util.adb
View File

@ -1057,7 +1057,6 @@ package body Exp_Util is
Adjust_Sloc : Boolean;
Needs_Wrapper : out Boolean)
is
function Replace_Entity (N : Node_Id) return Traverse_Result;
-- Replace reference to formal of inherited operation or to primitive
-- operation of root type, with corresponding entity for derived type,
@ -1102,8 +1101,8 @@ package body Exp_Util is
if Present (New_E) then
Rewrite (N, New_Occurrence_Of (New_E, Sloc (N)));
-- If the entity is an overridden primitive, we must build
-- a wrapper for the current inherited operation.
-- If the entity is an overridden primitive, we must build a
-- wrapper for the current inherited operation.
if Is_Subprogram (New_E) then
Needs_Wrapper := True;

61
gcc/ada/freeze.adb
View File

@ -1404,12 +1404,12 @@ package body Freeze is
A_Post : Node_Id;
A_Pre : Node_Id;
Decls : List_Id;
Needs_Wrapper : Boolean;
New_Prag : Node_Id;
Op_Node : Elmt_Id;
Par_Prim : Entity_Id;
Par_Type : Entity_Id;
New_Prag : Node_Id;
Prim : Entity_Id;
Needs_Wrapper : Boolean;
begin
Op_Node := First_Elmt (Prim_Ops);
@ -1452,8 +1452,6 @@ package body Freeze is
-- require a wrapper to handle inherited conditions that call other
-- primitives, so that LSP can be verified/enforced.
-- Wrapper construction TBD.
Op_Node := First_Elmt (Prim_Ops);
while Present (Op_Node) loop
Decls := Empty_List;
@ -1511,34 +1509,34 @@ package body Freeze is
-- controlling actuals are conversions to the corresponding type
-- in the parent primitive:
-- procedure New_Prim (F1 : T1.; ...) is
-- pragma Check (Precondition, Expr);
-- begin
-- Par_Prim (Par_Type (F1) ..);
-- end;
--
-- If the primitive is a function the statement is a call.
-- procedure New_Prim (F1 : T1.; ...) is
-- pragma Check (Precondition, Expr);
-- begin
-- Par_Prim (Par_Type (F1) ..);
-- end;
-- If the primitive is a function the statement is a call
declare
Loc : constant Source_Ptr := Sloc (R);
Formal : Entity_Id;
Actuals : List_Id;
Call : Node_Id;
Formal : Entity_Id;
New_F_Spec : Node_Id;
New_Formal : Entity_Id;
New_Proc : Node_Id;
New_Spec : Node_Id;
Call : Node_Id;
begin
Actuals := Empty_List;
New_Spec := Build_Overriding_Spec (Par_Prim, R);
Actuals := Empty_List;
New_Spec := Build_Overriding_Spec (Par_Prim, R);
Formal := First_Formal (Par_Prim);
New_F_Spec := First (Parameter_Specifications (New_Spec));
while Present (Formal) loop
New_Formal := Defining_Identifier (New_F_Spec);
-- If controlling argument, add conversion.
-- If controlling argument, add conversion
if Etype (Formal) = Par_Type then
Append_To (Actuals,
@ -1555,24 +1553,29 @@ package body Freeze is
end loop;
if Ekind (Par_Prim) = E_Procedure then
Call := Make_Procedure_Call_Statement (Loc,
Parameter_Associations => Actuals,
Name => New_Occurrence_Of (Par_Prim, Loc));
Call :=
Make_Procedure_Call_Statement (Loc,
Name =>
New_Occurrence_Of (Par_Prim, Loc),
Parameter_Associations => Actuals);
else
Call := Make_Simple_Return_Statement (Loc,
Call :=
Make_Simple_Return_Statement (Loc,
Expression =>
Make_Function_Call (Loc,
Parameter_Associations => Actuals,
Name => New_Occurrence_Of (Par_Prim, Loc)));
Name =>
New_Occurrence_Of (Par_Prim, Loc),
Parameter_Associations => Actuals));
end if;
New_Proc := Make_Subprogram_Body (Loc,
Specification => New_Spec,
Declarations => Decls,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List (Call),
End_Label => Make_Identifier (Loc, Chars (Prim))));
New_Proc :=
Make_Subprogram_Body (Loc,
Specification => New_Spec,
Declarations => Decls,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List (Call),
End_Label => Make_Identifier (Loc, Chars (Prim))));
Insert_After (Parent (R), New_Proc);
Analyze (New_Proc);

3
gcc/ada/scng.adb
View File

@ -2052,6 +2052,8 @@ package body Scng is
-- T'Digits'Img. Strings literals are included for things like
-- "abs"'Address. Other literals are included to give better error
-- behavior for illegal cases like 123'Img.
-- In Ada2020 a target name (i.e. @) is a valid prefix of an
-- attribute, and functions like a name.
if Prev_Token = Tok_Identifier
or else Prev_Token = Tok_Right_Paren
@ -2059,6 +2061,7 @@ package body Scng is
or else Prev_Token = Tok_Delta
or else Prev_Token = Tok_Digits
or else Prev_Token = Tok_Project
or else Prev_Token = Tok_At_Sign
or else Prev_Token in Token_Class_Literal
then
Token := Tok_Apostrophe;

5
gcc/ada/sem_ch3.adb
View File

@ -17660,8 +17660,9 @@ package body Sem_Ch3 is
end if;
while Present (Disc) loop
-- If no further associations return the discriminant, value
-- will be found on the second pass.
-- If no further associations return the discriminant, value will
-- be found on the second pass.
if No (Assoc) then
return Result;

18
gcc/ada/sem_ch5.adb
View File

@ -570,15 +570,6 @@ package body Sem_Ch5 is
Resolve (Rhs, T1);
-- If the right-hand side contains target names, expansion has been
-- disabled to prevent expansion that might move target names out of
-- the context of the assignment statement. Restore the expander mode
-- now so that assignment statement can be properly expanded.
if Nkind (N) = N_Assignment_Statement and then Has_Target_Names (N) then
Expander_Mode_Restore;
end if;
-- This is the point at which we check for an unset reference
Check_Unset_Reference (Rhs);
@ -939,6 +930,15 @@ package body Sem_Ch5 is
<<Leave>>
Current_LHS := Empty;
Restore_Ghost_Mode (Mode);
-- If the right-hand side contains target names, expansion has been
-- disabled to prevent expansion that might move target names out of
-- the context of the assignment statement. Restore the expander mode
-- now so that assignment statement can be properly expanded.
if Nkind (N) = N_Assignment_Statement and then Has_Target_Names (N) then
Expander_Mode_Restore;
end if;
end Analyze_Assignment;
-----------------------------

23
gcc/ada/sem_prag.adb
View File

@ -27026,9 +27026,6 @@ package body Sem_Prag is
Inher_Id : Entity_Id := Empty;
Keep_Pragma_Id : Boolean := False) return Node_Id
is
Needs_Wrapper : Boolean;
pragma Unreferenced (Needs_Wrapper);
function Suppress_Reference (N : Node_Id) return Traverse_Result;
-- Detect whether node N references a formal parameter subject to
-- pragma Unreferenced. If this is the case, set Comes_From_Source
@ -27065,11 +27062,14 @@ package body Sem_Prag is
-- Local variables
Loc : constant Source_Ptr := Sloc (Prag);
Prag_Nam : constant Name_Id := Pragma_Name (Prag);
Check_Prag : Node_Id;
Msg_Arg : Node_Id;
Nam : Name_Id;
Loc : constant Source_Ptr := Sloc (Prag);
Prag_Nam : constant Name_Id := Pragma_Name (Prag);
Check_Prag : Node_Id;
Msg_Arg : Node_Id;
Nam : Name_Id;
Needs_Wrapper : Boolean;
pragma Unreferenced (Needs_Wrapper);
-- Start of processing for Build_Pragma_Check_Equivalent
@ -27097,8 +27097,11 @@ package body Sem_Prag is
-- Build the inherited class-wide condition
Build_Class_Wide_Expression
(Check_Prag, Subp_Id, Inher_Id, Adjust_Sloc => True,
Needs_Wrapper => Needs_Wrapper);
(Prag => Check_Prag,
Subp => Subp_Id,
Par_Subp => Inher_Id,
Adjust_Sloc => True,
Needs_Wrapper => Needs_Wrapper);
-- If not an inherited condition simply copy the original pragma

9
gcc/ada/sem_util.adb
View File

@ -1596,18 +1596,21 @@ package body Sem_Util is
Formal_Spec : Node_Id;
Formal_Type : Node_Id;
New_Spec : Node_Id;
begin
New_Spec := Copy_Subprogram_Spec (Spec);
Formal_Spec := First (Parameter_Specifications (New_Spec));
while Present (Formal_Spec) loop
Formal_Type := Parameter_Type (Formal_Spec);
if Is_Entity_Name (Formal_Type)
and then Entity (Formal_Type) = Par_Typ
then
Rewrite (Formal_Type, New_Occurrence_Of (Typ, Loc));
end if;
-- Nothing needs to be done for access parameters.
-- Nothing needs to be done for access parameters
Next (Formal_Spec);
end loop;
@ -13588,8 +13591,8 @@ package body Sem_Util is
-- names.
when N_Explicit_Dereference =>
return not Nkind_In
(Original_Node (N), N_If_Expression, N_Case_Expression);
return not Nkind_In (Original_Node (N), N_Case_Expression,
N_If_Expression);
-- A view conversion of a tagged object is an object reference