aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/ChangeLog33
-rw-r--r--gcc/ada/a-crbtgk.adb56
-rw-r--r--gcc/ada/a-crbtgo.adb7
-rw-r--r--gcc/ada/a-rbtgbo.adb7
-rw-r--r--gcc/ada/einfo.ads14
-rw-r--r--gcc/ada/frontend.adb3
-rw-r--r--gcc/ada/par-ch12.adb7
-rw-r--r--gcc/ada/sem_ch12.adb10
-rw-r--r--gcc/ada/sem_ch13.adb16
-rw-r--r--gcc/ada/sem_ch3.adb11
-rw-r--r--gcc/ada/sprint.adb8
11 files changed, 145 insertions, 27 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ec3f06c2..21f43ac 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,36 @@
+2013-04-25 Matthew Heaney <heaney@adacore.com>
+
+ * a-rbtgbo.adb, a-crbtgo.adb (Generic_Equal): do not test for
+ tampering when container empty.
+ * a-crbtgk.adb (Ceiling, Find, Floor): ditto.
+ (Generic_Conditional_Insert, Generic_Conditional_Insert_With_Hint):
+ ditto.
+
+2013-04-25 Ed Schonberg <schonberg@adacore.com>
+
+ * par-ch12.adb: Move aspects from package specification to
+ generic package declaration.
+ * sem_ch12.adb: Analyze aspect specifications before building
+ and analyzing the generic copy, so that the generated pragmas
+ are properly taken into account.
+ * sem_ch13.adb: For compilation unit aspects that apply to a
+ generic package declaration, insert corresponding pragmas ahead
+ of visible declarations.
+ * sprint.adb: Display properly the aspects of a generic type
+ declaration.
+
+2013-04-25 Robert Dewar <dewar@adacore.com>
+
+ * frontend.adb: Minor reformatting.
+
+2013-04-25 Ed Schonberg <schonberg@adacore.com>
+
+ * einfo.ads: Extend documentation on use of Is_Private_Ancestor
+ for untagged types.
+ * sem_ch3.adb (Is_Visible_Component): Refine predicate for the
+ case of untagged types derived from private types, to reject
+ illegal selected components.
+
2013-04-25 Gary Dismukes <dismukes@adacore.com>
* sem_util.adb (Is_Dependent_Component_Of_Mutable_Object): Test
diff --git a/gcc/ada/a-crbtgk.adb b/gcc/ada/a-crbtgk.adb
index f1762f8..7cc3b25 100644
--- a/gcc/ada/a-crbtgk.adb
+++ b/gcc/ada/a-crbtgk.adb
@@ -45,6 +45,13 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
X : Node_Access;
begin
+ -- If the container is empty, return a result immediately, so that we do
+ -- not manipulate the tamper bits unnecessarily.
+
+ if Tree.Root = null then
+ return null;
+ end if;
+
-- Per AI05-0022, the container implementation is required to detect
-- element tampering by a generic actual subprogram.
@@ -87,6 +94,13 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
Result : Node_Access;
begin
+ -- If the container is empty, return a result immediately, so that we do
+ -- not manipulate the tamper bits unnecessarily.
+
+ if Tree.Root = null then
+ return null;
+ end if;
+
-- Per AI05-0022, the container implementation is required to detect
-- element tampering by a generic actual subprogram.
@@ -137,6 +151,13 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
X : Node_Access;
begin
+ -- If the container is empty, return a result immediately, so that we do
+ -- not manipulate the tamper bits unnecessarily.
+
+ if Tree.Root = null then
+ return null;
+ end if;
+
-- Per AI05-0022, the container implementation is required to detect
-- element tampering by a generic actual subprogram.
@@ -198,6 +219,15 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
-- its previous neighbor, in order for the conditional insertion to
-- succeed.
+ -- Handle insertion into an empty container as a special case, so that
+ -- we do not manipulate the tamper bits unnecessarily.
+
+ if Tree.Root = null then
+ Insert_Post (Tree, null, True, Node);
+ Inserted := True;
+ return;
+ end if;
+
-- We search the tree to find the nearest neighbor of Key, which is
-- either the smallest node greater than Key (Inserted is True), or the
-- largest node less or equivalent to Key (Inserted is False).
@@ -227,9 +257,9 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
if Inserted then
- -- Either Tree is empty, or Key is less than Y. If Y is the first
- -- node in the tree, then there are no other nodes that we need to
- -- search for, and we insert a new node into the tree.
+ -- Key is less than Y. If Y is the first node in the tree, then there
+ -- are no other nodes that we need to search for, and we insert a new
+ -- node into the tree.
if Y = Tree.First then
Insert_Post (Tree, Y, True, Node);
@@ -316,18 +346,26 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
-- is not a search and the only comparisons that occur are with
-- the hint and its neighbor.
- -- If Position is null, this is interpreted to mean that Key is
- -- large relative to the nodes in the tree. If the tree is empty,
- -- or Key is greater than the last node in the tree, then we're
- -- done; otherwise the hint was "wrong" and we must search.
+ -- Handle insertion into an empty container as a special case, so that
+ -- we do not manipulate the tamper bits unnecessarily.
+
+ if Tree.Root = null then
+ Insert_Post (Tree, null, True, Node);
+ Inserted := True;
+ return;
+ end if;
+
+ -- If Position is null, this is interpreted to mean that Key is large
+ -- relative to the nodes in the tree. If Key is greater than the last
+ -- node in the tree, then we're done; otherwise the hint was "wrong" and
+ -- we must search.
if Position = null then -- largest
begin
B := B + 1;
L := L + 1;
- Compare :=
- Tree.Last = null or else Is_Greater_Key_Node (Key, Tree.Last);
+ Compare := Is_Greater_Key_Node (Key, Tree.Last);
L := L - 1;
B := B - 1;
diff --git a/gcc/ada/a-crbtgo.adb b/gcc/ada/a-crbtgo.adb
index 6cce55d..1255ff5 100644
--- a/gcc/ada/a-crbtgo.adb
+++ b/gcc/ada/a-crbtgo.adb
@@ -646,6 +646,13 @@ package body Ada.Containers.Red_Black_Trees.Generic_Operations is
return False;
end if;
+ -- If the containers are empty, return a result immediately, so as to
+ -- not manipulate the tamper bits unnecessarily.
+
+ if Left.Length = 0 then
+ return True;
+ end if;
+
-- Per AI05-0022, the container implementation is required to detect
-- element tampering by a generic actual subprogram.
diff --git a/gcc/ada/a-rbtgbo.adb b/gcc/ada/a-rbtgbo.adb
index d6df756..ddf3fe2 100644
--- a/gcc/ada/a-rbtgbo.adb
+++ b/gcc/ada/a-rbtgbo.adb
@@ -626,6 +626,13 @@ package body Ada.Containers.Red_Black_Trees.Generic_Bounded_Operations is
return False;
end if;
+ -- If the containers are empty, return a result immediately, so as to
+ -- not manipulate the tamper bits unnecessarily.
+
+ if Left.Length = 0 then
+ return True;
+ end if;
+
-- Per AI05-0022, the container implementation is required to detect
-- element tampering by a generic actual subprogram.
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 38d4f22..bd58928 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -1753,12 +1753,14 @@ package Einfo is
-- is defined for the type.
-- Has_Private_Ancestor (Flag151)
--- Applies to type extensions. True if some ancestor is derived from a
--- private type, making some components invisible and aggregates illegal.
--- This flag is set at the point of derivation. The legality of the
--- aggregate must be rechecked because it also depends on the visibility
--- at the point the aggregate is resolved. See sem_aggr.adb.
--- This is part of AI05-0115.
+-- Applies to untagged derived types and to type extensions. True when
+-- some ancestor is derived from a private type, making some components
+-- invisible and aggregates illegal. Used to check the legality of
+-- selected components and aggregates. The flag is set at the point of
+-- derivation.
+-- The legality of an aggregate of a type with a private ancestor must
+-- be checked because it also depends on the visibility at the point the
+-- aggregate is resolved. See sem_aggr.adb. This is part of AI05-0115.
-- Has_Private_Declaration (Flag155)
-- Defined in all entities. Returns True if it is the defining entity
diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb
index 08536c4..7c56ac9 100644
--- a/gcc/ada/frontend.adb
+++ b/gcc/ada/frontend.adb
@@ -185,10 +185,13 @@ begin
-- Check for VAX Float
if Targparm.VAX_Float_On_Target then
+
-- pragma Float_Representation (VAX_Float);
+
Opt.Float_Format := 'V';
-- pragma Long_Float (G_Float);
+
Opt.Float_Format_Long := 'G';
Set_Standard_Fpt_Formats;
diff --git a/gcc/ada/par-ch12.adb b/gcc/ada/par-ch12.adb
index 06261bc..3c192f2 100644
--- a/gcc/ada/par-ch12.adb
+++ b/gcc/ada/par-ch12.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2011, 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- --
@@ -204,6 +204,11 @@ package body Ch12 is
Gen_Decl := New_Node (N_Generic_Package_Declaration, Gen_Sloc);
Set_Specification (Gen_Decl, P_Package (Pf_Spcn));
+ -- Aspects have been parsed by the package spec. Move them to the
+ -- generic declaration where they belong.
+
+ Move_Aspects (Specification (Gen_Decl), Gen_Decl);
+
else
Gen_Decl := New_Node (N_Generic_Subprogram_Declaration, Gen_Sloc);
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 5e1da8a..8652c70 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -3021,6 +3021,13 @@ package body Sem_Ch12 is
Id := Defining_Entity (N);
Generate_Definition (Id);
+ -- Analyze aspects now, so that generated pragmas appear in the
+ -- declarations before building and analyzing the generic copy.
+
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, Id);
+ end if;
+
-- Expansion is not applied to generic units
Start_Generic;
@@ -3079,9 +3086,6 @@ package body Sem_Ch12 is
end if;
end if;
- if Has_Aspects (N) then
- Analyze_Aspect_Specifications (N, Id);
- end if;
end Analyze_Generic_Package_Declaration;
--------------------------------------------
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index e6f39f5..1496912 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -1986,7 +1986,9 @@ package body Sem_Ch13 is
-- issue of visibility delay for these aspects.
if A_Id in Library_Unit_Aspects
- and then Nkind (N) = N_Package_Declaration
+ and then
+ Nkind_In (N, N_Package_Declaration,
+ N_Generic_Package_Declaration)
and then Nkind (Parent (N)) /= N_Compilation_Unit
then
Error_Msg_N
@@ -2041,7 +2043,9 @@ package body Sem_Ch13 is
-- In the context of a compilation unit, we directly put the
-- pragma in the Pragmas_After list of the N_Compilation_Unit_Aux
-- node (no delay is required here) except for aspects on a
- -- subprogram body (see below).
+ -- subprogram body (see below) and a generic package, for which
+ -- we need to introduce the pragma before building the generic
+ -- copy (see sem_ch12).
elsif Nkind (Parent (N)) = N_Compilation_Unit
and then (Present (Aitem) or else Is_Boolean_Aspect (Aspect))
@@ -2082,6 +2086,14 @@ package body Sem_Ch13 is
Prepend (Aitem, Declarations (N));
+ elsif Nkind (N) = N_Generic_Package_Declaration then
+ if No (Visible_Declarations (Specification (N))) then
+ Set_Visible_Declarations (Specification (N), New_List);
+ end if;
+
+ Prepend (Aitem,
+ Visible_Declarations (Specification (N)));
+
else
if No (Pragmas_After (Aux)) then
Set_Pragmas_After (Aux, New_List);
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 9e5b8de..29abd55 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -16468,10 +16468,15 @@ package body Sem_Ch3 is
Type_Scope := Scope (Base_Type (Scope (C)));
end if;
- -- This test only concerns tagged types
+ -- For an untagged type derived from a private type, the only
+ -- visible components are new discriminants.
if not Is_Tagged_Type (Original_Scope) then
- return True;
+ return not Has_Private_Ancestor (Original_Scope)
+ or else In_Open_Scopes (Scope (Original_Scope))
+ or else
+ (Ekind (Original_Comp) = E_Discriminant
+ and then Original_Scope = Type_Scope);
-- If it is _Parent or _Tag, there is no visibility issue
@@ -17383,8 +17388,6 @@ package body Sem_Ch3 is
-- now. We have to create a new entity with the same name, Thus we
-- can't use Create_Itype.
- -- This is messy, should be fixed ???
-
Full := Make_Defining_Identifier (Sloc (Id), Chars (Id));
Set_Is_Itype (Full);
Set_Associated_Node_For_Itype (Full, Related_Nod);
diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb
index 5185c15..8526716 100644
--- a/gcc/ada/sprint.adb
+++ b/gcc/ada/sprint.adb
@@ -2499,7 +2499,8 @@ package body Sprint is
Write_Str_With_Col_Check_Sloc ("package ");
Sprint_Node (Defining_Unit_Name (Node));
- if Nkind (Parent (Node)) = N_Package_Declaration
+ if Nkind_In (Parent (Node), N_Package_Declaration,
+ N_Generic_Package_Declaration)
and then Has_Aspects (Parent (Node))
then
Sprint_Aspect_Specifications
@@ -3304,7 +3305,10 @@ package body Sprint is
-- Print aspects, except for special case of package declaration,
-- where the aspects are printed inside the package specification.
- if Has_Aspects (Node) and Nkind (Node) /= N_Package_Declaration then
+ if Has_Aspects (Node)
+ and then not Nkind_In (Node, N_Package_Declaration,
+ N_Generic_Package_Declaration)
+ then
Sprint_Aspect_Specifications (Node, Semicolon => True);
end if;
generated by cgit v1.1 at 2024-11-03 03:58:22 +0000