Tasking troubles, unexpected termination.

Tasking troubles, unexpected termination.

[Shark8]

with
Ada.Text_IO,
Ada.Calendar,
Ada.Containers.Indefinite_Vectors;

Procedure Scheduling is

    -- Introduce shorthand so convert Strings to access strings.
    Function "+" (Item : String) Return Not Null Access String is
      ( New String'(Item) );
    
    -- Forward declare the Notification type; indicate it has discriminants.
    Type Notification(<>);
    
    -- Declare Handle for Notifications.
    Type Notification_Handle is Not Null Access Notification;
    
    Type Notification(	Message	: Not Null Access String;
			Expiry	: Not Null Access Ada.Calendar.Time
		     ) is null record;
    
    -- Declare the Timing-task.
    Task Type Timing ( Resolution : Not Null Access Duration ) is
	Entry Add( Event : Notification_Handle );
    end Timing;


    -- Implementation for the timing-task.
    Task body Timing is
	-- Internal package, defining Vectors holding notification handles.
	Package Notification_Vector is New Ada.Containers.Indefinite_Vectors
	  ( Index_Type => Positive, Element_Type => Notification_Handle );
	Use Notification_Vector;
	
	-- Declare a Vector to hold all the notifications.
	Notification_List : Vector:= Empty_Vector;
	
	Procedure Handle_Expiration is
	    Use Ada.Calendar, Ada.Text_IO;
	    Length : Positive:= Positive(Notification_List.Length);
	    Now    : Time:= Clock;
	begin
	    -- Iterate through the vector's elements; reversed so that deletion
	    -- does not intefere with the iteration.
	    for Index in reverse 1..Length loop
		declare
		    Item : Notification_Handle Renames Notification_List(Index);
		begin
		    -- If it's reached the expiry, then we display the message
		    -- and remove the item.
		    if Now > Item.Expiry.All then
			Put_Line( "Message: " & Item.Message.All);
			Notification_List.Delete(Index);
		    end if;
		end;
	    end loop;
	    
	    declare
		Post_op_length : Positive:= Positive(Notification_List.Length);
	    begin
		if Length /= post_op_length then
		    Put_Line( "Deleted items; New Length:" &  post_op_length'Img);
		end if;
	    end;
	end Handle_Expiration;

	Use Ada.Containers;
    begin
	-- When there are no items in our internal vector, then we need can only
	-- accept Add or terminate the task.
	-- When we add an item, then we can either add another item or when the
	-- time expires iterate the vector and handling Notifications as needed.
	loop
	    select 
		accept Add( Event : Notification_Handle ) do
		    Notification_List.Append( Event );
		end add;
		while not Notification_List.Is_Empty loop
		    Handle_Expiration;
		    select
			accept Add( Event : Notification_Handle ) do
			    Notification_List.Append( Event );
			    Ada.Text_IO.Put_Line( "New Length: " & Notification_List.Length'Img );
			end add;
		    or
			delay Timing.Resolution.All;
		    end select;
		end loop;
		Ada.Text_IO.Put_Line( "EMPTY. Length: " & Notification_List.Length'Img );
	    or
		terminate;
	    end select;
	end loop;
    end Timing;
    
    
    K : Timing( Resolution => New Duration'(2.0) );
    
begin
    For Index in 1..10 loop
	declare
	    Use Ada.Calendar;
	    Expire : Time:= Clock + (Index*2.0); -- Now and 2*Index seconds.
	    Item : Notification(
			 Message => + ("DD"&Positive'Image(Index)),
			 Expiry  => New Time'( Expire )
			);
	begin
	    K.Add( Event => New Notification'(Item) );
	end;
    end loop;
end Scheduling;

----------------------------------

Output:
C:\Programming\Projects\Scheduler>scheduling.exe
New Length:  2
New Length:  3
New Length:  4
New Length:  5
New Length:  6
New Length:  7
New Length:  8
New Length:  9
New Length:  10
Message: DD 10


As you can see there's something happening to force termination -- there should at the least be an new-length message -- this leads me to believe [or, more accurately, guess] that there's some exception happening in the task which is blowing everything up.

Is that the case?
Also, if there is some tasking-exceptions interaction, how do I force them to display [and/or handle them] instead of falling off a cliff?

Re: Tasking troubles, unexpected termination.

[Adam Beneschan]

On Tuesday, October 30, 2012 3:03:45 PM UTC-7, Shark8 wrote:

> Also, if there is some tasking-exceptions interaction, how do I force them to display [and/or handle them] instead of falling off a cliff?

Have you looked into Ada.Task_Termination?  (RM C.7.3)  That's just the first thought off the top of my head; I haven't looked at your code closely.

                           -- Adam

Re: Tasking troubles, unexpected termination.

[Anh Vo]

On Tuesday, October 30, 2012 4:01:11 PM UTC-7, Adam Beneschan wrote:
> On Tuesday, October 30, 2012 3:03:45 PM UTC-7, Shark8 wrote: > Also, if there is some tasking-exceptions interaction, how do I force them to display [and/or handle them] instead of falling off a cliff? Have you looked into Ada.Task_Termination? (RM C.7.3) That's just the first thought off the top of my head; I haven't looked at your code closely. -- Adam

Using Ada.Task_Termination to monitor the tasks in this program, I got the following results showing task K terminated due unhandled exception PROGRAM_ERROR.

C:\Ada_2005\gps_gpr\Aspect_Programming\scheduling
New Length:  2
New Length:  3
New Length:  4
New Length:  5
New Length:  6
New Length:  7
New Length:  8
New Length:  9
New Length:  10
Message: DD 10

Task k_003F5838 ran for 0 and 0.000000000 seconds
Task k_003F5838 is terminated due to UNHANDLED_EXCEPTION termination
Exception name: PROGRAM_ERROR
Message: attempt to tamper with cursors (vector is busy)


Task main_task_003F5008 ran for 0 and 0.109375000 seconds
Task main_task_003F5008 is terminated due to NORMAL termination
[2012-10-30 18:00:35] process terminated successfully (elapsed time: 20.60s)

Re: Tasking troubles, unexpected termination.

[Shark8]

Here's the updated code:

---- Scheduling.adb ------------------------------------------
with
Ada.Text_IO,
Ada.Calendar,
Ada.Containers.Indefinite_Vectors,
Ada.Task_Termination,
Ada.Task_Identification,
Task_Debugging;

Procedure Scheduling is

    -- Introduce shorthand so convert Strings to access strings.
    Function "+" (Item : String) Return Not Null Access String is
      ( New String'(Item) );
    
    -- Forward declare the Notification type; indicate it has discriminants.
    Type Notification(<>);
    
    -- Declare Handle for Notifications.
    Type Notification_Handle is Not Null Access Notification;
    
    Type Notification(	Message	: Not Null Access String;
			Expiry	: Not Null Access Ada.Calendar.Time
		     ) is null record;
    
    -- Declare the Timing-task.
    Task Type Timing ( Resolution : Not Null Access Duration ) is
	Entry Add( Event : Notification_Handle );
    end Timing;

    
    -- Implementation for the timing-task.
    Task body Timing is

	-- Package for showing Duration.
	Package Decimal_Display is new Ada.Text_IO.Fixed_IO( Duration );
	
	-- Internal package, defining Vectors holding notification handles.
	Package Notification_Vector is New Ada.Containers.Indefinite_Vectors
	  ( Index_Type => Positive, Element_Type => Notification_Handle );
	Use Notification_Vector;
	
	-- Handle expired messages.
	Procedure Handle_Expiration( List : in out Vector ) is
	    Use Ada.Calendar, Ada.Text_IO;
	    Length : Positive:= Positive(List.Length);
	    Now    : Time:= Clock;

	    -- We flag everything to be deleted, as tampering with the cursor is
	    -- not good.
	    Type Deletion_Flags is Array(1..Length) of Boolean;
	    Deletion_Marks : Deletion_Flags:= (Others => False);
	    
	    
	    procedure Execute(Position : Cursor) is
		Item	: Constant Notification_Handle:= Element(position);
		Index	: Constant Positive:= Positive( To_Index(position) );
	    begin
		Deletion_Marks(Index):= Now >= Item.Expiry.All;
		--
		Ada.Text_IO.Put( ASCII.HT & "Exipration: " );
		Decimal_Display.Put( Item.Expiry.All - Now, Fore => 2, Aft => 3 );
		Ada.Text_IO.New_Line;
	    end Execute;

	begin
	    -- Iterate through the vector's elements; old-style iterator.
	    List.Reverse_Iterate( Process => Execute'Access );

	    -- Delete flagged elements; iteration bckwards to preserve indicies.
	    For Index in reverse Deletion_Marks'Range loop
		if Deletion_Marks(Index) then
		    
		    Put_Line( "Message: " & List(Index).Message.All);
		    List.Delete( Index );
		end if;
	    end loop;
	    
	    -- Render a report on the new length, if it was altered.
	    declare
		Post_op_length : Natural:= Natural(List.Length);
	    begin
		if Length /= post_op_length then
		    Put_Line( "Deleted items; New Length:" &  post_op_length'Img);
		end if;
	    end;
	end Handle_Expiration;

	-- Declare a Vector to hold all the nofifications.
	Notification_List : Vector:= Empty_Vector;
	
	Use Ada.Task_Termination, Task_Debugging, Ada.Containers, Ada.Calendar;
	
	-- Mark the start-time.
	Start : Time:= Clock;
	
--	Function Elapsed Return String is
--	  ( Duration'Image(Clock - Start)(1..7) );
	Function Elapsed Return Duration is
	  ( Clock - Start );

    begin
	-- Set our debugging-handler for this task.
	Ada.Task_Termination.Set_Specific_Handler(
		T       => Ada.Task_Identification.Current_Task,
		Handler => Debug.Termination'Access );

	-- When there are no items in our internal vector, then we need can only
	-- accept Add or terminate the task.
	-- When we add an item, then we can either add another item or when the
	-- time expires iterate the vector and handling Notifications as needed.
	loop
	    select 
		accept Add( Event : Notification_Handle ) do
		    Notification_List.Append( Event );
		end add;
		while not Notification_List.Is_Empty loop
		    Ada.Text_IO.Put( "Elapsed:" );
		    Decimal_Display.Put( Elapsed, Fore => 2, Aft => 3 );
		    Ada.Text_IO.New_Line;
		    Handle_Expiration( List => Notification_List );
		    select
			accept Add( Event : Notification_Handle ) do
			    Notification_List.Append( Event );
			    Ada.Text_IO.Put_Line( "New Length: " & Notification_List.Length'Img );
			    Ada.Text_IO.Put( ASCII.HT & "Exipration: " );
			    Decimal_Display.Put( Event.Expiry.All - Clock, Fore => 2, Aft => 3 );
			    Ada.Text_IO.New_Line;
			end add;
		    or
			delay Timing.Resolution.All;
		    end select;
		end loop;
		Ada.Text_IO.Put_Line( "EMPTY." );
	    or
		terminate;
	    end select;
	end loop;
    end Timing;
    
    
      
    K : Timing( Resolution => New Duration'(2.0) ); -- 2 second resolution.
    Now : Ada.Calendar.Time:= Ada.Calendar.Clock;
begin
    For Index in 1..10 loop
	declare
	    Use Ada.Calendar;
	    Item : Notification(
			 Message => + ("DD"&Positive'Image(Index)),
			 -- Expire at Now and 3*Index seconds.
			 Expiry  => New Time'( Now + Duration(Index) )
			);
	begin
	    K.Add( Event => New Notification'(Item) );
	end;
    end loop;
    
    -- Add an element in the past... it should immediately be operated on.
    K.Add( Event => New Notification'(
	Message => + ("Last."),
	Expiry  => New Ada.Calendar.Time'( Now )
	)
    );

end Scheduling;

---- Task_Debugging.ads ----------------------------------------------
-- The following are not strictly nessacary, but used in this example for 
-- debugging purposes.
With
System.Address_To_Access_Conversions,
Ada.Unchecked_Conversion,
Ada.Exceptions.Traceback,
Ada.Task_Identification,
Ada.Task_Termination;

Package Task_Debugging is
    Pragma Elaborate_Body;
    
    Protected Type Debugging is
	-- Termination debugging function.
	procedure Termination(
				 Cause : Ada.Task_Termination.Cause_Of_Termination;
				 T     : Ada.Task_Identification.Task_Id;
				 X     : Ada.Exceptions.Exception_Occurrence);

    End Debugging;
    
    -- Debug, an instance of our debugging object.
    Debug : Debugging;
    
End Task_Debugging;

---- Task_Debugging.adb ----------------------------------------------
With Ada.Text_IO;

Package Body Task_Debugging is

    Protected body Debugging is
	-- Termination debugging function.
	procedure Termination(
		       Cause : Ada.Task_Termination.Cause_Of_Termination;
		       T     : Ada.Task_Identification.Task_Id;
		       X     : Ada.Exceptions.Exception_Occurrence) is
	    Use Ada.Text_IO, Ada.Task_Termination, Ada.Exceptions;
	begin
	    Put_Line("Termination: "& Cause'Img);
	    case Cause is
	    When Normal | Abnormal => Null;
	    When Unhandled_Exception =>
		Put_Line( Exception_Name(X)&": "&Exception_Message(X) );
	    end case;
	end Termination;	
    end Debugging;

End Task_Debugging;
---------------------------------------------------------------------------

I've fixed the original problems (first the "tampering", and second a constraint_error) but there's still something strange going on. The discriminants for notifications seem to be being ignored (or rather the latest one being used).

Here's the output:
C:\Programming\Projects\Scheduler>scheduling.exe
Elapsed: 0.000
        Exipration:  0.984
New Length:  2
        Exipration:  1.983
Elapsed: 0.002
        Exipration:  1.982
        Exipration:  1.982
New Length:  3
        Exipration:  2.981
Elapsed: 0.004
        Exipration:  2.980
        Exipration:  2.980
        Exipration:  2.980
[...]
Message: Last.
Deleted items; New Length: 10
Elapsed: 2.047
        Exipration:  7.938
        Exipration:  7.938
        Exipration:  7.938
        Exipration:  7.938
        Exipration:  7.938
        Exipration:  7.938
        Exipration:  7.938
        Exipration:  7.938
        Exipration:  7.938
        Exipration:  7.938
Elapsed: 4.051
        Exipration:  5.933
        Exipration:  5.933
        Exipration:  5.933
        Exipration:  5.933
        Exipration:  5.933
        Exipration:  5.933
        Exipration:  5.933
        Exipration:  5.933
        Exipration:  5.933
        Exipration:  5.933
Elapsed: 6.061
        Exipration:  3.923
        Exipration:  3.923
        Exipration:  3.923
        Exipration:  3.923
        Exipration:  3.923
        Exipration:  3.923
        Exipration:  3.923
        Exipration:  3.923
        Exipration:  3.923
        Exipration:  3.923
Elapsed: 8.086
        Exipration:  1.898
        Exipration:  1.898
        Exipration:  1.898
        Exipration:  1.898
        Exipration:  1.898
        Exipration:  1.898
        Exipration:  1.898
        Exipration:  1.898
        Exipration:  1.898
        Exipration:  1.898
Elapsed:10.106
        Exipration: -0.122
        Exipration: -0.122
        Exipration: -0.122
        Exipration: -0.122
        Exipration: -0.122
        Exipration: -0.122
        Exipration: -0.122
        Exipration: -0.122
        Exipration: -0.122
        Exipration: -0.122
Message: DD 10
Message: DD 9
Message: DD 8
Message: DD 7
Message: DD 6
Message: DD 5
Message: DD 4
Message: DD 3
Message: DD 2
Message: DD 1
Deleted items; New Length: 0
EMPTY.
Termination: NORMAL

As you can see, instead of each element being different they're all tagged as having the same expiration.

Re: Tasking troubles, unexpected termination.

[Shark8]

The following edit gives expected behavior:
--------------------------------------------------------------
    For Index in 1..10 loop
	declare
	    Use Ada.Calendar;
	    Function Alert Return Ada.Calendar.Time is
		( Now + Duration(1.5*Index) );
            -- Removed Item declaration in favor of building in-place.
	begin
	    K.Add( Event => New Notification'(
			 Message => + ("DD"&Positive'Image(Index)),
			 -- Expire at Now and 3*Index seconds.
			 Expiry  => New Time'( Alert )
			)
	  );
	end;
    end loop;
--------------------------------------------------------------
Though this raises the question of why the other behavior is executed with:
	    Item  : Notification:=
	      Notification'(
			 Message => + ("DD"&Positive'Image(Index)),
			 -- Expire at Now and 3*Index seconds.
			 Expiry  => New Time'( Alert )
			);
            [...]
	    K.Add( Event => New Notification'(Item) );

Re: Tasking troubles, unexpected termination.

[AdaMagica]

On Tuesday, October 30, 2012 11:03:45 PM UTC+1, Shark8 wrote:
>     -- Introduce shorthand so convert Strings to access strings.
>     Function "+" (Item : String) Return Not Null Access String is
>       ( New String'(Item) );

Haven't looked at the rest of our program, but this looks like an evil leak.

Re: Tasking troubles, unexpected termination.

[Shark8]

On Thursday, November 1, 2012 3:39:20 AM UTC-6, AdaMagica wrote:
> On Tuesday, October 30, 2012 11:03:45 PM UTC+1, Shark8 wrote:
> 
> >     -- Introduce shorthand so convert Strings to access strings.
> 
> >     Function "+" (Item : String) Return Not Null Access String is
> 
> >       ( New String'(Item) );
> 
> 
> 
> Haven't looked at the rest of our program, but this looks like an evil leak.

Unfortunately the following is rejected:
    Function "+" (Item : Aliased String) Return Not Null Access String is
      ( Item'Access );

Reason: "scheduling.adb:18:16: access-to-variable designates constant"

Re: Tasking troubles, unexpected termination.

[Anh Vo]

On Tuesday, October 30, 2012 7:59:33 PM UTC-7, Shark8 wrote:
> The following edit gives expected behavior: -------------------------------------------------------------- For Index in 1..10 loop declare Use Ada.Calendar; Function Alert Return Ada.Calendar.Time is ( Now + Duration(1.5*Index) ); -- Removed Item declaration in favor of building in-place. begin K.Add( Event => New Notification'( Message => + ("DD"&Positive'Image(Index)), -- Expire at Now and 3*Index seconds. Expiry => New Time'( Alert ) ) ); end; end loop; -------------------------------------------------------------- Though this raises the question of why the other behavior is executed with: Item : Notification:= Notification'( Message => + ("DD"&Positive'Image(Index)), -- Expire at Now and 3*Index seconds. Expiry => New Time'( Alert ) ); [...] K.Add( Event => New Notification'(Item) );

I do not have a good feeling to see these forms do not behave the same way. Thus, I made an initial investigation to see why. I am certain that it has to do with the way Expiry stored in the vector or how this value is extracted during iteration. I will investigate deeper when time permits.

Re: Tasking troubles, unexpected termination.

[Adam Beneschan]

On Thursday, November 1, 2012 6:18:20 PM UTC-7, Shark8 wrote:
> On Thursday, November 1, 2012 3:39:20 AM UTC-6, AdaMagica wrote:
> 
> > On Tuesday, October 30, 2012 11:03:45 PM UTC+1, Shark8 wrote:
> > >     -- Introduce shorthand so convert Strings to access strings.
> > >     Function "+" (Item : String) Return Not Null Access String is
> > >       ( New String'(Item) );
> 
> > Haven't looked at the rest of our program, but this looks like an evil leak.
> 
> Unfortunately the following is rejected:
> 
>     Function "+" (Item : Aliased String) Return Not Null Access String is
>       ( Item'Access );
> 
> Reason: "scheduling.adb:18:16: access-to-variable designates constant"

Perhaps the function result, as well as the type of the Message discriminant of the Notification type, should be "not null access constant string"?

I haven't looked at the entire program either.  But if you're not going to use Message to modify the string it points to, then I don't see any reason not to add "constant".

                          -- Adam 

Re: Tasking troubles, unexpected termination.

[Shark8]

On Friday, November 2, 2012 10:43:50 AM UTC-6, Adam Beneschan wrote:
> 
> Perhaps the function result, as well as the type of the Message discriminant of the Notification type, should be "not null access constant string"?

It could be; I was making a simple scheduling example for a [software-engineering] question over on stack-overflow; so it's really a model/toy not anything that's serious, nor anything I plan on becoming serious.

It's the troubles and [now] oddities encountered that prompted the questions.

> 
> I haven't looked at the entire program either.  But if you're not going to use Message to modify the string it points to, then I don't see any reason not to add "constant".

For this toy-example there's no reason not to, the question posed [on SO] however had to do with editable notifications.