+2013-04-25 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_ch4.adb (Analyze_Quantified_Expression):
+ Add local variable Loop_Id. Verify that the loop variable
+ is used within the condition of the quantified expression.
+ (Referenced): New routine.
+
+2013-04-25 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_case.adb (Analyze_Choices): Enhance the error message
+ given on a bad use of subtype predicate.
+ * sem_ch5.adb (Analyze_Loop_Parameter_Specification): Enhance
+ the error message given on a bad use of subtype predicate.
+ * sem_util.adb (Bad_Predicated_Subtype_Use): Add formal parameter
+ Suggest_Static. Emit an extra error message advising how to
+ remedy the bad use of the predicate if the context warrants it.
+ * sem_util.ads (Bad_Predicated_Subtype_Use): Add formal parameter
+ Suggest_Static along with a comment explaining its usage.
+
+2013-04-25 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_disp.adb (Check_Dispatching_Operation): Further refinement
+ to checks for AI05-0125: the check for a hidden primitive that
+ may be overridden by the new declaration only applies if the
+ hidden operation is never declared. This is not the case if the
+ operation is declared in a parent unit.
+
2013-04-25 Robert Dewar <dewar@adacore.com>
* debug.adb: Remove d.X and d.Y entries and documentation.
then
Bad_Predicated_Subtype_Use
("cannot use subtype& with non-static "
- & "predicate as case alternative", Choice, E);
+ & "predicate as case alternative", Choice, E,
+ Suggest_Static => True);
-- Static predicate case
-- Determine whether if expression If_Expr lacks an else part or if it
-- has one, it evaluates to True.
+ function Referenced (Id : Entity_Id; Expr : Node_Id) return Boolean;
+ -- Determine whether entity Id is referenced within expression Expr
+
--------------------
-- Is_Empty_Range --
--------------------
and then Is_True (Expr_Value (Else_Expr)));
end No_Else_Or_Trivial_True;
+ ----------------
+ -- Referenced --
+ ----------------
+
+ function Referenced (Id : Entity_Id; Expr : Node_Id) return Boolean is
+ Seen : Boolean := False;
+
+ function Is_Reference (N : Node_Id) return Traverse_Result;
+ -- Determine whether node N denotes a reference to Id. If this is the
+ -- case, set global flag Seen to True and stop the traversal.
+
+ function Is_Reference (N : Node_Id) return Traverse_Result is
+ begin
+ if Is_Entity_Name (N)
+ and then Present (Entity (N))
+ and then Entity (N) = Id
+ then
+ Seen := True;
+ return Abandon;
+ else
+ return OK;
+ end if;
+ end Is_Reference;
+
+ procedure Inspect_Expression is new Traverse_Proc (Is_Reference);
+
+ -- Start of processing for Referenced
+
+ begin
+ Inspect_Expression (Expr);
+
+ return Seen;
+ end Referenced;
+
-- Local variables
Cond : constant Node_Id := Condition (N);
+ Loop_Id : Entity_Id;
QE_Scop : Entity_Id;
-- Start of processing for Analyze_Quantified_Expression
if Present (Iterator_Specification (N)) then
Preanalyze (Iterator_Specification (N));
+ -- Do not proceed with the analysis when the range of iteration is
+ -- empty. The appropriate error is issued by Is_Empty_Range.
+
if Is_Entity_Name (Name (Iterator_Specification (N)))
and then Is_Empty_Range (Etype (Name (Iterator_Specification (N))))
then
return;
end if;
- else
+ else pragma Assert (Present (Loop_Parameter_Specification (N)));
Preanalyze (Loop_Parameter_Specification (N));
end if;
Preanalyze_And_Resolve (Cond, Standard_Boolean);
End_Scope;
-
Set_Etype (N, Standard_Boolean);
+ -- Verify that the loop variable is used within the condition of the
+ -- quantified expression.
+
+ if Present (Iterator_Specification (N)) then
+ Loop_Id := Defining_Identifier (Iterator_Specification (N));
+ else
+ Loop_Id := Defining_Identifier (Loop_Parameter_Specification (N));
+ end if;
+
+ if Warn_On_Suspicious_Contract
+ and then not Referenced (Loop_Id, Cond)
+ then
+ Error_Msg_N ("?T?unused variable &", Loop_Id);
+ end if;
+
-- Diagnose a possible misuse of the "some" existential quantifier. When
-- we have a quantified expression of the form
--
then
Bad_Predicated_Subtype_Use
("cannot use subtype& with non-static predicate for loop " &
- "iteration", DS, Entity (DS));
+ "iteration", DS, Entity (DS), Suggest_Static => True);
end if;
end if;
with Sem_Aux; use Sem_Aux;
with Sem_Ch3; use Sem_Ch3;
with Sem_Ch6; use Sem_Ch6;
+with Sem_Ch8; use Sem_Ch8;
with Sem_Eval; use Sem_Eval;
with Sem_Type; use Sem_Type;
with Sem_Util; use Sem_Util;
Vis_List : Elist_Id;
begin
- -- This Ada 2012 rule is valid only for type extensions or private
- -- extensions.
+ -- This Ada 2012 rule applies only for type extensions or private
+ -- extensions, where the parent type is not in a parent unit, and
+ -- where an operation is never declared but still inherited.
if No (Tag_Typ)
or else not Is_Record_Type (Tag_Typ)
or else Etype (Tag_Typ) = Tag_Typ
+ or else In_Open_Scopes (Scope (Etype (Tag_Typ)))
then
return Empty;
end if;
--------------------------------
procedure Bad_Predicated_Subtype_Use
- (Msg : String;
- N : Node_Id;
- Typ : Entity_Id)
+ (Msg : String;
+ N : Node_Id;
+ Typ : Entity_Id;
+ Suggest_Static : Boolean := False)
is
begin
if Has_Predicates (Typ) then
else
Error_Msg_FE (Msg, N, Typ);
end if;
+
+ -- Emit an optional suggestion on how to remedy the error if the
+ -- context warrants it.
+
+ if Suggest_Static and then Present (Static_Predicate (Typ)) then
+ Error_Msg_FE ("\predicate of & should be marked static", N, Typ);
+ end if;
end if;
end Bad_Predicated_Subtype_Use;
-- is an error.
procedure Bad_Predicated_Subtype_Use
- (Msg : String;
- N : Node_Id;
- Typ : Entity_Id);
+ (Msg : String;
+ N : Node_Id;
+ Typ : Entity_Id;
+ Suggest_Static : Boolean := False);
-- This is called when Typ, a predicated subtype, is used in a context
- -- which does not allow the use of a predicated subtype. Msg is passed
- -- to Error_Msg_FE to output an appropriate message using N as the
- -- location, and Typ as the entity. The caller must set up any insertions
- -- other than the & for the type itself. Note that if Typ is a generic
- -- actual type, then the message will be output as a warning, and a
- -- raise Program_Error is inserted using Insert_Action with node N as
- -- the insertion point. Node N also supplies the source location for
- -- construction of the raise node. If Typ is NOT a type with predicates
- -- this call has no effect.
+ -- which does not allow the use of a predicated subtype. Msg is passed to
+ -- Error_Msg_FE to output an appropriate message using N as the location,
+ -- and Typ as the entity. The caller must set up any insertions other than
+ -- the & for the type itself. Note that if Typ is a generic actual type,
+ -- then the message will be output as a warning, and a raise Program_Error
+ -- is inserted using Insert_Action with node N as the insertion point. Node
+ -- N also supplies the source location for construction of the raise node.
+ -- If Typ does not have any predicates, the call has no effect. Set flag
+ -- Suggest_Static when the context warrants an advice on how to avoid the
+ -- use error.
function Build_Actual_Subtype
(T : Entity_Id;
git://gcc.gnu.org / gcc.git / commitdiff