Commit 7893514c by Robert Dewar Committed by Arnaud Charlet

exp_aggr.adb: Minor reformatting.

2013-04-12  Robert Dewar  <dewar@adacore.com>

	* exp_aggr.adb: Minor reformatting.
	* namet.ads, namet.adb (Nam_In): New functions.

From-SVN: r197916
parent aab45d22
2013-04-12 Robert Dewar <dewar@adacore.com> 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. * einfo.adb (Has_Dynamic_Predicate_Aspect): New flag.
(Has_Static_Predicate_Aspect): New flag. (Has_Static_Predicate_Aspect): New flag.
* einfo.ads (Has_Dynamic_Predicate_Aspect): New flag. * einfo.ads (Has_Dynamic_Predicate_Aspect): New flag.
......
...@@ -1841,7 +1841,7 @@ package body Exp_Aggr is ...@@ -1841,7 +1841,7 @@ package body Exp_Aggr is
-- these discriminants are not components of the aggregate, and must be -- these discriminants are not components of the aggregate, and must be
-- initialized. The assignments are appended to List. -- 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 -- If the ancestor part is an unconstrained type and further ancestors
-- do not provide discriminants for it, check aggregate components for -- do not provide discriminants for it, check aggregate components for
-- values of the discriminants. -- values of the discriminants.
...@@ -2068,7 +2068,8 @@ package body Exp_Aggr is ...@@ -2068,7 +2068,8 @@ package body Exp_Aggr is
-- Get_Explicit_Discriminant_Value -- -- 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 is
Assoc : Node_Id; Assoc : Node_Id;
Choice : Node_Id; Choice : Node_Id;
...@@ -2081,6 +2082,7 @@ package body Exp_Aggr is ...@@ -2081,6 +2082,7 @@ package body Exp_Aggr is
Assoc := First (Component_Associations (N)); Assoc := First (Component_Associations (N));
while Present (Assoc) loop while Present (Assoc) loop
Choice := First (Choices (Assoc)); Choice := First (Choices (Assoc));
if Chars (Choice) = Chars (D) then if Chars (Choice) = Chars (D) then
Val := Expression (Assoc); Val := Expression (Assoc);
Remove (Assoc); Remove (Assoc);
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -1039,6 +1039,80 @@ package body Namet is ...@@ -1039,6 +1039,80 @@ package body Namet is
end if; end if;
end Name_Find; 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 -- -- Reinitialize --
------------------ ------------------
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -165,6 +165,55 @@ package Namet is ...@@ -165,6 +165,55 @@ package Namet is
First_Name_Id : constant Name_Id := Names_Low_Bound + 2; First_Name_Id : constant Name_Id := Names_Low_Bound + 2;
-- Subscript of first entry in names table -- 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 -- -- Subprograms --
----------------- -----------------
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment