Re: Tasking troubles, unexpected termination.

[Shark8 <onewingedshark@gmail.com>]

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.