In the case of complex generic instantiations, the warning on component
not being present can be spurious (corresponding to dead code for the
given instance), so we disable it.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* sem_util.ads, sem_util.adb
(Apply_Compile_Time_Constraint_Error): New parameter
Emit_Message.
* sem_ch4.adb (Analyze_Selected_Component): Disable warning
within an instance.diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -5471,7 +5471,9 @@ package body Sem_Ch4 is
Apply_Compile_Time_Constraint_Error
(N, "component not present in }??",
CE_Discriminant_Check_Failed,
- Ent => Prefix_Type);
+ Ent => Prefix_Type,
+ Emit_Message =>
+ SPARK_Mode = On or not In_Instance_Not_Visible);
return;
end if;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -1510,13 +1510,14 @@ package body Sem_Util is
-----------------------------------------
procedure Apply_Compile_Time_Constraint_Error
- (N : Node_Id;
- Msg : String;
- Reason : RT_Exception_Code;
- Ent : Entity_Id := Empty;
- Typ : Entity_Id := Empty;
- Loc : Source_Ptr := No_Location;
- Warn : Boolean := False)
+ (N : Node_Id;
+ Msg : String;
+ Reason : RT_Exception_Code;
+ Ent : Entity_Id := Empty;
+ Typ : Entity_Id := Empty;
+ Loc : Source_Ptr := No_Location;
+ Warn : Boolean := False;
+ Emit_Message : Boolean := True)
is
Stat : constant Boolean := Is_Static_Expression (N);
R_Stat : constant Node_Id :=
@@ -1530,8 +1531,10 @@ package body Sem_Util is
Rtyp := Typ;
end if;
- Discard_Node
- (Compile_Time_Constraint_Error (N, Msg, Ent, Loc, Warn => Warn));
+ if Emit_Message then
+ Discard_Node
+ (Compile_Time_Constraint_Error (N, Msg, Ent, Loc, Warn => Warn));
+ end if;
-- Now we replace the node by an N_Raise_Constraint_Error node
-- This does not need reanalyzing, so set it as analyzed now.
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -161,13 +161,14 @@ package Sem_Util is
-- part of the current package.
procedure Apply_Compile_Time_Constraint_Error
- (N : Node_Id;
- Msg : String;
- Reason : RT_Exception_Code;
- Ent : Entity_Id := Empty;
- Typ : Entity_Id := Empty;
- Loc : Source_Ptr := No_Location;
- Warn : Boolean := False);
+ (N : Node_Id;
+ Msg : String;
+ Reason : RT_Exception_Code;
+ Ent : Entity_Id := Empty;
+ Typ : Entity_Id := Empty;
+ Loc : Source_Ptr := No_Location;
+ Warn : Boolean := False;
+ Emit_Message : Boolean := True);
-- N is a subexpression that will raise Constraint_Error when evaluated
-- at run time. Msg is a message that explains the reason for raising the
-- exception. The last character is ? if the message is always a warning,
@@ -189,6 +190,7 @@ package Sem_Util is
-- when the caller wants to parameterize whether an error or warning is
-- given), or when the message should be treated as a warning even when
-- SPARK_Mode is On (which otherwise would force an error).
+ -- If Emit_Message is False, then do not emit any message.
function Async_Readers_Enabled (Id : Entity_Id) return Boolean;
-- Id should be the entity of a state abstraction, an object, or a type.
