Challenge 8 – Dynamic Dispatching, Dead Code and Floats

With electronic voting adding up to the heat of election nights, every citizen might be interested in getting some strong assurance that the machine is doing its job, especially since there might be a disclaimer that “no warranty is given on the exactitude of the next president chosen by the software”. Here, you have the source code to check it for yourself!

Have a look at the following code and see if you can spot the errors. Once you think you’ve got them all, click on the “Go CodePeer” button to see how well you matched up to CodePeer’s comprehensive and rapid analysis of the same code.

Go CodePeer!

Error line 71: “warning: useless self assignment into Win”

Here’s how CodePeer helps you coming to this conclusion: CodePeer detects that Win is reassigned its own value. Indeed, Win is initialized to True on line 60, so assigning it to True on line 71 is at best useless, at worst an error. Here, it is the latter: Win should be assigned False, which got the more votes.

Error line 86: “warning: useless self assignment into Scores(Vote)”

Here’s how CodePeer helps you coming to this conclusion: Reviewing the corresponding line shows immediately the error: Scores(Vote) is assigned to itself! As we are counting votes here, Scores(Vote) should really be incremented, so that a “+1″ was meant.

Error line 106: “warning: dead code because Fraction – 5_452_595/8_388_608 in (-Inf..-1_258_291/8_388_608]”

Here’s how CodePeer helps you coming to this conclusion: CodePeer detects that the test for this branch of the if-statement is always false. Indeed, execution reaches this point only when the first test is false, so that Fraction is less than or equal to 0.5. Then, Fraction cannot be greater than 0.65. The order of the tests should be changed. The strange fractions mentioned in the warning come from the machine representation of 0.5 and 0.65, which are close to these real numbers, but not exactly equal. (5_452_595/8_388_608 = 0,649999976)

Error line 128: “high: precondition failure on voting.analyze: requires M.Score to be initialized”

Here’s how CodePeer helps you coming to this conclusion: Because function Analyze reads its parameter M.Score, it requires in its precondition that M.Score is initialized (output as a pseudo Ada attribute M.Score’Initialized). This should be set by the dispatching call to procedure Count. Looking at the two overriding procedures Count, none sets the value of component Score.

package Voting is

   type Id is new Integer;               --  machine summary of a human being
   type Candidate_Pos is range 1 .. 20;  --  number identifying a candidate

   type Kind is (Referendum, Election);                --  type of vote
   type Ballot is private;                             --  human input
   type Ballots is array (Id range <>) of Ballot;

   type Machine (Population : Id) is tagged private;   --  voting machinery
   type Referendum_Machine is new Machine with private;
   type Election_Machine is new Machine with private;

   --  Store individual votes
   procedure Get_Votes (M : in out Machine; Votes : Ballots);

   --  Determine the winner of the vote by counting her supporters
   procedure Count (M : in out Machine) is null;
   procedure Count (M : in out Referendum_Machine);
   procedure Count (M : in out Election_Machine);

   --  Analyze the result of the vote for tomorrow's headlines
   type Analysis is (Coalition, Majority, Landslide);
   function Analyze (M : Machine) return Analysis;

private

   type Ballot is record
      Voter    : Id;
      Decision : Boolean;
      Choice   : Candidate_Pos;
   end record;

   type Machine (Population : Id) is tagged record
      Votes : Ballots (1 .. Population);
      Score : Positive;
   end record;

   type Referendum_Machine is new Machine with record
      Winner : Boolean;
   end record;

   type Election_Machine is new Machine with record
      Winner : Candidate_Pos;
   end record;

end Voting;

package body Voting is

   procedure Get_Votes (M : in out Machine; Votes : Ballots) is
   begin
      for Voter in Votes'Range loop
         M.Votes (Voter) := Votes (Voter);
      end loop;
   end Get_Votes;

   procedure Count (M : in out Referendum_Machine) is
      Scores : array (Boolean) of Natural := (others => 0);
      Win    : Boolean := True;
   begin
      for B in 1 .. M.Population loop
         declare
            Vote : constant Boolean := M.Votes (B).Decision;
         begin
            Scores (Vote) := Scores (Vote) + 1;
         end;
      end loop;

      if Scores (True) < Scores (False) then
         Win := True;
      end if;

      M.Winner := Win;
   end Count;

   procedure Count (M : in out Election_Machine) is
      Scores : array (Candidate_Pos) of Natural := (others => 0);
      Win    : Candidate_Pos := 1;
      High   : Natural := 0;
   begin
      for B in 1 .. M.Population loop
         declare
            Vote : constant Candidate_Pos := M.Votes (B).Choice;
         begin
            Scores (Vote) := Scores (Vote);
         end;
      end loop;

      for C in Candidate_Pos loop
         if Scores (C) > High then
            Win  := C;
            High := Scores (C);
         end if;
      end loop;

      M.Winner := Win;
   end Count;

   function Analyze (M : Machine) return Analysis is
      Fraction : constant Float := Float (M.Score) / Float (M.Population);
   begin
      if Fraction > 0.5 then
         return Majority;
      elsif Fraction > 0.65 then
         return Landslide;
      else
         return Coalition;
      end if;
   end Analyze;

end Voting;

with Voting; use Voting;

function Polls (K : Kind; Population : Id; Votes : Ballots) return Analysis
is
   M : access Machine'Class;
begin
   --  Initialize the machine
   case K is
      when Referendum => M := new Referendum_Machine (Population);
      when Election   => M := new Election_Machine (Population);
   end case;

   M.Get_Votes (Votes);  --  Feed the machine with votes
   M.Count;              --  Count the votes
   return M.Analyze;     --  Prepare for the media frenzy over the results
end Polls;