diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f89468e1d90..6f31df16ac8 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,22 @@ +2019-08-19 Gary Dismukes + + * 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 * socket.c: Removed the redefinition of getaddrinfo, getnameinfo diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 470ea3f2fb7..03cfcef1a38 100644 --- 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 10f8ffb940e..dcef852d975 100644 --- 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 1d3fcbf71e6..4d738da1de6 100644 --- 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