Ada: Declaration & assignment overhead - initialization

I'm curious about the initialization within Ada procedures:
Suppose I have the following procedure:
procedure Foo (Bar : Integer) is
Another_Bar : Integer := Bar;
begin
...
end Foo;
Should the assignment to Another_Bar have the same overhead as
procedure Foo2 (Bar : Integer) is
Another_Bar : Integer;
begin
Another_Bar := Bar;
...
end Foo;
My question is essentially if both assignments generate the same assembly instructions and thus are equal in speed? (without detailing the target machine)

Based on the Ada language standard, there is no general reason why those two forms of code should have different performance. It would all depend on the target machine and the compiler being used. Depending on the rest of the code in the procedure, some compilers could even completely optimize away the Another_Bar variable.
However, there is a semantic difference, which could be important if the subtypes of Bar and Another_Bar were different -- for example, if Another_Bar were declared as Positive instead of Integer. Namely, in the first form any exception raised by the initialization of Another_Bar (say, because Bar has a negative value) is not handled by the possible exception handlers in the procedure itself, but is propagated to the caller. In the second form, where Another_Bar is assigned after the begin, exceptions from that assignment can be handled by the procedure's own exception handlers.

Related

Ada deferred constant finalized using complicated calculation; where to put the code?

I needed the result of a rather complex calculation to define a private type, something like this:
generic
top_m : Positive;
package Mystic is
type T is private;
private
type Table is array (Positive range <>) of Positive;
function reallyComplicatedFunction(x : Positive) return Table;
mytable : constant Table := reallyComplicatedFunction(top_m);
-- I will need mytable for calculations later
type T is array (mytable'Range) of Natural;
-- T is very different from Table, except they share their Range
end Mystic;
I needed the type T to depend on generic parameter top_m in a really complicated way, embodied by reallyComplicatedFunction(.). The function is defined in the body of package Mystic, but it does not use anything else declared by the package.
To my surprise this setup works just fine. Maybe I'm just lucky, because as far as I can tell from decyphering the ARM, this kind of invocation of the function is merely 'legal' but it is not guaranteed not to throw a Program_Error. I interpret this as "it would be too restrictive to forbid this sort of stuff entirely, but the compiler can't be expected to determine its feasibility in all cases either, so we'll just allow you to experiment with it". And then there's the rather significant possibility that I'm completely misreading the reference manual. Anyway, books on Ada give rather stern warnings about this sort of thing, typically around the discussion of pragma Elaborate et al., such that I almost didn't try this solution.
I've also tried to put the function in a private child package of Mystic, but I could not resolve circularities between the child implicitly depending on the parent and the parent specification depending on the child. Anyway, this function is not an extension of Mystic but a necessary code to initialize it.
My question would then be: where is the proper place for such a function?
ETA: at the request of Simon Wright, here's the part of the ARM I struggle with: http://www.ada-auth.org/standards/12rm/html/RM-3-11.html entries 9, 10/1 and 14:
For a construct that attempts to use a body, a check
(Elaboration_Check) is performed, as follows:
For a call to a (non-protected) subprogram that has an explicit body, a check is made that the body is already elaborated. This check
and the evaluations of any actual parameters of the call are done in
an arbitrary order.
...
The exception Program_Error is raised if any of these checks fails.
As far as I understand, the construct mytable : constant Table := etc. tries to use the body of reallyComplicatedFunction, so it must check whether it was elaborated or not. I assume - this is a weak point in my reasoning but this is what I understood - that elaboration of the body of reallyComplicatedFunction only occurs during the elaboration of the body of package Mystic, so my function won't be elaborated at the time it is called from the private part of the package specification. Nonetheless, I don't receive the Program_Error as promised when using (an instance of) the package.
ETA2: following a remark from trashgod, I've tried turning package Mystic into a non-generic one; made top_m into a visible constant and removed the genericity part. The compiler now catches the circularity I was worried about from the beginning and the program exits with Program_Error: access before elaboration. It's as if the body of a generic package was elaborated before the first instantiation, or rather before the elaboration of the specification of said package during instantiation. Since I'd expect Ada to cater to this kind of need (of hiding complex calculations needed to instantiate a package in the body of said package), I'd not be surprised if it worked as per the standard, but I don't recall reading anything like this anywhere and would like to know the exact rules. Something very smart is going on because if I make the body of the function dependent on type T, the compiler warns about 'call to Tt may occur before body is seen' at the point of package instantiation (I guess 'Tt' is some internality of type T), and when the program is run, it throws a Program_Error complaining about access before elaboration, pointing to the first place where an object of type T is instantiated by another function I have called by reallyComplicatedFunction for testing purposes.
Edit, reflecting the comment that explain why reallyComplicatedFunction should not be public.
If I understand correctly, the function does not really not depend on Mystic, but reallyComplicatedFunction should be private. In that case, I'd try putting it elsewhere, and keep the dependency on top_m. I have assumed that Table could also be moved, even though formally it is creating a dependence of reallyComplicatedFunction, Table being in its parameter profile.
To resolve, a new private place is created in a hierarchy, a private sibling gets the declarations and will only be used in the private part of original Mystic. Hence, private with in the latter's context clause.
package Top is end;
private generic
top_m : Positive;
package Top.Outsourced is
type Table is array (Positive range <>) of Positive;
function reallyComplicatedFunction(x : Positive) return Table;
end Top.Outsourced;
private with Top.Outsourced;
generic
Top_M : Positive;
package Top.Mystic is
type T is private;
private
package Initializer is new Top.Outsourced (top_m);
subtype Table is Initializer.Table;
mytable : constant Table := Initializer.reallyComplicatedFunction (top_m);
-- I will need mytable for calculations later
type T is array (mytable'Range) of Natural;
-- T is very different from Table, except they share their Range
end Top.Mystic;
package body Top.Outsourced is
function reallyComplicatedFunction(x : Positive) return Table is
Limit : Positive;
begin
Limit := Positive'Min (top_m, 1) + x/2;
return Result : Table (1 .. Limit);
end reallyComplicatedFunction;
end Top.Outsourced;
Assuming (since you didn't specify it) the array returned from reallyComplicatedFunction has the range 1..top_m, you could define a new subtype and use that as the range for both arrays:
subtype My_Range is Positive range 1..m_top
type Table is array (My_Range) of Positive;
type T is array (My_Range) of Natural;
and move both my_table and reallyComplicatedFunction inside the package body.

What is the 'Address of an Ada subprogram passed as an access parameter?

Compiling the following program without optimization, and then running it, I see Program_Error,
raised PROGRAM_ERROR : addreq.adb:16 explicit raise
or, updating in view of Simon Wright's answer,
raised PROGRAM_ERROR : using address
This happens when using GNAT GPL 2014 on either Mac OS X or on GNU/Linux x84_64, on Linux, strangely, only for my program. Other versions of GNAT produce code that doesn't raise, older compilers do not accept (access-to-function parameters being more recent, I'm not surprised). Since my program needs to identify addresses of subprograms, I was hoping for a definitive statement in the RM; 13.3 (11) has ramifications that grow waivers, IINM. So, referring to the program below, would
Yes_no.all'Address = No'Adress
be a true statement if interpreted by the LRM? Legit? Is Yes_No.all actually a proper way to refer to the function No (if taking the 'Address)? As there is indirection through different pointer types, one having deeper accessibility, does this change the picture? I was thinking that Yes_No.all should yield the same 'Address as No, but apparently not, with some compilers.
with System;
procedure Addreq is
function No (Ignored : Integer) return Boolean is
begin
return False;
end No;
procedure Taking
(Yes_No : access function (N : Integer) return Boolean)
is
use type System.Address;
begin
if Yes_No.all'Address /= No'Address then
raise Program_Error;
end if;
end Taking;
begin
Taking (No'Access);
end Addreq;
One more update: if I make Addreq a package and have another subprogram call Taking, thus
with Addreq; -- now a package
procedure Driver is
use Addreq;
begin
Taking (No'Access);
end Driver;
then no exception is raised.
I think it must depend on your OS and compiler. Using FSF GCC 5.1.0 on Mac OS X, your code doesn’t raise the exception.
That said, I think it’d be more natural to avoid .all’Address (I was told by one of the Ada 95 Distinguished Reviewers that he’d got into the habit of saying .all’Access when what was really needed was an appropriate type conversion). This extension of your code doesn’t raise the exception for either case.
with Ada.Text_IO; use Ada.Text_IO;
with System;
procedure Addreq is
function No (Ignored : Integer) return Boolean is
begin
return False;
end No;
procedure Taking
(Yes_No : access function (N : Integer) return Boolean)
is
use type System.Address;
begin
if Yes_No.all'Address /= No'Address then
raise Program_Error with "using address";
end if;
Put_Line ("using address was OK");
if Yes_No /= No'Access then
raise Program_Error with "using access";
end if;
Put_Line ("using access was OK");
end Taking;
begin
Taking (No'Access);
end Addreq;
(later)
I rewrote this to not use exceptions ...
with Ada.Text_IO; use Ada.Text_IO;
with System;
procedure Addreq is
function No (Ignored : Integer) return Boolean is
begin
return False;
end No;
procedure Taking
(Yes_No : access function (N : Integer) return Boolean)
is
use type System.Address;
begin
Put_Line
((if Yes_No.all'Address /= No'Address
then "using address failed"
else "using address was OK"));
Put_Line
((if Yes_No /= No'Access
then "using access failed"
else "using access was OK"));
end Taking;
begin
Taking (No'Access);
end Addreq;
With GNAT GPL 2014 on Mac OS X, this gives
$ ./addreq
using address failed
using access was OK
If Yes_No.all'Address is not equal to No'Address, then most likely Yes_No.all'Address is the address of some kind of wrapper code.
No is a function nested inside a procedure. If you say No'access, the compiler generally cannot simply create a one-word pointer whose value is the address of No. The reason is that when the code makes an indirect call through the access value, the code has to do something special so that No can access local variables belonging to addreq, which will be somewhere on the stack. For example, one way to provide this access is to pass a static link as a parameter to No; this is an extra pointer that points to addreq's stack frame, which will contain its local variables (or something along those lines). Thus, when an indirect call is made through the access, the caller has to know what the static link is. One solution is to make nested access-to-function types dope vectors, that contain the function address and the static link. Another is to generate wrapper code. The wrapper code is responsible for calling the called subprogram with the static link parameter, and the access value is then simply a one-word pointer, which is the address of the wrapper code. I believe GNAT takes this approach. The advantage is that it makes it possible to pass My_Function'access as a parameter to a C function, for use as a callback. When the C code calls through the function pointer, it calls the wrapper function which then calls the nested function with the correct static link. There is a significant amount of public Ada code that depends on this mechanism. (GtkAda relies heavily on it.)
However, if the access value points to a wrapper, instead of the actual function, then The_Access.all'Address won't return what you think it should. When the code executes The_Access.all'Address, if The_Access is a single word with an address in it, that's all the attribute can return--the address in the pointer.
More: I don't know whether the original code is part of a larger example or just a test to see what the compiler does. But comparing 'Address values to see if a subprogram-access parameter refers to a specific subprogram strikes me a poor design, and comparing 'Access is no better. I would avoid doing that even in C. There's likely to be a more object-oriented solution to the problem (note that you can use tagged types to cause indirect subprogram calls to take place, because tagged type operations are dispatching). E.g.
type Boolean_Function_Object is abstract tagged null record;
function Apply (Obj : Boolean_Function_Object; N : Integer) return boolean;
function Is_Constant_False (Obj : Boolean_Function_Object) return boolean;
type No_Function is new Boolean_Function_Object with null record;
overriding
function Apply (Obj : No_Function; N : Integer) return boolean is (False);
overriding
function Is_Constant_False (Obj : No_Function) return boolean is (True);
procedure Taking (Func : Boolean_Function_Object) is
begin
if not Func.Is_Constant_False then
raise Program_Error;
end if;
end Taking;
Might not be the best design in all cases, but something like this should be considered if there seems to be a need to check a subprogram address to a particular subprogram. For one thing, this is more flexible; a programmer can define another derived type where Apply always return False but does something else, such as writing the argument to a log file.

Safety of unrestricted_access

I have a complicated situation so I hope I can explain it properly.
I am using unchecked_access in combination with Ada.Finalization.Controlled types to pass references to vectors to an out of scope protected hashed map type on the Initialize procedure and removing references in the protected map on the finalize procedure. This way I thought I could assure that it would be impossible for any tasks to see out of scope references in the map.
However, the way I have the protected map organized snap shots are taken at each instance that is it used (effectively making it a normal hashed_map) which during the course of it being used vector references could go out of scope and the snap shot would still have the reference and attempt to access it.
I could see this creating 2 problems, either I am creating dangling pointers and trying to reference freed memory or my snapshot of the references is keeping the memory alive and I am leaving garbage around. I made a test to see what would happen and it seems the memory is still alive but is this really the case? Are there any other problems with my organization?
with Ada.Containers; use Ada.Containers;
with Ada.Containers.Vectors;
with Ada.Text_IO; use Ada.Text_IO;
procedure Test is
package V_Integer is new Ada.Containers.Vectors(Positive, Integer);
use V_Integer;
type V_Access is access all Vector;
Bar : V_Access;
begin
declare
Foo : aliased Vector;
begin
Bar := Foo'unrestricted_Access;
Foo.Append(3);
Foo.Append(5);
Put_Line("In scope: " & count_type'image(Length(Bar.all)));
end;
-- Will this reference always exist? Does it need to be freed?
Put_Line("Out of scope: " & count_type'image(Length(Bar.all)));
end Test;
begin
declare
Foo : aliased Vector;
begin
Bar := Foo'unrestricted_Access;
Foo.Append(3);
Foo.Append(5);
Put_Line("In scope: " & count_type'image(Length(Bar.all)));
end;
-- Will this reference always exist? Does it need to be freed?
Put_Line("Out of scope: " & count_type'image(Length(Bar.all)));
end Test;
Foo will be an object of type Vector, and it will probably exist on the stack. This object is itself a relatively small record, maybe about 6 32-bit words in GNAT (give or take a few, I haven't checked). It contains an access component that is used to get at all the vector's elements, and it contains some other housekeeping information. Bar will point to that small 6-word record. Essentially it will contain the address of something on the stack.
Since the small record Foo exists on the stack, when it goes out of scope, the stack space could be used for something else. Whether it will happen in this case, I don't know. But if you have another declare...begin...end block after the one in the example, local variables used by the new block could reuse the same stack space. Or if a procedure is called, that will put different stuff on the stack. In either case, the stack space previously used by Foo will be overwritten. And Bar will still point to the same address, but the area it points to will have been overrun with other data. So the result is likely to be wrong and could be a disaster.
I don't know if this is exactly how the implementation will work, but no matter how it's implemented, this code is potentially disastrous. The main things to keep in mind are: (1) If a variable goes out of scope, the space used for that variable may be reused at will; (2) if you use 'Unchecked_Access (or 'Unrestricted_Access) to set up a pointer to that variable, then after the variable goes out of scope, accessing data pointed to by the pointer could get you garbage or very bad behavior; (3) variables, whether aliased or not, are not (usually) dynamically allocated and the program does not need to (and cannot) explicitly free them, even if you've created a reference to them with 'Unchecked_Access.

Fortran pointer as an argument to interface procedure

Im trying to use interfaces to call different subroutines with different types, however, it doesnt seem to work when i use the pointer attribute. for example, take this sample code
MODULE ptr_types
TYPE, abstract :: parent
INTEGER :: q
END TYPE
TYPE, extends(parent) :: child
INTEGER :: m
END TYPE
INTERFACE ptr_interface
MODULE PROCEDURE do_something
END INTERFACE
CONTAINS
SUBROUTINE do_something(atype)
CLASS(parent), POINTER :: atype
! code determines that this allocation is correct from input
ALLOCATE(child::atype)
WRITE (*,*) atype%q
END SUBROUTINE
END MODULE
PROGRAM testpass
USE ptr_types
CLASS(child), POINTER :: ctype
CALL ptr_interface(ctype)
END PROGRAM
This gives error
Error: There is no specific subroutine for the generic 'ptr_interface' at (1)
however if i remove the pointer attribute in the subroutine it compiles fine. Now, normally this wouldnt be a problem, but for my use case i need to be able to treat that argument as a pointer, mainly so i can allocate it if necessary.
Any suggestions? Mind you I'm new to fortran so I may have missed something
edit: forgot to put the allocation in the parents subroutine, the initial input is unallocated
EDIT 2
this is my second attempt, with caller side casting
MODULE ptr_types
TYPE, abstract :: parent
INTEGER :: q
END TYPE
TYPE, extends(parent) :: child
INTEGER :: m
END TYPE
TYPE, extends(parent) :: second
INTEGER :: meow
END TYPE
CONTAINS
SUBROUTINE do_something(this, type_num)
CLASS(parent), POINTER :: this
INTEGER type_num
IF (type_num == 0) THEN
ALLOCATE (child::this)
ELSE IF (type_num == 1) THEN
ALLOCATE (second::this)
ENDIF
END SUBROUTINE
END MODULE
PROGRAM testpass
USE ptr_types
CLASS(child), POINTER :: ctype
SELECT TYPE(ctype)
CLASS is (parent)
CALL do_something(ctype, 0)
END SELECT
WRITE (*,*) ctype%q
END PROGRAM
however this still fails. in the select statement it complains that parent must extend child. Im sure this is due to restrictions when dealing with the pointer attribute, for type safety, however, im looking for a way to convert a pointer into its parent type for generic allocation. Rather than have to write separate allocation functions for every type and hope they dont collide in an interface or something.
hopefully this example will illustrate a little more clearly what im trying to achieve, if you know a better way let me know
As indicated by High Performance Mark, you have a mismatch in the declared type of the actual and dummy arguments for the call to ptr_interface. This isn't permitted if the dummy argument has the pointer or allocatable attribute - see 12.5.2.5p2 of F2008.
There's a simple rationale for this restriction (which is discussed in Note 12.27 in the F2008 standard) - without it it would be possible for the subroutine to allocate the dummy argument to be of a type that is incompatible with the actual argument. For example - imagine if there was another extension of Parent in the program somewhere - a sibling of Child in the type heirarchy. If your do_something procedure allocate its dummy argument to that sibling type, then back in the the calling scope you have something declared as type Child that is actually some other incompatible (not an extension of Child) type.
If the do_something procedure cannot allocate the thing to anything other than type Child, then make its dummy argument of type Child. If it can allocate it to some other type that is an extension of Parent, then you need to make the declared type of the actual argument type Parent as well. You can use the SELECT TYPE construct to then downcast to an object of Child type in the calling scope.
Subsequent to your edits, my suggestion was for your main program to look something like:
PROGRAM testpass
USE ptr_types
IMPLICIT NONE ! <--
CLASS(Parent), POINTER :: ctype
!***
! ctype here is a pointer with undefined association status,
! (so no concept of dynamic type) and declared type Parent.
CALL do_something(ctype, 0)
! Assuming successful ALLOCATE(Child :: xxx) in the procedure,
! ctype here is an associated pointer with dynamic type Child.
SELECT TYPE(ctype)
CLASS is (Child)
! Declared type of ctype in here is Child. Dynamic type
! in this specific case is also Child, but this block would
! also be executed if the dynamic type was a further extension
! of Child, because a CLASS IS guard was used. (A TYPE IS
! guard requires an exact match of dynamic type.)
!
! If the allocate in do_something allocated the dummy argument
! to be of type second or nullified the argument, then this
! block of code would not be executed. If do_something left
! the association status of the pointer undefined, then
! your program is non-conforming, and anything could happen.
WRITE (*,*) ctype%m
! Continue to work with ctype as a thing with declared type
! Child inside this block of the select type construct.
END SELECT
! ctype back to having a declared type of Parent.
WRITE (*,*) ctype%q
! Don't forget deallocation!
END PROGRAM
If I change your line
CLASS(child), POINTER :: ctype
to
CLASS(parent), POINTER :: ctype
then your program compiles and executes. I'm quite new to all this object-oriented Fortran myself so I struggle to point to the clause in the standard which states the rules for rank-type-kind matching in this case and clarifies your mistake. Your mistake may simply be to use a compiler which doesn't implement the latest features of the language. On the other hand, perhaps my compiler (Intel Fortran 13.1) implements the latest features as incorrectly as yours does.
(On past form a guy named IanH here on SO will pass by later and clarify.)
One thing I have learned though, is that if your compiler is Fortran 2003 compliant (enough) then making variables ALLOCATABLE rather than POINTER makes a number of operations easier and passes the responsibility for freeing unwanted memory to the compiler. You don't need pointers for dynamic memory management in Fortran any more.
I think that your problem comes from the POINTER attribute of the argument in the subroutine do_something. Delete it and all should work.

Best practice for implementing in Ada (2005 or 2012) an equivalent of the java finalize block

Java has the finalize block which allows to execute some statements after a block
is left (executed even if an exception is raised). Example:
try {
...
} catch (Exception e) {
...
} finally {
... // any code here
}
Ada has the controlled objects which allows to implement a Finalize operation
but there is no finalize block equivalent as in java. This is useful for logging,
closing files, transactions and so on (without having to create a specific tagged type for each possible block).
How would you implement such finalize block in Ada 2005 (while keeping the code readable)?
Are there plans in Ada 2012 to allow executing any finalization code easily?
I believe this code will do what you ask; it successfully prints out 42 with the present raise or with return. It's an implementation of T.E.D's suggestion.
Tested with GCC 4.5.0 on Mac OS X, Darwin 10.6.0.
with Ada.Finalization;
package Finally is
-- Calls Callee on deletion.
type Caller (Callee : not null access procedure)
is new Ada.Finalization.Limited_Controlled with private;
private
type Caller (Callee : not null access procedure)
is new Ada.Finalization.Limited_Controlled with null record;
procedure Finalize (Object : in out Caller);
end Finally;
package body Finally is
procedure Finalize (Object : in out Caller)
is
begin
Object.Callee.all;
end Finalize;
end Finally;
with Ada.Text_IO; use Ada.Text_IO;
with Finally;
procedure Finally_Demo is
begin
declare
X : Integer := 21;
-- The cleanup procedure, to be executed when this block is left
procedure F
is
begin
Put_Line ("X is " & Integer'Image (X));
end F;
-- The controlled object, whose deletion will execute F
F_Caller : Finally.Caller (F'Access);
begin
X := 42;
raise Constraint_Error;
end;
end Finally_Demo;
As Adrien mentions in the comment, Finalize is more analogous to a destructor.
To get something approximating an exception/final sequence you can do something along these lines (WARNING, not compiled, just typed--we'll work out any errors together :-) See also the Exceptions section of the Ada RM.
with Ada.Exceptions; use Ada.Exceptions;
procedure Do_Something is
-- Variables and what-not...
-- In case you have an exception and want to reraise it after you've done
-- the 'final' processing.
Exception_Caught : Exception_Occurrence := Null_Occurrence;
begin
-- You can have some statements, like initializations, here that will not
-- raise exceptions. But you don't have to, it can all just go in the
-- following block. However you want to do it...
declare
-- If you need to declare some entities local to a block, put those here.
-- If not, just omit this declare section. Be aware, though, that if
-- you initialize something in here and it raises an exception, the
-- block's exception handler will not catch it. Such an exception will
-- propagate out of the whole procedure (unless it has an outermost
-- exception handler) because you're _not_ in the block's scope yet.
begin
-- Main processing that might raise an exception
...
exception
when E : others =>
-- Handle any exception that's raised. If there are specific
-- exceptions that can be raised, they should be explicitly
-- handled prior to this catch-all 'others' one.
-- Save the exception occurrence, i.e. make a copy of it that can
-- be reraised in the 'Final' section if needed. (If you want to
-- reraise for a specific exception, do this in those handlers as
-- well.
Save_Occurrence(Exception_Caught, E);
end;
-- Final processing. Everything from here to the end of the procedure is
-- executed regardless of whether an exception was raised in the above
-- block. By it including an others handler, it ensured that no exception
-- will propagate out of this procedure without hitting this 'Final' code.
-- If an exception was raised and needs to be propagated:
if Exception_Caught /= Null_Occurrence then
Reraise_Exception(Exception_Caught);
end if;
end Do_Something;
Assuming you have understood the difference between ada.finalization and a finalize block in java, i would do something similar to the following, which should have the same effect.
procedure x is
begin
-- some code
begin
-- more code (your try)
exception
-- handle exception if necessary (caught exception)
end;
-- yet more code which is executed regardless of any exception handling.
end x;
Marc C has the right approach for trying to emulate that in straight-line procedural code.
However, IMHO that structure is mostly a way to hack around Java's OO system, for those who want one of the structural benifits of OO in old-fashioned procedural programming. Even in Java you are almost always better off creating a proper class instead.
So I don't think it is too much of a stretch to say that the proper way to get that functionality in Ada would be to make a proper object, and make your object a child of Ada.Finalization.Controlled.
If you don't want to bother with creating an actual object, you could just create a dummy one, put your finalization code in it, and declare it on the stack at the top of the block you want it run for. The drawback to that is that controlled types themselves (as least the last time I used them) have to be declared at package-level scope. When that's the case, you'd be unable to put direct references to lower-declared objects in them. They claimed they were going to fix that in future language revision, but I haven't tried it recently to see if they did.
Just thought of another answer. Its a bit heavy (and perhaps more trouble than it is worth). But it would give you something that looks a bit like your old finalize block
The idea would be to put your "finalizable" code in a task. You cannot leave the scope a task is declared in until the task terminates. So you could put your work code in the task and your "finally" code just outside of the scope the task is defined in. The parent task would sit there and wait for the work task to end (one way or another), and then it would run the "finally" code no matter how it ended. The drawback is that if the task throws an exception, it will stop at the task. So you still don't quite get the behavior that you can throw an exception and it will propagate out automatically while the "finalize" code gets run. You could maybe get that behavior back by adding a rendezvous and a second task (that's the problem with tasks. They are like potato chips...you always need one more).
procedure Finalized is
begin
declare
task Worker is end Worker;
task body Worker is begin
--// Working code in here. Can throw exceptions or whatever.
--// Does not matter.
end Worker;
begin
end;
--// If we get here, we know the task finished somehow (for good or ill)
--// so the finalization code goes here.
end Finalized;
It seems to me there might be a way to do something like this with protected objects too. I'll leave that one for others to figure out.
Lets put this problem into perspective.
In programming theory there exists concepts of an object's create & destroy and a procedure's try & finally. Both ultimately deal with resource management but they pivot on different things.
With objects we pivot on the potentially long-living tree of objects and variables referenced by the object pointer.
With procedures we pivot on the usually temporary objects and variables existing in the scope of the procedure call (the notable exception is main)
Now, depending on the procedure we might need to spawn a series of resources which, if the procedure is interrupted by a fatal error, must rollback all spawned resources in reverse order. Quite often this is easiest achieved by creating objects dedicated to managing their respective resource. Ada.Finalization becomes quite useful here.
But this can be overkill, and there can be arguments made against this technique on a case-by-case basis. So if we are interested in self-containing resource management to a procedure and making use of a C++-style finally keyword, consider the following.
I have often initially been pleased by the promise of convenience using finally only to be disappointed by how complicated the code can turn out after making use of it. Nesting is required for complex rollback operations, and many times the process is not linear, requiring logic to decide exactly how to roll back depending on how far we made it through the initialization. The nested block structure corners you to use linear logic. Thus when you need something more complicated then you are seriously considering making use of goto.
I've gone through this enough times to realize that, as appetizing as OOP-style finalize can be with what I mentioned, a true try & finally can be achieved in Ada without all the headaches as demonstrated in the following example. Note, it's far from perfect, but I think the good outweighs the bad with this strategy. What I especially like about this strategy is how explicit the finalize process becomes, all steps labeled and checked against Ada's type system, well organized and easy to manage. The C++-style try & finally scatters this kind of code, and Ada's Finalize hide's it and makes it harder to control the higher-level order of fail-over logic.
procedure Proc is
type Init_Stages_All is (Do_Null, Do_Place, Do_Pour, Do_Drink);
subtype Init_Stages is Init_Stages_All range Do_Place .. Do_Drink;
Init_Stage : Init_Stages_All := Do_Null;
procedure Initialize_Next is
begin
Init_Stage := Init_Stages_All'Succ(Init_Stage);
case Init_Stage is
when Do_Place => ...
when Do_Pour => ...
when Do_Drink => ...
when Do_Null => null;
end case;
end Initialize_Next;
procedure Finally is
begin
for Deinit_Stage in reverse Init_Stage .. Init_Stages'Last loop
case Deinit_Stage is
when Do_Place => ...
when Do_Pour => ...
when Do_Drink => ...
end case;
end loop;
end Finally;
begin
Initialize_Next; -- Do_Place
...
Initialize_Next; -- Do_Pour
...
Initialize_Next; -- Do_Drink
...
Finally;
exception
when E : others =>
...
Finally;
raise;
end Proc;
On a final note, this strategy also makes it easier to deal with finalization exceptions. I'd suggest creating a procedure in Finally that is called when an exception is raised and recursively call Finally by manipulating the Init_Stage as well as interject any additional fail-over logic there.

Resources