+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
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.
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.
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.
-- 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).
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);
-- 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;
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.
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.
-- 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
-- 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;
-- --
-- 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- --
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);
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;
end if;
end if;
- if Has_Aspects (N) then
- Analyze_Aspect_Specifications (N, Id);
- end if;
end Analyze_Generic_Package_Declaration;
--------------------------------------------
-- 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
-- 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))
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);
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
-- 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);
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
-- 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;
projects / gcc.git / commitdiff