From 580d40e8da45d4a50edb5d31d7be9b5ddbc38590 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 23 Oct 2014 12:14:28 +0200 Subject: [PATCH] [multiple changes] 2014-10-23 Hristian Kirtchev * exp_util.ads, checks.ads: Minor comment reformatting. 2014-10-23 Javier Miranda * sem_eval (Test_In_Range): Disable removal of range_check for VM targets. 2014-10-23 Robert Dewar * erroutc.adb (Validate_Specific_Warnings): Fix test for -W messages, which got disabled when we unconditionally added an asterisk at the start of the string. 2014-10-23 Vincent Celier * gnatls.adb: Ensure that "gnatls -l" works even when there is no default runtime. 2014-10-23 Eric Botcazou * sem_ch3.adb (Build_Derived_Private_Type): When the parent is untagged and has discriminants, build the implicit full view after building the derived type. Capture original declaration and type here instead of... (Copy_And_Build): ...here. * sem_type.adb (Full_View_Covers): Handle the Underlying_Full_View. From-SVN: r216582 --- gcc/ada/ChangeLog | 29 +++++++++++++++++++++++++++++ gcc/ada/checks.ads | 6 ++++-- gcc/ada/erroutc.adb | 5 +++-- gcc/ada/exp_util.ads | 6 ++++-- gcc/ada/gnatls.adb | 25 ++++++++++++------------- gcc/ada/sem_ch3.adb | 26 +++++++++++++------------- gcc/ada/sem_eval.adb | 7 +++++++ gcc/ada/sem_type.adb | 2 ++ 8 files changed, 74 insertions(+), 32 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 85917acb087..32777f6617e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,32 @@ +2014-10-23 Hristian Kirtchev + + * exp_util.ads, checks.ads: Minor comment reformatting. + +2014-10-23 Javier Miranda + + * sem_eval (Test_In_Range): Disable removal of range_check for + VM targets. + +2014-10-23 Robert Dewar + + * erroutc.adb (Validate_Specific_Warnings): Fix test for -W + messages, which got disabled when we unconditionally added an + asterisk at the start of the string. + +2014-10-23 Vincent Celier + + * gnatls.adb: Ensure that "gnatls -l" works even when there is + no default runtime. + +2014-10-23 Eric Botcazou + + * sem_ch3.adb (Build_Derived_Private_Type): When the parent is + untagged and has discriminants, build the implicit full view after + building the derived type. Capture original declaration and type + here instead of... + (Copy_And_Build): ...here. + * sem_type.adb (Full_View_Covers): Handle the Underlying_Full_View. + 2014-10-23 Hristian Kirtchev * checks.adb (Ensure_Valid): Update the subprogram diff --git a/gcc/ada/checks.ads b/gcc/ada/checks.ads index 15a456b1117..d3e002cf18a 100644 --- a/gcc/ada/checks.ads +++ b/gcc/ada/checks.ads @@ -875,7 +875,8 @@ package Checks is -- Is_Low_Bound and Is_High_Bound specify whether the expression to check -- is the low or the high bound of a range. These three optional arguments -- signal Remove_Side_Effects to create an external symbol of the form - -- Chars (Related_Id)_FIRST/_LAST. + -- Chars (Related_Id)_FIRST/_LAST. For suggested use of these parameters + -- see the warning in the body of Sem_Ch3.Process_Range_Expr_In_Decl. function Expr_Known_Valid (Expr : Node_Id) return Boolean; -- This function tests it the value of Expr is known to be valid in the @@ -900,7 +901,8 @@ package Checks is -- Is_Low_Bound and Is_High_Bound specify whether the expression to check -- is the low or the high bound of a range. These three optional arguments -- signal Remove_Side_Effects to create an external symbol of the form - -- Chars (Related_Id)_FIRST/_LAST. + -- Chars (Related_Id)_FIRST/_LAST. For suggested use of these parameters + -- see the warning in the body of Sem_Ch3.Process_Range_Expr_In_Decl. procedure Null_Exclusion_Static_Checks (N : Node_Id); -- Ada 2005 (AI-231): Check bad usages of the null-exclusion issue diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb index 11eef8a9593..f4f1dfd1c8d 100644 --- a/gcc/ada/erroutc.adb +++ b/gcc/ada/erroutc.adb @@ -1537,10 +1537,11 @@ package body Erroutc is elsif not SWE.Used -- Do not issue this warning for -Wxxx messages since the - -- back-end doesn't report the information. + -- back-end doesn't report the information. Note that there + -- is always an asterisk at the start of every message. and then not - (SWE.Msg'Length > 2 and then SWE.Msg (1 .. 2) = "-W") + (SWE.Msg'Length > 3 and then SWE.Msg (2 .. 3) = "-W") then Eproc.all ("?W?no warning suppressed by this pragma", SWE.Start); diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index ef319fd56c4..770b23c2c03 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -388,7 +388,8 @@ package Exp_Util is -- Is_Low_Bound and Is_High_Bound specify whether the expression to check -- is the low or the high bound of a range. These three optional arguments -- signal Remove_Side_Effects to create an external symbol of the form - -- Chars (Related_Id)_FIRST/_LAST. + -- Chars (Related_Id)_FIRST/_LAST. For suggested use of these parameters + -- see the warning in the body of Sem_Ch3.Process_Range_Expr_In_Decl. function Duplicate_Subexpr_Move_Checks (Exp : Node_Id; @@ -858,7 +859,8 @@ package Exp_Util is -- is the low or the high bound of a range. These three optional arguments -- signal Remove_Side_Effects to create an external symbol of the form -- Chars (Related_Id)_FIRST/_LAST. If Related_Id is set, the exactly one - -- of the Is_xxx_Bound flags must be set. + -- of the Is_xxx_Bound flags must be set. For use of these parameters see + -- the warning in the body of Sem_Ch3.Process_Range_Expr_In_Decl. function Represented_As_Scalar (T : Entity_Id) return Boolean; -- Returns True iff the implementation of this type in code generation diff --git a/gcc/ada/gnatls.adb b/gcc/ada/gnatls.adb index 3db4d617be9..05ff3aee886 100644 --- a/gcc/ada/gnatls.adb +++ b/gcc/ada/gnatls.adb @@ -1595,12 +1595,18 @@ begin -- If -l (output license information) is given, it must be the only switch - if License and then Arg_Count /= 2 then - Set_Standard_Error; - Write_Str ("Can't use -l with another switch"); - Write_Eol; - Try_Help; - Exit_Program (E_Fatal); + if License then + if Arg_Count = 2 then + Output_License_Information; + Exit_Program (E_Success); + + else + Set_Standard_Error; + Write_Str ("Can't use -l with another switch"); + Write_Eol; + Try_Help; + Exit_Program (E_Fatal); + end if; end if; -- Handle --RTS switch @@ -1739,13 +1745,6 @@ begin Usage; end if; - -- Output license information when requested - - if License then - Output_License_Information; - Exit_Program (E_Success); - end if; - if not More_Lib_Files then if not Print_Usage and then not Verbose_Mode then if Argument_Count = 0 then diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 2f0f194e71b..aab006c478e 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -6671,7 +6671,8 @@ package body Sem_Ch3 is Loc : constant Source_Ptr := Sloc (N); Par_Base : constant Entity_Id := Base_Type (Parent_Type); Par_Scope : constant Entity_Id := Scope (Par_Base); - Full_Der : Entity_Id := Empty; + Full_N : constant Node_Id := New_Copy_Tree (N); + Full_Der : Entity_Id := New_Copy (Derived_Type); Full_P : Entity_Id; procedure Build_Full_Derivation; @@ -6718,7 +6719,6 @@ package body Sem_Ch3 is -------------------- procedure Copy_And_Build is - Full_N : Node_Id; Full_Parent : Entity_Id := Parent_Type; begin @@ -6755,8 +6755,6 @@ package body Sem_Ch3 is -- is originally a private declaration. Indicate that full view -- is internally generated. - Full_N := New_Copy_Tree (N); - Full_Der := New_Copy (Derived_Type); Set_Comes_From_Source (Full_N, False); Set_Comes_From_Source (Full_Der, False); Set_Parent (Full_Der, Full_N); @@ -6944,6 +6942,15 @@ package body Sem_Ch3 is return; elsif Has_Discriminants (Parent_Type) then + -- Build partial view of derived type from partial view of parent. + -- This must be done before building the full derivation because the + -- second derivation will modify the discriminants of the first and + -- the discriminants are chained with the rest of the components in + -- the full derivation. + + Build_Derived_Record_Type + (N, Parent_Type, Derived_Type, Derive_Subps); + -- Build the full derivation if this is not the anonymous derived -- base type created by Build_Derived_Record_Type in the constrained -- case (see point 5. of its head comment) since we build it for the @@ -6954,15 +6961,6 @@ package body Sem_Ch3 is and then not Is_Itype (Derived_Type) and then not (Ekind (Full_View (Parent_Type)) in Protected_Kind) then - Build_Full_Derivation; - end if; - - -- Build partial view of derived type from partial view of parent - - Build_Derived_Record_Type - (N, Parent_Type, Derived_Type, Derive_Subps); - - if Present (Full_Der) then declare Der_Base : constant Entity_Id := Base_Type (Derived_Type); Discr : Entity_Id; @@ -6975,6 +6973,8 @@ package body Sem_Ch3 is -- being built is a full view and the full derivation can -- only be its underlying full view. + Build_Full_Derivation; + if not Is_Completion then Set_Full_View (Derived_Type, Full_Der); else diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index e49c51c8671..43db1c74cf1 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -52,6 +52,7 @@ with Sinfo; use Sinfo; with Snames; use Snames; with Stand; use Stand; with Stringt; use Stringt; +with Targparm; use Targparm; with Tbuild; use Tbuild; package body Sem_Eval is @@ -6197,6 +6198,12 @@ package body Sem_Eval is and then Is_Known_Valid (Typ) and then Esize (Etype (N)) <= Esize (Typ) and then not Has_Biased_Representation (Etype (N)) + + -- This check cannot be disabled under VM targets because in some + -- unusual cases the backend of the native compiler raises a run-time + -- exception but the virtual machines do not raise any exception. + + and then VM_Target = No_VM then return In_Range; diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index be2b4c19daf..4f83aaed403 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -766,6 +766,8 @@ package body Sem_Type is and then ((Present (Full_View (Typ1)) and then Covers (Full_View (Typ1), Typ2)) + or else (Present (Underlying_Full_View (Typ1)) + and then Covers (Underlying_Full_View (Typ1), Typ2)) or else Base_Type (Typ1) = Typ2 or else Base_Type (Typ2) = Typ1); end Full_View_Covers; -- 2.30.2