From 4ffafd86209ac23e18c3c9e0bf4ac5b3e0d65e0d Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 7 Jan 2015 12:15:30 +0100 Subject: [PATCH] [multiple changes] 2015-01-07 Robert Dewar * 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 * usage.adb (Usage): Correct documentation of -gnatw.f switches. 2015-01-07 Robert Dewar * s-fileio.adb: Minor reformatting. 2015-01-07 Ed Schonberg * 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 * 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 * 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 --- gcc/ada/ChangeLog | 39 +++++++++++++++++++++ gcc/ada/s-fileio.adb | 5 +-- gcc/ada/sem_aggr.adb | 7 ++++ gcc/ada/sem_ch12.adb | 53 ++++++++++++++++++++++------ gcc/ada/sem_ch3.adb | 21 ++++++----- gcc/ada/sem_ch5.adb | 12 +++++++ gcc/ada/sem_util.adb | 28 ++++++++++++--- gcc/ada/sem_warn.adb | 83 ++++++++++++++++++++++++++++---------------- gcc/ada/usage.adb | 2 +- 9 files changed, 194 insertions(+), 56 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5b95b206a8f..5999da11bee 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,42 @@ +2015-01-07 Robert Dewar + + * 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 + + * usage.adb (Usage): Correct documentation of + -gnatw.f switches. + +2015-01-07 Robert Dewar + + * s-fileio.adb: Minor reformatting. + +2015-01-07 Ed Schonberg + + * 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 + + * 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 + + * 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 * usage.adb (Usage): Document -gnatw.f switch. diff --git a/gcc/ada/s-fileio.adb b/gcc/ada/s-fileio.adb index 73838bf8e54..1d8882e3ad8 100644 --- a/gcc/ada/s-fileio.adb +++ b/gcc/ada/s-fileio.adb @@ -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 diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index e0bd5cdca3d..f14381b2cea 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -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; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 311161ed660..b7e9343af32 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -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 := diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 2850afcdd2b..be69b412d13 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -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 diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 5cd60dd7180..5bac8b26f87 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -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 diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 51a67387416..3ba1085dbca 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -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; diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index ec3eb07c577..1d0cfe6d325 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -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. - - 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; - - -- 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. - - 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; + declare + Eitem : constant Entity_Id := + Entity (Name (Item)); + + 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. + + if not Has_Unreferenced (Eitem) + and then Serious_Errors_Detected = 0 + then + -- Get possible package renaming + + Pack := + Find_Package_Renaming (Munite, Lunit); + + -- 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; diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb index 15d8ecbf3be..803c44d7a51 100644 --- a/gcc/ada/usage.adb +++ b/gcc/ada/usage.adb @@ -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"); -- 2.30.2