+2011-08-04 Robert Dewar <dewar@adacore.com>
+
+ * bindgen.ads, gnatlink.adb, sem_ch4.adb, gnatbind.adb, put_alfa.adb,
+ gnatls.adb, exp_ch3.adb: Minor reformatting.
+
+2011-08-04 Marc Sango <sango@adacore.com>
+
+ * sem_attr.adb (Analyze_Attribute): Replace the message
+ "invisible attribute of}" of the spark restriction violation in
+ attribute reference by the simple message "invisible attribute of type".
+ Indeed, the node value Error_Msg_Node_1 used is in conflit with the
+ two insertion characters: '&' and '}'.
+
+2011-08-04 Vadim Godunko <godunko@adacore.com>
+
+ * impunit.adb (Non_Imp_File_Names_12): Add "a-coinho".
+ * a-coinho.ads, a-coinho.adb: New file.
+ * Makefile.rtl: Add Ada.Containers.Indefinite_Holders.
+
2011-08-04 Nicolas Roche <roche@adacore.com>
* alfa_test.adb: Not all ali files are containing alfa information even
a-cohama$(objext) \
a-cohase$(objext) \
a-cohata$(objext) \
+ a-coinho$(objext) \
a-coinve$(objext) \
a-colien$(objext) \
a-colire$(objext) \
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT LIBRARY COMPONENTS --
+-- --
+-- A D A . C O N T A I N E R S . B O U N D E D _ V E C T O R S --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2011, 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- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+------------------------------------------------------------------------------
+
+with Ada.Unchecked_Deallocation;
+
+package body Ada.Containers.Indefinite_Holders is
+
+ procedure Free is
+ new Ada.Unchecked_Deallocation (Element_Type, Element_Access);
+
+ ---------
+ -- "=" --
+ ---------
+
+ function "=" (Left, Right : Holder) return Boolean is
+ begin
+ if Left.Element = null and Right.Element = null then
+ return True;
+
+ elsif Left.Element /= null and Right.Element /= null then
+ return Left.Element.all = Right.Element.all;
+
+ else
+ return False;
+ end if;
+ end "=";
+
+ ------------
+ -- Adjust --
+ ------------
+
+ overriding procedure Adjust (Container : in out Holder) is
+ begin
+ if Container.Element /= null then
+ Container.Element := new Element_Type'(Container.Element.all);
+ end if;
+
+ Container.Busy := 0;
+ end Adjust;
+
+ ------------
+ -- Assign --
+ ------------
+
+ procedure Assign (Target : in out Holder; Source : Holder) is
+ begin
+ if Target.Busy /= 0 then
+ raise Program_Error with "attempt to tamper with elements";
+ end if;
+
+ if Target.Element /= Source.Element then
+ Free (Target.Element);
+
+ if Source.Element /= null then
+ Target.Element := new Element_Type'(Source.Element.all);
+ end if;
+ end if;
+ end Assign;
+
+ -----------
+ -- Clear --
+ -----------
+
+ procedure Clear (Container : in out Holder) is
+ begin
+ if Container.Busy /= 0 then
+ raise Program_Error with "attempt to tamper with elements";
+ end if;
+
+ Free (Container.Element);
+ end Clear;
+
+ ----------
+ -- Copy --
+ ----------
+
+ function Copy (Source : Holder) return Holder is
+ begin
+ if Source.Element = null then
+ return (AF.Controlled with null, 0);
+
+ else
+ return (AF.Controlled with new Element_Type'(Source.Element.all), 0);
+ end if;
+ end Copy;
+
+ -------------
+ -- Element --
+ -------------
+
+ function Element (Container : Holder) return Element_Type is
+ begin
+ if Container.Element = null then
+ raise Constraint_Error with "container is empty";
+
+ else
+ return Container.Element.all;
+ end if;
+ end Element;
+
+ --------------
+ -- Finalize --
+ --------------
+
+ overriding procedure Finalize (Container : in out Holder) is
+ begin
+ if Container.Busy /= 0 then
+ raise Program_Error with "attempt to tamper with elements";
+ end if;
+
+ Free (Container.Element);
+ end Finalize;
+
+ --------------
+ -- Is_Empty --
+ --------------
+
+ function Is_Empty (Container : Holder) return Boolean is
+ begin
+ return Container.Element = null;
+ end Is_Empty;
+
+ ----------
+ -- Move --
+ ----------
+
+ procedure Move (Target : in out Holder; Source : in out Holder) is
+ begin
+ if Target.Busy /= 0 then
+ raise Program_Error with "attempt to tamper with elements";
+ end if;
+
+ if Source.Busy /= 0 then
+ raise Program_Error with "attempt to tamper with elements";
+ end if;
+
+ if Target.Element /= Source.Element then
+ Free (Target.Element);
+ Target.Element := Source.Element;
+ Source.Element := null;
+ end if;
+ end Move;
+
+ -------------------
+ -- Query_Element --
+ -------------------
+
+ procedure Query_Element
+ (Container : Holder;
+ Process : not null access procedure (Element : Element_Type))
+ is
+ B : Natural renames Container'Unrestricted_Access.Busy;
+
+ begin
+ if Container.Element = null then
+ raise Constraint_Error with "container is empty";
+ end if;
+
+ B := B + 1;
+
+ begin
+ Process (Container.Element.all);
+
+ exception
+ when others =>
+ B := B - 1;
+
+ raise;
+ end;
+
+ B := B - 1;
+ end Query_Element;
+
+ ----------
+ -- Read --
+ ----------
+
+ procedure Read
+ (Stream : not null access Ada.Streams.Root_Stream_Type'Class;
+ Container : out Holder) is
+ begin
+ Clear (Container);
+
+ if not Boolean'Input (Stream) then
+ Container.Element := new Element_Type'(Element_Type'Input (Stream));
+ end if;
+ end Read;
+
+ ---------------------
+ -- Replace_Element --
+ ---------------------
+
+ procedure Replace_Element
+ (Container : in out Holder; New_Item : Element_Type) is
+ begin
+ if Container.Busy /= 0 then
+ raise Program_Error with "attempt to tamper with elements";
+ end if;
+
+ Free (Container.Element);
+ Container.Element := new Element_Type'(New_Item);
+ end Replace_Element;
+
+ ---------------
+ -- To_Holder --
+ ---------------
+
+ function To_Holder (New_Item : Element_Type) return Holder is
+ begin
+ return (AF.Controlled with new Element_Type'(New_Item), 0);
+ end To_Holder;
+
+ --------------------
+ -- Update_Element --
+ --------------------
+
+ procedure Update_Element
+ (Container : Holder;
+ Process : not null access procedure (Element : in out Element_Type))
+ is
+ B : Natural renames Container'Unrestricted_Access.Busy;
+
+ begin
+ if Container.Element = null then
+ raise Constraint_Error with "container is empty";
+ end if;
+
+ B := B + 1;
+
+ begin
+ Process (Container.Element.all);
+
+ exception
+ when others =>
+ B := B - 1;
+
+ raise;
+ end;
+
+ B := B - 1;
+ end Update_Element;
+
+ -----------
+ -- Write --
+ -----------
+
+ procedure Write
+ (Stream : not null access Ada.Streams.Root_Stream_Type'Class;
+ Container : Holder) is
+ begin
+ Boolean'Output (Stream, Container.Element = null);
+
+ if Container.Element /= null then
+ Element_Type'Output (Stream, Container.Element.all);
+ end if;
+ end Write;
+
+end Ada.Containers.Indefinite_Holders;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT LIBRARY COMPONENTS --
+-- --
+-- A D A . C O N T A I N E R S . B O U N D E D _ V E C T O R S --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2011, Free Software Foundation, Inc. --
+-- --
+-- This specification is derived from the Ada Reference Manual for use with --
+-- GNAT. The copyright notice above, and the license provisions that follow --
+-- apply solely to the contents of the part following the private keyword. --
+-- --
+-- 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- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+------------------------------------------------------------------------------
+
+private with Ada.Finalization;
+private with Ada.Streams;
+
+generic
+ type Element_Type (<>) is private;
+ with function "=" (Left, Right : Element_Type) return Boolean is <>;
+
+package Ada.Containers.Indefinite_Holders is
+ pragma Preelaborate (Indefinite_Holders);
+ pragma Remote_Types (Indefinite_Holders);
+
+ type Holder is tagged private;
+ pragma Preelaborable_Initialization (Holder);
+
+ Empty_Holder : constant Holder;
+
+ function "=" (Left, Right : Holder) return Boolean;
+
+ function To_Holder (New_Item : Element_Type) return Holder;
+
+ function Is_Empty (Container : Holder) return Boolean;
+
+ procedure Clear (Container : in out Holder);
+
+ function Element (Container : Holder) return Element_Type;
+
+ procedure Replace_Element
+ (Container : in out Holder; New_Item : Element_Type);
+
+ procedure Query_Element
+ (Container : Holder;
+ Process : not null access procedure (Element : Element_Type));
+ procedure Update_Element
+ (Container : Holder;
+ Process : not null access procedure (Element : in out Element_Type));
+
+ procedure Assign (Target : in out Holder; Source : Holder);
+
+ function Copy (Source : Holder) return Holder;
+
+ procedure Move (Target : in out Holder; Source : in out Holder);
+
+private
+
+ package AF renames Ada.Finalization;
+
+ type Element_Access is access all Element_Type;
+
+ procedure Read
+ (Stream : not null access Ada.Streams.Root_Stream_Type'Class;
+ Container : out Holder);
+
+ procedure Write
+ (Stream : not null access Ada.Streams.Root_Stream_Type'Class;
+ Container : Holder);
+
+ type Holder is new Ada.Finalization.Controlled with record
+ Element : Element_Access;
+ Busy : Natural := 0;
+ end record;
+ for Holder'Read use Read;
+ for Holder'Write use Write;
+
+ overriding procedure Adjust (Container : in out Holder);
+ overriding procedure Finalize (Container : in out Holder);
+
+ Empty_Holder : constant Holder := (AF.Controlled with null, 0);
+
+end Ada.Containers.Indefinite_Holders;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, 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- --
------------------------------------------------------------------------------
-- This package contains the routines to output the binder file. This is
--- an Ada or C program which contains the following:
+-- an Ada program which contains the following:
--- initialization for main program case
--- sequence of calls to elaboration routines in appropriate order
--- call to main program for main program case
+-- Initialization for main program case
+-- Sequence of calls to elaboration routines in appropriate order
+-- Call to main program for main program case
-- See the body for exact details of the file that is generated
-- Start processing for Stream_Operation_OK
begin
-
-- Special case of a limited type extension: a default implementation
-- of the stream attributes Read or Write exists if that attribute
-- has been specified or is available for an ancestor type; a default
Check_Extensions : declare
Length : constant Natural := Output_File_Name'Length;
Last : constant Natural := Output_File_Name'Last;
-
begin
if Length <= 4
or else Output_File_Name (Last - 3 .. Last) /= ".adb"
then
Fail ("output file name should have .adb extension");
end if;
-
end Check_Extensions;
end if;
then
Binder_Options_From_ALI.Increment_Last;
Binder_Options_From_ALI.Table
- (Binder_Options_From_ALI.Last)
- := String_Access (Arg);
+ (Binder_Options_From_ALI.Last) := String_Access (Arg);
-- Set the RTS_*_Path_Name variables, so that
-- the correct directories will be set when
Write_Str (" ");
Write_Line
(To_Host_Dir_Spec (Name_Buffer (1 .. Name_Len), True).all);
-
end if;
end if;
end;
"a-cborma", -- Ada.Containers.Bounded_Ordered_Maps
"a-cbhase", -- Ada.Containers.Bounded_Hashed_Sets
"a-cbhama", -- Ada.Containers.Bounded_Hashed_Maps
+ "a-coinho", -- Ada.Containers.Indefinite_Holders
"a-extiin", -- Ada.Execution_Time.Interrupts
-----------------------------------------
Write_Info_Char (' ');
pragma Assert (S.Scope_Name.all /= "");
+
for N in S.Scope_Name'Range loop
Write_Info_Char (S.Scope_Name (N));
end loop;
and then not In_Open_Scopes (Scope (P_Type))
and then not In_Spec_Expression
then
- Error_Msg_Node_1 := First_Subtype (P_Type);
- Check_SPARK_Restriction ("invisible attribute of}", N);
+ Check_SPARK_Restriction ("invisible attribute of type", N);
end if;
-- Remaining processing depends on attribute
else
Analyze (R);
+
if Is_Entity_Name (R)
and then Is_Type (Entity (R))
then
projects / gcc.git / commitdiff