Subprogram Contracts

Subprogram Contracts in Ada 2012 and SPARK 2014

  • Originate in Floyd-Hoare logic (1967-1969)

    • a Hoare triple {P}C{Q}

    • P is the precondition before executing command C

    • Q is the postcondition after executing command C

  • Executable version by Meyer in Eiffel (1988)

    • Called Design by Contract ™

    • Precondition is checked dynamically before a routine starts

    • Postcondition is checked dynamically when a routine returns

  • SPARK 2014 combines both views

    • SPARK 2005 version was only logic, Ada version is only executable

Dynamic Execution of Subprogram Contracts

  • Contract on subprogram declaration

    • Different from subprogram body in general (but not always)

  • Ada Reference Manual allows implementations choice

    • Contract can be checked in the caller or in the callee

    • GNAT's choice is to execute in the callee

  • GNAT introduces wrappers in some cases for contracts

    • For an imported subprogram (e.g. from C) with a contract

    • For cases where contracts on static call/dispatching are different

  • Contracts are not enabled by default

    • Switch -gnata enables dynamic checking of contracts in GNAT

Dynamic Behavior when Subprogram Contracts Fail

  • Violation of contract raises an exception

    • Standard exception Assertion_Error is raised (same as for pragma Assert and all other assertions)

    • Exception cannot be caught by subprogram's own exception handler implementation choice caller/callee has no effect

    • Idiom allows to select another exception

    
    
    
        
with Ada.Numerics; use Ada.Numerics;

package Show_Dynamic_Behavior is

   function Sqrt (X : Float) return Float with
      Pre => X >= 0.0 or else raise Argument_Error;

end Show_Dynamic_Behavior;

  • Control over sequencing of checks

    • Typical pre/post is a conjunction of Boolean conditions

    • Use and when no possible RTE, and then otherwise (recommended for SPARK)

Precondition

  • Better alternative to defensive programming, compare

    
    
    
        
with Ada.Numerics; use Ada.Numerics;

package Show_Precondition is

   function Sqrt (X : Float) return Float with
      Pre => X >= 0.0 or else raise Argument_Error;

end Show_Precondition;

and

    
    
    
        
with Ada.Numerics; use Ada.Numerics;

package Show_Precondition is

   --  X should be non-negative or Argument_Error is raised
   function Sqrt (X : Float) return Float;

end Show_Precondition;

    
        
package body Show_Precondition is

   function Sqrt (X : Float) return Float is
      Res : Float := 0.0;
   begin
      if X >= 0.0 then
         raise Argument_Error;
      end if;

      --  [...]

      return Res;
   end Sqrt;

end Show_Precondition;

  • Preconditions can be activated alone

pragma Assertion_Policy (Pre => Check);

Postcondition

  • Single place to check all return paths from the subprogram

    • Avoids duplication of checks before each return statement

    • Much more robust during maintenance

    • Only applies to normal returns (not in exception, not on abort)

  • Can relate input and output values

    • Special attribute X'Old for referring to input value of variable X

    • Special attribute Func'Result for referring to result of function Func

    • Special attribute Rec'Update or Arr'Update for referring to modified value of record Rec or array Arr

      • replaced by delta aggregate syntax in Ada 202X: ( Rec with delta Comp => Value)

Contract Cases

  • Convenient syntax to express a contract by cases

    • Cases must be disjoint and complete (forming a partition)

    • Introduced in SPARK, planned for inclusion in Ada 202X

    • Case is (guard => consequence) with 'Old / 'Result in consequence

    • Can be used in combination with precondition/postcondition

    
    
    
        
package Show_Contract_Cases is

   function Sqrt (X : Float) return Float with
     Contract_Cases =>
       (X > 1.0             => Sqrt'Result <= X,
        X = 1.0             => Sqrt'Result = 1.0,
        X < 1.0 and X > 0.0 => Sqrt'Result >= X,
        X = 0.0             => Sqrt'Result = 0.0);

end Show_Contract_Cases;

  • Both a precondition and a postcondition

    • On subprogram entry, exactly one guard must hold

    • On subprogram exit, the corresponding consequence must hold

Attribute 'Old

  • X'Old expresses the input value of X in postconditions

    • Same as X when variable not modified in the subprogram

    • Compiler inserts a copy of X on subprogram entry if X is large, copy can be expensive in memory footprint!

    • X can be a variable, a function call, a qualification (but not limited!)

    
    
    
        
package Show_Attribute_Old is

   type Value is new Integer;

   type My_Range is range 1 .. 10;

   type My_Array is array (My_Range) of Value;

   procedure Extract (A : in out My_Array;
                      J :        My_Range;
                      V :    out Value)
     with
       Post => (if J in A'Range then V = A (J)'Old and A (J) = 0);

end Show_Attribute_Old;

  • Expr'Old is rejected in potentially unevaluated context

    • pragma Unevaluated_Use_Of_Old (Allow) allows it

    • In Ada, user is responsible – in SPARK, user can rely on proof

Implication and Equivalence

  • If-expression can be used to express an implication

    • (if A then B) expresses the logical implication

      • A → B

    • (if A then B else C) expresses the formula

      • (A → B)  (¬A → C)

    • (if A then B else C) can also be used with B, C not of Boolean type

    • (A <= B) should not be used for expressing implication (same dynamic semantics, but less readable, and harmful in SPARK)

  • Equality can be used to express an equivalence

    • (A = B) expresses the logical equivalence

      • (A ↔ B)

    • A double implication should not be used for expressing equivalence (same semantics, but less readable and maintainable)

Reasoning by Cases

  • Case-expression can be used to reason by cases

    • Case test only on values of expressions of discrete type

    • Can sometimes be an alternative to contract cases

    
    
    
        
with Ada.Text_IO;

package Show_Case_Expression is

   type File_Mode is (Open, Active, Closed);

   type File is record
      F_Type : Ada.Text_IO.File_Type;
      Mode   : File_Mode;
   end record;

   procedure Open (F : in out File; Success : out Boolean) with
     Post =>
       (case F.Mode'Old is
          when Open   => Success,
          when Active => not Success,
          when Closed => Success = (F.Mode = Open));

end Show_Case_Expression;

  • Can sometimes be used at different levels in the expression

procedure Open (F : in out File; Success : out Boolean) with
  Post =>
    Success = (case F.Mode'Old is
                 when Open   => True,
                 when Active => False,
                 when Closed => F.Mode = Open);

Universal and Existential Quantification

  • Quantified expressions can be used to express a property over a collection of values

    • (for all X in A .. B => C) expresses the universally quantified property

      • (∀ X . X ≥ A ⋀ X ≤ B → C)

    • (for some X in A .. B => C) expresses the universally quantified property

      • (∃ X . X ≥ A ⋀ X ≤ B ⋀ C)

  • Quantified expressions translated as loops at run time

    • Control exits the loop as soon as the condition becomes false (resp. true) for a universally (resp. existentially) quantified expression

  • Quantification forms over array and collection content

    • Syntax uses (for all/some V of ... => C)

Expression Functions

  • Without abstraction, contracts can become unreadable

    • Also, use of quantifications can make them unprovable

  • Expression functions provide the means to abstract contracts

    • Expression function is a function consisting in an expression

    • Definition can complete a previous declaration

    • Definition is allowed in a package spec! (crucial for proof with SPARK)

function Valid_Configuration return Boolean is
   (case Cur_State is
      when Piece_Falling | Piece_Blocked =>
        No_Overlap (Cur_Board, Cur_Piece),
      when Board_Before_Clean => True,
      when Board_After_Clean =>
        No_Complete_Lines (Cur_Board));

Code Examples / Pitfalls

Example #1

    
    
    
        
with Ada.Assertions; use Ada.Assertions;

procedure Example_01 is

   --  Fail systematically fails a precondition and catches the
   --  resulting exception.

   procedure Fail (Condition : Boolean) with
     Pre => Condition
   is
      Bad_Condition : Boolean := False;
   begin
      Fail (Bad_Condition);
   exception
      when Assertion_Error => return;
   end Fail;
begin
   null;
end Example_01;

This code is not correct. The exception from the recursive call is always caught in the handler, but not the exception raised if caller of Fail passes False as value for Condition.

Example #2

    
    
    
        
with Interfaces.C; use Interfaces.C;

package Example_02 is

   procedure Memset
     (B  : in out char_array;
      Ch :        char;
      N  :        size_t)
     with
       Import,
       Pre  => N <= B'Length,
       Post => (for all Idx in B'Range =>
                  (if Idx < B'First + N then
                         B (Idx) = Ch
                       else
                         B (Idx) = B'Old (Idx)));

end Example_02;

This code is correct. GNAT will create a wrapper for checking the precondition and postcondition of Memset, calling the imported memset from libc.

Example #3

    
    
    
        
procedure Example_03 is

   pragma Assertion_Policy (Pre => Ignore);
   function Sqrt (X : Float) return Float with
     Pre => X >= 0.0;

   pragma Assertion_Policy (Pre => Check);
   function Sqrt (X : Float) return Float is
      Ret : Float := 0.0;
   begin
      --  missing implementation...
      return Ret;
   end Sqrt;

begin
   null;
end Example_03;

This code is not correct. Although GNAT inserts precondition checks in the subprogram body instead of its caller, it is the value of Pre assertion policy at the declaration of the subprogram that decides if preconditions are activated.

Example #4

    
    
    
        
procedure Example_04 is

   function Sqrt (X : Float) return Float with
     Pre => X >= 0.0;

   function Sqrt (X : Float) return Float with
     Pre => X >= 0.0
   is
      Ret : Float := 0.0;
   begin
      --  missing implementation...
      return Ret;
   end Sqrt;

begin
   null;
end Example_04;

This code is not correct. Contract is allowed only on the spec of a subprogram. Hence it is not allowed on the body when a separate spec is available.

Example #5

    
    
    
        
procedure Example_05 is

   procedure Add (X, Y : Natural; Z : out Integer) with
     Contract_Cases =>
       (X <= Integer'Last - Y => Z = X + Y,
        others                => Z = 0)
   is
   begin
      Z := 0;
      Z := X + Y;
   end Add;

begin
   null;
end Example_05;

This code is not correct. Postcondition is only relevant for normal returns.

Example #6

    
    
    
        
procedure Example_06 is

   procedure Add (X, Y : Natural; Z : out Integer) with
     Post => Z = X + Y
   is
   begin
      Z := 0;
      Z := X + Y;
   end Add;
begin
   null;
end Example_06;

This code is correct. Procedure may raise an exception, but postcondition correctly describes normal returns.

Example #7

    
    
    
        
procedure Example_07 is

   procedure Add (X, Y : Natural; Z : out Integer) with
     Pre  => X <= Integer'Last - Y,
     Post => Z = X + Y
   is
   begin
      Z := X + Y;
   end Add;
begin
   null;
end Example_07;

This code is correct. Precondition prevents exception inside Add. Postcondition is always satisfied.

Example #8

    
    
    
        
package Example_08 is

   procedure Memset
     (B  : in out String;
      Ch :        Character;
      N  :        Natural)
     with
       Pre  => N <= B'Length,
       Post => (for all Idx in B'Range =>
                  (if Idx < B'First + N then
                      B (Idx) = Ch
                   else
                      B (Idx) = B (Idx)'Old));
end Example_08;

This code is not correct. 'Old on expression including a quantified variable is not allowed.

Example #9

    
    
    
        
package Example_09 is

   procedure Memset
     (B  : in out String;
      Ch :        Character;
      N  :        Natural)
     with
       Pre  => N <= B'Length - 1,
       Post => (for all Idx in 1 .. N => B (B'First + Idx - 1) = Ch)
                and then B (B'First + N) = B (B'First + N)'Old;

end Example_09;

This code is not correct. Expr'Old on potentially unevaluated expression is allowed only when Expr is a variable.

Example #10

    
    
    
        
package Example_10 is

   procedure Memset
     (B  : in out String;
      Ch :        Character;
      N  :        Natural)
     with
       Pre  => N <= B'Length - 1,
       Post => (for all Idx in 1 .. N => B (B'First + Idx - 1) = Ch)
                and B (B'First + N) = B (B'First + N)'Old;

end Example_10;

This code is correct. Expr'Old does not appear anymore in a potentially unevaluated expression. Another solution would have been to apply 'Old on B or to use pragma Unevaluated_Use_Of_Old (Allow).