+2010-10-07 Robert Dewar <dewar@adacore.com>
+
+ * sem_res.adb: Minor reformatting
+
+2010-10-07 Olivier Ramonat <ramonat@adacore.com>
+
+ * gnat_ugn.texi: Minor editing.
+ * opt.ads: Document that scripts rely on specific formats in opt.ads
+
+2010-10-07 Robert Dewar <dewar@adacore.com>
+
+ * a-wichun.ads, a-wichun.adb (To_Lower_Case): New function
+ (To_Upper_Case): Fix to be inverse of To_Lower_Case
+ * a-zchuni.ads, a-zchuni.adb (To_Lower_Case): New function
+ (To_Upper_Case): Fix to be inverse of To_Lower_Case
+
+2010-10-07 Robert Dewar <dewar@adacore.com>
+
+ * a-wichha.adb, a-wichha.ads, a-zchhan.adb, a-zchhan.ads: New file.
+ * impunit.adb: Add entries for a-wichha/a-zchhan
+ * Makefile.rtl: Add entries for a-wichha/a-zchhan
+
+2010-10-07 Vincent Celier <celier@adacore.com>
+
+ * make.adb (Check): Call Check_Source_Info_In_ALI with Project_Tree
+ * makeutl.adb (Check_Source_Info_In_ALI): If there is at least one
+ replaced source, check that none of the replaced sources are in the
+ dependencies.
+ * makeutl.ads (Check_Source_Info_In_ALI): New parameter Tree
+ * prj-nmsc.adb (Remove_Source): New parameter Tree. If the source is
+ replaced with a source with a different file name, put it in the hash
+ table Replaced_Sources.
+ (Add_Source): Call Remove_Source with Data.Tree. If there is at least
+ one replaced source, check if it has the same file name as the current
+ source; if it has, remove it from the hash table Replaced_Sources.
+ * prj.adb (Reset): Reset hash table Tree.Replaced_Sources
+ * prj.ads (Replaced_Source_HTable): New hash table
+ (Project_Tree_Data): New components Replaced_Sources and
+ Replaced_Source_Number.
+
+2010-10-07 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_elab.adb (Check_A_Call): After inserting elaboration check, set
+ proper flag to prevent a double elaboration check on the same call.
+ * exp_util.adb (Insert_Actions): If the enclosing node is an
+ Expression_With_Actions and it has been analyzed already, find
+ insertion point further up in the tree.
+
+2010-10-07 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_ch13.adb (Analyze_Record_Representation_Clause): Alphabetize all
+ local variables. Remove the general restriction which prohibits the
+ application of record rep clauses to Unchecked_Union types. Add Ada
+ 2012 check to detect improper naming of an Unchecked_Union
+ discriminant in record rep clause.
+ * sem_prag.adb: Add with and use clause for Exp_Ch7.
+ (Analyze_Pragma): Unchecked_Union case: Propagate the Unchecked_Union
+ type to all invocations of Check_Component and Check_Variant.
+ (Check_Component): Add formal parameters UU_Typ and In_Variant_Part.
+ Rewritten. Add Ada 2012 check to detect improper use of formal
+ private types and private extensions as component types of an
+ Unchecked_Union declared inside a generic body.
+ (Check_Variant): Add formal parameter UU_Typ. Propagate the
+ Unchecked_Union type to all calls of Check_Component. Signal that the
+ current component comes from the variant part of an Unchecked_Union
+ type.
+ (Inside_Generic_Body): New routine.
+
+2010-10-07 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_ch4.adb (Expand_Composite_Equality): When looking for a primitive
+ equality operation for a record component, verify that both formals
+ have the same type, and the result type is boolean.
+
+2010-10-07 Vincent Celier <celier@adacore.com>
+
+ * gnatcmd.adb (Check_Files): When looking for the .ci file for a
+ binder generated file, look for both b~xxx and b__xxx as gprbuild
+ always uses b__ as the prefix of such files.
+
2010-10-07 Thomas Quinot <quinot@adacore.com>
* sem_res.adb: Minor reformatting.
a-tiunio$(objext) \
a-unccon$(objext) \
a-uncdea$(objext) \
+ a-wichha$(objext) \
a-wichun$(objext) \
a-widcha$(objext) \
a-witeio$(objext) \
a-wwboio$(objext) \
a-wwunio$(objext) \
a-zchara$(objext) \
+ a-zchhan$(objext) \
a-zchuni$(objext) \
a-zrstfi$(objext) \
a-ztcoau$(objext) \
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- A D A . W I D E _ C H A R A C T E R S . H A N D L I N G --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2010, 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/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with Ada.Wide_Characters.Unicode; use Ada.Wide_Characters.Unicode;
+
+package body Ada.Wide_Characters.Handling is
+
+ ---------------------
+ -- Is_Alphanumeric --
+ ---------------------
+
+ function Is_Alphanumeric (Item : Wide_Character) return Boolean is
+ begin
+ return Is_Letter (Item) or else Is_Digit (Item);
+ end Is_Alphanumeric;
+
+ ----------------
+ -- Is_Control --
+ ----------------
+
+ function Is_Control (Item : Wide_Character) return Boolean is
+ begin
+ return Get_Category (Item) = Cc;
+ end Is_Control;
+
+ --------------
+ -- Is_Digit --
+ --------------
+
+ function Is_Digit (Item : Wide_Character) return Boolean
+ renames Ada.Wide_Characters.Unicode.Is_Digit;
+
+ ----------------
+ -- Is_Graphic --
+ ----------------
+
+ function Is_Graphic (Item : Wide_Character) return Boolean is
+ begin
+ return not Is_Non_Graphic (Item);
+ end Is_Graphic;
+
+ --------------------------
+ -- Is_Hexadecimal_Digit --
+ --------------------------
+
+ function Is_Hexadecimal_Digit (Item : Wide_Character) return Boolean is
+ begin
+ return Is_Digit (Item)
+ or else Item in 'A' .. 'F'
+ or else Item in 'a' .. 'f';
+ end Is_Hexadecimal_Digit;
+
+ ---------------
+ -- Is_Letter --
+ ---------------
+
+ function Is_Letter (Item : Wide_Character) return Boolean
+ renames Ada.Wide_Characters.Unicode.Is_Letter;
+
+ ------------------------
+ -- Is_Line_Terminator --
+ ------------------------
+
+ function Is_Line_Terminator (Item : Wide_Character) return Boolean
+ renames Ada.Wide_Characters.Unicode.Is_Line_Terminator;
+
+ --------------
+ -- Is_Lower --
+ --------------
+
+ function Is_Lower (Item : Wide_Character) return Boolean is
+ begin
+ return Get_Category (Item) = Ll;
+ end Is_Lower;
+
+ -------------
+ -- Is_Mark --
+ -------------
+
+ function Is_Mark (Item : Wide_Character) return Boolean
+ renames Ada.Wide_Characters.Unicode.Is_Mark;
+
+ --------------
+ -- Is_Other --
+ --------------
+
+ function Is_Other (Item : Wide_Character) return Boolean
+ renames Ada.Wide_Characters.Unicode.Is_Other;
+
+ --------------------
+ -- Is_Punctuation --
+ --------------------
+
+ function Is_Punctuation (Item : Wide_Character) return Boolean
+ renames Ada.Wide_Characters.Unicode.Is_Punctuation;
+
+ --------------
+ -- Is_Space --
+ --------------
+
+ function Is_Space (Item : Wide_Character) return Boolean
+ renames Ada.Wide_Characters.Unicode.Is_Space;
+
+ ----------------
+ -- Is_Special --
+ ----------------
+
+ function Is_Special (Item : Wide_Character) return Boolean is
+ begin
+ return Is_Graphic (Item) and then not Is_Alphanumeric (Item);
+ end Is_Special;
+
+ --------------
+ -- Is_Upper --
+ --------------
+
+ function Is_Upper (Item : Wide_Character) return Boolean is
+ begin
+ return Get_Category (Item) = Lu;
+ end Is_Upper;
+
+ --------------
+ -- To_Lower --
+ --------------
+
+ function To_Lower (Item : Wide_Character) return Wide_Character
+ renames Ada.Wide_Characters.Unicode.To_Lower_Case;
+
+ function To_Lower (Item : Wide_String) return Wide_String is
+ Result : Wide_String (Item'Range);
+
+ begin
+ for J in Result'Range loop
+ Result (J) := To_Lower (Item (J));
+ end loop;
+
+ return Result;
+ end To_Lower;
+
+ --------------
+ -- To_Upper --
+ --------------
+
+ function To_Upper (Item : Wide_Character) return Wide_Character
+ renames Ada.Wide_Characters.Unicode.To_Upper_Case;
+
+ function To_Upper (Item : Wide_String) return Wide_String is
+ Result : Wide_String (Item'Range);
+
+ begin
+ for J in Result'Range loop
+ Result (J) := To_Upper (Item (J));
+ end loop;
+
+ return Result;
+ end To_Upper;
+
+end Ada.Wide_Characters.Handling;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- A D A . W I D E _ C H A R A C T E R S . H A N D L I N G --
+-- --
+-- S p e c --
+-- --
+-- This specification is derived from the Ada Reference Manual for use with --
+-- GNAT. In accordance with the copyright of that document, you can freely --
+-- copy and modify this specification, provided that if you redistribute a --
+-- modified version, any changes that you have made are clearly indicated. --
+-- --
+------------------------------------------------------------------------------
+
+package Ada.Wide_Characters.Handling is
+
+ function Is_Control (Item : Wide_Character) return Boolean;
+ pragma Inline (Is_Control);
+ -- Returns True if the Wide_Character designated by Item is categorized as
+ -- other_control, otherwise returns false.
+
+ function Is_Letter (Item : Wide_Character) return Boolean;
+ pragma Inline (Is_Letter);
+ -- Returns True if the Wide_Character designated by Item is categorized as
+ -- letter_uppercase, letter_lowercase, letter_titlecase, letter_modifier,
+ -- letter_other, or number_letter. Otherwise returns false.
+
+ function Is_Lower (Item : Wide_Character) return Boolean;
+ pragma Inline (Is_Lower);
+ -- Returns True if the Wide_Character designated by Item is categorized as
+ -- letter_lowercase, otherwise returns false.
+
+ function Is_Upper (Item : Wide_Character) return Boolean;
+ pragma Inline (Is_Upper);
+ -- Returns True if the Wide_Character designated by Item is categorized as
+ -- letter_uppercase, otherwise returns false.
+
+ function Is_Digit (Item : Wide_Character) return Boolean;
+ pragma Inline (Is_Digit);
+ -- Returns True if the Wide_Character designated by Item is categorized as
+ -- number_decimal, otherwise returns false.
+
+ function Is_Decimal_Digit (Item : Wide_Character) return Boolean
+ renames Is_Digit;
+
+ function Is_Hexadecimal_Digit (Item : Wide_Character) return Boolean;
+ -- Returns True if the Wide_Character designated by Item is categorized as
+ -- number_decimal, or is in the range 'A' .. 'F' or 'a' .. 'f', otherwise
+ -- returns false.
+
+ function Is_Alphanumeric (Item : Wide_Character) return Boolean;
+ pragma Inline (Is_Alphanumeric);
+ -- Returns True if the Wide_Character designated by Item is categorized as
+ -- number_decimal, or is in the range 'A' .. 'F' or 'a' .. 'f', otherwise
+ -- returns false.
+
+ function Is_Special (Item : Wide_Character) return Boolean;
+ pragma Inline (Is_Special);
+ -- Returns True if the Wide_Character designated by Item is categorized
+ -- as graphic_character, but not categorized as letter_uppercase,
+ -- letter_lowercase, letter_titlecase, letter_modifier, letter_other,
+ -- number_letter, or number_decimal. Otherwise returns false.
+
+ function Is_Line_Terminator (Item : Wide_Character) return Boolean;
+ pragma Inline (Is_Line_Terminator);
+ -- Returns True if the Wide_Character designated by Item is categorized as
+ -- separator_line or separator_paragraph, or if Item is a conventional line
+ -- terminator character (CR, LF, VT, or FF). Otherwise returns false.
+
+ function Is_Mark (Item : Wide_Character) return Boolean;
+ pragma Inline (Is_Mark);
+ -- Returns True if the Wide_Character designated by Item is categorized as
+ -- mark_non_spacing or mark_spacing_combining, otherwise returns false.
+
+ function Is_Other (Item : Wide_Character) return Boolean;
+ pragma Inline (Is_Other);
+ -- Returns True if the Wide_Character designated by Item is categorized as
+ -- other_format, otherwise returns false.
+
+ function Is_Punctuation (Item : Wide_Character) return Boolean;
+ pragma Inline (Is_Punctuation);
+ -- Returns True if the Wide_Character designated by Item is categorized as
+ -- punctuation_connector, otherwise returns false.
+
+ function Is_Space (Item : Wide_Character) return Boolean;
+ pragma Inline (Is_Space);
+ -- Returns True if the Wide_Character designated by Item is categorized as
+ -- separator_space, otherwise returns false.
+
+ function Is_Graphic (Item : Wide_Character) return Boolean;
+ pragma Inline (Is_Graphic);
+ -- Returns True if the Wide_Character designated by Item is categorized as
+ -- graphic_character, otherwise returns false.
+
+ function To_Lower (Item : Wide_Character) return Wide_Character;
+ pragma Inline (To_Lower);
+ -- Returns the Simple Lowercase Mapping of the Wide_Character designated by
+ -- Item. If the Simple Lowercase Mapping does not exist for the
+ -- Wide_Character designated by Item, then the value of Item is returned.
+
+ function To_Lower (Item : Wide_String) return Wide_String;
+ -- Returns the result of applying the To_Lower Wide_Character to
+ -- Wide_Character conversion to each element of the Wide_String designated
+ -- by Item. The result is the null Wide_String if the value of the formal
+ -- parameter is the null Wide_String.
+
+ function To_Upper (Item : Wide_Character) return Wide_Character;
+ pragma Inline (To_Upper);
+ -- Returns the Simple Uppercase Mapping of the Wide_Character designated by
+ -- Item. If the Simple Uppercase Mapping does not exist for the
+ -- Wide_Character designated by Item, then the value of Item is returned.
+
+ function To_Upper (Item : Wide_String) return Wide_String;
+ -- Returns the result of applying the To_Upper Wide_Character to
+ -- Wide_Character conversion to each element of the Wide_String designated
+ -- by Item. The result is the null Wide_String if the value of the formal
+ -- parameter is the null Wide_String.
+
+end Ada.Wide_Characters.Handling;
-- --
-- B o d y --
-- --
--- Copyright (C) 2005-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 2005-2010, 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- --
end Is_Space;
-------------------
+ -- To_Lower_Case --
+ -------------------
+
+ function To_Lower_Case
+ (U : Wide_Character) return Wide_Character
+ is
+ begin
+ return
+ Wide_Character'Val
+ (G.UTF_32_To_Lower_Case (Wide_Character'Pos (U)));
+ end To_Lower_Case;
+
+ -------------------
-- To_Upper_Case --
-------------------
-- --
-- S p e c --
-- --
--- Copyright (C) 2005-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 2005-2010, 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- --
-- The following function is used to fold to upper case, as required by
-- the Ada 2005 standard rules for identifier case folding. Two
-- identifiers are equivalent if they are identical after folding all
- -- letters to upper case using this routine.
+ -- letters to upper case using this routine. A corresponding function to
+ -- fold to lower case is also provided.
+
+ function To_Lower_Case (U : Wide_Character) return Wide_Character;
+ pragma Inline (To_Lower_Case);
+ -- If U represents an upper case letter, returns the corresponding lower
+ -- case letter, otherwise U is returned unchanged. The folding is locale
+ -- independent as defined by documents referenced in the note in section
+ -- 1 of ISO/IEC 10646:2003
function To_Upper_Case (U : Wide_Character) return Wide_Character;
pragma Inline (To_Upper_Case);
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- A D A . W I D E _ W I D E _ C H A R A C T E R S . H A N D L I N G --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2010, 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/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with Ada.Wide_Wide_Characters.Unicode; use Ada.Wide_Wide_Characters.Unicode;
+
+package body Ada.Wide_Wide_Characters.Handling is
+
+ ---------------------
+ -- Is_Alphanumeric --
+ ---------------------
+
+ function Is_Alphanumeric (Item : Wide_Wide_Character) return Boolean is
+ begin
+ return Is_Letter (Item) or else Is_Digit (Item);
+ end Is_Alphanumeric;
+
+ ----------------
+ -- Is_Control --
+ ----------------
+
+ function Is_Control (Item : Wide_Wide_Character) return Boolean is
+ begin
+ return Get_Category (Item) = Cc;
+ end Is_Control;
+
+ --------------
+ -- Is_Digit --
+ --------------
+
+ function Is_Digit (Item : Wide_Wide_Character) return Boolean
+ renames Ada.Wide_Wide_Characters.Unicode.Is_Digit;
+
+ ----------------
+ -- Is_Graphic --
+ ----------------
+
+ function Is_Graphic (Item : Wide_Wide_Character) return Boolean is
+ begin
+ return not Is_Non_Graphic (Item);
+ end Is_Graphic;
+
+ --------------------------
+ -- Is_Hexadecimal_Digit --
+ --------------------------
+
+ function Is_Hexadecimal_Digit (Item : Wide_Wide_Character) return Boolean is
+ begin
+ return Is_Digit (Item)
+ or else Item in 'A' .. 'F'
+ or else Item in 'a' .. 'f';
+ end Is_Hexadecimal_Digit;
+
+ ---------------
+ -- Is_Letter --
+ ---------------
+
+ function Is_Letter (Item : Wide_Wide_Character) return Boolean
+ renames Ada.Wide_Wide_Characters.Unicode.Is_Letter;
+
+ ------------------------
+ -- Is_Line_Terminator --
+ ------------------------
+
+ function Is_Line_Terminator (Item : Wide_Wide_Character) return Boolean
+ renames Ada.Wide_Wide_Characters.Unicode.Is_Line_Terminator;
+
+ --------------
+ -- Is_Lower --
+ --------------
+
+ function Is_Lower (Item : Wide_Wide_Character) return Boolean is
+ begin
+ return Get_Category (Item) = Ll;
+ end Is_Lower;
+
+ -------------
+ -- Is_Mark --
+ -------------
+
+ function Is_Mark (Item : Wide_Wide_Character) return Boolean
+ renames Ada.Wide_Wide_Characters.Unicode.Is_Mark;
+
+ --------------
+ -- Is_Other --
+ --------------
+
+ function Is_Other (Item : Wide_Wide_Character) return Boolean
+ renames Ada.Wide_Wide_Characters.Unicode.Is_Other;
+
+ --------------------
+ -- Is_Punctuation --
+ --------------------
+
+ function Is_Punctuation (Item : Wide_Wide_Character) return Boolean
+ renames Ada.Wide_Wide_Characters.Unicode.Is_Punctuation;
+
+ --------------
+ -- Is_Space --
+ --------------
+
+ function Is_Space (Item : Wide_Wide_Character) return Boolean
+ renames Ada.Wide_Wide_Characters.Unicode.Is_Space;
+
+ ----------------
+ -- Is_Special --
+ ----------------
+
+ function Is_Special (Item : Wide_Wide_Character) return Boolean is
+ begin
+ return Is_Graphic (Item) and then not Is_Alphanumeric (Item);
+ end Is_Special;
+
+ --------------
+ -- Is_Upper --
+ --------------
+
+ function Is_Upper (Item : Wide_Wide_Character) return Boolean is
+ begin
+ return Get_Category (Item) = Lu;
+ end Is_Upper;
+
+ --------------
+ -- To_Lower --
+ --------------
+
+ function To_Lower (Item : Wide_Wide_Character) return Wide_Wide_Character
+ renames Ada.Wide_Wide_Characters.Unicode.To_Lower_Case;
+
+ function To_Lower (Item : Wide_Wide_String) return Wide_Wide_String is
+ Result : Wide_Wide_String (Item'Range);
+
+ begin
+ for J in Result'Range loop
+ Result (J) := To_Lower (Item (J));
+ end loop;
+
+ return Result;
+ end To_Lower;
+
+ --------------
+ -- To_Upper --
+ --------------
+
+ function To_Upper (Item : Wide_Wide_Character) return Wide_Wide_Character
+ renames Ada.Wide_Wide_Characters.Unicode.To_Upper_Case;
+
+ function To_Upper (Item : Wide_Wide_String) return Wide_Wide_String is
+ Result : Wide_Wide_String (Item'Range);
+
+ begin
+ for J in Result'Range loop
+ Result (J) := To_Upper (Item (J));
+ end loop;
+
+ return Result;
+ end To_Upper;
+
+end Ada.Wide_Wide_Characters.Handling;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME COMPONENTS --
+-- --
+-- A D A . W I D E _ W I D E _ C H A R A C T E R S . H A N D L I N G --
+-- --
+-- S p e c --
+-- --
+-- This specification is derived from the Ada Reference Manual for use with --
+-- GNAT. In accordance with the copyright of that document, you can freely --
+-- copy and modify this specification, provided that if you redistribute a --
+-- modified version, any changes that you have made are clearly indicated. --
+-- --
+------------------------------------------------------------------------------
+
+package Ada.Wide_Wide_Characters.Handling is
+
+ function Is_Control (Item : Wide_Wide_Character) return Boolean;
+ pragma Inline (Is_Control);
+ -- Returns True if the Wide_Wide_Character designated by Item is
+ -- categorized as other_control, otherwise returns false.
+
+ function Is_Letter (Item : Wide_Wide_Character) return Boolean;
+ pragma Inline (Is_Letter);
+ -- Returns True if the Wide_Wide_Character designated by Item is
+ -- categorized as letter_uppercase, letter_lowercase, letter_titlecase,
+ -- letter_modifier, letter_other, or number_letter. Otherwise returns
+ -- false.
+
+ function Is_Lower (Item : Wide_Wide_Character) return Boolean;
+ pragma Inline (Is_Lower);
+ -- Returns True if the Wide_Wide_Character designated by Item is
+ -- categorized as letter_lowercase, otherwise returns false.
+
+ function Is_Upper (Item : Wide_Wide_Character) return Boolean;
+ pragma Inline (Is_Upper);
+ -- Returns True if the Wide_Wide_Character designated by Item is
+ -- categorized as letter_uppercase, otherwise returns false.
+
+ function Is_Digit (Item : Wide_Wide_Character) return Boolean;
+ pragma Inline (Is_Digit);
+ -- Returns True if the Wide_Wide_Character designated by Item is
+ -- categorized as number_decimal, otherwise returns false.
+
+ function Is_Decimal_Digit (Item : Wide_Wide_Character) return Boolean
+ renames Is_Digit;
+
+ function Is_Hexadecimal_Digit (Item : Wide_Wide_Character) return Boolean;
+ -- Returns True if the Wide_Wide_Character designated by Item is
+ -- categorized as number_decimal, or is in the range 'A' .. 'F' or
+ -- 'a' .. 'f', otherwise returns false.
+
+ function Is_Alphanumeric (Item : Wide_Wide_Character) return Boolean;
+ pragma Inline (Is_Alphanumeric);
+ -- Returns True if the Wide_Wide_Character designated by Item is
+ -- categorized as letter_uppercase, letter_lowercase, letter_titlecase,
+ -- letter_modifier, letter_other, number_letter, or number_decimal.
+ -- Otherwise returns false.
+
+ function Is_Special (Item : Wide_Wide_Character) return Boolean;
+ pragma Inline (Is_Special);
+ -- Returns True if the Wide_Wide_Character designated by Item
+ -- is categorized as graphic_character, but not categorized as
+ -- letter_uppercase, letter_lowercase, letter_titlecase, letter_modifier,
+ -- letter_other, number_letter, or number_decimal. Otherwise returns false.
+
+ function Is_Line_Terminator (Item : Wide_Wide_Character) return Boolean;
+ pragma Inline (Is_Line_Terminator);
+ -- Returns True if the Wide_Wide_Character designated by Item is
+ -- categorized as separator_line or separator_paragraph, or if Item is a
+ -- conventional line terminator character (CR, LF, VT, or FF). Otherwise
+ -- returns false.
+
+ function Is_Mark (Item : Wide_Wide_Character) return Boolean;
+ pragma Inline (Is_Mark);
+ -- Returns True if the Wide_Wide_Character designated by Item is
+ -- categorized as mark_non_spacing or mark_spacing_combining, otherwise
+ -- returns false.
+
+ function Is_Other (Item : Wide_Wide_Character) return Boolean;
+ pragma Inline (Is_Other);
+ -- Returns True if the Wide_Wide_Character designated by Item is
+ -- categorized as other_format, otherwise returns false.
+
+ function Is_Punctuation (Item : Wide_Wide_Character) return Boolean;
+ pragma Inline (Is_Punctuation);
+ -- Returns True if the Wide_Wide_Character designated by Item is
+ -- categorized as punctuation_connector, otherwise returns false.
+
+ function Is_Space (Item : Wide_Wide_Character) return Boolean;
+ pragma Inline (Is_Space);
+ -- Returns True if the Wide_Wide_Character designated by Item is
+ -- categorized as separator_space, otherwise returns false.
+
+ function Is_Graphic (Item : Wide_Wide_Character) return Boolean;
+ pragma Inline (Is_Graphic);
+ -- Returns True if the Wide_Wide_Character designated by Item is
+ -- categorized as graphic_character, otherwise returns false.
+
+ function To_Lower (Item : Wide_Wide_Character) return Wide_Wide_Character;
+ pragma Inline (To_Lower);
+ -- Returns the Simple Lowercase Mapping of the Wide_Wide_Character
+ -- designated by Item. If the Simple Lowercase Mapping does not exist for
+ -- the Wide_Wide_Character designated by Item, then the value of Item is
+ -- returned.
+
+ function To_Lower (Item : Wide_Wide_String) return Wide_Wide_String;
+ -- Returns the result of applying the To_Lower Wide_Wide_Character to
+ -- Wide_Wide_Character conversion to each element of the Wide_Wide_String
+ -- designated by Item. The result is the null Wide_Wide_String if the value
+ -- of the formal parameter is the null Wide_Wide_String.
+
+ function To_Upper (Item : Wide_Wide_Character) return Wide_Wide_Character;
+ pragma Inline (To_Upper);
+ -- Returns the Simple Uppercase Mapping of the Wide_Wide_Character
+ -- designated by Item. If the Simple Uppercase Mapping does not exist for
+ -- the Wide_Wide_Character designated by Item, then the value of Item is
+ -- returned.
+
+ function To_Upper (Item : Wide_Wide_String) return Wide_Wide_String;
+ -- Returns the result of applying the To_Upper Wide_Wide_Character to
+ -- Wide_Wide_Character conversion to each element of the Wide_Wide_String
+ -- designated by Item. The result is the null Wide_Wide_String if the value
+ -- of the formal parameter is the null Wide_Wide_String.
+
+end Ada.Wide_Wide_Characters.Handling;
-- --
-- B o d y --
-- --
--- Copyright (C) 2005-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 2005-2010, 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- --
end Is_Space;
-------------------
+ -- To_Lower_Case --
+ -------------------
+
+ function To_Lower_Case
+ (U : Wide_Wide_Character) return Wide_Wide_Character
+ is
+ begin
+ return
+ Wide_Wide_Character'Val
+ (G.UTF_32_To_Lower_Case (Wide_Wide_Character'Pos (U)));
+ end To_Lower_Case;
+
+ -------------------
-- To_Upper_Case --
-------------------
-- --
-- S p e c --
-- --
--- Copyright (C) 2005-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 2005-2010, 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- --
-- The following function is used to fold to upper case, as required by
-- the Ada 2005 standard rules for identifier case folding. Two
-- identifiers are equivalent if they are identical after folding all
- -- letters to upper case using this routine.
+ -- letters to upper case using this routine. A fold to lower routine is
+ -- also provided.
+
+ function To_Lower_Case
+ (U : Wide_Wide_Character) return Wide_Wide_Character;
+ pragma Inline (To_Lower_Case);
+ -- If U represents an upper case letter, returns the corresponding lower
+ -- case letter, otherwise U is returned unchanged. The folding is locale
+ -- independent as defined by documents referenced in the note in section
+ -- 1 of ISO/IEC 10646:2003
function To_Upper_Case
(U : Wide_Wide_Character) return Wide_Wide_Character;
begin
Prim := First_Elmt (Collect_Primitive_Operations (Full_Type));
while Present (Prim) loop
- if Chars (Node (Prim)) = Name_Op_Eq then
+
+ -- Locate primitive equality with the right signature
+
+ if Chars (Node (Prim)) = Name_Op_Eq
+ and then Etype (First_Formal (Node (Prim))) =
+ Etype (Next_Formal (First_Formal (Node (Prim))))
+ and then Etype (Node (Prim)) = Standard_Boolean
+ then
if Is_Abstract_Subprogram (Node (Prim)) then
return
Make_Raise_Program_Error (Loc,
return;
-- Case of appearing within an Expressions_With_Actions node. We
- -- prepend the actions to the list of actions already there.
+ -- prepend the actions to the list of actions already there, if
+ -- the node has not been analyzed yet. Otherwise find insertion
+ -- location further up the tree.
when N_Expression_With_Actions =>
- Prepend_List (Ins_Actions, Actions (P));
- return;
+ if not Analyzed (P) then
+ Prepend_List (Ins_Actions, Actions (P));
+ return;
+ end if;
-- Case of appearing in the condition of a while expression or
-- elsif. We insert the actions into the Condition_Actions field.
@option{-gnat83} and @option{-gnat95} switches for further
information).
+@ifset PROEDITION
Note that even though Ada 2005 is the current official version of the
language, GNAT still compiles in Ada 95 mode by default, so if you are
using Ada 2005 features in your program, you must use this switch (or
the equivalent Ada_05 or Ada_2005 configuration pragmas).
+@end ifset
@item -gnat12 or -gnat2012 (Ada 2012 mode)
@cindex @option{-gnat12} (@command{gcc})
-- harmless (and useful) to make then available in Ada 95 mode, since
-- they do not deal with Wide_Wide_Character.
+ "a-wichha", -- Ada.Wide_Characters.Handling
"a-stuten", -- Ada.Strings.UTF_Encoding
"a-suenco", -- Ada.Strings.UTF_Encoding.Conversions
"a-suesen", -- Ada.Strings.UTF_Encoding.String_Encoding
"a-wwboio", -- Ada.Wide_Text_IO.Wide_Bounded_IO
"a-wwunio", -- Ada.Wide_Text_IO.Wide_Unbounded_IO
"a-zchara", -- Ada.Wide_Wide_Characters
+ "a-zchhan", -- Ada.Wide_Wide_Characters.Handling
"a-ztcoio", -- Ada.Wide_Wide_Text_IO.Complex_IO
"a-ztedit", -- Ada.Wide_Wide_Text_IO.Editing
"a-zttest", -- Ada.Wide_Wide_Text_IO.Text_Streams
elsif not Read_Only and then Main_Project /= No_Project then
- if not Check_Source_Info_In_ALI (ALI) then
+ if not Check_Source_Info_In_ALI (ALI, Project_Tree) then
ALI := No_ALI_Id;
return;
end if;
-- Check_Source_Info_In_ALI --
------------------------------
- function Check_Source_Info_In_ALI (The_ALI : ALI_Id) return Boolean is
+ function Check_Source_Info_In_ALI
+ (The_ALI : ALI_Id;
+ Tree : Project_Tree_Ref) return Boolean
+ is
Unit_Name : Name_Id;
begin
end loop;
end loop;
- -- Loop to check subunits
+ -- Loop to check subunits and replaced sources
for D in ALIs.Table (The_ALI).First_Sdep ..
ALIs.Table (The_ALI).Last_Sdep
begin
Unit_Name := SD.Subunit_Name;
- if Unit_Name /= No_Name then
+ if Unit_Name = No_Name then
+ -- Check if this source file has been replaced by a source with
+ -- a different file name.
+
+ if Tree /= null and then Tree.Replaced_Source_Number > 0 then
+ declare
+ Replacement : constant File_Name_Type :=
+ Replaced_Source_HTable.Get
+ (Tree.Replaced_Sources, SD.Sfile);
+
+ begin
+ if Replacement /= No_File then
+ if Verbose_Mode then
+ Write_Line
+ ("source file" &
+ Get_Name_String (SD.Sfile) &
+ " has been replaced by " &
+ Get_Name_String (Replacement));
+ end if;
+ return False;
+ end if;
+ end;
+ end if;
+
+ else
-- For separates, the file is no longer associated with the
-- unit ("proc-sep.adb" is not associated with unit "proc.sep")
-- so we need to check whether the source file still exists in
-- True if the unit is in one of the project file, but the file name is not
-- one of its source. Returns False otherwise.
- function Check_Source_Info_In_ALI (The_ALI : ALI.ALI_Id) return Boolean;
+ function Check_Source_Info_In_ALI
+ (The_ALI : ALI.ALI_Id;
+ Tree : Project_Tree_Ref) return Boolean;
-- Check whether all file references in ALI are still valid (i.e. the
-- source files are still associated with the same units). Return True
-- if everything is still valid.
-- GNAT
-- Default Ada version if no switch given. The Warnings off is to kill
-- constant condition warnings.
+ --
+ -- WARNING: some scripts rely on the format of this line of code. Any
+ -- change must be coordinated with the scripts requirements.
Ada_Version : Ada_Version_Type := Ada_Version_Default;
-- GNAT
-- if file cannot be found.
procedure Remove_Source
- (Id : Source_Id;
+ (Tree : Project_Tree_Ref;
+ Id : Source_Id;
Replaced_By : Source_Id);
-- Remove a file from the list of sources of a project. This might be
-- because the file is replaced by another one in an extending project,
Lang_Id.First_Source := Id;
if Source_To_Replace /= No_Source then
- Remove_Source (Source_To_Replace, Id);
+ Remove_Source (Data.Tree, Source_To_Replace, Id);
+ end if;
+
+ if Data.Tree.Replaced_Source_Number > 0 and then
+ Replaced_Source_HTable.Get (Data.Tree.Replaced_Sources, Id.File) /=
+ No_File
+ then
+ Replaced_Source_HTable.Remove (Data.Tree.Replaced_Sources, Id.File);
+ Data.Tree.Replaced_Source_Number :=
+ Data.Tree.Replaced_Source_Number - 1;
end if;
Files_Htable.Set (Data.File_To_Source, File_Name, Id);
(Project.Source_Names,
Source.File,
No_Name_Location);
- Remove_Source (Source, No_Source);
+ Remove_Source (Data.Tree, Source, No_Source);
Error_Msg_Name_1 := Name_Id (Source.File);
Error_Msg
end if;
if Source.Path = No_Path_Information then
- Remove_Source (Source, No_Source);
+ Remove_Source (Data.Tree, Source, No_Source);
end if;
end if;
-------------------
procedure Remove_Source
- (Id : Source_Id;
+ (Tree : Project_Tree_Ref;
+ Id : Source_Id;
Replaced_By : Source_Id)
is
Source : Source_Id;
if Replaced_By /= No_Source then
Id.Replaced_By := Replaced_By;
Replaced_By.Declared_In_Interfaces := Id.Declared_In_Interfaces;
+
+ if Id.File /= Replaced_By.File then
+ declare
+ Replacement : constant File_Name_Type :=
+ Replaced_Source_HTable.Get (Tree.Replaced_Sources, Id.File);
+ begin
+ Replaced_Source_HTable.Set
+ (Tree.Replaced_Sources, Id.File, Replaced_By.File);
+
+ if Replacement = No_File then
+ Tree.Replaced_Source_Number :=
+ Tree.Replaced_Source_Number + 1;
+ end if;
+ end;
+ end if;
end if;
Id.In_Interfaces := False;
Array_Table.Init (Tree.Arrays);
Package_Table.Init (Tree.Packages);
Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
+ Replaced_Source_HTable.Reset (Tree.Replaced_Sources);
+
+ Tree.Replaced_Source_Number := 0;
Free_List (Tree.Projects, Free_Project => True);
Free_Units (Tree.Units_HT);
-- Project_Tree_Data --
-----------------------
+ package Replaced_Source_HTable is new Simple_HTable
+ (Header_Num => Header_Num,
+ Element => File_Name_Type,
+ No_Element => No_File,
+ Key => File_Name_Type,
+ Hash => Hash,
+ Equal => "=");
+
type Private_Project_Tree_Data is private;
-- Data for a project tree that is used only by the Project Manager
Packages : Package_Table.Instance;
Projects : Project_List;
+ Replaced_Sources : Replaced_Source_HTable.Instance;
+ -- The list of sources that have been replaced by sources with
+ -- different file names.
+
+ Replaced_Source_Number : Natural := 0;
+ -- The number of entries in Replaced_Sources
+
Units_HT : Units_Htable.Instance;
-- Unit name to Unit_Index (and from there so Source_Id)
-- for the remainder of this processing.
procedure Analyze_Record_Representation_Clause (N : Node_Id) is
- Ident : constant Node_Id := Identifier (N);
- Rectype : Entity_Id;
+ Ident : constant Node_Id := Identifier (N);
+ Biased : Boolean;
CC : Node_Id;
- Posit : Uint;
+ Comp : Entity_Id;
Fbit : Uint;
- Lbit : Uint;
Hbit : Uint := Uint_0;
- Comp : Entity_Id;
+ Lbit : Uint;
Ocomp : Entity_Id;
- Biased : Boolean;
+ Posit : Uint;
+ Rectype : Entity_Id;
CR_Pragma : Node_Id := Empty;
-- Points to N_Pragma node if Complete_Representation pragma present
("record type required, found}", Ident, First_Subtype (Rectype));
return;
- elsif Is_Unchecked_Union (Rectype) then
- Error_Msg_N
- ("record rep clause not allowed for Unchecked_Union", N);
-
elsif Scope (Rectype) /= Current_Scope then
Error_Msg_N ("type must be declared in this scope", N);
return;
Error_Msg_N
("component clause is for non-existent field", CC);
+ -- Ada 2012 (AI05-0026): Any name that denotes a
+ -- discriminant of an object of an unchecked union type
+ -- shall not occur within a record_representation_clause.
+
+ -- The general restriction of using record rep clauses on
+ -- Unchecked_Union types has now been lifted. Since it is
+ -- possible to introduce a record rep clause which mentions
+ -- the discriminant of an Unchecked_Union in non-Ada 2012
+ -- code, this check is applied to all versions of the
+ -- language.
+
+ elsif Ekind (Comp) = E_Discriminant
+ and then Is_Unchecked_Union (Rectype)
+ then
+ Error_Msg_N
+ ("cannot reference discriminant of Unchecked_Union",
+ Component_Name (CC));
+
elsif Present (Component_Clause (Comp)) then
-- Diagnose duplicate rep clause, or check consistency
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Elaborated,
Prefix => New_Occurrence_Of (Spec_Entity (E_Scope), Loc)));
+
+ -- Prevent duplicate elaboration checks on the same call,
+ -- which can happen if the body enclosing the call appears
+ -- itself in a call whose elaboration check is delayed.
+
+ if
+ Nkind_In (N, N_Function_Call, N_Procedure_Call_Statement)
+ then
+ Set_No_Elaboration_Check (N);
+ end if;
end if;
-- Case of static elaboration model
with Einfo; use Einfo;
with Elists; use Elists;
with Errout; use Errout;
+with Exp_Ch7; use Exp_Ch7;
with Exp_Dist; use Exp_Dist;
with Lib; use Lib;
with Lib.Writ; use Lib.Writ;
procedure Check_At_Most_N_Arguments (N : Nat);
-- Check there are no more than N arguments present
- procedure Check_Component (Comp : Node_Id);
- -- Examine Unchecked_Union component for correct use of per-object
+ procedure Check_Component
+ (Comp : Node_Id;
+ UU_Typ : Entity_Id;
+ In_Variant_Part : Boolean := False);
+ -- Examine an Unchecked_Union component for correct use of per-object
-- constrained subtypes, and for restrictions on finalizable components.
+ -- UU_Typ is the related Unchecked_Union type. Flag In_Variant_Part
+ -- should be set when Comp comes from a record variant.
procedure Check_Duplicated_Export_Name (Nam : Node_Id);
-- Nam is an N_String_Literal node containing the external name set by
-- and to library level instantiations), and they are simply ignored,
-- which is implemented by rewriting them as null statements.
- procedure Check_Variant (Variant : Node_Id);
- -- Check Unchecked_Union variant for lack of nested variants and
- -- presence of at least one component.
+ procedure Check_Variant (Variant : Node_Id; UU_Typ : Entity_Id);
+ -- Check an Unchecked_Union variant for lack of nested variants and
+ -- presence of at least one component. UU_Typ is the related Unchecked_
+ -- Union type.
procedure Error_Pragma (Msg : String);
pragma No_Return (Error_Pragma);
-- Check_Component --
---------------------
- procedure Check_Component (Comp : Node_Id) is
- begin
- if Nkind (Comp) = N_Component_Declaration then
- declare
- Sindic : constant Node_Id :=
- Subtype_Indication (Component_Definition (Comp));
- Typ : constant Entity_Id :=
- Etype (Defining_Identifier (Comp));
- begin
- if Nkind (Sindic) = N_Subtype_Indication then
+ procedure Check_Component
+ (Comp : Node_Id;
+ UU_Typ : Entity_Id;
+ In_Variant_Part : Boolean := False)
+ is
+ Comp_Id : constant Entity_Id := Defining_Identifier (Comp);
+ Sindic : constant Node_Id :=
+ Subtype_Indication (Component_Definition (Comp));
+ Typ : constant Entity_Id := Etype (Comp_Id);
- -- Ada 2005 (AI-216): If a component subtype is subject to
- -- a per-object constraint, then the component type shall
- -- be an Unchecked_Union.
+ function Inside_Generic_Body (Id : Entity_Id) return Boolean;
+ -- Determine whether entity Id appears inside a generic body
- if Has_Per_Object_Constraint (Defining_Identifier (Comp))
- and then
- not Is_Unchecked_Union (Etype (Subtype_Mark (Sindic)))
- then
- Error_Msg_N ("component subtype subject to per-object" &
- " constraint must be an Unchecked_Union", Comp);
- end if;
- end if;
+ -------------------------
+ -- Inside_Generic_Body --
+ -------------------------
- if Is_Controlled (Typ) then
- Error_Msg_N
- ("component of unchecked union cannot be controlled", Comp);
+ function Inside_Generic_Body (Id : Entity_Id) return Boolean is
+ S : Entity_Id := Id;
- elsif Has_Task (Typ) then
- Error_Msg_N
- ("component of unchecked union cannot have tasks", Comp);
+ begin
+ while Present (S)
+ and then S /= Standard_Standard
+ loop
+ if Ekind (S) = E_Generic_Package
+ and then In_Package_Body (S)
+ then
+ return True;
end if;
- end;
+
+ S := Scope (S);
+ end loop;
+
+ return False;
+ end Inside_Generic_Body;
+
+ -- Start of processing for Check_Component
+
+ begin
+ -- Ada 2005 (AI-216): If a component subtype is subject to a per-
+ -- object constraint, then the component type shall be an Unchecked_
+ -- Union.
+
+ if Nkind (Sindic) = N_Subtype_Indication
+ and then Has_Per_Object_Constraint (Comp_Id)
+ and then not Is_Unchecked_Union (Etype (Subtype_Mark (Sindic)))
+ then
+ Error_Msg_N
+ ("component subtype subject to per-object constraint " &
+ "must be an Unchecked_Union", Comp);
+
+ -- Ada 2012 (AI05-0026): For an unchecked union type declared within
+ -- the body of a generic unit, or within the body of any of its
+ -- descendant library units, no part of the type of a component
+ -- declared in a variant_part of the unchecked union type shall be of
+ -- a formal private type or formal private extension declared within
+ -- the formal part of the generic unit.
+
+ elsif Ada_Version >= Ada_2012
+ and then Inside_Generic_Body (UU_Typ)
+ and then In_Variant_Part
+ and then Is_Private_Type (Typ)
+ and then Is_Generic_Type (Typ)
+ then
+ Error_Msg_N
+ ("component of Unchecked_Union cannot be of generic type", Comp);
+
+ elsif Needs_Finalization (Typ) then
+ Error_Msg_N
+ ("component of Unchecked_Union cannot be controlled", Comp);
+
+ elsif Has_Task (Typ) then
+ Error_Msg_N
+ ("component of Unchecked_Union cannot have tasks", Comp);
end if;
end Check_Component;
-- Check_Variant --
-------------------
- procedure Check_Variant (Variant : Node_Id) is
+ procedure Check_Variant (Variant : Node_Id; UU_Typ : Entity_Id) is
Clist : constant Node_Id := Component_List (Variant);
Comp : Node_Id;
Comp := First (Component_Items (Clist));
while Present (Comp) loop
- Check_Component (Comp);
+ Check_Component (Comp, UU_Typ, In_Variant_Part => True);
Next (Comp);
end loop;
end Check_Variant;
Comp := First (Component_Items (Clist));
while Present (Comp) loop
- Check_Component (Comp);
+ Check_Component (Comp, Typ);
Next (Comp);
end loop;
Variant := First (Variants (Vpart));
while Present (Variant) loop
- Check_Variant (Variant);
+ Check_Variant (Variant, Typ);
Next (Variant);
end loop;
end if;
begin
return Ekind (Btyp) = E_Access_Type
or else (Ekind (Btyp) = E_Access_Subprogram_Type
- and then Comes_From_Source (Btyp));
+ and then Comes_From_Source (Btyp));
end Is_Definite_Access_Type;
----------------------
OSDN Git Service
