-- *************************************************************************** -- * 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;
Copyright ©
1996 Simon Johnston &
Addison Wesley Longman