[Ada] Improve warnings about "too few elements" and "too many elements"

When warning about length-check failures detected at compile time that
are flagged with "too few elements" or "too many elements", the compiler
now gives an additional message indicating the number of elements
expected by the context versus how many are present in the conflicting
expression (such as an aggregate that has too few or too many
components).

The test below reports the following warnings when compiled with this command:

$ gcc -c -gnatj78 length_warnings.adb

length_warnings.adb:6:09: warning: too few elements for subtype of
                          "Boolean_Array" defined at line 5, expected 10
                          elements; found 9 elements, "Constraint_Error" will
                          be raised at run time
length_warnings.adb:10:09: warning: too few elements for subtype of
                           "Boolean_Array" defined at line 9, expected 2
                           elements; found 1 element, "Constraint_Error" will
                           be raised at run time
length_warnings.adb:14:09: warning: too many elements for subtype of
                           "Boolean_Array" defined at line 13, expected 10
                           elements; found 11 elements, "Constraint_Error"
                           will be raised at run time
length_warnings.adb:18:09: warning: too many elements for subtype of
                           "Boolean_Array" defined at line 17, expected 0
                           elements; found 1 element, "Constraint_Error" will
                           be raised at run time
length_warnings.adb:22:09: warning: too many elements for subtype of
                           "Boolean_Array" defined at line 21, expected 1
                           element; found 2 elements, "Constraint_Error" will
                           be raised at run time

procedure Length_Check_Warnings is

   type Boolean_Array is array (Natural range <>) of Boolean;

   Bits_A : Boolean_Array (1 .. 10)
     := (True, True, True, True, True, True, True, True, True);
   -- Too few elements

   Bits_B : Boolean_Array (1 .. 2)
     := (1 => False);
   -- Too few elements

   Bits_C : Boolean_Array (1 .. 10)
     := (True, True, True, True, True, True, True, True, True, True, True);
   -- Too many elements

   Bits_D : Boolean_Array (1 .. 0)
     := (1 => True);
   -- Too many elements

   Bits_E : Boolean_Array (1 .. 1)
     := (True, False);
   -- Too many elements

begin
   null;
end Length_Check_Warnings;

2019-08-19  Gary Dismukes  <dismukes@adacore.com>

gcc/ada/

	* checks.adb (Length_Mismatch_Info_Message): New function in
	Selected_Length_Checks to return a message indicating the
	element counts for the mismatched lengths for a failed
	compile-time length check.
	(Plural_Or_Singular_Ending): Support function in
	Length_Mismatch_Info_Message to return either "" or "s", for
	concatenating to the end of words.
	(Selected_Length_Checks): Pass the result of
	Length_Mismatch_Info_Message as an extra warning message to
	Compile_Time_Constraint_Error to indicate the mismatched lengths
	for a failed compile-time length check.
	* sem_util.ads (Compile_Time_Constraint_Error): Add an optional
	message formal (Extra_Msg), defaulted to the empty string.
	* sem_util.adb (Compile_Time_Constraint_Error): Output an extra
	message following the main warning message (when Extra_Msg is
	not the empty string).

From-SVN: r274652

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index f89468e1d90613101061da4e5c52f0dd970a2245..6f31df16ac8b7705e0607486e5388eafbe75b5cc 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,22 @@
+2019-08-19  Gary Dismukes  <dismukes@adacore.com>
+
+       * checks.adb (Length_Mismatch_Info_Message): New function in
+       Selected_Length_Checks to return a message indicating the
+       element counts for the mismatched lengths for a failed
+       compile-time length check.
+       (Plural_Or_Singular_Ending): Support function in
+       Length_Mismatch_Info_Message to return either "" or "s", for
+       concatenating to the end of words.
+       (Selected_Length_Checks): Pass the result of
+       Length_Mismatch_Info_Message as an extra warning message to
+       Compile_Time_Constraint_Error to indicate the mismatched lengths
+       for a failed compile-time length check.
+       * sem_util.ads (Compile_Time_Constraint_Error): Add an optional
+       message formal (Extra_Msg), defaulted to the empty string.
+       * sem_util.adb (Compile_Time_Constraint_Error): Output an extra
+       message following the main warning message (when Extra_Msg is
+       not the empty string).
+
 2019-08-19  Patrick Bernardi  <bernardi@adacore.com>
 
        * socket.c: Removed the redefinition of getaddrinfo, getnameinfo

diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 470ea3f2fb7eaa6990ba57a1661c67e48f67cd49..03cfcef1a3880109f9e3a9c89435ea952182ac5e 100644 (file)
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -9542,6 +9542,12 @@ package body Checks is
       --  Returns expression to compute:
       --    Typ'Length /= Expr'Length
 
+      function Length_Mismatch_Info_Message
+        (Left_Element_Count  : Uint;
+         Right_Element_Count : Uint) return String;
+      --  Returns a message indicating how many elements were expected
+      --  (Left_Element_Count) and how many were found (Right_Element_Count).
+
       ---------------
       -- Add_Check --
       ---------------
@@ -9729,6 +9735,36 @@ package body Checks is
              Right_Opnd => Get_N_Length (Expr, Indx));
       end Length_N_Cond;
 
+      ----------------------------------
+      -- Length_Mismatch_Info_Message --
+      ----------------------------------
+
+      function Length_Mismatch_Info_Message
+        (Left_Element_Count  : Uint;
+         Right_Element_Count : Uint) return String
+      is
+
+         function Plural_Vs_Singular_Ending (Count : Uint) return String;
+         --  Returns an empty string if Count is 1; otherwise returns "s"
+
+         function Plural_Vs_Singular_Ending (Count : Uint) return String is
+         begin
+            if Count = 1 then
+               return "";
+            else
+               return "s";
+            end if;
+         end Plural_Vs_Singular_Ending;
+
+      begin
+         return "expected " & UI_Image (Left_Element_Count)
+                  & " element"
+                  & Plural_Vs_Singular_Ending (Left_Element_Count)
+                  & "; found " & UI_Image (Right_Element_Count)
+                  & " element"
+                  & Plural_Vs_Singular_Ending (Right_Element_Count);
+      end Length_Mismatch_Info_Message;
+
       -----------------
       -- Same_Bounds --
       -----------------
@@ -9923,12 +9959,16 @@ package body Checks is
                            if L_Length > R_Length then
                               Add_Check
                                 (Compile_Time_Constraint_Error
-                                  (Wnode, "too few elements for}??", T_Typ));
+                                  (Wnode, "too few elements for}??", T_Typ,
+                                   Extra_Msg => Length_Mismatch_Info_Message
+                                                  (L_Length, R_Length)));
 
                            elsif L_Length < R_Length then
                               Add_Check
                                 (Compile_Time_Constraint_Error
-                                  (Wnode, "too many elements for}??", T_Typ));
+                                  (Wnode, "too many elements for}??", T_Typ,
+                                   Extra_Msg => Length_Mismatch_Info_Message
+                                                  (L_Length, R_Length)));
                            end if;
 
                         --  The comparison for an individual index subtype

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 10f8ffb940e822198ab430f43b314526f8fcbf8f..dcef852d975e427259284d2c1905f22f7fa04a29 100644 (file)
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -5358,11 +5358,12 @@ package body Sem_Util is
    -----------------------------------
 
    function Compile_Time_Constraint_Error
-     (N    : Node_Id;
-      Msg  : String;
-      Ent  : Entity_Id  := Empty;
-      Loc  : Source_Ptr := No_Location;
-      Warn : Boolean    := False) return Node_Id
+     (N         : Node_Id;
+      Msg       : String;
+      Ent       : Entity_Id  := Empty;
+      Loc       : Source_Ptr := No_Location;
+      Warn      : Boolean    := False;
+      Extra_Msg : String     := "") return Node_Id
    is
       Msgc : String (1 .. Msg'Length + 3);
       --  Copy of message, with room for possible ?? or << and ! at end
@@ -5456,6 +5457,12 @@ package body Sem_Util is
                Error_Msg_NEL (Msgc (1 .. Msgl), N, Etype (N), Eloc);
             end if;
 
+            --  Emit any extra message as a continuation
+
+            if Extra_Msg /= "" then
+               Error_Msg_N ('\' & Extra_Msg, N);
+            end if;
+
             if Wmsg then
 
                --  Check whether the context is an Init_Proc

diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 1d3fcbf71e6f84cdbf781d88c28d2308c00dde1f..4d738da1de6d8bd26d310a0781a8d7a30f8f1a07 100644 (file)
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -465,16 +465,20 @@ package Sem_Util is
    --  the type itself.
 
    function Compile_Time_Constraint_Error
-     (N    : Node_Id;
-      Msg  : String;
-      Ent  : Entity_Id  := Empty;
-      Loc  : Source_Ptr := No_Location;
-      Warn : Boolean    := False) return Node_Id;
+     (N         : Node_Id;
+      Msg       : String;
+      Ent       : Entity_Id  := Empty;
+      Loc       : Source_Ptr := No_Location;
+      Warn      : Boolean    := False;
+      Extra_Msg : String     := "") return Node_Id;
    --  This is similar to Apply_Compile_Time_Constraint_Error in that it
    --  generates a warning (or error) message in the same manner, but it does
    --  not replace any nodes. For convenience, the function always returns its
    --  first argument. The message is a warning if the message ends with ?, or
    --  we are operating in Ada 83 mode, or the Warn parameter is set to True.
+   --  If Extra_Msg is not a null string, then it's associated with N and
+   --  emitted immediately after the main message (and before output of any
+   --  message indicating that Constraint_Error will be raised).
 
    procedure Conditional_Delay (New_Ent, Old_Ent : Entity_Id);
    --  Sets the Has_Delayed_Freeze flag of New_Ent if the Delayed_Freeze flag