Chapter 2 Examples

-- ***************************************************************************
-- *                     Complex_Loops.adb 
-- * Copyright (c) Simon Johnston & Addison Wesley Longman 1996.
-- *
-- * Description: This example corresponds to example 2.2 in the text and
-- *    demonstrates the use of named loops to handle complex nested
-- *    looping issues.
-- * Inputs:  Will try and read this file as input.
-- * Outputs: None.
-- ***************************************************************************
with Ada.Text_IO; use Ada.Text_IO;
procedure Complex_Loops is
   File_Handle : File_Type;
   Input_Line  : String(1 .. 255);
   Last_Char   : Natural;
   Null_Char   : constant Character := Character'Val(0);
   Percent_Char: constant Character := '%';
begin
   Open(File => File_Handle,
        Mode => In_File,
        Name => "Complex_Loops.adb");
   Get_Line(File => File_Handle, Item => Input_Line, Last => Last_Char);
   Main_Loop:
      while not End_Of_File(File => File_Handle) loop
         for Char_Index in 1 .. Last_Char loop
            exit           when Input_Line(Char_Index) = Null_Char;
            exit Main_Loop when Input_Line(Char_Index) = Percent_Char;
         end loop;
 
         Get_Line(File => File_Handle, Item => Input_Line, Last => Last_Char);
      end loop Main_Loop;
   Close(File => File_Handle);
end Complex_Loops;

 

-- ***************************************************************************
-- *                         Fix_This.adb 
-- * Copyright (c) Simon Johnston & Addison Wesley Longman 1996.
-- *
-- * Description: This example is basically Ada code, but with some common
-- *   C/C++ code style, see if you can fix it, the answer is in fixed.adb.
-- *
-- * Inputs:  None
-- * Outputs: This file will not compile.
-- ***************************************************************************
procedure Fix_This is
   int a;
begin
   if a == 1 then
      a = 2;
   end if;
end Fix_This;

 

-- ***************************************************************************
-- *                            Fixed.adb 
-- * Copyright (c) Simon Johnston & Addison Wesley Longman 1996.
-- *
-- * Description: This is the answer to the Fix_This.adb problem.
-- *
-- * Inputs:  None
-- * Outputs: None
-- ***************************************************************************
procedure Fix_This is
   a : Integer := 0;
begin
   if a = 1 then
      a := 2;
   end if;
end Fix_This;

 

-- ***************************************************************************
-- *                       Simple_Tests.adb 
-- * Copyright (c) Simon Johnston & Addison Wesley Longman 1996.
-- *
-- * Description: This example shows various uses of Ada statements.
-- *
-- * Inputs:  None.
-- * Outputs: This program has no outputs, and in fact due to some of the
-- *    loops involved can't even finish.
-- ***************************************************************************
with Ada.Text_IO;
use  Ada.Text_IO;
with Ada.Integer_Text_IO;
use  Ada.Integer_Text_IO;
with Ada.Exceptions;
use  Ada.Exceptions;
procedure Simple_Tests is
   -- please ignore these declarations, see chapter 3.
   Test_1, Test_2, Test_3 : Boolean;
   Test_4 : Integer;
   -- end of declarations.
begin
   pragma Page;
   Assignment_Tests:
      begin
         Put_Line("Assignment_Tests:");
	 Test_1 := True;
	 Test_2 := True;
	 Test_3 := False;
	 Test_4 := 1;
      end Assignment_Tests;
   pragma Page;
   Conditional_Statement_Tests:
      begin
         Put_Line("Conditional_Statement_Tests:");
	 if Test_1 then
	    Put_Line("condition 1");
	 elsif Test_2 then
	    Put_Line("condition 2");
	 else
	    Put_Line("condition 3");
	 end if;
	 if Test_1 and Test_2 then
	    Put_Line("condition 4");
	 end if;
	 if Test_1 and then Test_2 then
	    Put_Line("condition 5");
	 end if;
	 case Test_4 is
	    when 0 => 
               Put_Line("condition 6");
	    when 1 => 
               Put_Line("condition 7");
	    when 2 | 3 | 4 => 
               Put_Line("condition 8");
	    when 5 .. 10 => 
               Put_Line("condition 9");
	    when others => 
               Put_Line("condition 10");
	 end case;
      end Conditional_Statement_Tests;
   pragma Page;
   Loop_Statement_Tests:
      begin
         Put_Line("Loop_Statement_Tests:");
	 loop
	    Put_Line("never ending loop ...");
	 end loop;
	 
	 while Test_2 loop
	    Test_2 := False;
	 end loop;
	 
	 for New_Variable in 1 .. 10 loop
	    Put_Line("You should see 10 of these");
	 end loop;
	 for New_Variable_2 in reverse 1 .. 10 loop
	    Put_Line("You should see 10 of these as well");
	 end loop;
	 Test_2 := True;
         Outer_Loop:
	    while Test_1 loop
	       while Test_2 loop
		  exit Outer_Loop when Test_4 > 0;
	       end loop;
	    end loop Outer_Loop;
      end Loop_Statement_Tests;
   pragma Page;
   Goto_Test:
      begin
         Put_Line("Goto_Test:");
	 goto Goto_Target;
         Put_Line("You should never see this");
	 <<Goto_Target>>
	 null;
      end Goto_Test;
   pragma Page;
   Exception_Tests:
      begin
         Put_Line("Exception_Tests:");
	 begin
	    raise Program_Error;
	 exception
	    when Constraint_Error =>
	       Put_Line("caught Constraint_Error");
	    when Program_Error =>
	       Put_Line("caught Program_Error");
	    when The_Exception : others =>
	       Put_Line("caught " & Exception_Name(The_Exception)); 
	 end ;
      end Exception_Tests;
      Put_Line("Tests Complete.");
end Simple_Tests;

 

-- ***************************************************************************
-- *                    Subprogram_Tests.adb 
-- * Copyright (c) Simon Johnston & Addison Wesley Longman 1996.
-- *
-- * Description: This short program illustrates some simple subprograms, it
-- *    is best to read the subprograms at the beginning first before the
-- *    main body of the outer procedure.
-- * Inputs:  None.
-- * Outputs: Some simple text messages.
-- ***************************************************************************
with Ada.Text_IO;
use  Ada.Text_IO;
with Ada.Integer_Text_IO;
use  Ada.Integer_Text_IO;
procedure Subprogram_Tests is
   -- the following subprograms are dealt with later on.
   function Min(A, B : Integer) return Integer;
   procedure Swap(A, B : in out Integer);
   procedure Say_Boo(To_Who : in String := "to a goose");
   function Min(A, B : Integer) return Integer is
   begin
      if A < B then
	 return A;
      else
	 return B;
      end if;
   end Min;
   procedure Swap(A, B : in out Integer) is
      Temp : Integer := A;
   begin
      A := B;
      B := Temp;
   end Swap;
   procedure Say_Boo(To_Who : in String := "to a goose") is
   begin
      Put_Line("Saying boo " & To_Who);
   end Say_Boo;
   -- end of subprograms.
   -- please ignore these declarations, see chapter 3.
   Test_1, Test_2, Test_3 : Integer;
   -- end of declarations.
begin
   pragma Page;
   Function_Tests:
      begin
	 Test_1 := 1;
	 Test_2 := 10;
	 
	 Test_3 := Min(Test_1, Test_2);
         Put("Min is ");
         Put(Test_3);
         New_Line;
	 Test_3 := Min(A => Test_1, B => Test_2);
         Put("Min is ");
         Put(Test_3);
         New_Line;
      end Function_Tests;
   pragma Page;
   Procedure_Tests:
      begin
	 Swap(Test_1, Test_2);
	 Swap(A => Test_1, B => Test_2);
         Put(Test_1);
         Put(Test_2);
         New_Line;
	 Say_Boo(To_Who => "the reader");
	 Say_Boo;
      end Procedure_Tests;
end Subprogram_Tests;

Contents Page

Copyright © 1996 Simon Johnston &
Addison Wesley Longman