2005-06-14 Robert Dewar <dewar@adacore.com>

	* system-unixware.ads, system-linux-ia64.ads, system-freebsd-x86.ads,
	system-lynxos-ppc.ads, system-lynxos-x86.ads, system-linux-x86_64.ads,
	system-tru64.ads, system-aix.ads, system-vxworks-sparcv9.ads,
	system-vxworks-xscale.ads, system-solaris-x86.ads, system-irix-o32.ads,
	system-irix-n32.ads, system-hpux.ads, system-vxworks-m68k.ads,
	system-linux-x86.ads, system-vxworks-mips.ads, system-vxworks-mips.ads,
	system-os2.ads, system-interix.ads, system-solaris-sparc.ads,
	system-solaris-sparcv9.ads, system-vms.ads, system-mingw.ads,
	system-vms-zcx.ads, system-vxworks-ppc.ads, system.ads,
	system-darwin-ppc.ads, system-vxworks-x86.ads, system-linux-ppc.ads,
	system-linux-hppa.ads, system-vms_64.ads,
	system-vxworks-alpha.ads: Minor comment update for
	AI-362 (unit is Pure).

	* a-chahan.ads, a-chahan.adb: Move Wide_Wide functions to Conversions
	Add pragma Pure_05 for AI-362
	Make remaining conversion functions obsolescent in Ada 95

	* impunit.adb: Change a-swunha to a-swuwha and a-szunha to a-szuzha
	Make Ada.Wide_Characters[.Unicode] available in Ada 95 mode
	Add entries for a-wichun and a-zchuni
	Add a-widcha a-zchara for AI-395
	Add a-chacon (Ada.Characters.Conversions) to list of Ada 2005 routines

	* Makefile.rtl: Change a-swunha to a-swuwha and a-szunha to a-szuzha
	Add entries for a-wichun.o and a-zchuni.o
	Entries for a-widcha.o and a-zchara.o
	Add entry for a-chacon.o

	* a-ztenau.adb: Add with of Ada.Characters.Conversions

	* a-chacon.ads, a-chacon.adb: New files.

	* a-taside.adb, a-exstat.adb, a-excach.adb: Add warnings off to allow
	categorization violations.

	* a-strmap.ads: Add pragma Pure_05 for AI-362
	* a-strmap.ads: Add note on implicit categorization for AI-362

	* a-tgdico.ads, a-taside.ads: Add pragma Preelaborate_05 for AI-362

	* par-prag.adb: Dummy entry for pragma Persistent_BSS
	Set Ada_Version_Explicit, for implementation of AI-362
	Add processing for pragma Pure_05 and Preelaborate_05
	Add entry for Assertion_Policy pragma

	* sem.adb: Make sure predefined units are compiled with GNAT_Mode true
	when needed for proper processing of categorization stuff

	* sem_cat.adb:
	For several cases, make errors in preealborate units warnings,
	instead of errors, if GNAT_Mode is set. For AI-362.

	* sem_elab.adb (Check_Elab_Call): Call to non-static subprogram in
	preelaborate unit is now warning if in GNAT mode

	* s-stoele.ads: Document AI-362 for pragma preelaborate


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@101016 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 267 insertions, 0 deletions

diff --git a/gcc/ada/a-chacon.adb b/gcc/ada/a-chacon.adb
new file mode 100755
index 00000000000..bfbf13c8b03
--- /dev/null
+++ b/gcc/ada/a-chacon.adb
@@ -0,0 +1,267 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--              A D A . C H A R A C T E R S . H A N D L I N G               --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--             Copyright (C) 2005 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 2,  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.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- As a special exception,  if other files  instantiate  generics from this --
+-- unit, or you link  this unit with other files  to produce an executable, --
+-- this  unit  does not  by itself cause  the resulting  executable  to  be --
+-- covered  by the  GNU  General  Public  License.  This exception does not --
+-- however invalidate  any other reasons why  the executable file  might be --
+-- covered by the  GNU Public License.                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+package body Ada.Characters.Conversions is
+
+   ------------------
+   -- Is_Character --
+   ------------------
+
+   function Is_Character (Item : Wide_Character) return Boolean is
+   begin
+      return Wide_Character'Pos (Item) < 256;
+   end Is_Character;
+
+   function Is_Character (Item : Wide_Wide_Character) return Boolean is
+   begin
+      return Wide_Wide_Character'Pos (Item) < 256;
+   end Is_Character;
+
+   ---------------
+   -- Is_String --
+   ---------------
+
+   function Is_String (Item : Wide_String) return Boolean is
+   begin
+      for J in Item'Range loop
+         if Wide_Character'Pos (Item (J)) >= 256 then
+            return False;
+         end if;
+      end loop;
+
+      return True;
+   end Is_String;
+
+   function Is_String (Item : Wide_Wide_String) return Boolean is
+   begin
+      for J in Item'Range loop
+         if Wide_Wide_Character'Pos (Item (J)) >= 256 then
+            return False;
+         end if;
+      end loop;
+
+      return True;
+   end Is_String;
+
+   -----------------------
+   -- Is_Wide_Character --
+   -----------------------
+
+   function Is_Wide_Character (Item : Wide_Wide_Character) return Boolean is
+   begin
+      return Wide_Wide_Character'Pos (Item) < 2**16;
+   end Is_Wide_Character;
+
+   --------------------
+   -- Is_Wide_String --
+   --------------------
+
+   function Is_Wide_String (Item : Wide_Wide_String) return Boolean is
+   begin
+      for J in Item'Range loop
+         if Wide_Wide_Character'Pos (Item (J)) >= 2**16 then
+            return False;
+         end if;
+      end loop;
+
+      return True;
+   end Is_Wide_String;
+
+   ------------------
+   -- To_Character --
+   ------------------
+
+   function To_Character
+     (Item       : Wide_Character;
+      Substitute : Character := ' ') return Character
+   is
+   begin
+      if Is_Character (Item) then
+         return Character'Val (Wide_Character'Pos (Item));
+      else
+         return Substitute;
+      end if;
+   end To_Character;
+
+   function To_Character
+     (Item       : Wide_Wide_Character;
+      Substitute : Character := ' ') return Character
+   is
+   begin
+      if Is_Character (Item) then
+         return Character'Val (Wide_Wide_Character'Pos (Item));
+      else
+         return Substitute;
+      end if;
+   end To_Character;
+
+   ---------------
+   -- To_String --
+   ---------------
+
+   function To_String
+     (Item       : Wide_String;
+      Substitute : Character := ' ') return String
+   is
+      Result : String (1 .. Item'Length);
+
+   begin
+      for J in Item'Range loop
+         Result (J - (Item'First - 1)) := To_Character (Item (J), Substitute);
+      end loop;
+
+      return Result;
+   end To_String;
+
+   function To_String
+     (Item       : Wide_Wide_String;
+      Substitute : Character := ' ') return String
+   is
+      Result : String (1 .. Item'Length);
+
+   begin
+      for J in Item'Range loop
+         Result (J - (Item'First - 1)) := To_Character (Item (J), Substitute);
+      end loop;
+
+      return Result;
+   end To_String;
+
+   -----------------------
+   -- To_Wide_Character --
+   -----------------------
+
+   function To_Wide_Character
+     (Item : Character) return Wide_Character
+   is
+   begin
+      return Wide_Character'Val (Character'Pos (Item));
+   end To_Wide_Character;
+
+   function To_Wide_Character
+     (Item       : Wide_Wide_Character;
+      Substitute : Wide_Character := ' ') return Wide_Character
+   is
+   begin
+      if Wide_Wide_Character'Pos (Item) < 2**16 then
+         return Wide_Character'Val (Wide_Wide_Character'Pos (Item));
+      else
+         return Substitute;
+      end if;
+   end To_Wide_Character;
+
+   --------------------
+   -- To_Wide_String --
+   --------------------
+
+   function To_Wide_String
+     (Item : String) return Wide_String
+   is
+      Result : Wide_String (1 .. Item'Length);
+
+   begin
+      for J in Item'Range loop
+         Result (J - (Item'First - 1)) := To_Wide_Character (Item (J));
+      end loop;
+
+      return Result;
+   end To_Wide_String;
+
+   function To_Wide_String
+     (Item       : Wide_Wide_String;
+      Substitute : Wide_Character := ' ') return Wide_String
+   is
+      Result : Wide_String (1 .. Item'Length);
+
+   begin
+      for J in Item'Range loop
+         Result (J - (Item'First - 1)) :=
+           To_Wide_Character (Item (J), Substitute);
+      end loop;
+
+      return Result;
+   end To_Wide_String;
+
+   ----------------------------
+   -- To_Wide_Wide_Character --
+   ----------------------------
+
+   function To_Wide_Wide_Character
+     (Item : Character) return Wide_Wide_Character
+   is
+   begin
+      return Wide_Wide_Character'Val (Character'Pos (Item));
+   end To_Wide_Wide_Character;
+
+   function To_Wide_Wide_Character
+     (Item : Wide_Character) return Wide_Wide_Character
+   is
+   begin
+      return Wide_Wide_Character'Val (Wide_Character'Pos (Item));
+   end To_Wide_Wide_Character;
+
+   -------------------------
+   -- To_Wide_Wide_String --
+   -------------------------
+
+   function To_Wide_Wide_String
+     (Item : String) return Wide_Wide_String
+   is
+      Result : Wide_Wide_String (1 .. Item'Length);
+
+   begin
+      for J in Item'Range loop
+         Result (J - (Item'First - 1)) := To_Wide_Wide_Character (Item (J));
+      end loop;
+
+      return Result;
+   end To_Wide_Wide_String;
+
+   function To_Wide_Wide_String
+     (Item : Wide_String) return Wide_Wide_String
+   is
+      Result : Wide_Wide_String (1 .. Item'Length);
+
+   begin
+      for J in Item'Range loop
+         Result (J - (Item'First - 1)) := To_Wide_Wide_Character (Item (J));
+      end loop;
+
+      return Result;
+   end To_Wide_Wide_String;
+
+end Ada.Characters.Conversions;