Ada Shutdown Hook - ada

There are some ‘cleanup’ calls that I want called when an Ada application is shutdown/killed.
For instance if I was in java, I would do something like this to achieve the effect of having something called at shutdown:
Runtime.getRuntime().addShutdownHook(new Thread(){
public void run(){
method();
}
});
Is there anything similar in Ada or another way to achieve this?

Since an Ada main program is treated as a task, you can use the Ada.Task_Termination package to manage post-execution cleanup. There's a writeup on this in the Ada 2005 Rationale, and what follows is a quick demo I put together that builds on the example.
You have to provide a library level protected termination procedure, so here's a package for that:
with Ada.Task_Termination;
with Ada.Task_Identification;
with Ada.Exceptions;
package Main_Program_Finalization is
protected Shutdown_Handler is
procedure Termination_Finalizer
(Cause : in Ada.Task_Termination.Cause_Of_Termination;
T : in Ada.Task_Identification.Task_Id;
X : in Ada.Exceptions.Exception_Occurrence);
end Shutdown_Handler;
end Main_Program_Finalization;
Body:
with Text_IO; use Text_IO;
package body Main_Program_Finalization is
protected body Shutdown_Handler is
procedure Termination_Finalizer
(Cause : in Ada.Task_Termination.Cause_Of_Termination;
T : in Ada.Task_Identification.Task_Id;
X : in Ada.Exceptions.Exception_Occurrence)
is
use Ada.Task_Termination;
use Ada.Task_Identification;
use Ada.Exceptions;
begin
New_Line;
Put_Line("Shutdown information:");
New_Line;
case Cause is
when Normal =>
Put_Line("Normal, boring termination");
when Abnormal =>
Put_Line("Something nasty happened to task ");
Put_Line(Image(T));
when Unhandled_Exception =>
Put_Line("Unhandled exception occurred in task ");
Put_Line(Image(T));
Put_Line(Exception_Information(X));
end case;
end Termination_Finalizer;
end Shutdown_Handler;
end Main_Program_Finalization;
Main program (it's set up for a normal termination as posted, uncomment the last two lines and run it to see the effect of an unhandled-exception triggered termination):
with Main_Program_Finalization;
with Ada.Task_Identification;
with Ada.Task_Termination;
with Text_IO; use Text_IO;
procedure task_term is
use Ada;
Task_ID : Task_Identification.Task_Id
:= Task_Identification.Current_Task;
begin
Put_Line("Main Task ID: " & Task_Identification.Image(Task_ID));
Put_Line("Setting termination finalizer");
Task_Termination.Set_Specific_Handler
(Task_ID,
Main_Program_Finalization.Shutdown_Handler.Termination_Finalizer'Access);
Put_Line("Go off and do things now...");
delay 1.0;
Put_Line("Done with mainline processing, the shutdown handler should now execute");
-- Put_Line("Raise an unhandled exception and see what the shutdown handler does");
-- raise Constraint_Error;
end Task_Term;

You could create a Controlled (or Limited_Controlled) object to the main procedure, which calls the necessary stuff in its Finalization method.
Be aware that you can't access any local variables of the main procedure, so put anything necessary into the controlled object.
example:
with Ada.Text_IO;
with Ada.Finalization;
procedure Main is
type Cleaner is new Ada.Finalization.Limited_Controlled with record
Some_Interesting_Data : Integer;
end record;
overriding procedure Finalize (X : in out Cleaner) is
begin
Ada.Text_IO.Put_Line ("Cleaning..." & Integer'Image (X.Some_Interesting_Data));
end Finalize;
The_Cleaner : Cleaner;
begin
Ada.Text_IO.Put_Line ("Main Procedure.");
The_Cleaner.Some_Interesting_Data := 42;
Ada.Text_IO.Put_Line ("Finished.");
end Main;

If it's a controlled shutdown initiated by the user or because the program is simply done doing what it does, then you can simply add a final call to a cleanup procedure.
If the program is terminated due to an interrupt signal, such as a user sending a SIGINT signal, or the system shutting down, then you can catch those signals and put your cleanup procedure in the registered callback.
I wrote a short example on how to catch interrupts using Ada. It's available at github and as a wiki article.
Another option is using the Florist POSIX package from libre.adacore.com. Perhaps there's something of use in the posix-signals package.

You can raise an exception, which can be one defined by the language or one defined in your program. Your exception handler would then execute.
You can also use Ada.Command_Line.Set_Exit_Status to return a code to the invoking environment.
Addendum: You can also handle external interrupts, as shown here.

Seems like there should be a way to do this in pure Ada, but I couldn't find one.
One idea would be to use Interfaces.C and call atexit() with a callback function that does the cleanup. I haven't tried it, but I can't think of any reason it wouldn't work.
More info on Ada callbacks from C

If the program is allowed to shut down nicely, then you can use standard language facilities like controlled types to provide your "on shutdown" behavior.
If the program isn't allowed to shut down nicely by the OS, then there is no language-defined way to do it in any language. You will have to use some kind of OS call to do it.
Note that the example you showed was not a Java call, but a JVM call. JVM = Java Virtual Machine...essentially the Java OS. You could make the exact same call from Ada, assuming your Ada code is running on the JVM. If you are running under Windows instead you'd have to do it with Win32 system calls. You can make those from Ada, but obviously the exact calls aren't portably defined in the language.

Related

create a simple example of tasking error and storage error

I need some simple Ada code for test my "system". In order to test it I need some example of code that raise a storage error and a tasking error (I know normally they are avoided but I need to simulate this problems). I know that seems a basic request but I am a little new on ada coding and I find a little difficult to solve these tasks. I have tried to search on the internet for a fitted solution but all are not usable for my needs(or too specific or wrong). What I am searching is to create an .adb with a function/procedure that raises these two errors.
I hope you’ll be happy with different procedures for the two errors?
For Storage_Error,
procedure Storage is
procedure Recursive is
begin
Recursive;
end Recursive;
begin
Recursive;
end Storage;
and for Tasking_Error,
procedure Tasking is
task T is
entry E;
end T;
task body T is
begin
null;
end;
begin
delay 0.01;
T.E;
end Tasking;
This raises the exception because, when the main program calls T.E, there’s no task there at all. To explore this, replace the null; by e.g. delay 5.0; - the program waits 5 seconds before the exception terminates it.

Problem calling procedure in protected object using access type

Consider attached code showing three different calls to the same procedure. It compiles good but hangs up in execution time. I suspect about some kind of lock but I can not understand why.
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Exceptions; use Ada.Exceptions;
procedure Main is
type A_Proc is access protected procedure (B: in out Integer);
protected Obj is
procedure Inc (B: in out Integer);
procedure Test (B: in out Integer);
end Obj;
protected body Obj is
procedure Inc (B: in out Integer) is
begin
B:=B+1;
end Inc;
procedure Test (B: in out Integer) is
Proc : A_Proc:=Inc'Access;
begin
Proc.all (B);
end Test;
end Obj;
B : Integer:=1;
Proc : A_Proc:=Obj.Inc'Access;
begin
Put_Line(B'Image);
Obj.Inc (B);
Put_Line(B'Image);
Proc.all (B);
Put_Line(B'Image);
Obj.Test (B);
Put_Line(B'Image);
Put_Line("The End");
end Main;
In ARM 9.5.1(3), we find
For the execution of a call on a protected subprogram, [...] If the call is an internal call (see 9.5), the body of the subprogram is executed as for a normal subprogram call. If the call is an external call, then the body of the subprogram is executed as part of a new protected action on the target protected object
and in ARM 9.5(2,3),
When a name or prefix denotes an entry, protected subprogram, [...] the name or prefix determines a target object, as follows:
If it is a direct_name or expanded name that denotes the declaration (or body) of the operation, then the target object is implicitly specified to be the current instance of the task or protected unit immediately enclosing the operation; a call using such a name is defined to be an internal call
but, in (5),
If the name or prefix is a dereference (implicit or explicit) of an access-to-protected-subprogram value, then the target object is determined by the prefix of the Access attribute_reference that produced the access value originally; a call using such a name is defined to be an external call
so I’m afraid that the ARM explicitly warns against what you’re trying to do; Obj is locked on entry to Obj.Test, and the external call via Proc attempts to take the lock again. See DeeDee’s answer.
As an addendum to the answer by Simon Wright, I think that ARM 9.5.1 (15) ,
During a protected action, it is a bounded error to invoke an operation that is potentially blocking. The following are defined to be potentially blocking operations:
[...]
an external call on a protected subprogram (or an external requeue) with the same target object as that of the protected action;
and ARM 9.5.1 (17),
If the bounded error is detected, Program_Error is raised. If not detected, the bounded error might result in deadlock or a (nested) protected action on the same target object.
also apply. If so, then performing an external call on a protected subprogram might result in a deadlock, but it might also result in the program continue to run (or a Program_Error to be raised).
I executed the program on GNAT CE 2018 both Windows and Linux (Debian). The program on Windows runs till the end, but hangs on Linux after printing 3.
To elaborate on the comments below: you may use the configuration pragma Detect_Blocking to make the Ada run time check for these potentially blocking calls (see ARM H.5).
If you use GPRbuild, then you can enable the detection by putting pragma Detect_Blocking; into a file (typically named gnat.adc) and reference this configuration file in you're project file by adding the Local_Configuration_Pragmas attribute to the compiler package (see also here and here):
project Default is
for Source_Dirs use ("src");
for Object_Dir use "obj";
for Main use ("main.adb");
package Compiler is
for Local_Configuration_Pragmas use "gnat.adc";
end Compiler;
end Default;

How to stop execution in my program

Without copy-pasting my code here, how can I stop my ADA program from executing anymore lines of code during run-time if it calculates a certain value to 'X'?
something like:
variable_name := variable_name +4;
if variable_name >1 then
// END program here and dont execute any lines under this one
end if
I am not new to programming but new to ADA so finding the correct syntax is a pain. Any help?
There isn’t any specific syntax for this.
If you are in the main procedure, a simple return will do.
An Ada83-compatible answer is here on SO.
Both those are OK so long as you don’t have any tasks.
There’s an Ada95 Rosetta Code solution, which will work whether you have tasks or not:
with Ada.Task_Identification; use Ada.Task_Identification;
procedure Main is
-- Create as many task objects as your program needs
begin
-- whatever logic is required in your Main procedure
if some_condition then
Abort_Task (Current_Task);
end if;
end Main;
and a GNAT-specific solution, also OK with tasks:
with Ada.Text_IO; use Ada.Text_IO;
with GNAT.OS_Lib;
procedure Stopping is
procedure P is
begin
GNAT.OS_Lib.OS_Exit (0);
end P;
begin
Put_Line ("starting");
P;
Put_Line ("shouldn't have got here");
end Stopping;
if variable_name >1 then
raise PROGRAM_ERROR with "Aborted because ...";
end if;
will do what you ask. Whether that's what you want is another matter, you haven't given us enough context to guess at that.
The "abort" statement might also be usable, but its normal role is terminating tasks within a multi-tasking program.
Raising an exception is probably easiest, and if you don't like the standard ones, you can always declare your own. With an exception you can also do any tidying up (such as closing files if you need to) in your own exception handler. See the Wikibook for more details.

Ada 83(Only) How to end an entire program which has multiple procedures

I am using Ada83 (It's a course requirement to use this version), I am using multiple procedures. I don't know how to come out of the entire program. Some thing like Exit in C program which closes entire procedure. Where is the exit is called from?
If your program does not use tasks, you can define an exception that signifies an "emergency exit"; perhaps in some package:
package Emergency is
Emergency_Exit : exception;
end Emergency;
In your main procedure, catch this exception:
procedure Your_Main_Procedure is
begin
... whatever the main procedure does
exception
when Emergency.Emergency_Exit =>
null;
end Your_Main_Procedure;
So that whenever you raise the exception somewhere in your program:
raise Emergency_Exit;
it will transfer control to the null statement, which will then reach the end of the main procedure and exit the program.
Doing it this way means you can add cleanup code to other procedures:
procedure Something_Else is
...
begin
Direct_IO_Instance.Open (Some_File, Direct_IO_Instance.Out_File, "filename");
begin
... do your work
exception
when Emergency.Emergency_Exit =>
-- cleanup
Finish_Writing (Some_File);
Direct_IO_Instance.Close (Some_File);
-- now reraise, which will eventually reach the end of the program
raise;
end;
end Something_Else;
So when Emergency_Exit is raised, it will eventually transfer control to the end of the main procedure, but it might stop off in other exception handlers along the way to do any needed cleanup.
I don't think this works if there are other tasks running, because the main procedure will wait for those other tasks to complete before the program exits. In that case, in Ada 83, you'll need to coordinate the exit with the other tasks; perhaps you can define a global Boolean that those tasks check periodically to get them to exit, or perhaps you can structure the program in a way so that the Emergency_Exit exception handler knows what tasks to abort, or can call a task entry to get those tasks to terminate. The best solution would depend on the actual program structure.
On this page there is some explanation on how to do it, and what the risks are:
http://rosettacode.org/wiki/Program_termination#Ada

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