diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2011-09-01 10:32:07 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2011-09-01 10:32:07 +0000 |
commit | e7b8f0ea2585687ebf4a18f8a69ffe5f52d8412a (patch) | |
tree | 3bf386129cb6edc9bc9ad806556457084e89b051 /gcc/ada | |
parent | 5cf8a00884edaefd3723f5f435d3602dd779810e (diff) | |
download | gcc-e7b8f0ea2585687ebf4a18f8a69ffe5f52d8412a.tar.gz |
2011-09-01 Hristian Kirtchev <kirtchev@adacore.com>
* exp_strm.adb: Remove with and use clause for Opt.
(Build_Array_Input_Function): Remove the version-dependent generation
of the return statement. The Ada 2005 tree is now the default.
2011-09-01 Yannick Moy <moy@adacore.com>
* put_alfa.adb: Unconditionnally write files in Alfa section, so that
it is never empty when compiling in Alfa mode.
2011-09-01 Robert Dewar <dewar@adacore.com>
* sem_aggr.adb, sem_ch3.adb, a-direct.adb, s-taprop-vxworks.adb,
comperr.adb, exp_ch9.adb, exp_pakd.adb, sem_ch12.adb, freeze.adb,
s-taprop-mingw.adb, s-taprop-linux.adb, s-taprop-solaris.adb,
gnat1drv.adb, a-rbtgbo.adb, exp_dist.adb: Minor reformatting
2011-09-01 Matthew Heaney <heaney@adacore.com>
* Makefile.rtl, impunit.adb: Add a-csquin.ads, a-cusyqu.ad[sb],
a-cuprqu.ad[sb], a-cbsyqu.ad[sb], a-cbprqu.ad[sb]
* a-csquin.ads: New Ada 2012 unit that specifies the queue interface
* a-cusyqu.ads, a-cusyqu.adb: New Ada 2012 unit that specifies the
unbounded queue container.
* a-cbsyqu.ads, a-cbsyqu.adb: New Ada 2012 unit that specifies the
bounded queue container.
* a-cuprqu.ads, a-cuprqu.adb: New Ada 2012 unit that specifies the
unbounded priority queue container.
* a-cbprqu.ads, a-cbprqu.adb: New Ada 2012 unit that specifies the
bounded priority queue container.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@178398 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada')
-rw-r--r-- | gcc/ada/ChangeLog | 32 | ||||
-rw-r--r-- | gcc/ada/Makefile.rtl | 5 | ||||
-rw-r--r-- | gcc/ada/a-cbprqu.adb | 159 | ||||
-rw-r--r-- | gcc/ada/a-cbprqu.ads | 118 | ||||
-rw-r--r-- | gcc/ada/a-cbsyqu.adb | 168 | ||||
-rw-r--r-- | gcc/ada/a-cbsyqu.ads | 104 | ||||
-rw-r--r-- | gcc/ada/a-csquin.ads | 56 | ||||
-rw-r--r-- | gcc/ada/a-cuprqu.adb | 223 | ||||
-rw-r--r-- | gcc/ada/a-cuprqu.ads | 127 | ||||
-rw-r--r-- | gcc/ada/a-cusyqu.adb | 174 | ||||
-rw-r--r-- | gcc/ada/a-cusyqu.ads | 107 | ||||
-rw-r--r-- | gcc/ada/a-direct.adb | 7 | ||||
-rw-r--r-- | gcc/ada/a-rbtgbo.adb | 1 | ||||
-rw-r--r-- | gcc/ada/comperr.adb | 48 | ||||
-rw-r--r-- | gcc/ada/exp_ch9.adb | 15 | ||||
-rw-r--r-- | gcc/ada/exp_dist.adb | 3 | ||||
-rw-r--r-- | gcc/ada/exp_pakd.adb | 11 | ||||
-rw-r--r-- | gcc/ada/exp_strm.adb | 23 | ||||
-rw-r--r-- | gcc/ada/freeze.adb | 1 | ||||
-rw-r--r-- | gcc/ada/gnat1drv.adb | 2 | ||||
-rw-r--r-- | gcc/ada/impunit.adb | 5 | ||||
-rw-r--r-- | gcc/ada/put_alfa.adb | 24 | ||||
-rw-r--r-- | gcc/ada/s-taprop-linux.adb | 9 | ||||
-rw-r--r-- | gcc/ada/s-taprop-mingw.adb | 9 | ||||
-rw-r--r-- | gcc/ada/s-taprop-solaris.adb | 9 | ||||
-rw-r--r-- | gcc/ada/s-taprop-vxworks.adb | 9 | ||||
-rw-r--r-- | gcc/ada/sem_aggr.adb | 1 | ||||
-rw-r--r-- | gcc/ada/sem_ch12.adb | 1 | ||||
-rw-r--r-- | gcc/ada/sem_ch3.adb | 3 |
29 files changed, 1366 insertions, 88 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3c0621129c5..4188b5597db 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,35 @@ +2011-09-01 Hristian Kirtchev <kirtchev@adacore.com> + + * exp_strm.adb: Remove with and use clause for Opt. + (Build_Array_Input_Function): Remove the version-dependent generation + of the return statement. The Ada 2005 tree is now the default. + +2011-09-01 Yannick Moy <moy@adacore.com> + + * put_alfa.adb: Unconditionnally write files in Alfa section, so that + it is never empty when compiling in Alfa mode. + +2011-09-01 Robert Dewar <dewar@adacore.com> + + * sem_aggr.adb, sem_ch3.adb, a-direct.adb, s-taprop-vxworks.adb, + comperr.adb, exp_ch9.adb, exp_pakd.adb, sem_ch12.adb, freeze.adb, + s-taprop-mingw.adb, s-taprop-linux.adb, s-taprop-solaris.adb, + gnat1drv.adb, a-rbtgbo.adb, exp_dist.adb: Minor reformatting + +2011-09-01 Matthew Heaney <heaney@adacore.com> + + * Makefile.rtl, impunit.adb: Add a-csquin.ads, a-cusyqu.ad[sb], + a-cuprqu.ad[sb], a-cbsyqu.ad[sb], a-cbprqu.ad[sb] + * a-csquin.ads: New Ada 2012 unit that specifies the queue interface + * a-cusyqu.ads, a-cusyqu.adb: New Ada 2012 unit that specifies the + unbounded queue container. + * a-cbsyqu.ads, a-cbsyqu.adb: New Ada 2012 unit that specifies the + bounded queue container. + * a-cuprqu.ads, a-cuprqu.adb: New Ada 2012 unit that specifies the + unbounded priority queue container. + * a-cbprqu.ads, a-cbprqu.adb: New Ada 2012 unit that specifies the + bounded priority queue container. + 2011-08-31 Pascal Obry <obry@adacore.com> * a-direct.adb: Do not try to create an UNC path on Windows. diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index 762ca78da28..7707300d0be 100644 --- a/gcc/ada/Makefile.rtl +++ b/gcc/ada/Makefile.rtl @@ -94,6 +94,8 @@ GNATRTL_NONTASKING_OBJS= \ a-cbdlli$(objext) \ a-cbmutr$(objext) \ a-cborma$(objext) \ + a-cbprqu$(objext) \ + a-cbsyqu$(objext) \ a-cdlili$(objext) \ a-cfdlli$(objext) \ a-cfhama$(objext) \ @@ -144,6 +146,9 @@ GNATRTL_NONTASKING_OBJS= \ a-crdlli$(objext) \ a-comutr$(objext) \ a-cimutr$(objext) \ + a-csquin$(objext) \ + a-cuprqu$(objext) \ + a-cusyqu$(objext) \ a-cwila1$(objext) \ a-cwila9$(objext) \ a-decima$(objext) \ diff --git a/gcc/ada/a-cbprqu.adb b/gcc/ada/a-cbprqu.adb new file mode 100644 index 00000000000..99c9f0801af --- /dev/null +++ b/gcc/ada/a-cbprqu.adb @@ -0,0 +1,159 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT LIBRARY COMPONENTS -- +-- -- +-- ADA.CONTAINERS.BOUNDED_PRIORITY_QUEUES -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2004-2011, Free Software Foundation, Inc. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- This unit was originally developed by Matthew J Heaney. -- +------------------------------------------------------------------------------ + +package body Ada.Containers.Bounded_Priority_Queues is + + package body Implementation is + + ------------- + -- Dequeue -- + ------------- + + procedure Dequeue + (List : in out List_Type; + Element : out Queue_Interfaces.Element_Type) + is + begin + Element := List.Container.First_Element; + List.Container.Delete_First; + end Dequeue; + + ------------- + -- Enqueue -- + ------------- + + procedure Enqueue + (List : in out List_Type; + New_Item : Queue_Interfaces.Element_Type) + is + P : constant Queue_Priority := Get_Priority (New_Item); + + C : List_Types.Cursor; + use List_Types; + + Count : Count_Type; + + begin + C := List.Container.First; + while Has_Element (C) loop + -- ??? + -- if Before (P, Get_Priority (List.Constant_Reference (C))) then + if Before (P, Get_Priority (Element (C))) then + List.Container.Insert (C, New_Item); + exit; + end if; + + Next (C); + end loop; + + if not Has_Element (C) then + List.Container.Append (New_Item); + end if; + + Count := List.Container.Length; + + if Count > List.Max_Length then + List.Max_Length := Count; + end if; + end Enqueue; + + ------------ + -- Length -- + ------------ + + function Length (List : List_Type) return Count_Type is + begin + return List.Container.Length; + end Length; + + ---------------- + -- Max_Length -- + ---------------- + + function Max_Length (List : List_Type) return Count_Type is + begin + return List.Max_Length; + end Max_Length; + + end Implementation; + + protected body Queue is + + ------------------ + -- Current_Use -- + ------------------ + + function Current_Use return Count_Type is + begin + return List.Length; + end Current_Use; + + -------------- + -- Dequeue -- + -------------- + + entry Dequeue (Element : out Queue_Interfaces.Element_Type) + when List.Length > 0 + is + begin + List.Dequeue (Element); + end Dequeue; + + -- ??? + -- entry Dequeue_Only_High_Priority + -- (Low_Priority : Queue_Priority; + -- Element : out Queue_Interfaces.Element_Type) when True + -- is + -- begin + -- null; + -- end Dequeue_Only_High_Priority; + + -------------- + -- Enqueue -- + -------------- + + entry Enqueue (New_Item : Queue_Interfaces.Element_Type) + when List.Length < Capacity + is + begin + List.Enqueue (New_Item); + end Enqueue; + + --------------- + -- Peak_Use -- + --------------- + + function Peak_Use return Count_Type is + begin + return List.Max_Length; + end Peak_Use; + + end Queue; + +end Ada.Containers.Bounded_Priority_Queues; diff --git a/gcc/ada/a-cbprqu.ads b/gcc/ada/a-cbprqu.ads new file mode 100644 index 00000000000..1ee087a9ed2 --- /dev/null +++ b/gcc/ada/a-cbprqu.ads @@ -0,0 +1,118 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT LIBRARY COMPONENTS -- +-- -- +-- ADA.CONTAINERS.BOUNDED_PRIORITY_QUEUES -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2004-2011, Free Software Foundation, Inc. -- +-- -- +-- This specification is derived from the Ada Reference Manual for use with -- +-- GNAT. The copyright notice above, and the license provisions that follow -- +-- apply solely to the contents of the part following the private keyword. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- This unit was originally developed by Matthew J Heaney. -- +------------------------------------------------------------------------------ + +with System; +with Ada.Containers.Synchronized_Queue_Interfaces; +with Ada.Containers.Bounded_Doubly_Linked_Lists; + +generic + with package Queue_Interfaces is + new Ada.Containers.Synchronized_Queue_Interfaces (<>); + + type Queue_Priority is private; + + with function Get_Priority + (Element : Queue_Interfaces.Element_Type) return Queue_Priority is <>; + + with function Before + (Left, Right : Queue_Priority) return Boolean is <>; + + Default_Capacity : Count_Type; + Default_Ceiling : System.Any_Priority := System.Priority'Last; + +package Ada.Containers.Bounded_Priority_Queues is + pragma Preelaborate; + + package Implementation is + + type List_Type (Capacity : Count_Type) is tagged limited private; + + procedure Enqueue + (List : in out List_Type; + New_Item : Queue_Interfaces.Element_Type); + + procedure Dequeue + (List : in out List_Type; + Element : out Queue_Interfaces.Element_Type); + + function Length (List : List_Type) return Count_Type; + + function Max_Length (List : List_Type) return Count_Type; + + private + + -- We need a better data structure here, such as a proper heap. ??? + + package List_Types is new Bounded_Doubly_Linked_Lists + (Element_Type => Queue_Interfaces.Element_Type, + "=" => Queue_Interfaces."="); + + type List_Type (Capacity : Count_Type) is tagged limited record + Container : List_Types.List (Capacity); + Max_Length : Count_Type := 0; + end record; + + end Implementation; + + protected type Queue + (Capacity : Count_Type := Default_Capacity; + Ceiling : System.Any_Priority := Default_Ceiling) + -- ??? + -- with Priority => Ceiling is new Queue_Interfaces.Queue with + is new Queue_Interfaces.Queue with + + overriding + entry Enqueue (New_Item : Queue_Interfaces.Element_Type); + + overriding + entry Dequeue (Element : out Queue_Interfaces.Element_Type); + + -- ??? + -- not overriding + -- entry Dequeue_Only_High_Priority + -- (Low_Priority : Queue_Priority; + -- Element : out Queue_Interfaces.Element_Type); + + overriding + function Current_Use return Count_Type; + + overriding + function Peak_Use return Count_Type; + + private + + List : Implementation.List_Type (Capacity); + + end Queue; + +end Ada.Containers.Bounded_Priority_Queues; diff --git a/gcc/ada/a-cbsyqu.adb b/gcc/ada/a-cbsyqu.adb new file mode 100644 index 00000000000..7f8400e4840 --- /dev/null +++ b/gcc/ada/a-cbsyqu.adb @@ -0,0 +1,168 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT LIBRARY COMPONENTS -- +-- -- +-- ADA.CONTAINERS.BOUNDED_SYNCHRONIZED_QUEUES -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2004-2011, Free Software Foundation, Inc. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- This unit was originally developed by Matthew J Heaney. -- +------------------------------------------------------------------------------ + +package body Ada.Containers.Bounded_Synchronized_Queues is + + package body Implementation is + + ------------- + -- Dequeue -- + ------------- + + procedure Dequeue + (List : in out List_Type; + Element : out Queue_Interfaces.Element_Type) + is + EE : Element_Array renames List.Elements; + + begin + Element := EE (List.First); + List.Length := List.Length - 1; + + if List.Length = 0 then + List.First := 0; + List.Last := 0; + + elsif List.First <= List.Last then + List.First := List.First + 1; + + else + List.First := List.First + 1; + + if List.First > List.Capacity then + List.First := 1; + end if; + end if; + end Dequeue; + + ------------- + -- Enqueue -- + ------------- + + procedure Enqueue + (List : in out List_Type; + New_Item : Queue_Interfaces.Element_Type) + is + begin + if List.Length >= List.Capacity then + raise Capacity_Error with "No capacity for insertion"; + end if; + + if List.Length = 0 then + List.Elements (1) := New_Item; + List.First := 1; + List.Last := 1; + + elsif List.First <= List.Last then + if List.Last < List.Capacity then + List.Elements (List.Last + 1) := New_Item; + List.Last := List.Last + 1; + + else + List.Elements (1) := New_Item; + List.Last := 1; + end if; + + else + List.Elements (List.Last + 1) := New_Item; + List.Last := List.Last + 1; + end if; + + List.Length := List.Length + 1; + + if List.Length > List.Max_Length then + List.Max_Length := List.Length; + end if; + end Enqueue; + + ------------ + -- Length -- + ------------ + + function Length (List : List_Type) return Count_Type is + begin + return List.Length; + end Length; + + ---------------- + -- Max_Length -- + ---------------- + + function Max_Length (List : List_Type) return Count_Type is + begin + return List.Max_Length; + end Max_Length; + + end Implementation; + + protected body Queue is + + ----------------- + -- Current_Use -- + ----------------- + + function Current_Use return Count_Type is + begin + return List.Length; + end Current_Use; + + ------------- + -- Dequeue -- + ------------- + + entry Dequeue (Element : out Queue_Interfaces.Element_Type) + when List.Length > 0 + is + begin + List.Dequeue (Element); + end Dequeue; + + ------------- + -- Enqueue -- + ------------- + + entry Enqueue (New_Item : Queue_Interfaces.Element_Type) + when List.Length < Capacity + is + begin + List.Enqueue (New_Item); + end Enqueue; + + -------------- + -- Peak_Use -- + -------------- + + function Peak_Use return Count_Type is + begin + return List.Max_Length; + end Peak_Use; + + end Queue; + +end Ada.Containers.Bounded_Synchronized_Queues; diff --git a/gcc/ada/a-cbsyqu.ads b/gcc/ada/a-cbsyqu.ads new file mode 100644 index 00000000000..ab4a31cb28d --- /dev/null +++ b/gcc/ada/a-cbsyqu.ads @@ -0,0 +1,104 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT LIBRARY COMPONENTS -- +-- -- +-- ADA.CONTAINERS.BOUNDED_SYNCHRONIZED_QUEUES -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2004-2011, Free Software Foundation, Inc. -- +-- -- +-- This specification is derived from the Ada Reference Manual for use with -- +-- GNAT. The copyright notice above, and the license provisions that follow -- +-- apply solely to the contents of the part following the private keyword. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- This unit was originally developed by Matthew J Heaney. -- +------------------------------------------------------------------------------ + +with System; +with Ada.Containers.Synchronized_Queue_Interfaces; + +generic + with package Queue_Interfaces is + new Ada.Containers.Synchronized_Queue_Interfaces (<>); + + Default_Capacity : Count_Type; + Default_Ceiling : System.Any_Priority := System.Priority'Last; + +package Ada.Containers.Bounded_Synchronized_Queues is + pragma Preelaborate; + + package Implementation is + + type List_Type (Capacity : Count_Type) is tagged limited private; + + procedure Enqueue + (List : in out List_Type; + New_Item : Queue_Interfaces.Element_Type); + + procedure Dequeue + (List : in out List_Type; + Element : out Queue_Interfaces.Element_Type); + + function Length (List : List_Type) return Count_Type; + + function Max_Length (List : List_Type) return Count_Type; + + private + + -- Need proper heap data structure here ??? + + type Element_Array is + array (Count_Type range <>) of Queue_Interfaces.Element_Type; + + type List_Type (Capacity : Count_Type) is tagged limited record + First, Last : Count_Type := 0; + Length : Count_Type := 0; + Max_Length : Count_Type := 0; + Elements : Element_Array (1 .. Capacity) := (others => <>); + end record; + + end Implementation; + + protected type Queue + (Capacity : Count_Type := Default_Capacity; + Ceiling : System.Any_Priority := Default_Ceiling) + -- ??? + -- with Priority => Ceiling is new Queue_Interfaces.Queue with + is new Queue_Interfaces.Queue with + + overriding + entry Enqueue (New_Item : Queue_Interfaces.Element_Type); + + overriding + entry Dequeue (Element : out Queue_Interfaces.Element_Type); + + overriding + function Current_Use return Count_Type; + + overriding + function Peak_Use return Count_Type; + + private + + List : Implementation.List_Type (Capacity); + + end Queue; + +end Ada.Containers.Bounded_Synchronized_Queues; diff --git a/gcc/ada/a-csquin.ads b/gcc/ada/a-csquin.ads new file mode 100644 index 00000000000..4a544d43188 --- /dev/null +++ b/gcc/ada/a-csquin.ads @@ -0,0 +1,56 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT LIBRARY COMPONENTS -- +-- -- +-- ADA.CONTAINERS.SYNCHRONIZED_QUEUE_INTERFACES -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2004-2011, Free Software Foundation, Inc. -- +-- -- +-- This specification is derived from the Ada Reference Manual for use with -- +-- GNAT. The copyright notice above, and the license provisions that follow -- +-- apply solely to the contents of the part following the private keyword. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- This unit was originally developed by Matthew J Heaney. -- +------------------------------------------------------------------------------ + +generic + type Element_Type is private; + +package Ada.Containers.Synchronized_Queue_Interfaces is + pragma Pure; + + type Queue is synchronized interface; + + procedure Enqueue + (Container : in out Queue; + New_Item : Element_Type) is abstract; + -- with Is_Synchronized => By_Entry; ??? + + procedure Dequeue + (Container : in out Queue; + Element : out Element_Type) is abstract; + -- with Is_Synchronized => By_Entry; ??? + + function Current_Use (Container : Queue) return Count_Type is abstract; + + function Peak_Use (Container : Queue) return Count_Type is abstract; + +end Ada.Containers.Synchronized_Queue_Interfaces; diff --git a/gcc/ada/a-cuprqu.adb b/gcc/ada/a-cuprqu.adb new file mode 100644 index 00000000000..f83ca429012 --- /dev/null +++ b/gcc/ada/a-cuprqu.adb @@ -0,0 +1,223 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT LIBRARY COMPONENTS -- +-- -- +-- ADA.CONTAINERS.UNBOUNDED_PRIORITY_QUEUES -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2004-2011, Free Software Foundation, Inc. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- This unit was originally developed by Matthew J Heaney. -- +------------------------------------------------------------------------------ + +with Ada.Unchecked_Deallocation; + +package body Ada.Containers.Unbounded_Priority_Queues is + + package body Implementation is + + ----------------------- + -- Local Subprograms -- + ----------------------- + + procedure Free is + new Ada.Unchecked_Deallocation (Node_Type, Node_Access); + + ------------- + -- Dequeue -- + ------------- + + procedure Dequeue + (List : in out List_Type; + Element : out Queue_Interfaces.Element_Type) + is + X : Node_Access; + + begin + Element := List.First.Element; + + X := List.First; + List.First := List.First.Next; + + if List.First = null then + List.Last := null; + end if; + + List.Length := List.Length - 1; + + Free (X); + end Dequeue; + + ------------- + -- Enqueue -- + ------------- + + procedure Enqueue + (List : in out List_Type; + New_Item : Queue_Interfaces.Element_Type) + is + P : constant Queue_Priority := Get_Priority (New_Item); + + Node : Node_Access; + Prev : Node_Access; + + begin + Node := new Node_Type'(New_Item, null); + + if List.First = null then + List.First := Node; + List.Last := List.First; + + else + Prev := List.First; + + if Before (P, Get_Priority (Prev.Element)) then + Node.Next := List.First; + List.First := Node; + + else + while Prev.Next /= null loop + if Before (P, Get_Priority (Prev.Next.Element)) then + Node.Next := Prev.Next; + Prev.Next := Node; + + exit; + end if; + + Prev := Prev.Next; + end loop; + + if Prev.Next = null then + List.Last.Next := Node; + List.Last := Node; + end if; + end if; + end if; + + List.Length := List.Length + 1; + + if List.Length > List.Max_Length then + List.Max_Length := List.Length; + end if; + end Enqueue; + + -------------- + -- Finalize -- + -------------- + + procedure Finalize (List : in out List_Type) is + X : Node_Access; + + begin + while List.First /= null loop + X := List.First; + List.First := List.First.Next; + Free (X); + end loop; + end Finalize; + + ------------------------ + -- Have_High_Priority -- + ------------------------ + + -- ??? + -- function Have_High_Priority + -- (List : List_Type; + -- Low_Priority : Queue_Priority) return Boolean + -- is + -- begin + -- if List.Length = 0 then + -- return False; + -- end if; + -- return Before (Get_Priority (List.First.Element), Low_Priority); + -- end Have_High_Priority; + + ------------ + -- Length -- + ------------ + + function Length (List : List_Type) return Count_Type is + begin + return List.Length; + end Length; + + ---------------- + -- Max_Length -- + ---------------- + + function Max_Length (List : List_Type) return Count_Type is + begin + return List.Max_Length; + end Max_Length; + + end Implementation; + + protected body Queue is + + ----------------- + -- Current_Use -- + ----------------- + + function Current_Use return Count_Type is + begin + return List.Length; + end Current_Use; + + ------------- + -- Dequeue -- + ------------- + + entry Dequeue (Element : out Queue_Interfaces.Element_Type) + when List.Length > 0 + is + begin + List.Dequeue (Element); + end Dequeue; + + -- ??? + -- entry Dequeue_Only_High_Priority + -- (Low_Priority : Queue_Priority; + -- Element : out Queue_Interfaces.Element_Type) when True + -- is + -- begin + -- null; + -- end Dequeue_Only_High_Priority; + + ------------- + -- Enqueue -- + ------------- + + entry Enqueue (New_Item : Queue_Interfaces.Element_Type) when True is + begin + List.Enqueue (New_Item); + end Enqueue; + + -------------- + -- Peak_Use -- + -------------- + + function Peak_Use return Count_Type is + begin + return List.Max_Length; + end Peak_Use; + + end Queue; + +end Ada.Containers.Unbounded_Priority_Queues; diff --git a/gcc/ada/a-cuprqu.ads b/gcc/ada/a-cuprqu.ads new file mode 100644 index 00000000000..c06faf33cab --- /dev/null +++ b/gcc/ada/a-cuprqu.ads @@ -0,0 +1,127 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT LIBRARY COMPONENTS -- +-- -- +-- ADA.CONTAINERS.UNBOUNDED_PRIORITY_QUEUES -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2004-2011, Free Software Foundation, Inc. -- +-- -- +-- This specification is derived from the Ada Reference Manual for use with -- +-- GNAT. The copyright notice above, and the license provisions that follow -- +-- apply solely to the contents of the part following the private keyword. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- This unit was originally developed by Matthew J Heaney. -- +------------------------------------------------------------------------------ + +with System; +with Ada.Containers.Synchronized_Queue_Interfaces; +with Ada.Finalization; + +generic + with package Queue_Interfaces is + new Ada.Containers.Synchronized_Queue_Interfaces (<>); + + type Queue_Priority is private; + + with function Get_Priority + (Element : Queue_Interfaces.Element_Type) return Queue_Priority is <>; + + with function Before + (Left, Right : Queue_Priority) return Boolean is <>; + + Default_Ceiling : System.Any_Priority := System.Priority'Last; + +package Ada.Containers.Unbounded_Priority_Queues is + pragma Preelaborate; + + package Implementation is + + type List_Type is tagged limited private; + + procedure Enqueue + (List : in out List_Type; + New_Item : Queue_Interfaces.Element_Type); + + procedure Dequeue + (List : in out List_Type; + Element : out Queue_Interfaces.Element_Type); + + function Length (List : List_Type) return Count_Type; + + function Max_Length (List : List_Type) return Count_Type; + + private + + type Node_Type; + type Node_Access is access Node_Type; + + type Node_Type is limited record + Element : Queue_Interfaces.Element_Type; + Next : Node_Access; + end record; + + type List_Type is new Ada.Finalization.Limited_Controlled with record + First, Last : Node_Access; + Length : Count_Type := 0; + Max_Length : Count_Type := 0; + end record; + + overriding + procedure Finalize (List : in out List_Type); + + -- ??? + -- not overriding + -- function Have_High_Priority + -- (List : List_Type; + -- Low_Priority : Queue_Priority) return Boolean; + + end Implementation; + + protected type Queue (Ceiling : System.Any_Priority := Default_Ceiling) + -- ??? + -- with Priority => Ceiling is new Queue_Interfaces.Queue with + is new Queue_Interfaces.Queue with + + overriding + entry Enqueue (New_Item : Queue_Interfaces.Element_Type); + + overriding + entry Dequeue (Element : out Queue_Interfaces.Element_Type); + + -- ??? + -- not overriding + -- entry Dequeue_Only_High_Priority + -- (Low_Priority : Queue_Priority; + -- Element : out Queue_Interfaces.Element_Type); + + overriding + function Current_Use return Count_Type; + + overriding + function Peak_Use return Count_Type; + + private + + List : Implementation.List_Type; + + end Queue; + +end Ada.Containers.Unbounded_Priority_Queues; diff --git a/gcc/ada/a-cusyqu.adb b/gcc/ada/a-cusyqu.adb new file mode 100644 index 00000000000..6a8e0d8506e --- /dev/null +++ b/gcc/ada/a-cusyqu.adb @@ -0,0 +1,174 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT LIBRARY COMPONENTS -- +-- -- +-- ADA.CONTAINERS.UNBOUNDED_SYNCHRONIZED_QUEUES -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2004-2011, Free Software Foundation, Inc. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- This unit was originally developed by Matthew J Heaney. -- +------------------------------------------------------------------------------ + +with Ada.Unchecked_Deallocation; + +package body Ada.Containers.Unbounded_Synchronized_Queues is + + package body Implementation is + + ----------------------- + -- Local Subprograms -- + ----------------------- + + procedure Free is + new Ada.Unchecked_Deallocation (Node_Type, Node_Access); + + ------------- + -- Dequeue -- + ------------- + + procedure Dequeue + (List : in out List_Type; + Element : out Queue_Interfaces.Element_Type) + is + X : Node_Access; + + begin + Element := List.First.Element; + + X := List.First; + List.First := List.First.Next; + + if List.First = null then + List.Last := null; + end if; + + List.Length := List.Length - 1; + + Free (X); + end Dequeue; + + ------------- + -- Enqueue -- + ------------- + + procedure Enqueue + (List : in out List_Type; + New_Item : Queue_Interfaces.Element_Type) + is + Node : Node_Access; + + begin + Node := new Node_Type'(New_Item, null); + + if List.First = null then + List.First := Node; + List.Last := List.First; + + else + List.Last.Next := Node; + List.Last := Node; + end if; + + List.Length := List.Length + 1; + + if List.Length > List.Max_Length then + List.Max_Length := List.Length; + end if; + end Enqueue; + + -------------- + -- Finalize -- + -------------- + + procedure Finalize (List : in out List_Type) is + X : Node_Access; + + begin + while List.First /= null loop + X := List.First; + List.First := List.First.Next; + Free (X); + end loop; + end Finalize; + + ------------ + -- Length -- + ------------ + + function Length (List : List_Type) return Count_Type is + begin + return List.Length; + end Length; + + ---------------- + -- Max_Length -- + ---------------- + + function Max_Length (List : List_Type) return Count_Type is + begin + return List.Max_Length; + end Max_Length; + + end Implementation; + + protected body Queue is + + ----------------- + -- Current_Use -- + ----------------- + + function Current_Use return Count_Type is + begin + return List.Length; + end Current_Use; + + ------------- + -- Dequeue -- + ------------- + + entry Dequeue (Element : out Queue_Interfaces.Element_Type) + when List.Length > 0 + is + begin + List.Dequeue (Element); + end Dequeue; + + ------------- + -- Enqueue -- + ------------- + + entry Enqueue (New_Item : Queue_Interfaces.Element_Type) when True is + begin + List.Enqueue (New_Item); + end Enqueue; + + -------------- + -- Peak_Use -- + -------------- + + function Peak_Use return Count_Type is + begin + return List.Max_Length; + end Peak_Use; + + end Queue; + +end Ada.Containers.Unbounded_Synchronized_Queues; diff --git a/gcc/ada/a-cusyqu.ads b/gcc/ada/a-cusyqu.ads new file mode 100644 index 00000000000..a8a2dda160c --- /dev/null +++ b/gcc/ada/a-cusyqu.ads @@ -0,0 +1,107 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT LIBRARY COMPONENTS -- +-- -- +-- ADA.CONTAINERS.UNBOUNDED_SYNCHRONIZED_QUEUES -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2004-2011, Free Software Foundation, Inc. -- +-- -- +-- This specification is derived from the Ada Reference Manual for use with -- +-- GNAT. The copyright notice above, and the license provisions that follow -- +-- apply solely to the contents of the part following the private keyword. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- This unit was originally developed by Matthew J Heaney. -- +------------------------------------------------------------------------------ + +with System; +with Ada.Containers.Synchronized_Queue_Interfaces; +with Ada.Finalization; + +generic + with package Queue_Interfaces is + new Ada.Containers.Synchronized_Queue_Interfaces (<>); + + Default_Ceiling : System.Any_Priority := System.Priority'Last; + +package Ada.Containers.Unbounded_Synchronized_Queues is + pragma Preelaborate; + + package Implementation is + + type List_Type is tagged limited private; + + procedure Enqueue + (List : in out List_Type; + New_Item : Queue_Interfaces.Element_Type); + + procedure Dequeue + (List : in out List_Type; + Element : out Queue_Interfaces.Element_Type); + + function Length (List : List_Type) return Count_Type; + + function Max_Length (List : List_Type) return Count_Type; + + private + + type Node_Type; + type Node_Access is access Node_Type; + + type Node_Type is limited record + Element : Queue_Interfaces.Element_Type; + Next : Node_Access; + end record; + + type List_Type is new Ada.Finalization.Limited_Controlled with record + First, Last : Node_Access; + Length : Count_Type := 0; + Max_Length : Count_Type := 0; + end record; + + overriding + procedure Finalize (List : in out List_Type); + + end Implementation; + + protected type Queue (Ceiling : System.Any_Priority := Default_Ceiling) + -- ??? + -- with Priority => Ceiling is new Queue_Interfaces.Queue with + is new Queue_Interfaces.Queue with + + overriding + entry Enqueue (New_Item : Queue_Interfaces.Element_Type); + + overriding + entry Dequeue (Element : out Queue_Interfaces.Element_Type); + + overriding + function Current_Use return Count_Type; + + overriding + function Peak_Use return Count_Type; + + private + + List : Implementation.List_Type; + + end Queue; + +end Ada.Containers.Unbounded_Synchronized_Queues; diff --git a/gcc/ada/a-direct.adb b/gcc/ada/a-direct.adb index 3050b1404f0..e27bb3fdd6d 100644 --- a/gcc/ada/a-direct.adb +++ b/gcc/ada/a-direct.adb @@ -32,7 +32,7 @@ with Ada.Calendar; use Ada.Calendar; with Ada.Calendar.Formatting; use Ada.Calendar.Formatting; with Ada.Directories.Validity; use Ada.Directories.Validity; -with Ada.Strings.Maps; use Ada; use Ada.Strings.Maps; +with Ada.Strings.Maps; use Ada.Strings.Maps; with Ada.Strings.Fixed; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with Ada.Unchecked_Conversion; @@ -451,14 +451,15 @@ package body Ada.Directories is New_Dir (1 .. New_Directory'Length) := New_Directory; New_Dir (New_Dir'Last) := Directory_Separator; + -- If host is windows, and the first two characters are directory + -- separators, we have an UNC path. Skip it. + if Directory_Separator = '\' and then New_Dir'Length > 2 and then Is_In (New_Dir (1), Dir_Seps) and then Is_In (New_Dir (2), Dir_Seps) then Start := 2; - -- If the first two characters are directory separators and host - -- is windows, we have an UNC path. Skip it. loop Start := Start + 1; exit when Start = New_Dir'Last diff --git a/gcc/ada/a-rbtgbo.adb b/gcc/ada/a-rbtgbo.adb index a2590e93390..d66571396c7 100644 --- a/gcc/ada/a-rbtgbo.adb +++ b/gcc/ada/a-rbtgbo.adb @@ -63,6 +63,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Bounded_Operations is -- that the busy status (which monitors "cursor tampering") is set too; -- this is a representation invariant. Thus if the busy bit is not set, -- then the lock bit must not be set either. + pragma Assert (Tree.Lock = 0); Tree.First := 0; diff --git a/gcc/ada/comperr.adb b/gcc/ada/comperr.adb index 676995fef1c..d21b3ecb34f 100644 --- a/gcc/ada/comperr.adb +++ b/gcc/ada/comperr.adb @@ -23,30 +23,30 @@ -- -- ------------------------------------------------------------------------------ --- This package contains routines called when a fatal internal compiler --- error is detected. Calls to these routines cause termination of the --- current compilation with appropriate error output. - -with Atree; use Atree; -with Debug; use Debug; -with Errout; use Errout; -with Gnatvsn; use Gnatvsn; -with Lib; use Lib; -with Namet; use Namet; -with Opt; use Opt; -with Osint; use Osint; -with Output; use Output; -with Sinfo; use Sinfo; -with Sinput; use Sinput; -with Sprint; use Sprint; -with Sdefault; use Sdefault; -with System.OS_Lib; use System.OS_Lib; -with Targparm; use Targparm; -with Treepr; use Treepr; -with Types; use Types; +-- This package contains routines called when a fatal internal compiler error +-- is detected. Calls to these routines cause termination of the current +-- compilation with appropriate error output. + +with Atree; use Atree; +with Debug; use Debug; +with Errout; use Errout; +with Gnatvsn; use Gnatvsn; +with Lib; use Lib; +with Namet; use Namet; +with Opt; use Opt; +with Osint; use Osint; +with Output; use Output; +with Sinfo; use Sinfo; +with Sinput; use Sinput; +with Sprint; use Sprint; +with Sdefault; use Sdefault; +with Targparm; use Targparm; +with Treepr; use Treepr; +with Types; use Types; with Ada.Exceptions; use Ada.Exceptions; +with System.OS_Lib; use System.OS_Lib; with System.Soft_Links; use System.Soft_Links; package body Comperr is @@ -147,6 +147,8 @@ package body Comperr is end if; end if; + -- If we are in CodePeer mode, we must also delete SCIL files + if CodePeer_Mode then Delete_SCIL_Files; end if; @@ -439,6 +441,7 @@ package body Comperr is Main : Node_Id; Success : Boolean; pragma Unreferenced (Success); + begin -- If parsing was not successful, no Main_Unit is available, so return -- immediately. @@ -458,7 +461,8 @@ package body Comperr is Get_Name_String (Chars (Defining_Unit_Name (Main))); end if; - Delete_File ("SCIL/" & Name_Buffer (1 .. Name_Len) & ".scil", Success); + Delete_File + ("SCIL/" & Name_Buffer (1 .. Name_Len) & ".scil", Success); Delete_File ("SCIL/" & Name_Buffer (1 .. Name_Len) & "__body.scil", Success); end Delete_SCIL_Files; diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 4dd7a434d75..3d0652232cb 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -10851,7 +10851,7 @@ package body Exp_Ch9 is then Append_To (Cdecls, Make_Component_Declaration (Loc, - Defining_Identifier => + Defining_Identifier => Make_Defining_Identifier (Loc, Name_uDispatching_Domain), Component_Definition => @@ -10861,13 +10861,14 @@ package body Exp_Ch9 is New_Reference_To (RTE (RE_Dispatching_Domain_Access), Loc)), - Expression => + Expression => Unchecked_Convert_To (RTE (RE_Dispatching_Domain_Access), - Relocate_Node ( - Expression (First ( - Pragma_Argument_Associations ( - Find_Task_Or_Protected_Pragma - (Taskdef, Name_Dispatching_Domain)))))))); + Relocate_Node + (Expression + (First + (Pragma_Argument_Associations + (Find_Task_Or_Protected_Pragma + (Taskdef, Name_Dispatching_Domain)))))))); end if; Insert_After (Size_Decl, Rec_Decl); diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb index 212dc4b0379..4717d74afac 100644 --- a/gcc/ada/exp_dist.adb +++ b/gcc/ada/exp_dist.adb @@ -10846,7 +10846,8 @@ package body Exp_Dist is -- always force transmission as a 64-bit value. if Is_RTE (FST, RE_Stream_Element_Offset) - or else Is_RTE (FST, RE_Storage_Offset) + or else + Is_RTE (FST, RE_Storage_Offset) then return RTE (RE_Unsigned_64); end if; diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb index 9b95adc829e..8a95ec5c876 100644 --- a/gcc/ada/exp_pakd.adb +++ b/gcc/ada/exp_pakd.adb @@ -703,10 +703,10 @@ package body Exp_Pakd is -- array reference, reanalysis can produce spurious type errors when the -- PAT type is replaced again with the original type of the array. Same -- for the case of a dereference. Ditto for function calls: expansion - -- may introduce additional actuals which will trigger errors if call - -- is reanalyzed. The following is correct and minimal, - -- but the handling of more complex packed expressions in actuals is - -- confused. Probably the problem only remains for actuals in calls. + -- may introduce additional actuals which will trigger errors if call is + -- reanalyzed. The following is correct and minimal, but the handling of + -- more complex packed expressions in actuals is confused. Probably the + -- problem only remains for actuals in calls. Set_Etype (Aexp, Packed_Array_Type (Act_ST)); @@ -714,8 +714,7 @@ package body Exp_Pakd is or else (Nkind (Aexp) = N_Indexed_Component and then Is_Entity_Name (Prefix (Aexp))) - or else Nkind (Aexp) = N_Explicit_Dereference - or else Nkind (Aexp) = N_Function_Call + or else Nkind_In (Aexp, N_Explicit_Dereference, N_Function_Call) then Set_Analyzed (Aexp); end if; diff --git a/gcc/ada/exp_strm.adb b/gcc/ada/exp_strm.adb index c6c6d7c3d59..d7aba2447a7 100644 --- a/gcc/ada/exp_strm.adb +++ b/gcc/ada/exp_strm.adb @@ -29,7 +29,6 @@ with Exp_Util; use Exp_Util; with Namet; use Namet; with Nlists; use Nlists; with Nmake; use Nmake; -with Opt; use Opt; with Rtsfind; use Rtsfind; with Sem_Aux; use Sem_Aux; with Sem_Util; use Sem_Util; @@ -222,23 +221,11 @@ package body Exp_Strm is Make_Identifier (Loc, Name_S), Make_Identifier (Loc, Name_V))); - if Ada_Version >= Ada_2005 then - Stms := New_List ( - Make_Extended_Return_Statement (Loc, - Return_Object_Declarations => New_List (Odecl), - Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, New_List (Rstmt)))); - else - -- pragma Assert (not Is_Limited_Type (Typ)); - -- Returning a local object, shouldn't happen in the case of a - -- limited type, but currently occurs in DSA stubs in Ada 95 mode??? - - Stms := New_List ( - Odecl, - Rstmt, - Make_Simple_Return_Statement (Loc, - Expression => Make_Identifier (Loc, Name_V))); - end if; + Stms := New_List ( + Make_Extended_Return_Statement (Loc, + Return_Object_Declarations => New_List (Odecl), + Handled_Statement_Sequence => + Make_Handled_Sequence_Of_Statements (Loc, New_List (Rstmt)))); Fnam := Make_Defining_Identifier (Loc, diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index d686d3f7063..a64c0d782a0 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -1839,6 +1839,7 @@ package body Freeze is -- since the component type has to be frozen for us to know -- if it is variable length. We omit this test in a generic -- context, it will be applied at instantiation time. + -- We also omit this test in CodePeer mode, since we do not -- have sufficient info on size and representation clauses. diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 98998fff9f0..b0b90242209 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -842,6 +842,8 @@ begin Tree_Gen; end if; + -- In CodePeer mode we delete SCIL files if there is an error + if CodePeer_Mode then Comperr.Delete_SCIL_Files; end if; diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb index 87498d85f30..c3d250032fe 100644 --- a/gcc/ada/impunit.adb +++ b/gcc/ada/impunit.adb @@ -519,6 +519,11 @@ package body Impunit is "a-comutr", -- Ada.Containers.Multiway_Trees "a-cimutr", -- Ada.Containers.Indefinite_Multiway_Trees "a-cbmutr", -- Ada.Containers.Bounded_Multiway_Trees + "a-csquin", -- Ada.Containers.Synchronized_Queue_Interfaces + "a-cusyqu", -- Ada.Containers.Unbounded_Synchronized_Queues + "a-cuprqu", -- Ada.Containers.Unbounded_Priority_Queues + "a-cbsyqu", -- Ada.Containers.Bounded_Synchronized_Queues + "a-cbprqu", -- Ada.Containers.Bounded_Priority_Queues "a-extiin", -- Ada.Execution_Time.Interrupts "a-iteint", -- Ada.Iterator_Interfaces "a-synbar", -- Ada.Synchronous_Barriers diff --git a/gcc/ada/put_alfa.adb b/gcc/ada/put_alfa.adb index 76ed47ca6a3..adb41a8397f 100644 --- a/gcc/ada/put_alfa.adb +++ b/gcc/ada/put_alfa.adb @@ -39,19 +39,17 @@ begin Start := F.From_Scope; Stop := F.To_Scope; - if Start <= Stop then - Write_Info_Initiate ('F'); - Write_Info_Char ('D'); - Write_Info_Char (' '); - Write_Info_Nat (F.File_Num); - Write_Info_Char (' '); - - for N in F.File_Name'Range loop - Write_Info_Char (F.File_Name (N)); - end loop; - - Write_Info_Terminate; - end if; + Write_Info_Initiate ('F'); + Write_Info_Char ('D'); + Write_Info_Char (' '); + Write_Info_Nat (F.File_Num); + Write_Info_Char (' '); + + for N in F.File_Name'Range loop + Write_Info_Char (F.File_Name (N)); + end loop; + + Write_Info_Terminate; -- Loop through scope entries for this file diff --git a/gcc/ada/s-taprop-linux.adb b/gcc/ada/s-taprop-linux.adb index a80d14947db..a8f1568ee78 100644 --- a/gcc/ada/s-taprop-linux.adb +++ b/gcc/ada/s-taprop-linux.adb @@ -822,10 +822,11 @@ package body System.Task_Primitives.Operations is -- task, and the CPU value is not contained within the range of -- processors for the domain. - if T.Common.Domain /= null and then - T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU and then - (T.Common.Base_CPU not in T.Common.Domain'Range - or else not T.Common.Domain (T.Common.Base_CPU)) + if T.Common.Domain /= null + and then T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU + and then + (T.Common.Base_CPU not in T.Common.Domain'Range + or else not T.Common.Domain (T.Common.Base_CPU)) then Succeeded := False; return; diff --git a/gcc/ada/s-taprop-mingw.adb b/gcc/ada/s-taprop-mingw.adb index 0d380da2c52..ab66a889741 100644 --- a/gcc/ada/s-taprop-mingw.adb +++ b/gcc/ada/s-taprop-mingw.adb @@ -902,10 +902,11 @@ package body System.Task_Primitives.Operations is -- task, and the CPU value is not contained within the range of -- processors for the domain. - if T.Common.Domain /= null and then - T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU and then - (T.Common.Base_CPU not in T.Common.Domain'Range - or else not T.Common.Domain (T.Common.Base_CPU)) + if T.Common.Domain /= null + and then T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU + and then + (T.Common.Base_CPU not in T.Common.Domain'Range + or else not T.Common.Domain (T.Common.Base_CPU)) then Succeeded := False; return; diff --git a/gcc/ada/s-taprop-solaris.adb b/gcc/ada/s-taprop-solaris.adb index 042fed25212..421c60e219e 100644 --- a/gcc/ada/s-taprop-solaris.adb +++ b/gcc/ada/s-taprop-solaris.adb @@ -981,10 +981,11 @@ package body System.Task_Primitives.Operations is -- task, and the CPU value is not contained within the range of -- processors for the domain. - if T.Common.Domain /= null and then - T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU and then - (T.Common.Base_CPU not in T.Common.Domain'Range - or else not T.Common.Domain (T.Common.Base_CPU)) + if T.Common.Domain /= null + and then T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU + and then + (T.Common.Base_CPU not in T.Common.Domain'Range + or else not T.Common.Domain (T.Common.Base_CPU)) then Succeeded := False; return; diff --git a/gcc/ada/s-taprop-vxworks.adb b/gcc/ada/s-taprop-vxworks.adb index f0e9e038a83..ae286498d5c 100644 --- a/gcc/ada/s-taprop-vxworks.adb +++ b/gcc/ada/s-taprop-vxworks.adb @@ -897,10 +897,11 @@ package body System.Task_Primitives.Operations is -- task, and the CPU value is not contained within the range of -- processors for the domain. - if T.Common.Domain /= null and then - T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU and then - (T.Common.Base_CPU not in T.Common.Domain'Range - or else not T.Common.Domain (T.Common.Base_CPU)) + if T.Common.Domain /= null + and then T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU + and then + (T.Common.Base_CPU not in T.Common.Domain'Range + or else not T.Common.Domain (T.Common.Base_CPU)) then Succeeded := False; return; diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index ebd6e9393b0..d4ea223c7b8 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -1052,6 +1052,7 @@ package body Sem_Aggr is end if; -- Ada 2005 (AI-287): Limited aggregates allowed + -- In an instance, ignore aggregate subcomponents tnat may be limited, -- because they originate in view conflicts. If the original aggregate -- is legal and the actuals are legal, the aggregate itself is legal. diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 3f1dde852a4..5ab7783b277 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -12745,7 +12745,6 @@ package body Sem_Ch12 is if Has_Aspects (N) then declare Aspect : Node_Id; - begin Aspect := First (Aspect_Specifications (N)); while Present (Aspect) loop diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 542ffee3f51..3dded45cd12 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -2869,7 +2869,7 @@ package body Sem_Ch3 is -- 2. Those generated by the Expression -- 3. Those used to constrain the Object Definition with the - -- expression constraints when the definition is unconstrained + -- expression constraints when the definition is unconstrained. -- They must be generated in this order to avoid order of elaboration -- issues. Thus the first step (after entering the name) is to analyze @@ -2880,6 +2880,7 @@ package body Sem_Ch3 is if Present (Prev_Entity) and then + -- If the homograph is an implicit subprogram, it is overridden -- by the current declaration. |