diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2013-04-25 12:31:36 +0200 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2013-04-25 12:31:36 +0200 |
commit | 5708155960d0abd5f30e12e9477f946c60da43c8 (patch) | |
tree | 07a7fa542ef43428eaa03bf75cb41942d3c95bab /gcc | |
parent | 0812b84e77d5b5d187ea4c75841e4569f016612f (diff) | |
download | gcc-5708155960d0abd5f30e12e9477f946c60da43c8.zip gcc-5708155960d0abd5f30e12e9477f946c60da43c8.tar.gz gcc-5708155960d0abd5f30e12e9477f946c60da43c8.tar.bz2 |
[multiple changes]
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.
From-SVN: r198288
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/ChangeLog | 27 | ||||
-rw-r--r-- | gcc/ada/sem_case.adb | 3 | ||||
-rw-r--r-- | gcc/ada/sem_ch4.adb | 59 | ||||
-rw-r--r-- | gcc/ada/sem_ch5.adb | 2 | ||||
-rw-r--r-- | gcc/ada/sem_disp.adb | 7 | ||||
-rw-r--r-- | gcc/ada/sem_util.adb | 14 | ||||
-rw-r--r-- | gcc/ada/sem_util.ads | 26 |
7 files changed, 117 insertions, 21 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d40d2eb..a3e8f83 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,30 @@ +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. diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb index 6f066fe..515d2a6 100644 --- a/gcc/ada/sem_case.adb +++ b/gcc/ada/sem_case.adb @@ -1260,7 +1260,8 @@ package body Sem_Case is 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 diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 2fa9c5a..d54d992 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -3510,6 +3510,9 @@ package body Sem_Ch4 is -- 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 -- -------------------- @@ -3561,9 +3564,44 @@ package body Sem_Ch4 is 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 @@ -3590,22 +3628,39 @@ package body Sem_Ch4 is 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 -- diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index b2ed158..5b34ecc 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -2310,7 +2310,7 @@ package body Sem_Ch5 is 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; diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index 8d779b2..9f80a7d 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -44,6 +44,7 @@ with Sem; use Sem; 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; @@ -1867,12 +1868,14 @@ package body Sem_Disp is 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; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index bf032fd..dbee4fd 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -449,9 +449,10 @@ package body Sem_Util is -------------------------------- 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 @@ -465,6 +466,13 @@ package body Sem_Util is 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; diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index fd9b940..c9b5da6 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -122,19 +122,21 @@ package Sem_Util is -- 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; |