diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/ada/exp_aggr.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/namet.adb | 76 | ||||
| -rw-r--r-- | gcc/ada/namet.ads | 51 |
4 files changed, 134 insertions, 4 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 258e97c3891..60e39f5eca5 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,10 @@ 2013-04-12 Robert Dewar <dewar@adacore.com> + * exp_aggr.adb: Minor reformatting. + * namet.ads, namet.adb (Nam_In): New functions. + +2013-04-12 Robert Dewar <dewar@adacore.com> + * einfo.adb (Has_Dynamic_Predicate_Aspect): New flag. (Has_Static_Predicate_Aspect): New flag. * einfo.ads (Has_Dynamic_Predicate_Aspect): New flag. diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 3303636db81..c4a80ef8406 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -1841,7 +1841,7 @@ package body Exp_Aggr is -- these discriminants are not components of the aggregate, and must be -- initialized. The assignments are appended to List. - function Get_Explicit_Discriminant_Value (D : Entity_Id) return Node_Id; + function Get_Explicit_Discriminant_Value (D : Entity_Id) return Node_Id; -- If the ancestor part is an unconstrained type and further ancestors -- do not provide discriminants for it, check aggregate components for -- values of the discriminants. @@ -2068,7 +2068,8 @@ package body Exp_Aggr is -- Get_Explicit_Discriminant_Value -- ------------------------------------- - function Get_Explicit_Discriminant_Value (D : Entity_Id) return Node_Id + function Get_Explicit_Discriminant_Value + (D : Entity_Id) return Node_Id is Assoc : Node_Id; Choice : Node_Id; @@ -2081,6 +2082,7 @@ package body Exp_Aggr is Assoc := First (Component_Associations (N)); while Present (Assoc) loop Choice := First (Choices (Assoc)); + if Chars (Choice) = Chars (D) then Val := Expression (Assoc); Remove (Assoc); diff --git a/gcc/ada/namet.adb b/gcc/ada/namet.adb index 2842dfd4e81..c4ffa4b592d 100644 --- a/gcc/ada/namet.adb +++ b/gcc/ada/namet.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -1039,6 +1039,80 @@ package body Namet is end if; end Name_Find; + ------------- + -- Nam_In -- + ------------- + + function Nam_In + (T : Name_Id; + V1 : Name_Id; + V2 : Name_Id) return Boolean + is + begin + return T = V1 or else + T = V2; + end Nam_In; + + function Nam_In + (T : Name_Id; + V1 : Name_Id; + V2 : Name_Id; + V3 : Name_Id) return Boolean + is + begin + return T = V1 or else + T = V2 or else + T = V3; + end Nam_In; + + function Nam_In + (T : Name_Id; + V1 : Name_Id; + V2 : Name_Id; + V3 : Name_Id; + V4 : Name_Id) return Boolean + is + begin + return T = V1 or else + T = V2 or else + T = V3 or else + T = V4; + end Nam_In; + + function Nam_In + (T : Name_Id; + V1 : Name_Id; + V2 : Name_Id; + V3 : Name_Id; + V4 : Name_Id; + V5 : Name_Id) return Boolean + is + begin + return T = V1 or else + T = V2 or else + T = V3 or else + T = V4 or else + T = V5; + end Nam_In; + + function Nam_In + (T : Name_Id; + V1 : Name_Id; + V2 : Name_Id; + V3 : Name_Id; + V4 : Name_Id; + V5 : Name_Id; + V6 : Name_Id) return Boolean + is + begin + return T = V1 or else + T = V2 or else + T = V3 or else + T = V4 or else + T = V5 or else + T = V6; + end Nam_In; + ------------------ -- Reinitialize -- ------------------ diff --git a/gcc/ada/namet.ads b/gcc/ada/namet.ads index e8978f8b52f..facb1822dec 100644 --- a/gcc/ada/namet.ads +++ b/gcc/ada/namet.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -165,6 +165,55 @@ package Namet is First_Name_Id : constant Name_Id := Names_Low_Bound + 2; -- Subscript of first entry in names table + ------------------------------ + -- Name_Id Membership Tests -- + ------------------------------ + + -- The following functions allow a convenient notation for testing whether + -- a Name_Id value matches any one of a list of possible values. In each + -- case True is returned if the given T argument is equal to any of the V + -- arguments. These essentially duplicate the Ada 2012 membership tests, + -- but we cannot use the latter (yet) in the compiler front end, because + -- of bootstrap considerations + + function Nam_In + (T : Name_Id; + V1 : Name_Id; + V2 : Name_Id) return Boolean; + + function Nam_In + (T : Name_Id; + V1 : Name_Id; + V2 : Name_Id; + V3 : Name_Id) return Boolean; + + function Nam_In + (T : Name_Id; + V1 : Name_Id; + V2 : Name_Id; + V3 : Name_Id; + V4 : Name_Id) return Boolean; + + function Nam_In + (T : Name_Id; + V1 : Name_Id; + V2 : Name_Id; + V3 : Name_Id; + V4 : Name_Id; + V5 : Name_Id) return Boolean; + + function Nam_In + (T : Name_Id; + V1 : Name_Id; + V2 : Name_Id; + V3 : Name_Id; + V4 : Name_Id; + V5 : Name_Id; + V6 : Name_Id) return Boolean; + + pragma Inline (Nam_In); + -- Inline all above functions + ----------------- -- Subprograms -- ----------------- |