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

[multiple changes]

Browse Source 
2015-01-07  Robert Dewar  <dewar@adacore.com>

	* sem_warn.adb (Check_One_Unit): Don't give unused entities
	warning for a package which is used as a generic parameter.

2015-01-07  Bob Duff  <duff@adacore.com>

	* usage.adb (Usage): Correct documentation of
	-gnatw.f switches.

2015-01-07  Robert Dewar  <dewar@adacore.com>

	* s-fileio.adb: Minor reformatting.

2015-01-07  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb (Instantiate_Object): If formal is an anonymous
	access to subprogram, replace its formals with new entities when
	building the object declaration, both if actual is present and
	when it is defaulted.

2015-01-07  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch5.adb (Analyze_Assignment): If left-hand side is a view
	conversion and type of expression has invariant, apply invariant
	check on expression.

2015-01-07  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Create_Constrained_Components): A call to
	Gather_Components may detect an error if an inherited discriminant
	that controls a variant is non-static.
	* sem_aggr.adb (Resolve_Record_Aggregate, Step 5): The call to
	Gather_Components may report an error if an inherited discriminant
	in a variant in non-static.
	* sem_util.adb (Gather_Components): If a non-static discriminant
	is inherited do not report error here, but let caller handle it.
	(Find_Actual): Small optimization.

From-SVN: r219297
This commit is contained in:
Arnaud Charlet 2015-01-07 12:15:30 +01:00
parent 91669e7ee5
commit 4ffafd8620
9 changed files with 190 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
gcc/ada/ChangeLog
View File

@ -1,3 +1,42 @@
2015-01-07 Robert Dewar <dewar@adacore.com>
* sem_warn.adb (Check_One_Unit): Don't give unused entities
warning for a package which is used as a generic parameter.
2015-01-07 Bob Duff <duff@adacore.com>
* usage.adb (Usage): Correct documentation of
-gnatw.f switches.
2015-01-07 Robert Dewar <dewar@adacore.com>
* s-fileio.adb: Minor reformatting.
2015-01-07 Ed Schonberg <schonberg@adacore.com>
* sem_ch12.adb (Instantiate_Object): If formal is an anonymous
access to subprogram, replace its formals with new entities when
building the object declaration, both if actual is present and
when it is defaulted.
2015-01-07 Ed Schonberg <schonberg@adacore.com>
* sem_ch5.adb (Analyze_Assignment): If left-hand side is a view
conversion and type of expression has invariant, apply invariant
check on expression.
2015-01-07 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Create_Constrained_Components): A call to
Gather_Components may detect an error if an inherited discriminant
that controls a variant is non-static.
* sem_aggr.adb (Resolve_Record_Aggregate, Step 5): The call to
Gather_Components may report an error if an inherited discriminant
in a variant in non-static.
* sem_util.adb (Gather_Components): If a non-static discriminant
is inherited do not report error here, but let caller handle it.
(Find_Actual): Small optimization.
2015-01-07 Bob Duff <duff@adacore.com> 2015-01-07 Bob Duff <duff@adacore.com>
* usage.adb (Usage): Document -gnatw.f switch. * usage.adb (Usage): Document -gnatw.f switch.

5
gcc/ada/s-fileio.adb
View File

@ -213,11 +213,12 @@ package body System.File_IO is
----------- -----------
procedure Close (File_Ptr : access AFCB_Ptr) is procedure Close (File_Ptr : access AFCB_Ptr) is
Close_Status : int := 0; Close_Status : int := 0;
Dup_Strm : Boolean := False; Dup_Strm : Boolean := False;
File : AFCB_Ptr renames File_Ptr.all;
Errno : Integer := 0; Errno : Integer := 0;
File : AFCB_Ptr renames File_Ptr.all;
begin begin
-- Take a task lock, to protect the global data value Open_Files -- Take a task lock, to protect the global data value Open_Files

7
gcc/ada/sem_aggr.adb
View File

@ -3984,6 +3984,13 @@ package body Sem_Aggr is
Governed_By => New_Assoc_List, Governed_By => New_Assoc_List,
Into => Components, Into => Components,
Report_Errors => Errors_Found); Report_Errors => Errors_Found);
if Errors_Found then
Error_Msg_N
("discriminant controlling variant part is not static",
N);
return;
end if;
end if; end if;
end if; end if;

53
gcc/ada/sem_ch12.adb
View File

@ -4690,7 +4690,10 @@ package body Sem_Ch12 is
Set_Parent (Act_Decl_Id, Parent (Anon_Id)); Set_Parent (Act_Decl_Id, Parent (Anon_Id));
Set_Chars (Act_Decl_Id, Chars (Defining_Entity (N))); Set_Chars (Act_Decl_Id, Chars (Defining_Entity (N)));
Set_Sloc (Act_Decl_Id, Sloc (Defining_Entity (N))); Set_Sloc (Act_Decl_Id, Sloc (Defining_Entity (N)));
Set_Comes_From_Source (Act_Decl_Id, True);
-- Subprogram instance comes from source only if generic does
Set_Comes_From_Source (Act_Decl_Id, Comes_From_Source (Gen_Unit));
-- The signature may involve types that are not frozen yet, but the -- The signature may involve types that are not frozen yet, but the
-- subprogram will be frozen at the point the wrapper package is -- subprogram will be frozen at the point the wrapper package is
@ -9879,6 +9882,43 @@ package body Sem_Ch12 is
Subt_Decl : Node_Id := Empty; Subt_Decl : Node_Id := Empty;
Subt_Mark : Node_Id := Empty; Subt_Mark : Node_Id := Empty;
function Copy_Access_Def return Node_Id;
-- If formal is an anonymous access, copy access definition of formal
-- for generated object declaration.
---------------------
-- Copy_Access_Def --
---------------------
function Copy_Access_Def return Node_Id is
begin
Def := New_Copy_Tree (Acc_Def);
-- In addition, if formal is an access to subprogram we need to
-- generate new formals for the signature of the default, so that
-- the tree is properly formatted for ASIS use.
if Present (Access_To_Subprogram_Definition (Acc_Def)) then
declare
Par_Spec : Node_Id;
begin
Par_Spec :=
First (Parameter_Specifications
(Access_To_Subprogram_Definition (Def)));
while Present (Par_Spec) loop
Set_Defining_Identifier (Par_Spec,
Make_Defining_Identifier (Sloc (Acc_Def),
Chars => Chars (Defining_Identifier (Par_Spec))));
Next (Par_Spec);
end loop;
end;
end if;
return Def;
end Copy_Access_Def;
-- Start of processing for Instantiate_Object
begin begin
-- Formal may be an anonymous access -- Formal may be an anonymous access
@ -10061,7 +10101,7 @@ package body Sem_Ch12 is
if Present (Subt_Mark) then if Present (Subt_Mark) then
Def := New_Copy_Tree (Subt_Mark); Def := New_Copy_Tree (Subt_Mark);
else pragma Assert (Present (Acc_Def)); else pragma Assert (Present (Acc_Def));
Def := Copy_Separate_Tree (Acc_Def); Def := Copy_Access_Def;
end if; end if;
Decl_Node := Decl_Node :=
@ -10142,15 +10182,8 @@ package body Sem_Ch12 is
if Present (Subt_Mark) then if Present (Subt_Mark) then
Def := New_Copy (Subt_Mark); Def := New_Copy (Subt_Mark);
else pragma Assert (Present (Acc_Def)); else pragma Assert (Present (Acc_Def));
Def := Copy_Access_Def;
-- If formal is an anonymous access, copy access definition of
-- formal for object declaration.
-- In the case of an access to subprogram we need to
-- generate new formals for the signature of the default.
Def := Copy_Separate_Tree (Acc_Def);
end if; end if;
Decl_Node := Decl_Node :=

21
gcc/ada/sem_ch3.adb
View File

@ -13887,19 +13887,22 @@ package body Sem_Ch3 is
then then
Collect_Fixed_Components (Typ); Collect_Fixed_Components (Typ);
Gather_Components ( Gather_Components
Typ, (Typ,
Component_List (Type_Definition (Parent (Parent_Type))), Component_List (Type_Definition (Parent (Parent_Type))),
Governed_By => Assoc_List, Governed_By => Assoc_List,
Into => Comp_List, Into => Comp_List,
Report_Errors => Errors); Report_Errors => Errors);
pragma Assert (not Errors);
-- Note: previously there was a check at this point that no errors
-- were detected. As a consequence of AI05-220 there may be an error
-- if an inherited discriminant that controls a variant has a non-
-- static constraint.
-- If the tagged derivation has a type extension, collect all the -- If the tagged derivation has a type extension, collect all the
-- new components therein. -- new components therein.
if Present if Present (Record_Extension_Part (Type_Definition (Parent (Typ))))
(Record_Extension_Part (Type_Definition (Parent (Typ))))
then then
Old_C := First_Component (Typ); Old_C := First_Component (Typ);
while Present (Old_C) loop while Present (Old_C) loop

12
gcc/ada/sem_ch5.adb
View File

@ -764,6 +764,18 @@ package body Sem_Ch5 is
Set_Referenced_Modified (Lhs, Out_Param => False); Set_Referenced_Modified (Lhs, Out_Param => False);
end if; end if;
-- RM 7.3.2 (12/3) An assignment to a view conversion (from a type
-- to one of its ancestors) requires an invariant check. Apply check
-- only if expression comes from source, otherwise it will be applied
-- when value is assigned to source entity.
if Nkind (Lhs) = N_Type_Conversion
and then Has_Invariants (Etype (Expression (Lhs)))
and then Comes_From_Source (Expression (Lhs))
then
Insert_After (N, Make_Invariant_Call (Expression (Lhs)));
end if;
-- Final step. If left side is an entity, then we may be able to reset -- Final step. If left side is an entity, then we may be able to reset
-- the current tracked values to new safe values. We only have something -- the current tracked values to new safe values. We only have something
-- to do if the left side is an entity name, and expansion has not -- to do if the left side is an entity name, and expansion has not

28
gcc/ada/sem_util.adb
View File

@ -5999,6 +5999,14 @@ package body Sem_Util is
and then Is_Overloadable (Entity (Name (Call))) and then Is_Overloadable (Entity (Name (Call)))
and then not Is_Overloaded (Name (Call)) and then not Is_Overloaded (Name (Call))
then then
-- If node is name in call it is not an actual
if N = Name (Call) then
Call := Empty;
Formal := Empty;
return;
end if;
-- Fall here if we are definitely a parameter -- Fall here if we are definitely a parameter
Actual := First_Actual (Call); Actual := First_Actual (Call);
@ -6626,10 +6634,22 @@ package body Sem_Util is
Discrim_Value := Expression (Assoc); Discrim_Value := Expression (Assoc);
if not Is_OK_Static_Expression (Discrim_Value) then if not Is_OK_Static_Expression (Discrim_Value) then
Error_Msg_FE
("value for discriminant & must be static!", -- If the variant part is governed by a discriminant of the type
Discrim_Value, Discrim); -- this is an error. If the variant part and the discriminant are
Why_Not_Static (Discrim_Value); -- inherited from an ancestor this is legal (AI05-120) unless the
-- components are being gathered for an aggregate, in which case
-- the caller must check Report_Errors.
if Scope (Original_Record_Component
((Entity (First (Choices (Assoc)))))) = Typ
then
Error_Msg_FE
("value for discriminant & must be static!",
Discrim_Value, Discrim);
Why_Not_Static (Discrim_Value);
end if;
Report_Errors := True; Report_Errors := True;
return; return;
end if; end if;

75
gcc/ada/sem_warn.adb
View File

@ -2457,38 +2457,61 @@ package body Sem_Warn is
elsif Check_System_Aux then elsif Check_System_Aux then
null; null;
-- Else give the warning -- Else the warning may be needed
else else
-- Warn if we unreferenced flag set and we have declare
-- not had serious errors. The reason we inhibit Eitem : constant Entity_Id :=
-- the message if there are errors is to prevent Entity (Name (Item));
-- false positives from disabling expansion.
if not Has_Unreferenced (Entity (Name (Item))) begin
and then Serious_Errors_Detected = 0 -- Warn if we unreferenced flag set and we
then -- have not had serious errors. The reason we
Error_Msg_N -- CODEFIX -- inhibit the message if there are errors is
("?u?no entities of & are referenced!", -- to prevent false positives from disabling
Name (Item)); -- expansion.
end if;
-- Look for renamings of this package, and flag if not Has_Unreferenced (Eitem)
-- them as well. If the original package has and then Serious_Errors_Detected = 0
-- warnings off, we suppress the warning on the then
-- renaming as well. -- Get possible package renaming
Pack := Find_Package_Renaming (Munite, Lunit); Pack :=
Find_Package_Renaming (Munite, Lunit);
if Present (Pack) -- No warning if either the package or its
and then not Has_Warnings_Off (Lunit) -- renaming is used as a generic actual.
and then not Has_Unreferenced (Pack)
then if Used_As_Generic_Actual (Eitem)
Error_Msg_NE -- CODEFIX or else
("?u?no entities of & are referenced!", (Present (Pack)
Unit_Declaration_Node (Pack), and then
Pack); Used_As_Generic_Actual (Pack))
end if; then
exit;
end if;
-- Here we give the warning
Error_Msg_N -- CODEFIX
("?u?no entities of & are referenced!",
Name (Item));
-- Flag renaming of package as well. If
-- the original package has warnings off,
-- we suppress the warning on the renaming
-- as well.
if Present (Pack)
and then not Has_Warnings_Off (Lunit)
and then not Has_Unreferenced (Pack)
then
Error_Msg_NE -- CODEFIX
("?u?no entities of& are referenced!",
Unit_Declaration_Node (Pack), Pack);
end if;
end if;
end;
end if; end if;
exit; exit;

2
gcc/ada/usage.adb
View File

@ -502,7 +502,7 @@ begin
Write_Line (" f+ turn on warnings for unreferenced formal"); Write_Line (" f+ turn on warnings for unreferenced formal");
Write_Line (" F* turn off warnings for unreferenced formal"); Write_Line (" F* turn off warnings for unreferenced formal");
Write_Line (" .f turn on warnings for suspicious Subp'Access"); Write_Line (" .f turn on warnings for suspicious Subp'Access");
Write_Line (" .F turn off warnings for suspicious Subp'Access"); Write_Line (" .F* turn off warnings for suspicious Subp'Access");
Write_Line (" g*+ turn on warnings for unrecognized pragma"); Write_Line (" g*+ turn on warnings for unrecognized pragma");
Write_Line (" G turn off warnings for unrecognized pragma"); Write_Line (" G turn off warnings for unrecognized pragma");
Write_Line (" .g turn on GNAT warnings"); Write_Line (" .g turn on GNAT warnings");