From b55993b3534aaa8ddc062e1b7373b21eb57f6c2c Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 2 May 2017 11:00:48 +0200 Subject: [PATCH] [multiple changes] 2017-05-02 Justin Squirek * sem_ch4.adb (Analyze_Case_Expression): Add check for valid alternative expression. * sem_res.adb (Resolve_Case_Expression): Ditto. 2017-05-02 Ed Schonberg * exp_disp.adb (Set_All_DT_Position, In_Predef_Prim_DT): Refine predicate for the case where the primitive operation is a renaming of equality. An overriding operation that is a user-defined renaming of predefined equality inherits its slot from the overridden operation. Otherwise it is treated as a predefined op and occupies the same predefined slot as equality. A call to it is transformed into a call to its alias, which is the predefined equality. A dispatching call thus uses the proper slot if operation is further inherited and called with class-wide arguments. 2017-05-02 Justin Squirek * errout.adb (Set_Msg_Text): Add a case to switch the message type when the character '[' is detected signifying a warning about a run-time exception. * opt.ads Add a new Warning_Mode value for new switch * switch-b.adb (Scan_Binder_Switches): Add case for the binder to handle new warning mode * usage.adb (Usage): Add usage entry for -gnatwE * warnsw.adb (Set_Warning_Switch): Add case for the new switch 2017-05-02 Ed Schonberg * sem_prag.adb (Process_Conversion): Reject an intrinsic operator declaration that operates on some fixed point type. 2017-05-02 Justin Squirek * a-crbtgo.adb, s-taasde.adb: Remove unused use-type clauses. From-SVN: r247478 --- gcc/ada/ChangeLog | 39 +++++++++++++++++++++++++++++++++++++++ gcc/ada/a-crbtgo.adb | 6 +++--- gcc/ada/errout.adb | 11 +++++++++++ gcc/ada/exp_disp.adb | 25 +++++++++++-------------- gcc/ada/opt.ads | 13 ++++++++----- gcc/ada/s-taasde.adb | 5 +---- gcc/ada/sem_ch4.adb | 10 ++++++++-- gcc/ada/sem_prag.adb | 16 ++++++++++++++++ gcc/ada/sem_res.adb | 11 ++++++++--- gcc/ada/switch-b.adb | 5 ++++- gcc/ada/usage.adb | 1 + gcc/ada/warnsw.adb | 3 +++ 12 files changed, 113 insertions(+), 32 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f11110e01c0..ffa39763488 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,42 @@ +2017-05-02 Justin Squirek + + * sem_ch4.adb (Analyze_Case_Expression): Add check for valid + alternative expression. + * sem_res.adb (Resolve_Case_Expression): Ditto. + +2017-05-02 Ed Schonberg + + * exp_disp.adb (Set_All_DT_Position, In_Predef_Prim_DT): + Refine predicate for the case where the primitive operation + is a renaming of equality. An overriding operation that is + a user-defined renaming of predefined equality inherits its + slot from the overridden operation. Otherwise it is treated + as a predefined op and occupies the same predefined slot as + equality. A call to it is transformed into a call to its alias, + which is the predefined equality. A dispatching call thus uses + the proper slot if operation is further inherited and called + with class-wide arguments. + +2017-05-02 Justin Squirek + + * errout.adb (Set_Msg_Text): Add a case to switch the message + type when the character '[' is detected signifying a warning + about a run-time exception. + * opt.ads Add a new Warning_Mode value for new switch + * switch-b.adb (Scan_Binder_Switches): Add case for the binder + to handle new warning mode + * usage.adb (Usage): Add usage entry for -gnatwE + * warnsw.adb (Set_Warning_Switch): Add case for the new switch + +2017-05-02 Ed Schonberg + + * sem_prag.adb (Process_Conversion): Reject an intrinsic operator + declaration that operates on some fixed point type. + +2017-05-02 Justin Squirek + + * a-crbtgo.adb, s-taasde.adb: Remove unused use-type clauses. + 2017-05-02 Hristian Kirtchev * sem_ch6.adb (Analyze_Null_Procedure): Revert previous change. diff --git a/gcc/ada/a-crbtgo.adb b/gcc/ada/a-crbtgo.adb index 1843b78bf11..53fe273fd96 100644 --- a/gcc/ada/a-crbtgo.adb +++ b/gcc/ada/a-crbtgo.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2017, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -510,9 +510,9 @@ package body Ada.Containers.Red_Black_Trees.Generic_Operations is -------------------- procedure Generic_Adjust (Tree : in out Tree_Type) is - N : constant Count_Type := Tree.Length; + N : constant Count_Type := Tree.Length; Root : constant Node_Access := Tree.Root; - use type Helpers.Tamper_Counts; + begin -- If the counts are nonzero, execution is technically erroneous, but -- it seems friendly to allow things like concurrent "=" on shared diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index c8c9d386601..3378190cc79 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -3097,6 +3097,17 @@ package body Errout is -- '[' (will be/would have been raised at run time) when '[' => + + -- Switch the message from a warning to an error if the flag + -- -gnatwE is specified to treat run-time exception warnings + -- as errors. + + if Is_Warning_Msg + and then Warning_Mode = Treat_Run_Time_As_Error + then + Is_Warning_Msg := False; + end if; + if Is_Warning_Msg then Set_Msg_Str ("will be raised at run time"); else diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index b26aab0af2c..2b633778835 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -7430,8 +7430,6 @@ package body Exp_Disp is ------------------------ function In_Predef_Prims_DT (Prim : Entity_Id) return Boolean is - E : Entity_Id; - begin -- Predefined primitives @@ -7446,20 +7444,19 @@ package body Exp_Disp is if Chars (Ultimate_Alias (Prim)) /= Name_Op_Eq then return True; - -- User-defined renamings of predefined equality have their own - -- slot in the primary dispatch table + -- An overriding operation that is a user-defined renaming of + -- predefined equality inherits its slot from the overridden + -- operation. Otherwise it is treated as a predefined op and + -- occupies the same predefined slot as equality. A call to it is + -- transformed into a call to its alias, which is the predefined + -- equality op. A dispatching call thus uses the proper slot if + -- operation is further inherited and called with class-wide + -- arguments. else - E := Prim; - while Present (Alias (E)) loop - if Comes_From_Source (E) then - return False; - end if; - - E := Alias (E); - end loop; - - return not Comes_From_Source (E); + return + not Comes_From_Source (Prim) + or else No (Overridden_Operation (Prim)); end if; -- User-defined primitives diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index ee7b5551777..2140d5e39fb 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -1860,16 +1860,19 @@ package Opt is -- or where no warning has been suppressed by the use of the pragma. -- Modified by use of -gnatw.w/.W. - type Warning_Mode_Type is (Suppress, Normal, Treat_As_Error); + type Warning_Mode_Type is + (Suppress, Normal, Treat_As_Error, Treat_Run_Time_As_Error); Warning_Mode : Warning_Mode_Type := Normal; -- GNAT, GNATBIND -- Controls treatment of warning messages. If set to Suppress, warning -- messages are not generated at all. In Normal mode, they are generated -- but do not count as errors. In Treat_As_Error mode, warning messages are - -- generated and are treated as errors. Note that Warning_Mode = Suppress - -- causes pragma Warnings to be ignored (except for legality checks), - -- unless we are in GNATprove_Mode, which requires pragma Warnings to - -- be stored for the formal verification backend. + -- generated and are treated as errors. In Treat_Run_Time_As_Error, warning + -- messages regarding errors raised at run time are treated as errors. Note + -- that Warning_Mode = Suppress causes pragma Warnings to be ignored + -- (except for legality checks), unless we are in GNATprove_Mode, which + -- requires pragma Warnings to be stored for the formal verification + -- backend. Warnings_As_Errors_Count : Natural; -- GNAT diff --git a/gcc/ada/s-taasde.adb b/gcc/ada/s-taasde.adb index b111f31a7a0..d7be38473ea 100644 --- a/gcc/ada/s-taasde.adb +++ b/gcc/ada/s-taasde.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1998-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2017, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -203,9 +203,6 @@ package body System.Tasking.Async_Delays is Self_Id : constant Task_Id := STPO.Self; Q : Delay_Block_Access; - use type ST.Task_Id; - -- for visibility of operator "=" - begin pragma Debug (Debug.Trace (Self_Id, "Async_Delay", 'P')); pragma Assert (Self_Id.Deferral_Level = 1, diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 3952789f762..9de32782dbc 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -1548,6 +1548,10 @@ package body Sem_Ch4 is Alt := First (Alternatives (N)); while Present (Alt) loop + if Error_Posted (Expression (Alt)) then + return; + end if; + Analyze (Expression (Alt)); if No (FirstX) and then Etype (Expression (Alt)) /= Any_Type then @@ -2120,8 +2124,8 @@ package body Sem_Ch4 is New_N := Make_Function_Call (Loc, - Name => Make_Explicit_Dereference (Loc, P), - Parameter_Associations => New_List); + Name => Make_Explicit_Dereference (Loc, P), + Parameter_Associations => New_List); -- If the prefix is overloaded, remove operations that have formals, -- we know that this is a parameterless call. @@ -2226,12 +2230,14 @@ package body Sem_Ch4 is Check_Error_Detected; return; end if; + Then_Expr := Next (Condition); if No (Then_Expr) then Check_Error_Detected; return; end if; + Else_Expr := Next (Then_Expr); if Comes_From_Source (N) then diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index e19535fed1c..6aad5d49a54 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -7732,6 +7732,22 @@ package body Sem_Prag is -- given entity, not its homonyms. if From_Aspect_Specification (N) then + if C = Convention_Intrinsic + and then Nkind (Ent) = N_Defining_Operator_Symbol + then + if Is_Fixed_Point_Type (Etype (Ent)) + or else Is_Fixed_Point_Type (Etype (First_Entity (Ent))) + or else Is_Fixed_Point_Type (Etype (Last_Entity (Ent))) + then + Error_Msg_N + ("no intrinsic operator available for this fixed-point " + & "operation", N); + Error_Msg_N + ("\use expression functions with the desired " + & "conversions made explicit", N); + end if; + end if; + return; end if; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index ff0a3e85f3a..cbafcd6582d 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -6712,6 +6712,11 @@ package body Sem_Res is Alt := First (Alternatives (N)); while Present (Alt) loop Alt_Expr := Expression (Alt); + + if Error_Posted (Alt_Expr) then + return; + end if; + Resolve (Alt_Expr, Typ); Alt_Typ := Etype (Alt_Expr); @@ -8252,11 +8257,13 @@ package body Sem_Res is if No (Condition) then return; end if; + Then_Expr := Next (Condition); if No (Then_Expr) then return; end if; + Else_Expr := Next (Then_Expr); Resolve (Condition, Any_Boolean); @@ -8268,9 +8275,7 @@ package body Sem_Res is -- a constraint check. The same is done for the else part below, again -- comparing subtypes rather than base types. - if Is_Scalar_Type (Then_Typ) - and then Then_Typ /= Typ - then + if Is_Scalar_Type (Then_Typ) and then Then_Typ /= Typ then Rewrite (Then_Expr, Convert_To (Typ, Then_Expr)); Analyze_And_Resolve (Then_Expr, Typ); end if; diff --git a/gcc/ada/switch-b.adb b/gcc/ada/switch-b.adb index 71ee61ad426..1e13f3c6b45 100644 --- a/gcc/ada/switch-b.adb +++ b/gcc/ada/switch-b.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2017, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -490,6 +490,9 @@ package body Switch.B is when 'e' => Warning_Mode := Treat_As_Error; + when 'E' => + Warning_Mode := Treat_Run_Time_As_Error; + when 's' => Warning_Mode := Suppress; diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb index 8eb362f63b5..5e3ecbd8d80 100644 --- a/gcc/ada/usage.adb +++ b/gcc/ada/usage.adb @@ -488,6 +488,7 @@ begin Write_Line (" e treat all warnings (but not info) as errors"); Write_Line (" .e turn on every optional info/warning " & "(no exceptions)"); + Write_Line (" E treat all run time warnings as errors"); 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"); diff --git a/gcc/ada/warnsw.adb b/gcc/ada/warnsw.adb index 013ea10d87d..5165bf09eb6 100644 --- a/gcc/ada/warnsw.adb +++ b/gcc/ada/warnsw.adb @@ -532,6 +532,9 @@ package body Warnsw is when 'e' => Warning_Mode := Treat_As_Error; + when 'E' => + Warning_Mode := Treat_Run_Time_As_Error; + when 'f' => Check_Unreferenced_Formals := True; -- 2.30.2