Exceptions

Uninitialized Value

Goal: implement an enumeration to avoid the use of uninitialized values.

Steps:

  1. Implement the Options package.

    1. Declare the Option enumeration type.

    2. Declare the Uninitialized_Value exception.

    3. Implement the Image function.

Requirements:

  1. Enumeration Option contains:

    1. the Uninitialized value, and

    2. the actual options:

      • Option_1,

      • Option_2,

      • Option_3.

  2. Function Image returns a string for the Option type.

    1. In case the argument to Image is Uninitialized, the function must raise the Uninitialized_Value exception.

Remarks:

  1. In this exercise, we employ exceptions as a mechanism to avoid the use of uninitialized values for a certain type.

    
        
    
    
    
        
package Options is

   --  Declare the Option enumeration type!
   type Option is null record;

   function Image (O : Option) return String;

end Options;

    
        
package body Options is

   function Image (O : Option) return String is
   begin
      return "";
   end Image;

end Options;

    
        
with Ada.Command_Line; use Ada.Command_Line;
with Ada.Text_IO;      use Ada.Text_IO;
with Ada.Exceptions;   use Ada.Exceptions;

with Options;          use Options;

procedure Main is
   type Test_Case_Index is
     (Options_Chk);

   procedure Check (TC : Test_Case_Index) is

      procedure Check (O : Option) is
      begin
         Put_Line (Image (O));
      exception
         when E : Uninitialized_Value =>
            Put_Line (Exception_Message (E));
      end Check;

   begin
      case TC is
      when Options_Chk =>
         for O in Option loop
            Check (O);
         end loop;
      end case;
   end Check;

begin
   if Argument_Count < 1 then
      Put_Line ("ERROR: missing arguments! Exiting...");
      return;
   elsif Argument_Count > 1 then
      Put_Line ("Ignoring additional arguments...");
   end if;

   Check (Test_Case_Index'Value (Argument (1)));
end Main;

Numerical Exception

Goal: handle numerical exceptions in a test procedure.

Steps:

  1. Add exception handling to the Check_Exception procedure.

Requirements:

  1. The test procedure Num_Exception_Test from the Tests package below must be used in the implementation of Check_Exception.

  2. The Check_Exception procedure must be extended to handle exceptions as follows:

    1. If the exception raised by Num_Exception_Test is Constraint_Error, the procedure must display the message "Constraint_Error detected!" to the user.

    2. Otherwise, it must display the message associated with the exception.

Remarks:

  1. You can use the Exception_Message function to retrieve the message associated with an exception.

    
        
    
    
    
        
package Tests is

   type Test_ID is (Test_1, Test_2);

   Custom_Exception : exception;

   procedure Num_Exception_Test (ID : Test_ID);

end Tests;

    
        
package body Tests is

   pragma Warnings (Off, "variable ""C"" is assigned but never read");

   procedure Num_Exception_Test (ID : Test_ID) is
      A, B, C : Integer;
   begin
      case ID is
         when Test_1 =>
            A := Integer'Last;
            B := Integer'Last;
            C := A + B;
         when Test_2 =>
            raise Custom_Exception with "Custom_Exception raised!";
      end case;
   end Num_Exception_Test;

   pragma Warnings (On, "variable ""C"" is assigned but never read");

end Tests;

    
        
with Tests; use Tests;

procedure Check_Exception (ID : Test_ID) is
begin
   Num_Exception_Test (ID);
end Check_Exception;

    
        
with Ada.Command_Line; use Ada.Command_Line;
with Ada.Text_IO;      use Ada.Text_IO;
with Ada.Exceptions;   use Ada.Exceptions;

with Tests;            use Tests;
with Check_Exception;

procedure Main is
   type Test_Case_Index is
     (Exception_1_Chk,
      Exception_2_Chk);

   procedure Check (TC : Test_Case_Index) is

      procedure Check_Handle_Exception (ID : Test_ID) is
      begin
         Check_Exception (ID);
      exception
         when Constraint_Error =>
            Put_Line ("Constraint_Error"
                      & " (raised by Check_Exception) detected!");
         when E : others =>
            Put_Line (Exception_Name (E)
                      & " (raised by Check_Exception) detected!");
      end Check_Handle_Exception;

   begin
      case TC is
      when Exception_1_Chk =>
         Check_Handle_Exception (Test_1);
      when Exception_2_Chk =>
         Check_Handle_Exception (Test_2);
      end case;
   end Check;

begin
   if Argument_Count < 1 then
      Put_Line ("ERROR: missing arguments! Exiting...");
      return;
   elsif Argument_Count > 1 then
      Put_Line ("Ignoring additional arguments...");
   end if;

   Check (Test_Case_Index'Value (Argument (1)));
end Main;

Re-raising Exceptions

Goal: make use of exception re-raising in a test procedure.

Steps:

  1. Declare new exception: Another_Exception.

  2. Add exception re-raise to the Check_Exception procedure.

Requirements:

  1. Exception Another_Exception must be declared in the Tests package.

  2. Procedure Check_Exception must be extended to re-raise any exception. When an exception is detected, the procedure must:

    1. display a user message (as implemented in the previous exercise), and then

    2. Raise or re-raise exception depending on the exception that is being handled:

      1. In case of Constraint_Error exception, re-raise the exception.

      2. In all other cases, raise Another_Exception.

Remarks:

  1. In this exercise, you should extend the implementation of the Check_Exception procedure from the previous exercise.

    1. Naturally, you can use the code for the Check_Exception procedure from the previous exercise as a starting point.

    
        
    
    
    
        
package Tests is

   type Test_ID is (Test_1, Test_2);

   Custom_Exception : exception;

   procedure Num_Exception_Test (ID : Test_ID);

end Tests;

    
        
package body Tests is

   pragma Warnings (Off, "variable ""C"" is assigned but never read");

   procedure Num_Exception_Test (ID : Test_ID) is
      A, B, C : Integer;
   begin
      case ID is
         when Test_1 =>
            A := Integer'Last;
            B := Integer'Last;
            C := A + B;
         when Test_2 =>
            raise Custom_Exception with "Custom_Exception raised!";
      end case;
   end Num_Exception_Test;

   pragma Warnings (On, "variable ""C"" is assigned but never read");

end Tests;

    
        
with Tests; use Tests;

procedure Check_Exception (ID : Test_ID);

    
        
procedure Check_Exception (ID : Test_ID) is
begin
   Num_Exception_Test (ID);
end Check_Exception;

    
        
with Ada.Command_Line; use Ada.Command_Line;
with Ada.Text_IO;      use Ada.Text_IO;
with Ada.Exceptions;   use Ada.Exceptions;

with Tests;            use Tests;
with Check_Exception;

procedure Main is
   type Test_Case_Index is
     (Exception_1_Chk,
      Exception_2_Chk);

   procedure Check (TC : Test_Case_Index) is

      procedure Check_Handle_Exception (ID : Test_ID) is
      begin
         Check_Exception (ID);
      exception
         when Constraint_Error =>
            Put_Line ("Constraint_Error"
                      & " (raised by Check_Exception) detected!");
         when E : others =>
            Put_Line (Exception_Name (E)
                      & " (raised by Check_Exception) detected!");
      end Check_Handle_Exception;

   begin
      case TC is
      when Exception_1_Chk =>
         Check_Handle_Exception (Test_1);
      when Exception_2_Chk =>
         Check_Handle_Exception (Test_2);
      end case;
   end Check;

begin
   if Argument_Count < 1 then
      Put_Line ("ERROR: missing arguments! Exiting...");
      return;
   elsif Argument_Count > 1 then
      Put_Line ("Ignoring additional arguments...");
   end if;

   Check (Test_Case_Index'Value (Argument (1)));
end Main;