[multiple changes]
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
parent
91669e7ee5
commit
4ffafd8620
|
|
@ -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>
|
||||
|
||||
* usage.adb (Usage): Document -gnatw.f switch.
|
||||
|
|
|
|||
|
|
@ -213,11 +213,12 @@ package body System.File_IO is
|
|||
-----------
|
||||
|
||||
procedure Close (File_Ptr : access AFCB_Ptr) is
|
||||
Close_Status : int := 0;
|
||||
Close_Status : int := 0;
|
||||
Dup_Strm : Boolean := False;
|
||||
File : AFCB_Ptr renames File_Ptr.all;
|
||||
Errno : Integer := 0;
|
||||
|
||||
File : AFCB_Ptr renames File_Ptr.all;
|
||||
|
||||
begin
|
||||
-- Take a task lock, to protect the global data value Open_Files
|
||||
|
||||
|
|
|
|||
|
|
@ -3984,6 +3984,13 @@ package body Sem_Aggr is
|
|||
Governed_By => New_Assoc_List,
|
||||
Into => Components,
|
||||
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;
|
||||
|
||||
|
|
|
|||
|
|
@ -4690,7 +4690,10 @@ package body Sem_Ch12 is
|
|||
Set_Parent (Act_Decl_Id, Parent (Anon_Id));
|
||||
Set_Chars (Act_Decl_Id, Chars (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
|
||||
-- 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_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
|
||||
-- Formal may be an anonymous access
|
||||
|
||||
|
|
@ -10061,7 +10101,7 @@ package body Sem_Ch12 is
|
|||
if Present (Subt_Mark) then
|
||||
Def := New_Copy_Tree (Subt_Mark);
|
||||
else pragma Assert (Present (Acc_Def));
|
||||
Def := Copy_Separate_Tree (Acc_Def);
|
||||
Def := Copy_Access_Def;
|
||||
end if;
|
||||
|
||||
Decl_Node :=
|
||||
|
|
@ -10142,15 +10182,8 @@ package body Sem_Ch12 is
|
|||
|
||||
if Present (Subt_Mark) then
|
||||
Def := New_Copy (Subt_Mark);
|
||||
|
||||
else pragma Assert (Present (Acc_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);
|
||||
Def := Copy_Access_Def;
|
||||
end if;
|
||||
|
||||
Decl_Node :=
|
||||
|
|
|
|||
|
|
@ -13887,19 +13887,22 @@ package body Sem_Ch3 is
|
|||
then
|
||||
Collect_Fixed_Components (Typ);
|
||||
|
||||
Gather_Components (
|
||||
Typ,
|
||||
Component_List (Type_Definition (Parent (Parent_Type))),
|
||||
Governed_By => Assoc_List,
|
||||
Into => Comp_List,
|
||||
Report_Errors => Errors);
|
||||
pragma Assert (not Errors);
|
||||
Gather_Components
|
||||
(Typ,
|
||||
Component_List (Type_Definition (Parent (Parent_Type))),
|
||||
Governed_By => Assoc_List,
|
||||
Into => Comp_List,
|
||||
Report_Errors => 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
|
||||
-- new components therein.
|
||||
|
||||
if Present
|
||||
(Record_Extension_Part (Type_Definition (Parent (Typ))))
|
||||
if Present (Record_Extension_Part (Type_Definition (Parent (Typ))))
|
||||
then
|
||||
Old_C := First_Component (Typ);
|
||||
while Present (Old_C) loop
|
||||
|
|
|
|||
|
|
@ -764,6 +764,18 @@ package body Sem_Ch5 is
|
|||
Set_Referenced_Modified (Lhs, Out_Param => False);
|
||||
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
|
||||
-- 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
|
||||
|
|
|
|||
|
|
@ -5999,6 +5999,14 @@ package body Sem_Util is
|
|||
and then Is_Overloadable (Entity (Name (Call)))
|
||||
and then not Is_Overloaded (Name (Call))
|
||||
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
|
||||
|
||||
Actual := First_Actual (Call);
|
||||
|
|
@ -6626,10 +6634,22 @@ package body Sem_Util is
|
|||
Discrim_Value := Expression (Assoc);
|
||||
|
||||
if not Is_OK_Static_Expression (Discrim_Value) then
|
||||
Error_Msg_FE
|
||||
("value for discriminant & must be static!",
|
||||
Discrim_Value, Discrim);
|
||||
Why_Not_Static (Discrim_Value);
|
||||
|
||||
-- If the variant part is governed by a discriminant of the type
|
||||
-- this is an error. If the variant part and the discriminant are
|
||||
-- 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;
|
||||
return;
|
||||
end if;
|
||||
|
|
|
|||
|
|
@ -2457,38 +2457,61 @@ package body Sem_Warn is
|
|||
elsif Check_System_Aux then
|
||||
null;
|
||||
|
||||
-- Else give the warning
|
||||
-- Else the warning may be needed
|
||||
|
||||
else
|
||||
-- Warn if we unreferenced flag set and we have
|
||||
-- not had serious errors. The reason we inhibit
|
||||
-- the message if there are errors is to prevent
|
||||
-- false positives from disabling expansion.
|
||||
declare
|
||||
Eitem : constant Entity_Id :=
|
||||
Entity (Name (Item));
|
||||
|
||||
if not Has_Unreferenced (Entity (Name (Item)))
|
||||
and then Serious_Errors_Detected = 0
|
||||
then
|
||||
Error_Msg_N -- CODEFIX
|
||||
("?u?no entities of & are referenced!",
|
||||
Name (Item));
|
||||
end if;
|
||||
begin
|
||||
-- Warn if we unreferenced flag set and we
|
||||
-- have not had serious errors. The reason we
|
||||
-- inhibit the message if there are errors is
|
||||
-- to prevent false positives from disabling
|
||||
-- expansion.
|
||||
|
||||
-- Look for renamings of this package, and flag
|
||||
-- them as well. If the original package has
|
||||
-- warnings off, we suppress the warning on the
|
||||
-- renaming as well.
|
||||
if not Has_Unreferenced (Eitem)
|
||||
and then Serious_Errors_Detected = 0
|
||||
then
|
||||
-- Get possible package renaming
|
||||
|
||||
Pack := Find_Package_Renaming (Munite, Lunit);
|
||||
Pack :=
|
||||
Find_Package_Renaming (Munite, Lunit);
|
||||
|
||||
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;
|
||||
-- No warning if either the package or its
|
||||
-- renaming is used as a generic actual.
|
||||
|
||||
if Used_As_Generic_Actual (Eitem)
|
||||
or else
|
||||
(Present (Pack)
|
||||
and then
|
||||
Used_As_Generic_Actual (Pack))
|
||||
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;
|
||||
|
||||
exit;
|
||||
|
|
|
|||
|
|
@ -502,7 +502,7 @@ begin
|
|||
Write_Line (" f+ turn on 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 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 off warnings for unrecognized pragma");
|
||||
Write_Line (" .g turn on GNAT warnings");
|
||||
|
|
|
|||
Loading…
Reference in New Issue