OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2011-10-06  Thomas Quinot  <quinot@adacore.com>

	* einfo.ads, exp_attr.adb, exp_ch3.adb, exp_ch4.adb, exp_ch7.adb,
	exp_ch9.adb, exp_ch9.ads, exp_strm.adb, exp_util.adb, freeze.adb,
	g-debpoo.ads, opt.ads, par-ch12.adb, par-ch2.adb, par-ch3.adb,
	par-ch5.adb, par-ch6.adb, sem_aggr.adb, sem_attr.adb, sem_cat.adb,
	sem_ch10.adb, sem_ch12.adb, sem_ch3.adb, sem_ch4.adb, sem_ch5.adb,
	sem_ch6.adb, sem_intr.adb, sem_res.ads, sem_type.adb, sem_util.adb,
	s-regpat.adb, s-tpopde-vms.ads: Minor reformatting.
	* s-osinte-freebsd.ads: Fix for tasking failures on FreeBSD.

2011-10-06  Ed Schonberg  <schonberg@adacore.com>

	* a-cihase.adb, a-ciorma.adb: Avoid accessibility checks in container
	references.

2011-10-06  Matthew Heaney  <heaney@adacore.com>

	* a-cuprqu.ads, a-cuprqu.adb, a-cbprqu.ads, a-cbprqu.adb
	(Dequeue_Only_High_Priority): Protected procedure now implemented.

2011-10-06  Vincent Celier  <celier@adacore.com>

	* g-trasym.adb: Replace old implementation with the default
	implementation that returns list of addresses as "0x...".
	* g-trasym.ads: Update the list of platforms with the full
	capability.  Indicate that there is a default implementation
	for other platforms.
	* g-trasym-unimplemented.ads, g-trasym-unimplemented.adb: Remove.
	* gcc-interface/Makefile.in: Remove g-trasym-unimplemented, as there
	is now a default implementation for all platforms without the full
	capability.

From-SVN: r179631
This commit is contained in:
Arnaud Charlet 2011-10-06 21:37:25 +02:00
parent e12671331b
commit 885c4871af
45 changed files with 284 additions and 404 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
gcc/ada/ChangeLog
View File

@ -1,3 +1,36 @@
2011-10-06 Thomas Quinot <quinot@adacore.com>
* einfo.ads, exp_attr.adb, exp_ch3.adb, exp_ch4.adb, exp_ch7.adb,
exp_ch9.adb, exp_ch9.ads, exp_strm.adb, exp_util.adb, freeze.adb,
g-debpoo.ads, opt.ads, par-ch12.adb, par-ch2.adb, par-ch3.adb,
par-ch5.adb, par-ch6.adb, sem_aggr.adb, sem_attr.adb, sem_cat.adb,
sem_ch10.adb, sem_ch12.adb, sem_ch3.adb, sem_ch4.adb, sem_ch5.adb,
sem_ch6.adb, sem_intr.adb, sem_res.ads, sem_type.adb, sem_util.adb,
s-regpat.adb, s-tpopde-vms.ads: Minor reformatting.
* s-osinte-freebsd.ads: Fix for tasking failures on FreeBSD.
2011-10-06 Ed Schonberg <schonberg@adacore.com>
* a-cihase.adb, a-ciorma.adb: Avoid accessibility checks in container
references.
2011-10-06 Matthew Heaney <heaney@adacore.com>
* a-cuprqu.ads, a-cuprqu.adb, a-cbprqu.ads, a-cbprqu.adb
(Dequeue_Only_High_Priority): Protected procedure now implemented.
2011-10-06 Vincent Celier <celier@adacore.com>
* g-trasym.adb: Replace old implementation with the default
implementation that returns list of addresses as "0x...".
* g-trasym.ads: Update the list of platforms with the full
capability. Indicate that there is a default implementation
for other platforms.
* g-trasym-unimplemented.ads, g-trasym-unimplemented.adb: Remove.
* gcc-interface/Makefile.in: Remove g-trasym-unimplemented, as there
is now a default implementation for all platforms without the full
capability.
2011-10-06 Robert Dewar <dewar@adacore.com>
* a-ciorse.adb, a-cihase.adb, a-cihase.ads, a-coorse.adb,

50
gcc/ada/a-cbprqu.adb
View File

@ -44,6 +44,24 @@ package body Ada.Containers.Bounded_Priority_Queues is
List.Container.Delete_First;
end Dequeue;
procedure Dequeue
(List : in out List_Type;
At_Least : Queue_Priority;
Element : in out Queue_Interfaces.Element_Type;
Success : out Boolean)
is
begin
if List.Length = 0
or else not Before (At_Least, Get_Priority (List.First_Element))
then
Success := False;
return;
end if;
List.Dequeue (Element);
Success := True;
end Dequeue;
-------------
-- Enqueue --
-------------
@ -83,6 +101,18 @@ package body Ada.Containers.Bounded_Priority_Queues is
end if;
end Enqueue;
-------------------
-- First_Element --
-------------------
function First_Element
(List : List_Type) return Queue_Interfaces.Element_Type
is
begin
-- Use Constant_Reference for this. ???
return List.Container.First_Element;
end First_Element;
------------
-- Length --
------------
@ -125,14 +155,18 @@ package body Ada.Containers.Bounded_Priority_Queues is
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;
--------------------------------
-- Dequeue_Only_High_Priority --
--------------------------------
procedure Dequeue_Only_High_Priority
(At_Least : Queue_Priority;
Element : in out Queue_Interfaces.Element_Type;
Success : out Boolean)
is
begin
List.Dequeue (At_Least, Element, Success);
end Dequeue_Only_High_Priority;
--------------
-- Enqueue --

27
gcc/ada/a-cbprqu.ads
View File

@ -70,6 +70,15 @@ package Ada.Containers.Bounded_Priority_Queues is
(List : in out List_Type;
Element : out Queue_Interfaces.Element_Type);
procedure Dequeue
(List : in out List_Type;
At_Least : Queue_Priority;
Element : in out Queue_Interfaces.Element_Type;
Success : out Boolean);
function First_Element
(List : List_Type) return Queue_Interfaces.Element_Type;
function Length (List : List_Type) return Count_Type;
function Max_Length (List : List_Type) return Count_Type;
@ -102,11 +111,18 @@ package Ada.Containers.Bounded_Priority_Queues is
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);
-- The priority queue operation Dequeue_Only_High_Priority had been a
-- protected entry in early drafts of AI05-0159, but it was discovered
-- that that operation as specified was not in fact implementable. The
-- operation was changed from an entry to a protected procedure per the
-- ARG meeting in Edinburgh (June 2011), with a different signature and
-- semantics.
not overriding
procedure Dequeue_Only_High_Priority
(At_Least : Queue_Priority;
Element : in out Queue_Interfaces.Element_Type;
Success : out Boolean);
overriding
function Current_Use return Count_Type;
@ -115,6 +131,7 @@ package Ada.Containers.Bounded_Priority_Queues is
function Peak_Use return Count_Type;
private
List : Implementation.List_Type (Capacity);
end Queue;

6
gcc/ada/a-cihase.adb
View File

@ -1169,7 +1169,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
is
pragma Unreferenced (Container);
begin
return (Element => Position.Node.Element);
return (Element => Position.Node.Element.all'Access);
end Constant_Reference;
-------------
@ -2072,7 +2072,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
is
pragma Unreferenced (Container);
begin
return (Element => Position.Node.Element);
return (Element => Position.Node.Element.all'Access);
end Reference_Preserving_Key;
function Reference_Preserving_Key
@ -2081,7 +2081,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
is
Position : constant Cursor := Find (Container, Key);
begin
return (Element => Position.Node.Element);
return (Element => Position.Node.Element.all'Access);
end Reference_Preserving_Key;
end Generic_Keys;

8
gcc/ada/a-ciorma.adb
View File

@ -36,6 +36,7 @@ with Ada.Containers.Red_Black_Trees.Generic_Keys;
pragma Elaborate_All (Ada.Containers.Red_Black_Trees.Generic_Keys);
package body Ada.Containers.Indefinite_Ordered_Maps is
pragma Suppress (All_Checks);
type Iterator is new
Map_Iterator_Interfaces.Reversible_Iterator with record
@ -325,8 +326,9 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
(Container : Map;
Key : Key_Type) return Constant_Reference_Type
is
Node : aliased Element_Type := Element (Container, Key);
begin
return (Element => Container.Element (Key)'Unrestricted_Access);
return (Element => Node'Access);
end Constant_Reference;
--------------
@ -1149,8 +1151,10 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
Key : Key_Type)
return Reference_Type
is
Node : aliased Element_Type := Element (Container, Key);
begin
return (Element => Container.Element (Key)'Unrestricted_Access);
return (Element => Node'Access);
end Reference;
-------------

54
gcc/ada/a-cuprqu.adb
View File

@ -65,6 +65,24 @@ package body Ada.Containers.Unbounded_Priority_Queues is
Free (X);
end Dequeue;
procedure Dequeue
(List : in out List_Type;
At_Least : Queue_Priority;
Element : in out Queue_Interfaces.Element_Type;
Success : out Boolean)
is
begin
if List.Length = 0
or else not Before (At_Least, Get_Priority (List.First.Element))
then
Success := False;
return;
end if;
List.Dequeue (Element);
Success := True;
end Dequeue;
-------------
-- Enqueue --
-------------
@ -132,22 +150,6 @@ package body Ada.Containers.Unbounded_Priority_Queues is
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 --
------------
@ -190,14 +192,18 @@ package body Ada.Containers.Unbounded_Priority_Queues is
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;
--------------------------------
-- Dequeue_Only_High_Priority --
--------------------------------
procedure Dequeue_Only_High_Priority
(At_Least : Queue_Priority;
Element : in out Queue_Interfaces.Element_Type;
Success : out Boolean)
is
begin
List.Dequeue (At_Least, Element, Success);
end Dequeue_Only_High_Priority;
-------------
-- Enqueue --

51
gcc/ada/a-cuprqu.ads
View File

@ -68,6 +68,12 @@ package Ada.Containers.Unbounded_Priority_Queues is
(List : in out List_Type;
Element : out Queue_Interfaces.Element_Type);
procedure Dequeue
(List : in out List_Type;
At_Least : Queue_Priority;
Element : in out Queue_Interfaces.Element_Type;
Success : out Boolean);
function Length (List : List_Type) return Count_Type;
function Max_Length (List : List_Type) return Count_Type;
@ -91,36 +97,37 @@ package Ada.Containers.Unbounded_Priority_Queues is
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
-- ???
-- 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 Enqueue (New_Item : Queue_Interfaces.Element_Type);
overriding
entry Dequeue (Element : out 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);
-- The priority queue operation Dequeue_Only_High_Priority had been a
-- protected entry in early drafts of AI05-0159, but it was discovered
-- that that operation as specified was not in fact implementable. The
-- operation was changed from an entry to a protected procedure per the
-- ARG meeting in Edinburgh (June 2011), with a different signature and
-- semantics.
overriding
function Current_Use return Count_Type;
not overriding
procedure Dequeue_Only_High_Priority
(At_Least : Queue_Priority;
Element : in out Queue_Interfaces.Element_Type;
Success : out Boolean);
overriding
function Peak_Use return Count_Type;
overriding
function Current_Use return Count_Type;
overriding
function Peak_Use return Count_Type;
private

4
gcc/ada/einfo.ads
View File

@ -2475,11 +2475,11 @@ package Einfo is
-- Is_Local_Anonymous_Access (Flag194)
-- Present in access types. Set for an anonymous access type to indicate
-- that the type is created for a record component with an access
-- definition, an array component, or (pre-Ada2012) a stand-alone object.
-- definition, an array component, or (pre-Ada 2012) a standalone object.
-- Such anonymous types have an accessibility level equal to that of the
-- declaration in which they appear, unlike the anonymous access types
-- that are created for access parameters, access discriminants, and
-- (as of Ada2012) stand-alone objects.
-- (as of Ada 2012) stand-alone objects.
-- Is_Machine_Code_Subprogram (Flag137)
-- Present in subprogram entities. Set to indicate that the subprogram

2
gcc/ada/exp_attr.adb
View File

@ -678,7 +678,7 @@ package body Exp_Attr is
case Id is
-- Attributes related to Ada2012 iterators (placeholder ???)
-- Attributes related to Ada 2012 iterators (placeholder ???)
when Attribute_Constant_Indexing => null;
when Attribute_Default_Iterator => null;

2
gcc/ada/exp_ch3.adb
View File

@ -6289,7 +6289,7 @@ package body Exp_Ch3 is
end if;
end if;
-- In the non-tagged case, ever since Ada83 an equality function must
-- In the non-tagged case, ever since Ada 83 an equality function must
-- be provided for variant records that are not unchecked unions.
-- In Ada 2012 the equality function composes, and thus must be built
-- explicitly just as for tagged records.

2
gcc/ada/exp_ch4.adb
View File

@ -765,7 +765,7 @@ package body Exp_Ch4 is
-- Start of processing for Expand_Allocator_Expression
begin
-- In the case of an Ada2012 allocator whose initial value comes from a
-- In the case of an Ada 2012 allocator whose initial value comes from a
-- function call, pass "the accessibility level determined by the point
-- of call" (AI05-0234) to the function. Conceptually, this belongs in
-- Expand_Call but it couldn't be done there (because the Etype of the

2
gcc/ada/exp_ch7.adb
View File

@ -3842,7 +3842,7 @@ package body Exp_Ch7 is
----------------------------------
-- Add call to Activate_Tasks if there are tasks declared and the package
-- has no body. Note that in Ada83, this may result in premature activation
-- has no body. Note that in Ada 83 this may result in premature activation
-- of some tasks, given that we cannot tell whether a body will eventually
-- appear.

4
gcc/ada/exp_ch9.adb
View File

@ -178,7 +178,7 @@ package body Exp_Ch9 is
-- body or an accept body. The renamed object is a component of the
-- parameter block that is a parameter in the entry call.
-- In Ada2012, If the formal is an incomplete tagged type, the renaming
-- In Ada 2012, if the formal is an incomplete tagged type, the renaming
-- does not dereference the corresponding component to prevent an illegal
-- use of the incomplete type (AI05-0151).
@ -11857,7 +11857,7 @@ package body Exp_Ch9 is
S : Entity_Id;
begin
-- In Ada2005, the master is the innermost enclosing scope that is not
-- In Ada 2005, the master is the innermost enclosing scope that is not
-- transient. If the enclosing block is the rewriting of a call or the
-- scope is an extended return statement this is valid master. The
-- master in an extended return is only used within the return, and is

4
gcc/ada/exp_ch9.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -266,7 +266,7 @@ package Exp_Ch9 is
function Find_Master_Scope (E : Entity_Id) return Entity_Id;
-- When a type includes tasks, a master entity is created in the scope, to
-- be used by the runtime during activation. In general the master is the
-- immediate scope in which the type is declared, but in Ada2005, in the
-- immediate scope in which the type is declared, but in Ada 2005, in the
-- presence of synchronized classwide interfaces, the immediate scope of
-- an anonymous access type may be a transient scope, which has no run-time
-- presence. In this case, the scope of the master is the innermost scope

6
gcc/ada/exp_strm.adb
View File

@ -1592,7 +1592,7 @@ package body Exp_Strm is
begin
-- (Ada 2005: AI-441): Set the null-excluding attribute because it has
-- no semantic meaning in Ada 95 but it is a requirement in Ada2005.
-- no semantic meaning in Ada 95 but it is a requirement in Ada 2005.
Profile := New_List (
Make_Parameter_Specification (Loc,
@ -1632,7 +1632,7 @@ package body Exp_Strm is
-- Construct function specification
-- (Ada 2005: AI-441): Set the null-excluding attribute because it has
-- no semantic meaning in Ada 95 but it is a requirement in Ada2005.
-- no semantic meaning in Ada 95 but it is a requirement in Ada 2005.
Spec :=
Make_Function_Specification (Loc,
@ -1676,7 +1676,7 @@ package body Exp_Strm is
-- Construct procedure specification
-- (Ada 2005: AI-441): Set the null-excluding attribute because it has
-- no semantic meaning in Ada 95 but it is a requirement in Ada2005.
-- no semantic meaning in Ada 95 but it is a requirement in Ada 2005.
Spec :=
Make_Procedure_Specification (Loc,

4
gcc/ada/exp_util.adb
View File

@ -1921,11 +1921,11 @@ package body Exp_Util is
then
null;
-- In Ada95 nothing to be done if the type of the expression is limited,
-- In Ada 95 nothing to be done if the type of the expression is limited
-- because in this case the expression cannot be copied, and its use can
-- only be by reference.
-- In Ada2005, the context can be an object declaration whose expression
-- In Ada 2005 the context can be an object declaration whose expression
-- is a function that returns in place. If the nominal subtype has
-- unknown discriminants, the call still provides constraints on the
-- object, and we have to create an actual subtype from it.

6
gcc/ada/freeze.adb
View File

@ -1616,9 +1616,9 @@ package body Freeze is
-- Start of processing for Check_Current_Instance
begin
-- In Ada95, the (imprecise) rule is that the current instance of a
-- limited type is aliased. In Ada2005, limitedness must be explicit:
-- either a tagged type, or a limited record.
-- In Ada 95, the (imprecise) rule is that the current instance of a
-- limited type is aliased. In Ada 2005, limitedness must be
-- explicit: either a tagged type, or a limited record.
if Is_Limited_Type (Rec_Type)
and then (Ada_Version < Ada_2005 or else Is_Tagged_Type (Rec_Type))

4
gcc/ada/g-debpoo.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -29,7 +29,7 @@
-- --
------------------------------------------------------------------------------
-- This packages provides a special implementation of the Ada95 storage pools
-- This packages provides a special implementation of the Ada 95 storage pools
-- The goal of this debug pool is to detect incorrect uses of memory
-- (multiple deallocations, access to invalid memory,...). Errors are reported

70
gcc/ada/g-trasym-unimplemented.adb
View File

@ -1,70 +0,0 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- G N A T . T R A C E B A C K . S Y M B O L I C --
-- --
-- B o d y --
-- --
-- Copyright (C) 1999-2010, AdaCore --
-- --
-- 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. --
-- --
------------------------------------------------------------------------------
-- Version used on unimplemented targets
-- Run-time symbolic traceback is currently supported on the following
-- targets:
-- HP-UX
-- IRIX
-- GNU/Linux x86
-- AIX
-- Solaris sparc
-- Tru64
-- OpenVMS/Alpha
-- Windows NT/XP/Vista
-- This version is used on all other targets, it generates a warning at
-- compile time if it is with'ed, and the bodies generate messages saying
-- that the functions are not implemented.
package body GNAT.Traceback.Symbolic is
------------------------
-- Symbolic_Traceback --
------------------------
function Symbolic_Traceback (Traceback : Tracebacks_Array) return String
is
pragma Unreferenced (Traceback);
begin
return "Symbolic_Traceback not implemented on this target";
end Symbolic_Traceback;
function Symbolic_Traceback (E : Exception_Occurrence) return String
is
pragma Unreferenced (E);
begin
return "Symbolic_Traceback not implemented on this target";
end Symbolic_Traceback;
end GNAT.Traceback.Symbolic;

64
gcc/ada/g-trasym-unimplemented.ads
View File

@ -1,64 +0,0 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- G N A T . T R A C E B A C K . S Y M B O L I C --
-- --
-- S p e c --
-- --
-- Copyright (C) 1999-2010, AdaCore --
-- --
-- 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. --
-- --
------------------------------------------------------------------------------
-- Version used on unimplemented targets
-- Run-time symbolic traceback is currently supported on the following
-- targets:
-- HP-UX hppa and ia64
-- IRIX
-- GNU/Linux x86, x86_64, ia64
-- AIX
-- Solaris sparc and x86
-- Tru64
-- OpenVMS/Alpha
-- Windows NT/XP/Vista
-- This version is used on all other targets, it generates a warning at
-- compile time if it is with'ed, and the bodies generate messages saying
-- that the functions are not implemented.
with Ada.Exceptions; use Ada.Exceptions;
package GNAT.Traceback.Symbolic is
pragma Elaborate_Body;
-- pragma Compile_Time_Warning
-- (True, "symbolic traceback not implemented on this target");
function Symbolic_Traceback (Traceback : Tracebacks_Array) return String;
-- Build a string containing a symbolic traceback of the given call chain
function Symbolic_Traceback (E : Exception_Occurrence) return String;
-- Build string containing symbolic traceback of given exception occurrence
end GNAT.Traceback.Symbolic;

125
gcc/ada/g-trasym.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1999-2010, AdaCore --
-- Copyright (C) 1999-2011, AdaCore --
-- --
-- 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- --
@ -29,122 +29,47 @@
-- --
------------------------------------------------------------------------------
-- Run-time symbolic traceback support
-- This is the default implementation for platforms where the full capability
-- is not supported. It returns tracebacks as lists of "0x..." strings
-- corresponding to the addresses.
with System.Soft_Links;
with Ada.Exceptions.Traceback; use Ada.Exceptions.Traceback;
with System.Address_Image;
package body GNAT.Traceback.Symbolic is
pragma Linker_Options ("-laddr2line");
pragma Linker_Options ("-lbfd");
pragma Linker_Options ("-liberty");
package TSL renames System.Soft_Links;
-- To perform the raw addresses to symbolic form translation we rely on a
-- libaddr2line symbolizer which examines debug info from a provided
-- executable file name, and an absolute path is needed to ensure the file
-- is always found. This is "__gnat_locate_exec_on_path (gnat_argv [0])"
-- for our executable file, a fairly heavy operation so we cache the
-- result.
Exename : System.Address;
-- Pointer to the name of the executable file to be used on all
-- invocations of the libaddr2line symbolization service.
Exename_Resolved : Boolean := False;
-- Flag to indicate whether we have performed the executable file name
-- resolution already. Relying on a not null Exename for this purpose
-- would be potentially inefficient as this is what we will get if the
-- resolution attempt fails.
------------------------
-- Symbolic_Traceback --
------------------------
function Symbolic_Traceback (Traceback : Tracebacks_Array) return String is
procedure convert_addresses
(filename : System.Address;
addrs : System.Address;
n_addrs : Integer;
buf : System.Address;
len : System.Address);
pragma Import (C, convert_addresses, "convert_addresses");
-- This is the procedure version of the Ada-aware addr2line. It places
-- in BUF a string representing the symbolic translation of the N_ADDRS
-- raw addresses provided in ADDRS, looked up in debug information from
-- FILENAME. LEN points to an integer which contains the size of the
-- BUF buffer at input and the result length at output.
--
-- This procedure is provided by libaddr2line on targets that support
-- it. A dummy version is in adaint.c for other targets so that build
-- of shared libraries doesn't generate unresolved symbols.
--
-- Note that this procedure is *not* thread-safe.
type Argv_Array is array (0 .. 0) of System.Address;
gnat_argv : access Argv_Array;
pragma Import (C, gnat_argv, "gnat_argv");
function locate_exec_on_path
(c_exename : System.Address) return System.Address;
pragma Import (C, locate_exec_on_path, "__gnat_locate_exec_on_path");
Res : String (1 .. 256 * Traceback'Length);
Len : Integer;
use type System.Address;
function Symbolic_Traceback (Traceback : Tracebacks_Array) return String
is
begin
-- The symbolic translation of an empty set of addresses is an empty
-- string.
if Traceback'Length = 0 then
return "";
end if;
-- If our input set of raw addresses is not empty, resort to the
-- libaddr2line service to symbolize it all.
-- Compute, cache and provide the absolute path to our executable file
-- name as the binary file where the relevant debug information is to be
-- found. If the executable file name resolution fails, we have no
-- sensible basis to invoke the symbolizer at all.
-- Protect all this against concurrent accesses explicitly, as the
-- underlying services are potentially thread unsafe.
TSL.Lock_Task.all;
if not Exename_Resolved then
Exename := locate_exec_on_path (gnat_argv (0));
Exename_Resolved := True;
end if;
if Exename /= System.Null_Address then
Len := Res'Length;
convert_addresses
(Exename, Traceback'Address, Traceback'Length,
Res (1)'Address, Len'Address);
end if;
TSL.Unlock_Task.all;
-- Return what the addr2line symbolizer has produced if we have called
-- it (the executable name resolution succeeded), or an empty string
-- otherwise.
if Exename /= System.Null_Address then
return Res (1 .. Len);
else
return "";
end if;
declare
Img : String := System.Address_Image (Traceback (Traceback'First));
Result : String (1 .. (Img'Length + 3) * Traceback'Length);
Last : Natural := 0;
begin
for J in Traceback'Range loop
Img := System.Address_Image (Traceback (J));
Result (Last + 1 .. Last + 2) := "0x";
Last := Last + 2;
Result (Last + 1 .. Last + Img'Length) := Img;
Last := Last + Img'Length + 1;
Result (Last) := ASCII.LF;
end loop;
return Result (1 .. Last);
end;
end if;
end Symbolic_Traceback;
function Symbolic_Traceback (E : Exception_Occurrence) return String is
function Symbolic_Traceback (E : Exception_Occurrence) return String
is
begin
return Symbolic_Traceback (Tracebacks (E));
end Symbolic_Traceback;

16
gcc/ada/g-trasym.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1999-2010, AdaCore --
-- Copyright (C) 1999-2011, AdaCore --
-- --
-- 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- --
@ -31,16 +31,16 @@
-- Run-time symbolic traceback support
-- This capability is currently supported on the following targets:
-- The full capability is currently supported on the following targets:
-- HP-UX hppa and ia64
-- HP-UX ia64
-- IRIX
-- GNU/Linux x86, x86_64, ia64
-- AIX
-- FreeBSD x86, x86_64
-- Solaris sparc and x86
-- Tru64
-- OpenVMS/Alpha
-- Windows NT/XP/Vista
-- OpenVMS Alpha and ia64
-- Windows
-- The routines provided in this package assume that your application has
-- been compiled with debugging information turned on, since this information
@ -77,6 +77,10 @@
-- libraries. However, the OS should be at least v7.3-1 and OS patch
-- VMS731_TRACE-V0100 must be applied in order to use this package.
-- On platforms where the full capability is not supported, function
-- Symbolic_Traceback return a list of addresses expressed as "0x..."
-- separated by line feed.
with Ada.Exceptions; use Ada.Exceptions;
package GNAT.Traceback.Symbolic is

36
gcc/ada/gcc-interface/Makefile.in
View File

@ -469,8 +469,6 @@ ifeq ($(strip $(filter-out m68k% wrs vx%,$(targ))),)
g-socthi.ads<g-socthi-vxworks.ads \
g-socthi.adb<g-socthi-vxworks.adb \
g-stsifd.adb<g-stsifd-sockets.adb \
g-trasym.ads<g-trasym-unimplemented.ads \
g-trasym.adb<g-trasym-unimplemented.adb \
system.ads<system-vxworks-m68k.ads
TOOLS_TARGET_PAIRS=mlib-tgt-specific.adb<mlib-tgt-specific-vxworks.adb
@ -512,8 +510,6 @@ ifeq ($(strip $(filter-out e500% powerpc% wrs vxworks,$(targ))),)
g-socthi.ads<g-socthi-vxworks.ads \
g-socthi.adb<g-socthi-vxworks.adb \
g-stsifd.adb<g-stsifd-sockets.adb \
g-trasym.ads<g-trasym-unimplemented.ads \
g-trasym.adb<g-trasym-unimplemented.adb \
$(ATOMICS_TARGET_PAIRS) \
$(ATOMICS_BUILTINS_TARGET_PAIRS)
@ -613,8 +609,6 @@ ifeq ($(strip $(filter-out powerpc% e500v2 wrs vxworksae,$(targ))),)
s-vxwext.adb<s-vxwext-noints.adb \
s-vxwext.ads<s-vxwext-vthreads.ads \
s-vxwork.ads<s-vxwork-ppc.ads \
g-trasym.ads<g-trasym-unimplemented.ads \
g-trasym.adb<g-trasym-unimplemented.adb \
system.ads<system-vxworks-ppc-vthread.ads \
$(ATOMICS_TARGET_PAIRS) \
$(ATOMICS_BUILTINS_TARGET_PAIRS)
@ -676,8 +670,6 @@ ifeq ($(strip $(filter-out e500% powerpc% wrs vxworksmils,$(targ))),)
s-thread.adb<s-thread-ae653.adb \
s-tpopsp.adb<s-tpopsp-vxworks.adb \
s-vxwork.ads<s-vxwork-ppc.ads \
g-trasym.ads<g-trasym-unimplemented.ads \
g-trasym.adb<g-trasym-unimplemented.adb \
system.ads<system-vxworks-ppc.ads \
$(ATOMICS_TARGET_PAIRS) \
$(ATOMICS_BUILTINS_TARGET_PAIRS) \
@ -728,8 +720,6 @@ ifeq ($(strip $(filter-out %86 wrs vxworksae vxworksmils,$(targ))),)
s-vxwext.adb<s-vxwext-noints.adb \
s-vxwext.ads<s-vxwext-vthreads.ads \
s-vxwork.ads<s-vxwork-x86.ads \
g-trasym.ads<g-trasym-unimplemented.ads \
g-trasym.adb<g-trasym-unimplemented.adb \
$(ATOMICS_TARGET_PAIRS) \
$(X86_TARGET_PAIRS) \
system.ads<system-vxworks-x86.ads
@ -789,8 +779,6 @@ ifeq ($(strip $(filter-out sparc% wrs vx%,$(targ))),)
g-socthi.ads<g-socthi-vxworks.ads \
g-socthi.adb<g-socthi-vxworks.adb \
g-stsifd.adb<g-stsifd-sockets.adb \
g-trasym.ads<g-trasym-unimplemented.ads \
g-trasym.adb<g-trasym-unimplemented.adb \
system.ads<system-vxworks-sparcv9.ads \
TOOLS_TARGET_PAIRS=\
@ -825,8 +813,6 @@ ifeq ($(strip $(filter-out %86 wrs vxworks,$(targ))),)
g-socthi.ads<g-socthi-vxworks.ads \
g-socthi.adb<g-socthi-vxworks.adb \
g-stsifd.adb<g-stsifd-sockets.adb \
g-trasym.ads<g-trasym-unimplemented.ads \
g-trasym.adb<g-trasym-unimplemented.adb \
$(ATOMICS_TARGET_PAIRS) \
$(X86_TARGET_PAIRS)
@ -922,8 +908,6 @@ ifeq ($(strip $(filter-out arm% coff wrs vx%,$(targ))),)
g-socthi.ads<g-socthi-vxworks.ads \
g-socthi.adb<g-socthi-vxworks.adb \
g-stsifd.adb<g-stsifd-sockets.adb \
g-trasym.ads<g-trasym-unimplemented.ads \
g-trasym.adb<g-trasym-unimplemented.adb \
system.ads<system-vxworks-arm.ads
TOOLS_TARGET_PAIRS=\
@ -960,8 +944,6 @@ ifeq ($(strip $(filter-out mips% wrs vx%,$(targ))),)
g-socthi.ads<g-socthi-vxworks.ads \
g-socthi.adb<g-socthi-vxworks.adb \
g-stsifd.adb<g-stsifd-sockets.adb \
g-trasym.ads<g-trasym-unimplemented.ads \
g-trasym.adb<g-trasym-unimplemented.adb \
system.ads<system-vxworks-mips.ads
TOOLS_TARGET_PAIRS=\
@ -1271,9 +1253,7 @@ ifeq ($(strip $(filter-out s390% linux%,$(arch) $(osys))),)
s-tasinf.ads<s-tasinf-linux.ads \
s-tasinf.adb<s-tasinf-linux.adb \
s-taspri.ads<s-taspri-posix-noaltstack.ads \
s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
g-trasym.ads<g-trasym-unimplemented.ads \
g-trasym.adb<g-trasym-unimplemented.adb
s-tpopsp.adb<s-tpopsp-posix-foreign.adb
LIBGNAT_TARGET_PAIRS_32 = \
system.ads<system-linux-s390.ads
@ -1447,9 +1427,7 @@ ifeq ($(strip $(filter-out rtems%,$(osys))),)
s-taspri.ads<s-taspri-posix.ads \
s-tpopsp.adb<s-tpopsp-rtems.adb \
s-stchop.adb<s-stchop-rtems.adb \
s-interr.adb<s-interr-hwint.adb \
g-trasym.ads<g-trasym-unimplemented.ads \
g-trasym.adb<g-trasym-unimplemented.adb
s-interr.adb<s-interr-hwint.adb
endif
ifeq ($(strip $(filter-out alpha% dec osf%,$(targ))),)
@ -1914,8 +1892,6 @@ ifeq ($(strip $(filter-out sparc% linux%,$(arch) $(osys))),)
s-tpopsp.adb<s-tpopsp-tls.adb
LIBGNAT_TARGET_PAIRS_32 = \
g-trasym.ads<g-trasym-unimplemented.ads \
g-trasym.adb<g-trasym-unimplemented.adb \
system.ads<system-linux-sparc.ads
LIBGNAT_TARGET_PAIRS_64 = \
@ -1955,8 +1931,6 @@ ifeq ($(strip $(filter-out hppa% linux%,$(arch) $(osys))),)
s-tasinf.adb<s-tasinf-linux.adb \
s-taspri.ads<s-taspri-posix-noaltstack.ads \
s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
g-trasym.ads<g-trasym-unimplemented.ads \
g-trasym.adb<g-trasym-unimplemented.adb \
system.ads<system-linux-hppa.ads
TOOLS_TARGET_PAIRS = \
@ -2079,8 +2053,6 @@ ifeq ($(strip $(filter-out alpha% linux%,$(arch) $(osys))),)
s-tasinf.adb<s-tasinf-linux.adb \
s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
s-taspri.ads<s-taspri-posix-noaltstack.ads \
g-trasym.ads<g-trasym-unimplemented.ads \
g-trasym.adb<g-trasym-unimplemented.adb \
system.ads<system-linux-alpha.ads \
$(ATOMICS_TARGET_PAIRS) \
$(ATOMICS_BUILTINS_TARGET_PAIRS)
@ -2144,9 +2116,7 @@ ifeq ($(strip $(filter-out darwin%,$(osys))),)
s-osinte.ads<s-osinte-darwin.ads \
s-taprop.adb<s-taprop-posix.adb \
s-taspri.ads<s-taspri-posix.ads \
s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
g-trasym.ads<g-trasym-unimplemented.ads \
g-trasym.adb<g-trasym-unimplemented.adb
s-tpopsp.adb<s-tpopsp-posix-foreign.adb
ifeq ($(strip $(filter-out %86,$(arch))),)
LIBGNAT_TARGET_PAIRS += \

10
gcc/ada/opt.ads
View File

@ -1638,11 +1638,11 @@ package Opt is
-- GNAT
-- This is the value of the configuration switch for the Ada 83 mode, as
-- set by the command line switches -gnat83/95/05, and possibly modified by
-- the use of configuration pragmas Ada_83/Ada95/Ada05. This switch is used
-- to set the initial value for Ada_Version mode at the start of analysis
-- of a unit. Note however, that the setting of this flag is ignored for
-- internal and predefined units (which are always compiled in the most up
-- to date version of Ada).
-- the use of configuration pragmas Ada_*. This switch is used to set the
-- initial value for Ada_Version mode at the start of analysis of a unit.
-- Note however that the setting of this flag is ignored for internal and
-- predefined units (which are always compiled in the most up to date
-- version of Ada).
Ada_Version_Explicit_Config : Ada_Version_Type;
-- GNAT

2
gcc/ada/par-ch12.adb
View File

@ -336,7 +336,7 @@ package body Ch12 is
begin
Generic_Assoc_Node := New_Node (N_Generic_Association, Token_Ptr);
-- Ada2005: an association can be given by: others => <>
-- Ada 2005: an association can be given by: others => <>
if Token = Tok_Others then
if Ada_Version < Ada_2005 then

8
gcc/ada/par-ch2.adb
View File

@ -59,10 +59,14 @@ package body Ch2 is
begin
-- All set if we do indeed have an identifier
-- Code duplication, see Par_Ch3.P_Defining_Identifier???
if Token = Tok_Identifier then
-- Ada 2005 (AI-284): Compiling in Ada95 mode we warn that INTERFACE,
-- OVERRIDING, and SYNCHRONIZED are new reserved words.
-- Shouldn't the warnings below be emitted when in Ada 83 mode???
-- Ada 2005 (AI-284): If compiling in Ada 95 mode, we warn that
-- INTERFACE, OVERRIDING, and SYNCHRONIZED are new reserved words.
if Ada_Version = Ada_95
and then Warn_On_Ada_2005_Compatibility

19
gcc/ada/par-ch3.adb
View File

@ -210,12 +210,19 @@ package body Ch3 is
-- we set Force_Msg to True, since we want at least one message for each
-- separate declaration (but not use) of a reserved identifier.
-- Duplication should be removed, common code should be factored???
if Token = Tok_Identifier then
-- Ada 2005 (AI-284): Compiling in Ada95 mode we warn that INTERFACE,
-- OVERRIDING, and SYNCHRONIZED are new reserved words. Note that
-- in the case where these keywords are misused in Ada 95 mode,
-- this routine will generally not be called at all.
-- Shouldn't the warnings below be emitted when in Ada 83 mode???
-- Ada 2005 (AI-284): If compiling in Ada 95 mode, we warn that
-- INTERFACE, OVERRIDING, and SYNCHRONIZED are new reserved words.
-- Note that in the case where these keywords are misused in Ada 95
-- mode, this routine will generally not be called at all.
-- What sort of misuse is this comment talking about??? These are
-- perfectly legitimate defining identifiers in Ada 95???
if Ada_Version = Ada_95
and then Warn_On_Ada_2005_Compatibility
@ -657,7 +664,7 @@ package body Ch3 is
Error_Msg_SP
("(Ada 83) limited record declaration not allowed!");
-- In Ada2005, "abstract limited" can appear before "new",
-- In Ada 2005, "abstract limited" can appear before "new",
-- but it cannot be part of an untagged record declaration.
elsif Abstract_Present
@ -4236,7 +4243,7 @@ package body Ch3 is
P_Identifier_Declarations (Decls, Done, In_Spec);
end if;
-- Ada2005: A subprogram declaration can start with "not" or
-- Ada 2005: A subprogram declaration can start with "not" or
-- "overriding". In older versions, "overriding" is handled
-- like an identifier, with the appropriate messages.

2
gcc/ada/par-ch5.adb
View File

@ -1649,7 +1649,7 @@ package body Ch5 is
if Token = Tok_Of or else Token = Tok_Colon then
if Ada_Version < Ada_2012 then
Error_Msg_SC ("iterator is an Ada2012 feature");
Error_Msg_SC ("iterator is an Ada 2012 feature");
end if;
return P_Iterator_Specification (ID_Node);

4
gcc/ada/par-ch6.adb
View File

@ -184,7 +184,7 @@ package body Ch6 is
Scope.Table (Scope.Last).Ecol := Start_Column;
Scope.Table (Scope.Last).Lreq := False;
-- Ada2005: scan leading NOT OVERRIDING indicator
-- Ada 2005: scan leading NOT OVERRIDING indicator
if Token = Tok_Not then
Scan; -- past NOT
@ -1341,7 +1341,7 @@ package body Ch6 is
if Token = Tok_Aliased then
if Ada_Version < Ada_2012 then
Error_Msg_SC ("ALIASED parameter is an Ada2012 feature");
Error_Msg_SC ("ALIASED parameter is an Ada 2012 feature");
else
Set_Aliased_Present (Specification_Node);
end if;

5
gcc/ada/s-osinte-freebsd.ads
View File

@ -645,7 +645,10 @@ private
type clockid_t is new int;
CLOCK_REALTIME : constant clockid_t := 0;
CLOCK_MONOTONIC : constant clockid_t := 4;
CLOCK_MONOTONIC : constant clockid_t := 0;
-- On FreeBSD, pthread_cond_timedwait assumes a CLOCK_REALTIME time by
-- default (unless pthread_condattr_setclock is used to set an alternate
-- clock).
type pthread_t is new System.Address;
type pthread_attr_t is new System.Address;

4
gcc/ada/s-regpat.adb
View File

@ -7,7 +7,7 @@
-- B o d y --
-- --
-- Copyright (C) 1986 by University of Toronto. --
-- Copyright (C) 1999-2010, AdaCore --
-- Copyright (C) 1999-2011, AdaCore --
-- --
-- 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- --
@ -2017,7 +2017,7 @@ package body System.Regpat is
(Dummy.Program'First .. Dummy.Program'First + Size - 1));
else
-- We have to recompile now that we know the size
-- ??? Can we use Ada05's return construct ?
-- ??? Can we use Ada 05's return construct ?
declare
Result : Pattern_Matcher (Size);
begin

4
gcc/ada/s-tpopde-vms.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2000-2009, Free Software Foundation, Inc. --
-- Copyright (C) 2000-2011, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -36,7 +36,7 @@ package System.Task_Primitives.Operations.DEC is
procedure Interrupt_AST_Handler (ID : Address);
pragma Convention (C, Interrupt_AST_Handler);
-- Handles the AST for Ada95 Interrupts
-- Handles the AST for Ada 95 Interrupts
procedure RMS_AST_Handler (ID : Address);
-- Handles the AST for RMS_Asynch_Operations

2
gcc/ada/sem_aggr.adb
View File

@ -3414,7 +3414,7 @@ package body Sem_Aggr is
Selector_Name);
return;
-- (Ada2005): If this is an association with a box,
-- (Ada 2005): If this is an association with a box,
-- indicate that the association need not represent
-- any component.

4
gcc/ada/sem_attr.adb
View File

@ -2125,7 +2125,7 @@ package body Sem_Attr is
case Attr_Id is
-- Attributes related to Ada2012 iterators. Attribute specifications
-- Attributes related to Ada 2012 iterators. Attribute specifications
-- exist for these, but they cannot be queried.
when Attribute_Constant_Indexing |
@ -6120,7 +6120,7 @@ package body Sem_Attr is
case Id is
-- Attributes related to Ada2012 iterators (placeholder ???)
-- Attributes related to Ada 2012 iterators (placeholder ???)
when Attribute_Constant_Indexing => null;
when Attribute_Default_Iterator => null;

2
gcc/ada/sem_cat.adb
View File

@ -900,7 +900,7 @@ package body Sem_Cat is
-- If the type is private, it must have the Ada 2005 pragma
-- Has_Preelaborable_Initialization.
-- The check is omitted within predefined units. This is probably
-- obsolete code to fix the Ada95 weakness in this area ???
-- obsolete code to fix the Ada 95 weakness in this area ???
if Is_Private_Type (T)
and then not Has_Pragma_Preelab_Init (T)

2
gcc/ada/sem_ch10.adb
View File

@ -208,7 +208,7 @@ package body Sem_Ch10 is
-- Limited_With_Clauses --
--------------------------
-- Limited_With clauses are the mechanism chosen for Ada05 to support
-- Limited_With clauses are the mechanism chosen for Ada 05 to support
-- mutually recursive types declared in different units. A limited_with
-- clause that names package P in the context of unit U makes the types
-- declared in the visible part of P available within U, but with the

2
gcc/ada/sem_ch12.adb
View File

@ -258,7 +258,7 @@ package body Sem_Ch12 is
-- are not accessible outside of the instance.
-- In a generic, a formal package is treated like a special instantiation.
-- Our Ada95 compiler handled formals with and without box in different
-- Our Ada 95 compiler handled formals with and without box in different
-- ways. With partial parametrization, we use a single model for both.
-- We create a package declaration that consists of the specification of
-- the generic package, and a set of declarations that map the actuals

4
gcc/ada/sem_ch3.adb
View File

@ -9026,7 +9026,7 @@ package body Sem_Ch3 is
-- The partial view of T may have been a private extension, for
-- which inherited functions dispatching on result are abstract.
-- If the full view is a null extension, there is no need for
-- overriding in Ada2005, but wrappers need to be built for them
-- overriding in Ada 2005, but wrappers need to be built for them
-- (see exp_ch3, Build_Controlling_Function_Wrappers).
if Is_Null_Extension (T)
@ -18287,7 +18287,7 @@ package body Sem_Ch3 is
-- Look up tree to find an appropriate insertion point. We
-- can't just use insert_actions because later processing
-- depends on the insertion node. Prior to Ada2012 the
-- depends on the insertion node. Prior to Ada 2012 the
-- insertion point could only be a declaration or a loop, but
-- quantified expressions can appear within any context in an
-- expression, and the insertion point can be any statement,

2
gcc/ada/sem_ch4.adb
View File

@ -3434,7 +3434,7 @@ package body Sem_Ch4 is
-- of the high bound.
procedure Check_Universal_Expression (N : Node_Id);
-- In Ada83, reject bounds of a universal range that are not
-- In Ada 83, reject bounds of a universal range that are not
-- literals or entity names.
-----------------------

2
gcc/ada/sem_ch5.adb
View File

@ -2068,7 +2068,7 @@ package body Sem_Ch5 is
Set_Parent (D_Copy, Parent (DS));
Pre_Analyze_Range (D_Copy);
-- Ada2012: If the domain of iteration is a function call,
-- Ada 2012: If the domain of iteration is a function call,
-- it is the new iterator form.
-- We have also implemented the shorter form : for X in S

12
gcc/ada/sem_ch6.adb
View File

@ -387,7 +387,7 @@ package body Sem_Ch6 is
begin
Analyze (P);
-- A call of the form A.B (X) may be an Ada05 call, which is rewritten
-- A call of the form A.B (X) may be an Ada 05 call, which is rewritten
-- as B (A, X). If the rewriting is successful, the call has been
-- analyzed and we just return.
@ -495,7 +495,7 @@ package body Sem_Ch6 is
elsif Warn_On_Ada_2005_Compatibility or GNAT_Mode then
if Inside_A_Generic then
Error_Msg_N
("return of limited object not permitted in Ada2005 "
("return of limited object not permitted in Ada 2005 "
& "(RM-2005 6.5(5.5/2))?", Expr);
elsif Is_Immutably_Limited_Type (R_Type) then
@ -2381,7 +2381,7 @@ package body Sem_Ch6 is
-- expansion has generated an equivalent type that is used when
-- elaborating the body.
-- An exception in the case of Ada2012, AI05-177: The bodies
-- An exception in the case of Ada 2012, AI05-177: The bodies
-- created for expression functions do not freeze.
if No (Spec_Id)
@ -6134,7 +6134,7 @@ package body Sem_Ch6 is
Desig_2 : Entity_Id;
begin
-- In Ada2005, access constant indicators must match for
-- In Ada 2005, access constant indicators must match for
-- subtype conformance.
if Ada_Version >= Ada_2005
@ -8725,7 +8725,7 @@ package body Sem_Ch6 is
-- inherited in a derivation, or when an inherited operation
-- of a tagged full type overrides the inherited operation of
-- a private extension. Ada 83 had a special rule for the
-- literal case. In Ada95, the later implicit operation hides
-- literal case. In Ada 95, the later implicit operation hides
-- the former, and the literal is always the former. In the
-- odd case where both are derived operations declared at the
-- same point, both operations should be declared, and in that
@ -10262,7 +10262,7 @@ package body Sem_Ch6 is
if Nkind (Parameter_Type (Spec)) = N_Access_Definition then
-- Ada 2005 (AI-231): In Ada95, access parameters are always non-
-- Ada 2005 (AI-231): In Ada 95, access parameters are always non-
-- null; In Ada 2005, only if then null_exclusion is explicit.
if Ada_Version < Ada_2005

4
gcc/ada/sem_intr.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -124,7 +124,7 @@ package body Sem_Intr is
end if;
-- For Import_xxx calls, argument must be static string. A string
-- literal is legal even in Ada83 mode, where such literals are
-- literal is legal even in Ada 83 mode, where such literals are
-- not static.
if Cnam = Name_Import_Address

4
gcc/ada/sem_res.ads
View File

@ -95,8 +95,8 @@ package Sem_Res is
procedure Ambiguous_Character (C : Node_Id);
-- Give list of candidate interpretations when a character literal cannot
-- be resolved, for example in a (useless) comparison such as 'A' = 'B'.
-- In Ada95 the literals in question can be of type Character or Wide_
-- Character. In Ada2005 Wide_Wide_Character is also a candidate. The
-- In Ada 95 the literals in question can be of type Character or Wide_
-- Character. In Ada 2005 Wide_Wide_Character is also a candidate. The
-- node may also be overloaded with user-defined character types.
procedure Check_Parameterless_Call (N : Node_Id);

4
gcc/ada/sem_type.adb
View File

@ -1988,11 +1988,11 @@ package body Sem_Type is
-- Otherwise, the predefined operator has precedence, or if the user-
-- defined operation is directly visible we have a true ambiguity.
-- If this is a fixed-point multiplication and division in Ada83 mode,
-- If this is a fixed-point multiplication and division in Ada 83 mode,
-- exclude the universal_fixed operator, which often causes ambiguities
-- in legacy code.
-- Ditto in Ada2012, where an ambiguity may arise for an operation on
-- Ditto in Ada 2012, where an ambiguity may arise for an operation on
-- a partial view that is completed with a fixed point type. See
-- AI05-0020 and AI05-0209. The ambiguity is resolved in favor of the
-- user-defined subprogram so that a client of the package has the

6
gcc/ada/sem_util.adb
View File

@ -2993,7 +2993,7 @@ package body Sem_Util is
if not Is_Local_Anonymous_Access (Etype (Expr)) then
-- Handle type conversions introduced for a rename of an
-- Ada2012 stand-alone object of an anonymous access type.
-- Ada 2012 stand-alone object of an anonymous access type.
return Dynamic_Accessibility_Level (Expression (Expr));
end if;
@ -7501,7 +7501,7 @@ package body Sem_Util is
Is_Object_Reference (Prefix (N))
or else Is_Access_Type (Etype (Prefix (N)));
-- In Ada95, a function call is a constant object; a procedure
-- In Ada 95, a function call is a constant object; a procedure
-- call is not.
when N_Function_Call =>
@ -7617,7 +7617,7 @@ package body Sem_Util is
elsif Original_Node (AV) /= AV then
-- In Ada2012, the explicit dereference may be a rewritten call to a
-- In Ada 2012, the explicit dereference may be a rewritten call to a
-- Reference function.
if Ada_Version >= Ada_2012