diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/ChangeLog | 16 | ||||
| -rw-r--r-- | gcc/ada/einfo.adb | 21 | ||||
| -rw-r--r-- | gcc/ada/einfo.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 55 | ||||
| -rw-r--r-- | gcc/ada/sem_util.adb | 20 | ||||
| -rw-r--r-- | gcc/ada/sem_util.ads | 5 |
6 files changed, 62 insertions, 61 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3d60a92..71295d8 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,21 @@ 2013-04-25 Hristian Kirtchev <kirtchev@adacore.com> + * einfo.ads, einfo.adb: Remove with and use clauses for Namet. + (Find_Pragma): New routine. + * sem_util.ads, sem_util.adb (Find_Pragma): Moved to einfo. + +2013-04-25 Hristian Kirtchev <kirtchev@adacore.com> + + * sem_ch13.adb (Add_Call): Do not capture the nature of the inherited + predicate. + (Add_Predicates): Save the static predicate for diagnostics and error + reporting purposes. + (Process_PPCs): Remove local variables Dynamic_Predicate_Present and + Static_Predicate_Present. Add local variable Static_Pred. Ensure that + the expression of a static predicate is static. + +2013-04-25 Hristian Kirtchev <kirtchev@adacore.com> + * einfo.adb (Is_Ghost_Subprogram): Remove useless code. 2013-04-25 Robert Dewar <dewar@adacore.com> diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 7092ee7..81b35f7 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -33,7 +33,6 @@ pragma Style_Checks (All_Checks); -- Turn off subprogram ordering, not used for this unit with Atree; use Atree; -with Namet; use Namet; with Nlists; use Nlists; with Output; use Output; with Sinfo; use Sinfo; @@ -6102,6 +6101,26 @@ package body Einfo is return Etype (Discrete_Subtype_Definition (Parent (Id))); end Entry_Index_Type; + ----------------- + -- Find_Pragma -- + ----------------- + + function Find_Pragma (Id : Entity_Id; Name : Name_Id) return Node_Id is + Item : Node_Id; + + begin + Item := First_Rep_Item (Id); + while Present (Item) loop + if Nkind (Item) = N_Pragma and then Pragma_Name (Item) = Name then + return Item; + end if; + + Item := Next_Rep_Item (Item); + end loop; + + return Empty; + end Find_Pragma; + --------------------- -- First_Component -- --------------------- diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index fd38a1f..38d4f22 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -29,6 +29,7 @@ -- -- ------------------------------------------------------------------------------ +with Namet; use Namet; with Snames; use Snames; with Types; use Types; with Uintp; use Uintp; @@ -7351,6 +7352,11 @@ package Einfo is -- expression is deferred to the freeze point. For further details see -- Sem_Ch13.Analyze_Aspect_Specifications. + function Find_Pragma (Id : Entity_Id; Name : Name_Id) return Node_Id; + -- Given entity Id and pragma name Name, attempt to find the corresponding + -- pragma in Id's chain of representation items. The function returns Empty + -- if no such pragma has been found. + function Get_Attribute_Definition_Clause (E : Entity_Id; Id : Attribute_Id) return Node_Id; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 709947b..e6f39f5 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -5741,6 +5741,9 @@ package body Sem_Ch13 is Raise_Expression_Present : Boolean := False; -- Set True if Expr has at least one Raise_Expression + Static_Predic : Node_Id := Empty; + -- Set to N_Pragma node for a static predicate if one is encountered + procedure Add_Call (T : Entity_Id); -- Includes a call to the predicate function for type T in Expr if T -- has predicates and Predicate_Function (T) is non-empty. @@ -5765,13 +5768,6 @@ package body Sem_Ch13 is procedure Process_REs is new Traverse_Proc (Process_RE); -- Marks any raise expressions in Expr_M to return False - Dynamic_Predicate_Present : Boolean := False; - -- Set True if a dynamic predicate is present, results in the entire - -- predicate being considered dynamic even if it looks static. - - Static_Predicate_Present : Node_Id := Empty; - -- Set to N_Pragma node for a static predicate if one is encountered - -------------- -- Add_Call -- -------------- @@ -5783,12 +5779,6 @@ package body Sem_Ch13 is if Present (T) and then Present (Predicate_Function (T)) then Set_Has_Predicates (Typ); - -- Capture the nature of the inherited ancestor predicate - - if Has_Dynamic_Predicate_Aspect (T) then - Dynamic_Predicate_Present := True; - end if; - -- Build the call to the predicate function of T Exp := @@ -5872,17 +5862,14 @@ package body Sem_Ch13 is if Nkind (Ritem) = N_Pragma and then Pragma_Name (Ritem) = Name_Predicate then - -- Capture the nature of the predicate - - if Present (Corresponding_Aspect (Ritem)) then - case Chars (Identifier (Corresponding_Aspect (Ritem))) is - when Name_Dynamic_Predicate => - Dynamic_Predicate_Present := True; - when Name_Static_Predicate => - Static_Predicate_Present := Ritem; - when others => - null; - end case; + -- Save the static predicate of the type for diagnostics and + -- error reporting purposes. + + if Present (Corresponding_Aspect (Ritem)) + and then Chars (Identifier (Corresponding_Aspect (Ritem))) = + Name_Static_Predicate + then + Static_Predic := Ritem; end if; -- Acquire arguments @@ -6211,7 +6198,9 @@ package body Sem_Ch13 is -- Attempt to build a static predicate for a discrete or a real -- subtype. This action may fail because the actual expression may - -- not be static. + -- not be static. Note that the presence of an inherited or + -- explicitly declared dynamic predicate is orthogonal to this + -- check because we are only interested in the static predicate. if Ekind_In (Typ, E_Decimal_Fixed_Point_Subtype, E_Enumeration_Subtype, @@ -6222,30 +6211,26 @@ package body Sem_Ch13 is then Build_Static_Predicate (Typ, Expr, Object_Name); - -- The predicate is categorized as static but its expression is - -- dynamic. Note that the predicate may become non-static when - -- inherited dynamic predicates are involved. + -- Emit an error when the predicate is categorized as static + -- but its expression is dynamic. - if Present (Static_Predicate_Present) + if Present (Static_Predic) and then No (Static_Predicate (Typ)) - and then not Dynamic_Predicate_Present then Error_Msg_F ("expression does not have required form for " & "static predicate", Next (First (Pragma_Argument_Associations - (Static_Predicate_Present)))); + (Static_Predic)))); end if; end if; - -- If a Static_Predicate applies on other types, that's an error: + -- If a static predicate applies on other types, that's an error: -- either the type is scalar but non-static, or it's not even a -- scalar type. We do not issue an error on generated types, as -- these may be duplicates of the same error on a source type. - elsif Present (Static_Predicate_Present) - and then Comes_From_Source (Typ) - then + elsif Present (Static_Predic) and then Comes_From_Source (Typ) then if Is_Scalar_Type (Typ) then Error_Msg_FE ("static predicate not allowed for non-static type&", diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index f55f594..095510e 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -4882,26 +4882,6 @@ package body Sem_Util is end if; end Find_Parameter_Type; - ----------------- - -- Find_Pragma -- - ----------------- - - function Find_Pragma (Id : Entity_Id; Name : Name_Id) return Node_Id is - Item : Node_Id; - - begin - Item := First_Rep_Item (Id); - while Present (Item) loop - if Nkind (Item) = N_Pragma and then Pragma_Name (Item) = Name then - return Item; - end if; - - Item := Next_Rep_Item (Item); - end loop; - - return Empty; - end Find_Pragma; - ----------------------------- -- Find_Static_Alternative -- ----------------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 11b7a91..fa5b6e3 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -494,11 +494,6 @@ package Sem_Util is -- Return the type of formal parameter Param as determined by its -- specification. - function Find_Pragma (Id : Entity_Id; Name : Name_Id) return Node_Id; - -- Given entity Id and pragma name Name, attempt to find the corresponding - -- pragma in Id's chain of representation items. The function returns Empty - -- if no such pragma has been found. - function Find_Static_Alternative (N : Node_Id) return Node_Id; -- N is a case statement whose expression is a compile-time value. -- Determine the alternative chosen, so that the code of non-selected |