[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Tue, 2 May 2017 09:00:48 +0000 (11:00 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Tue, 2 May 2017 09:00:48 +0000 (11:00 +0200)
2017-05-02  Justin Squirek  <squirek@adacore.com>

* sem_ch4.adb (Analyze_Case_Expression): Add check for valid
alternative expression.
* sem_res.adb (Resolve_Case_Expression): Ditto.

2017-05-02  Ed Schonberg  <schonberg@adacore.com>

* 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  <squirek@adacore.com>

* 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  <schonberg@adacore.com>

* sem_prag.adb (Process_Conversion): Reject an intrinsic operator
declaration that operates on some fixed point type.

2017-05-02  Justin Squirek  <squirek@adacore.com>

* a-crbtgo.adb, s-taasde.adb: Remove unused use-type clauses.

From-SVN: r247478

12 files changed:
gcc/ada/ChangeLog
gcc/ada/a-crbtgo.adb
gcc/ada/errout.adb
gcc/ada/exp_disp.adb
gcc/ada/opt.ads
gcc/ada/s-taasde.adb
gcc/ada/sem_ch4.adb
gcc/ada/sem_prag.adb
gcc/ada/sem_res.adb
gcc/ada/switch-b.adb
gcc/ada/usage.adb
gcc/ada/warnsw.adb

index f11110e01c0f08b2d29d63e6caf1c23d29d5ff0c..ffa39763488e418437d5968de56cb3a542df18a7 100644 (file)
@@ -1,3 +1,42 @@
+2017-05-02  Justin Squirek  <squirek@adacore.com>
+
+       * sem_ch4.adb (Analyze_Case_Expression): Add check for valid
+       alternative expression.
+       * sem_res.adb (Resolve_Case_Expression): Ditto.
+
+2017-05-02  Ed Schonberg  <schonberg@adacore.com>
+
+       * 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  <squirek@adacore.com>
+
+       * 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  <schonberg@adacore.com>
+
+       * sem_prag.adb (Process_Conversion): Reject an intrinsic operator
+       declaration that operates on some fixed point type.
+
+2017-05-02  Justin Squirek  <squirek@adacore.com>
+
+       * a-crbtgo.adb, s-taasde.adb: Remove unused use-type clauses.
+
 2017-05-02  Hristian Kirtchev  <kirtchev@adacore.com>
 
        * sem_ch6.adb (Analyze_Null_Procedure): Revert previous change.
index 1843b78bf11b443a2a17e18ce4730da6e194f582..53fe273fd96277646f8c15fe6730259c27146dcf 100644 (file)
@@ -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
index c8c9d386601e0438d75e90b4eef52927fcda2d83..3378190cc79e5c14bed2ed372d23bddcb4465911 100644 (file)
@@ -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
index b26aab0af2cc0d858f6ec5b9f316a3cac0bd416e..2b633778835f24175bf6e23f5f65226d819b2c87 100644 (file)
@@ -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
index ee7b555177749dac5f2ede038a89a9e535c5ef26..2140d5e39fba9ea3e95827e017a998bdebeb5019 100644 (file)
@@ -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
index b111f31a7a0434fa5b8d99534eb4636093aaea4a..d7be38473eaff777f850015a35e3c261f972c757 100644 (file)
@@ -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,
index 3952789f762c80c086c7bf552a34066413c1e14b..9de32782dbc47d9a32262dca7a2dfd1ae3b5baa1 100644 (file)
@@ -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
index e19535fed1c0b4925267059be3e15e9b222e3bf4..6aad5d49a54d2dc17a30119ade58d124b07ef3c4 100644 (file)
@@ -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;
 
index ff0a3e85f3a5e22c3f40bda7e0802e253d74af43..cbafcd6582d2350535d3eefc2904c4e8129624aa 100644 (file)
@@ -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;
index 71ee61ad42615020465b97737a1a5452b1dcf82e..1e13f3c6b45f5c929f08bb3b4194adb15285c851 100644 (file)
@@ -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;
 
index 8eb362f63b5f06dfb87cbfa6571adca78ded3d55..5e3ecbd8d80d401b0ecb59d904c0eceec4d152e2 100644 (file)
@@ -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");
index 013ea10d87d3eb6be3912cb9dbff05968f1b9130..5165bf09eb6b9fb6066fae88040cdb4ea479f409 100644 (file)
@@ -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;