Skip to content

Commit c1a800c

Browse files
authored
SPARK submission (#3)
1 parent 81ba935 commit c1a800c

File tree

5 files changed

+83
-0
lines changed

5 files changed

+83
-0
lines changed

SPARK/README.md

Lines changed: 37 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,37 @@
1+
# SPARK submission
2+
3+
## About SPARK
4+
5+
SPARK is a subset of Ada which is amenable to formal verification. The
6+
`gnatprove` tool allows users to prove SPARK programs.
7+
8+
## The implementation
9+
10+
This implementation uses Ada protected types which provide synchronization for
11+
shared data. In particular, the two "entries" Enqueue and Dequeue can't be
12+
entered in a concurrent way. Those two entries also have guards, so that the
13+
entry can only be entered when the condition is true (otherwise it blocks).
14+
15+
The Ada standard defines a so-called profile (set of restrictions) called
16+
Jorvik. One of these restrictions is that the program use a specific priority
17+
protocol. If this priority protocol is respected, [the program is
18+
deadlock-free](https://blog.adacore.com/spark-2014-rationale-support-for-ravenscar).
19+
SPARK checks that this is the case for the example program.
20+
21+
The example program doesn't contain any tasks that would use the queue. If it
22+
did, SPARK would also verify that the tasks only communicate via the
23+
language-provided features such as protected types, and rendez-vous calls, and
24+
not via e.g. unprotected global variables.
25+
26+
SPARK also checks that the program is free of runtime errors. This property
27+
requires a predicate on the data, mainly stating that the `Head` and `Tail`
28+
variables are always in the range of the buffer. One can't directly attach a
29+
predicate to a protected type, therefore the submission uses a separate record
30+
type which permits the definition of a predicate.
31+
32+
33+
## Pointers
34+
35+
[SPARK repository](https://github.com/AdaCore/spark2014)
36+
[SPARK website](https://www.adacore.com/about-spark)
37+
[Learning SPARK](https://learn.adacore.com/courses/intro-to-spark/index.html)

SPARK/queue.adb

Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,18 @@
1+
package body Queue with SPARK_Mode is
2+
3+
protected body Bounded_Queue is
4+
entry Enqueue(Item : in Element_Type) when Data.Count < Buffer_Size is
5+
begin
6+
Data.Buffer(Data.Tail) := Item;
7+
Data.Tail := (Data.Tail mod Buffer_Size) + 1;
8+
Data.Count := Data.Count + 1;
9+
end Enqueue;
10+
11+
entry Dequeue(Item : out Element_Type) when Data.Count > 0 is
12+
begin
13+
Item := Data.Buffer(Data.Head);
14+
Data.Head := (Data.Head mod Buffer_Size) + 1;
15+
Data.Count := Data.Count - 1;
16+
end Dequeue;
17+
end Bounded_Queue;
18+
end Queue;

SPARK/queue.ads

Lines changed: 21 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,21 @@
1+
package Queue with SPARK_Mode is
2+
3+
Buffer_Size : constant := 20;
4+
5+
type Element_Type is new Integer;
6+
type Element_Type_Array is array (Integer range <>) of Element_Type;
7+
8+
type Data_Rec is record
9+
Buffer : Element_Type_Array(1 .. Buffer_Size) := (others => 0);
10+
Head, Tail : Natural := 1;
11+
Count : Natural := 0;
12+
end record with Predicate => Head in 1 .. Buffer_Size and Tail in 1 .. Buffer_Size;
13+
14+
protected type Bounded_Queue is
15+
entry Enqueue(Item : in Element_Type);
16+
entry Dequeue(Item : out Element_Type);
17+
private
18+
Data : Data_Rec;
19+
end Bounded_Queue ;
20+
21+
end Queue;

SPARK/spark.adc

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
pragma Profile (Jorvik);
2+
pragma Partition_Elaboration_Policy (Sequential);

SPARK/test.gpr

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,5 @@
1+
project Test is
2+
package Compiler is
3+
for Local_Configuration_Pragmas use "spark.adc";
4+
end Compiler;
5+
end Test;

0 commit comments

Comments
 (0)