Ada: Array of tasks

Question

What is a good way to link an indexed task to a corresponding indexed protected type in SPARK?

For specifics, consider this setup:

subtype Thread_Range is Natural range 1..n;
protected type P is ... end P;
p: array(Thread_Range) of P;

For each p(i) I would like a task t(i) that monitors p(i) and, when it's ready, processes it. I can make this work pretty easily in Ada, but SPARK w/Ravenscar is more demanding. I've tried two approaches that appear to work fine when I run them:

1. Give T an Integer discriminant, then instantiate a T(i); for each i , but this grows burdensome with not-very-large i .

task type T(which: Integer);
t1: T(1);
t2: T(2);
...

2. Add an is_not_monitored function and a set_monitor procedure to P . Create an array of tasks without discriminant. When t(i) begins, it assigns itself to monitor the first p(j) it finds that hasn't already been assigned a monitor.

task type T;
task body T is
  which: Integer;
  available: Boolean;
begin
  for i in Thread_Range loop
    available := p(i).is_not_monitored;
    if available then
      p(i).set_monitor;
      which := i;
    end if;
  end loop;
  -- what the task does with p(i) follows
end T;
t: array(Thread_Range) of T;

I like the second one better, but not by much. In any case, SPARK "Prove" grumbles about potential data races, and I can see why (though I'm not sure it's actually due to this).

Hence the question.

Answer 1

This doesn't cause gnatprove to choke.

And I think the main difference from your option 2 is that Claim checks whether the claim is possible and, if so, performs the claim in one protected call.

But I don't quite see how to prove that the loop Claim in T exits with Ps (J) being claimed. I tried putting an assertion after the loop, but couldn't get it to prove.

protected type P is
   procedure Claim (Succeeded : out Boolean);
private
   Claimed : Boolean := False;
end P;

subtype Thread_Range is Integer range 1 .. 2;

Ps : array (Thread_Range) of P;

Ts : array (Thread_Range) of T;

task body T is
   Which : Integer;
begin
Claim:
   for J in Thread_Range loop
      declare
         Claimed : Boolean;
      begin
         Ps (J).Claim (Succeeded => Claimed);
         if Claimed then
            Which := J;
            exit Claim;
         end if;
      end;
   end loop Claim;

   loop  -- having a loop keeps gnatprove quiet
      delay until Ada.Real_Time.Time_Last;
   end loop;
end T;

protected body P is
   procedure Claim (Succeeded : out Boolean) is
   begin
      if not Claimed then
         Claimed := True;
         Succeeded := True;
      else
         Succeeded := False;
      end if;
   end Claim;
end P;

---

After out-of-band discussions with John, we've found that this postcondition can be proved:

  procedure Claim (Succeeded : out Boolean)
  with
    Post =>
      (Is_Claimed'Old or (Succeeded and Is_Claimed))
      or
      (not Succeeded and Is_Claimed);

Note that it's not P'Old.Is_Claimed , mainly because 'Old requires a copy, and P is limited (because it's a protected type).

We also found several alternative formulations that prove in GPL 2017 but not in CE 2018: for example,

      (Is_Claimed
       and
       (Is_Claimed'Old xor Succeeded)

Answer 2

I'm not an expert in this, but it seems that you cannot show SPARK that there's a one-to-one relation between a task instance and a protected object instance unless you reference that protected object instance explicitly from a task instance. This is in particular to make SPARK prove that only one task will queue on the entry of a protected object; the Wait entry in the code below). Therefore (and while this might not be exactly what you're looking for), I could only solve the problem of connecting tasks and protected objects, and at the same time having a monitor functionality, by using a generic package that can be instantiated multiple times. This proves in GNAT CE 2018:

generic
package Generic_Worker with SPARK_Mode is   

   task T;

   protected P is
      entry Wait;
      procedure Trigger;
   private
      Triggered : Boolean := False;
   end P;

end Generic_Worker;

with body:

package body Generic_Worker with SPARK_Mode is

   task body T is      
   begin
      loop   --  Ravenscar: Tasks must not terminate.         
         P.Wait;
      end loop;
   end T;

   protected body P is

      entry Wait when Triggered is
      begin
         Triggered := False; 
         --  Do some work.
      end Wait;

      procedure Trigger is
      begin
         Triggered := True;
      end Trigger;

   end P;

end Generic_Worker;

and instantiations:

with Generic_Worker;

pragma Elaborate_All (Generic_Worker);

package Workers with SPARK_Mode is

   package Worker_0 is new Generic_Worker;
   package Worker_1 is new Generic_Worker;
   package Worker_2 is new Generic_Worker;
   package Worker_3 is new Generic_Worker;
   package Worker_4 is new Generic_Worker;

end Workers;