[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Thu, 4 Aug 2011 15:27:59 +0000 (17:27 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Thu, 4 Aug 2011 15:27:59 +0000 (17:27 +0200)
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.

From-SVN: r177400

13 files changed:
gcc/ada/ChangeLog
gcc/ada/Makefile.rtl
gcc/ada/a-coinho.adb [new file with mode: 0644]
gcc/ada/a-coinho.ads [new file with mode: 0644]
gcc/ada/bindgen.ads
gcc/ada/exp_ch3.adb
gcc/ada/gnatbind.adb
gcc/ada/gnatlink.adb
gcc/ada/gnatls.adb
gcc/ada/impunit.adb
gcc/ada/put_alfa.adb
gcc/ada/sem_attr.adb
gcc/ada/sem_ch4.adb

index 283365b125480f560e9577a4c5ababa130595294..9f3bcb56e170489b18de48b2db67a5691eb5ae8c 100644 (file)
@@ -1,3 +1,22 @@
+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
index 046e5378bf9fcbac0a62f88cc4ec0c4416071457..a03aeaf48a49e60440d31cda934e8681749ce91c 100644 (file)
@@ -121,6 +121,7 @@ GNATRTL_NONTASKING_OBJS= \
   a-cohama$(objext) \
   a-cohase$(objext) \
   a-cohata$(objext) \
+  a-coinho$(objext) \
   a-coinve$(objext) \
   a-colien$(objext) \
   a-colire$(objext) \
diff --git a/gcc/ada/a-coinho.adb b/gcc/ada/a-coinho.adb
new file mode 100644 (file)
index 0000000..539c3b1
--- /dev/null
@@ -0,0 +1,282 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         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;
diff --git a/gcc/ada/a-coinho.ads b/gcc/ada/a-coinho.ads
new file mode 100644 (file)
index 0000000..63bcb34
--- /dev/null
@@ -0,0 +1,100 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         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;
index 96d2e306888b0b1552dd2d140ed41cca756e903c..71596284963e1742ee4e0243426b1b230ab432b0 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 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
 
index 44896515bf0dbf91c22141d50c9fef85d7c5abee..6d73822c3568dd9994ac0ef6dbda8dd3abb1213b 100644 (file)
@@ -9017,7 +9017,6 @@ package body Exp_Ch3 is
    --  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
index 18eb36e01ec72efa512b678a2327bec983d65c03..0382371b6888192d26a31b8862336cfb7b12ac84 100644 (file)
@@ -566,14 +566,12 @@ begin
       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;
 
index 7e7a10bd9abc6255a4d5778d16b972ef4ac2321a..9c340fbfd42f16fd93fc8946d861716390f682d9 100644 (file)
@@ -1591,8 +1591,7 @@ begin
                   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
index ce0bd19633a955b9ab68d095bfa797ef69c5f58e..a2612861c082846089f7f8e7f46ceacaf037c270 100644 (file)
@@ -1733,7 +1733,6 @@ begin
                Write_Str ("   ");
                Write_Line
                  (To_Host_Dir_Spec (Name_Buffer (1 .. Name_Len), True).all);
-
             end if;
          end if;
       end;
index e58b345d72a4c26b8d7edca23d1175ca5cfe2c77..153c15913aeb5e1d4052f6ca706d7c2dbdaa5b4b 100644 (file)
@@ -514,6 +514,7 @@ package body Impunit is
      "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
 
    -----------------------------------------
index 7ccb80a34f2d0cc12cc0426e7070c3bcb108662b..59be7c2824cdabf349075344ee3424615f8fad4f 100644 (file)
@@ -75,6 +75,7 @@ begin
                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;
index 7a03ad1bc9b2d4df4673b2a3b44a45799cf52120..caf036cda707b2ab2e9af51f9be9de74d6081c59 100644 (file)
@@ -2068,8 +2068,7 @@ package body Sem_Attr is
         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
index 276c2843274205a6aed8a10f415fa5b44ee7d4c0..d62f2628058c4ffe0ceda6b41c04f9d2974208b9 100644 (file)
@@ -2492,6 +2492,7 @@ package body Sem_Ch4 is
 
       else
          Analyze (R);
+
          if Is_Entity_Name (R)
            and then Is_Type (Entity (R))
          then