[multiple changes]
2011-08-03 Hristian Kirtchev <kirtchev@adacore.com> * exp_ch7.adb (Create_Finalizer): Treat freeze nodes in similar fashion to packages. This ensures that the finalizer body will not end up inside the freeze node. (Process_Declarations): Add code to detect whether a freeze node has a nested finalization collection. 2011-08-03 Pascal Obry <obry@adacore.com> * g-awk.adb, g-awk.ads: Make GNAT.AWK API compatible with Ada 2005. (Current_Session): Return a not null access to Session_Type. (Default_Session): Likewise. From-SVN: r177282
This commit is contained in:
parent
243cae0a51
commit
1cdfa9be54
|
@ -1,3 +1,17 @@
|
||||||
|
2011-08-03 Hristian Kirtchev <kirtchev@adacore.com>
|
||||||
|
|
||||||
|
* exp_ch7.adb (Create_Finalizer): Treat freeze nodes in similar fashion
|
||||||
|
to packages. This ensures that the finalizer body will not end up
|
||||||
|
inside the freeze node.
|
||||||
|
(Process_Declarations): Add code to detect whether a freeze node has a
|
||||||
|
nested finalization collection.
|
||||||
|
|
||||||
|
2011-08-03 Pascal Obry <obry@adacore.com>
|
||||||
|
|
||||||
|
* g-awk.adb, g-awk.ads: Make GNAT.AWK API compatible with Ada 2005.
|
||||||
|
(Current_Session): Return a not null access to Session_Type.
|
||||||
|
(Default_Session): Likewise.
|
||||||
|
|
||||||
2011-08-03 Robert Dewar <dewar@adacore.com>
|
2011-08-03 Robert Dewar <dewar@adacore.com>
|
||||||
|
|
||||||
* a-cfdlli.adb, bindgen.adb, exp_ch4.adb, exp_ch13.adb, sem_warn.adb,
|
* a-cfdlli.adb, bindgen.adb, exp_ch4.adb, exp_ch13.adb, sem_warn.adb,
|
||||||
|
|
|
@ -1756,10 +1756,12 @@ package body Exp_Ch7 is
|
||||||
Set_Is_Frozen (Fin_Id);
|
Set_Is_Frozen (Fin_Id);
|
||||||
|
|
||||||
-- In the case where the last construct to contain a controlled
|
-- In the case where the last construct to contain a controlled
|
||||||
-- object is either a nested package or instantiation, the body
|
-- object is either a nested package, an instantiation or a
|
||||||
-- must be inserted directly after the construct.
|
-- freeze node, the body must be inserted directly after the
|
||||||
|
-- construct.
|
||||||
|
|
||||||
if Nkind_In (Last_Top_Level_Ctrl_Construct,
|
if Nkind_In (Last_Top_Level_Ctrl_Construct,
|
||||||
|
N_Freeze_Entity,
|
||||||
N_Package_Declaration,
|
N_Package_Declaration,
|
||||||
N_Package_Body)
|
N_Package_Body)
|
||||||
then
|
then
|
||||||
|
@ -1988,7 +1990,24 @@ package body Exp_Ch7 is
|
||||||
(Is_Type (Typ)
|
(Is_Type (Typ)
|
||||||
and then Needs_Finalization (Typ))
|
and then Needs_Finalization (Typ))
|
||||||
then
|
then
|
||||||
|
Old_Counter_Val := Counter_Val;
|
||||||
|
|
||||||
|
-- Freeze nodes are considered to be identical to packages
|
||||||
|
-- and blocks in terms of nesting. The difference is that
|
||||||
|
-- a finalization collection created inside the freeze node
|
||||||
|
-- is at the same nesting level as the node itself.
|
||||||
|
|
||||||
Process_Declarations (Actions (Decl), Preprocess);
|
Process_Declarations (Actions (Decl), Preprocess);
|
||||||
|
|
||||||
|
-- The freeze node contains a finalization collection
|
||||||
|
|
||||||
|
if Preprocess
|
||||||
|
and then Top_Level
|
||||||
|
and then No (Last_Top_Level_Ctrl_Construct)
|
||||||
|
and then Counter_Val > Old_Counter_Val
|
||||||
|
then
|
||||||
|
Last_Top_Level_Ctrl_Construct := Decl;
|
||||||
|
end if;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- Nested package declarations, avoid generics
|
-- Nested package declarations, avoid generics
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
-- --
|
-- --
|
||||||
-- B o d y --
|
-- B o d y --
|
||||||
-- --
|
-- --
|
||||||
-- Copyright (C) 2000-2010, AdaCore --
|
-- Copyright (C) 2000-2011, AdaCore --
|
||||||
-- --
|
-- --
|
||||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
-- 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- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||||
|
@ -29,11 +29,6 @@
|
||||||
-- --
|
-- --
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
|
|
||||||
pragma Ada_95;
|
|
||||||
-- This is needed because the pragmas Warnings (Off) in Current_Session and
|
|
||||||
-- Default_Session (see below) do not work when compiling clients of this
|
|
||||||
-- package that instantiate generic units herein.
|
|
||||||
|
|
||||||
with Ada.Exceptions;
|
with Ada.Exceptions;
|
||||||
with Ada.Text_IO;
|
with Ada.Text_IO;
|
||||||
with Ada.Strings.Unbounded;
|
with Ada.Strings.Unbounded;
|
||||||
|
@ -735,30 +730,18 @@ package body GNAT.AWK is
|
||||||
-- Current_Session --
|
-- Current_Session --
|
||||||
---------------------
|
---------------------
|
||||||
|
|
||||||
function Current_Session return Session_Type is
|
function Current_Session return not null access Session_Type is
|
||||||
begin
|
begin
|
||||||
pragma Warnings (Off);
|
return Cur_Session.Self;
|
||||||
return Cur_Session;
|
|
||||||
-- ???The above return statement violates the Ada 2005 rule forbidding
|
|
||||||
-- copying of limited objects (see RM-7.5(2.8/2)). When compiled with
|
|
||||||
-- -gnatg, the compiler gives a warning instead of an error, so we can
|
|
||||||
-- turn it off.
|
|
||||||
pragma Warnings (On);
|
|
||||||
end Current_Session;
|
end Current_Session;
|
||||||
|
|
||||||
---------------------
|
---------------------
|
||||||
-- Default_Session --
|
-- Default_Session --
|
||||||
---------------------
|
---------------------
|
||||||
|
|
||||||
function Default_Session return Session_Type is
|
function Default_Session return not null access Session_Type is
|
||||||
begin
|
begin
|
||||||
pragma Warnings (Off);
|
return Def_Session.Self;
|
||||||
return Def_Session;
|
|
||||||
-- ???The above return statement violates the Ada 2005 rule forbidding
|
|
||||||
-- copying of limited objects (see RM-7.5(2.8/2)). When compiled with
|
|
||||||
-- -gnatg, the compiler gives a warning instead of an error, so we can
|
|
||||||
-- turn it off.
|
|
||||||
pragma Warnings (On);
|
|
||||||
end Default_Session;
|
end Default_Session;
|
||||||
|
|
||||||
--------------------
|
--------------------
|
||||||
|
|
|
@ -229,12 +229,12 @@ package GNAT.AWK is
|
||||||
-- Set the session to be used by default. This file will be used when the
|
-- Set the session to be used by default. This file will be used when the
|
||||||
-- Session parameter in following services is not specified.
|
-- Session parameter in following services is not specified.
|
||||||
|
|
||||||
function Current_Session return Session_Type;
|
function Current_Session return not null access Session_Type;
|
||||||
-- Returns the session used by default by all services. This is the
|
-- Returns the session used by default by all services. This is the
|
||||||
-- latest session specified by Set_Current service or the session
|
-- latest session specified by Set_Current service or the session
|
||||||
-- provided by default with this implementation.
|
-- provided by default with this implementation.
|
||||||
|
|
||||||
function Default_Session return Session_Type;
|
function Default_Session return not null access Session_Type;
|
||||||
-- Returns the default session provided by this package. Note that this is
|
-- Returns the default session provided by this package. Note that this is
|
||||||
-- the session return by Current_Session if Set_Current has not been used.
|
-- the session return by Current_Session if Set_Current has not been used.
|
||||||
|
|
||||||
|
@ -633,6 +633,7 @@ private
|
||||||
|
|
||||||
type Session_Type is new Ada.Finalization.Limited_Controlled with record
|
type Session_Type is new Ada.Finalization.Limited_Controlled with record
|
||||||
Data : Session_Data_Access;
|
Data : Session_Data_Access;
|
||||||
|
Self : not null access Session_Type := Session_Type'Unchecked_Access;
|
||||||
end record;
|
end record;
|
||||||
|
|
||||||
procedure Initialize (Session : in out Session_Type);
|
procedure Initialize (Session : in out Session_Type);
|
||||||
|
|
Loading…
Reference in New Issue