summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2010-10-07 09:26:27 +0000
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2010-10-07 09:26:27 +0000
commit7800b9207149c3e61d50c05a4e3b39483bc883ec (patch)
tree18f5293df900e9613129fa71e2e652368370cc1c
parentbb0ed4ab93c51ff538f3368a236c984d1314fd56 (diff)
downloadgcc-7800b9207149c3e61d50c05a4e3b39483bc883ec.tar.gz
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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@165084 138bc75d-0d04-0410-961f-82ee72b054a4
-rw-r--r--gcc/ada/ChangeLog80
-rw-r--r--gcc/ada/Makefile.rtl2
-rwxr-xr-xgcc/ada/a-wichha.adb186
-rwxr-xr-xgcc/ada/a-wichha.ads120
-rw-r--r--gcc/ada/a-wichun.adb15
-rw-r--r--gcc/ada/a-wichun.ads12
-rwxr-xr-xgcc/ada/a-zchhan.adb186
-rwxr-xr-xgcc/ada/a-zchhan.ads126
-rwxr-xr-xgcc/ada/a-zchuni.adb15
-rwxr-xr-xgcc/ada/a-zchuni.ads13
-rw-r--r--gcc/ada/exp_ch4.adb9
-rw-r--r--gcc/ada/exp_util.adb10
-rw-r--r--gcc/ada/gnat_ugn.texi2
-rw-r--r--gcc/ada/impunit.adb2
-rw-r--r--gcc/ada/make.adb2
-rw-r--r--gcc/ada/makeutl.adb33
-rw-r--r--gcc/ada/makeutl.ads4
-rw-r--r--gcc/ada/opt.ads3
-rw-r--r--gcc/ada/prj-nmsc.adb36
-rw-r--r--gcc/ada/prj.adb3
-rw-r--r--gcc/ada/prj.ads15
-rw-r--r--gcc/ada/sem_ch13.adb34
-rw-r--r--gcc/ada/sem_elab.adb10
-rw-r--r--gcc/ada/sem_prag.adb122
-rw-r--r--gcc/ada/sem_res.adb2
25 files changed, 974 insertions, 68 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 1bbae2632ed..bc00ea0c57c 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,83 @@
+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.
diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl
index 169c368427c..b913d2f0331 100644
--- a/gcc/ada/Makefile.rtl
+++ b/gcc/ada/Makefile.rtl
@@ -268,6 +268,7 @@ GNATRTL_NONTASKING_OBJS= \
a-tiunio$(objext) \
a-unccon$(objext) \
a-uncdea$(objext) \
+ a-wichha$(objext) \
a-wichun$(objext) \
a-widcha$(objext) \
a-witeio$(objext) \
@@ -292,6 +293,7 @@ GNATRTL_NONTASKING_OBJS= \
a-wwboio$(objext) \
a-wwunio$(objext) \
a-zchara$(objext) \
+ a-zchhan$(objext) \
a-zchuni$(objext) \
a-zrstfi$(objext) \
a-ztcoau$(objext) \
diff --git a/gcc/ada/a-wichha.adb b/gcc/ada/a-wichha.adb
new file mode 100755
index 00000000000..2dad375a4f0
--- /dev/null
+++ b/gcc/ada/a-wichha.adb
@@ -0,0 +1,186 @@
+------------------------------------------------------------------------------
+-- --
+-- 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;
diff --git a/gcc/ada/a-wichha.ads b/gcc/ada/a-wichha.ads
new file mode 100755
index 00000000000..50c3ff8ed19
--- /dev/null
+++ b/gcc/ada/a-wichha.ads
@@ -0,0 +1,120 @@
+------------------------------------------------------------------------------
+-- --
+-- 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;
diff --git a/gcc/ada/a-wichun.adb b/gcc/ada/a-wichun.adb
index 65df45119cc..b36d4a435d4 100644
--- a/gcc/ada/a-wichun.adb
+++ b/gcc/ada/a-wichun.adb
@@ -6,7 +6,7 @@
-- --
-- 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- --
@@ -150,6 +150,19 @@ package body Ada.Wide_Characters.Unicode is
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 --
-------------------
diff --git a/gcc/ada/a-wichun.ads b/gcc/ada/a-wichun.ads
index af614538067..08ac83d6f67 100644
--- a/gcc/ada/a-wichun.ads
+++ b/gcc/ada/a-wichun.ads
@@ -6,7 +6,7 @@
-- --
-- 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- --
@@ -176,7 +176,15 @@ package Ada.Wide_Characters.Unicode is
-- 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);
diff --git a/gcc/ada/a-zchhan.adb b/gcc/ada/a-zchhan.adb
new file mode 100755
index 00000000000..836d334ebd9
--- /dev/null
+++ b/gcc/ada/a-zchhan.adb
@@ -0,0 +1,186 @@
+------------------------------------------------------------------------------
+-- --
+-- 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;
diff --git a/gcc/ada/a-zchhan.ads b/gcc/ada/a-zchhan.ads
new file mode 100755
index 00000000000..973a7803dce
--- /dev/null
+++ b/gcc/ada/a-zchhan.ads
@@ -0,0 +1,126 @@
+------------------------------------------------------------------------------
+-- --
+-- 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;
diff --git a/gcc/ada/a-zchuni.adb b/gcc/ada/a-zchuni.adb
index 4e628961d81..5e0b1cbdc26 100755
--- a/gcc/ada/a-zchuni.adb
+++ b/gcc/ada/a-zchuni.adb
@@ -6,7 +6,7 @@
-- --
-- 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- --
@@ -150,6 +150,19 @@ package body Ada.Wide_Wide_Characters.Unicode is
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 --
-------------------
diff --git a/gcc/ada/a-zchuni.ads b/gcc/ada/a-zchuni.ads
index 1786e79d92e..10506957a29 100755
--- a/gcc/ada/a-zchuni.ads
+++ b/gcc/ada/a-zchuni.ads
@@ -6,7 +6,7 @@
-- --
-- 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- --
@@ -173,7 +173,16 @@ package Ada.Wide_Wide_Characters.Unicode is
-- 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;
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 48a96d80d27..41de2b5ffe0 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -2193,7 +2193,14 @@ package body Exp_Ch4 is
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,
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 99ec49ad21c..b1f96e9398f 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -2451,11 +2451,15 @@ package body Exp_Util is
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.
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 03d0976168a..ae154fc215e 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -6980,10 +6980,12 @@ may generally be compiled using this switch (see the description of the
@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})
diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb
index fe89924333e..2b6f3192201 100644
--- a/gcc/ada/impunit.adb
+++ b/gcc/ada/impunit.adb
@@ -177,6 +177,7 @@ package body Impunit is
-- 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
@@ -426,6 +427,7 @@ package body Impunit is
"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
diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb
index 154e1dd2450..567f1269510 100644
--- a/gcc/ada/make.adb
+++ b/gcc/ada/make.adb
@@ -1843,7 +1843,7 @@ package body Make is
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;
diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb
index f72e613bc50..1ac84a2b3f8 100644
--- a/gcc/ada/makeutl.adb
+++ b/gcc/ada/makeutl.adb
@@ -203,7 +203,10 @@ package body Makeutl is
-- 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
@@ -242,7 +245,7 @@ package body Makeutl is
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
@@ -253,8 +256,32 @@ package body Makeutl is
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
diff --git a/gcc/ada/makeutl.ads b/gcc/ada/makeutl.ads
index 4bfe6cdd704..5ba084a0004 100644
--- a/gcc/ada/makeutl.ads
+++ b/gcc/ada/makeutl.ads
@@ -105,7 +105,9 @@ package Makeutl is
-- 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.
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index eae72e0dd08..17e1c3de8df 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -78,6 +78,9 @@ package Opt is
-- 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
diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index ae0c882da68..82c74f52948 100644
--- a/gcc/ada/prj-nmsc.adb
+++ b/gcc/ada/prj-nmsc.adb
@@ -482,7 +482,8 @@ package body Prj.Nmsc is
-- 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,
@@ -872,7 +873,16 @@ package body Prj.Nmsc is
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);
@@ -6193,7 +6203,7 @@ package body Prj.Nmsc is
(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
@@ -6277,7 +6287,7 @@ package body Prj.Nmsc is
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;
@@ -7589,7 +7599,8 @@ package body Prj.Nmsc is
-------------------
procedure Remove_Source
- (Id : Source_Id;
+ (Tree : Project_Tree_Ref;
+ Id : Source_Id;
Replaced_By : Source_Id)
is
Source : Source_Id;
@@ -7609,6 +7620,21 @@ package body Prj.Nmsc is
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;
diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb
index 4ec2349edaf..5a69848a808 100644
--- a/gcc/ada/prj.adb
+++ b/gcc/ada/prj.adb
@@ -898,6 +898,9 @@ package body Prj is
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);
diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads
index 76a2e326dad..4fc6c93a669 100644
--- a/gcc/ada/prj.ads
+++ b/gcc/ada/prj.ads
@@ -1333,6 +1333,14 @@ package Prj is
-- 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
@@ -1347,6 +1355,13 @@ package Prj is
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)
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index e5d174bec4d..a583ddece69 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -2506,16 +2506,16 @@ package body Sem_Ch13 is
-- 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
@@ -2543,10 +2543,6 @@ package body Sem_Ch13 is
("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;
@@ -2722,6 +2718,24 @@ package body Sem_Ch13 is
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
diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb
index b4c214ddeeb..9af2e5c96a2 100644
--- a/gcc/ada/sem_elab.adb
+++ b/gcc/ada/sem_elab.adb
@@ -939,6 +939,16 @@ package body Sem_Elab is
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
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 409293a09d3..64724c92427 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -37,6 +37,7 @@ with Debug; use Debug;
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;
@@ -392,9 +393,14 @@ package body Sem_Prag is
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
@@ -483,9 +489,10 @@ package body Sem_Prag is
-- 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);
@@ -1094,39 +1101,80 @@ package body Sem_Prag is
-- 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;
@@ -1698,7 +1746,7 @@ package body Sem_Prag is
-- 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;
@@ -1712,7 +1760,7 @@ package body Sem_Prag is
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;
@@ -11971,7 +12019,7 @@ package body Sem_Prag is
Comp := First (Component_Items (Clist));
while Present (Comp) loop
- Check_Component (Comp);
+ Check_Component (Comp, Typ);
Next (Comp);
end loop;
@@ -11986,7 +12034,7 @@ package body Sem_Prag is
Variant := First (Variants (Vpart));
while Present (Variant) loop
- Check_Variant (Variant);
+ Check_Variant (Variant, Typ);
Next (Variant);
end loop;
end if;
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 34bddda4346..84576770ec8 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -1150,7 +1150,7 @@ package body Sem_Res is
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;
----------------------