-- © Copyright 1999, John Halleck, All Rights Reserved
-- Test the SHA package
-- This is part of a project at http://www.cc.utah.edu/~nahaj/
with Ada.Text_IO; use Ada.Text_IO;
with Interfaces; use Interfaces; -- We need bit rotates...
with Ada.Command_Line; use Ada.Command_Line;
with SHA; use SHA; -- Definition of a digest.
with SHA.Strings; use SHA.Strings; -- Convert Digest to String.
with SHA.Process_Data; use SHA.Process_Data; -- Compute Digests.
pragma Elaborate_All (SHA.Process_Data);
procedure SHA_Process_Data_TEST is
Expected : Digest :=
(16#A9993E36#, 16#4706816A#, 16#BA3E2571#, 16#7850C26C#, 16#9CD0D89D#);
Expected_Second_Test : constant Digest :=
(16#84983E44#, 16#1C3BD26E#, 16#BAAE4AA1#, 16#F95129E5#, 16#E54670F1#);
Expected_Third_Test : constant Digest :=
(16#34AA973C#, 16#D4C4DAA4#, 16#F61EEB2B#, 16#DBAD2731#, 16#6534016F#);
Computed : Digest;
Actual : Digest;
type Test_Index is new Natural range 0 .. ((256 * 8) - 1);
Buffer : array (Test_Index) of Boolean;
Result : Exit_Status := Success;
procedure Verify (Assumed, Given : Digest);
-- (Keep over agressive style checkers happy.)
procedure Verify (Assumed, Given : Digest) is
begin
if Assumed = Given then
Put_Line (" Passed!");
else
Put_Line (" *** FAILED ***");
Put (" Expected: ");
Put_Line (String (Hex_From_SHA (Assumed)));
Put (" Got: ");
Put_Line (String (Hex_From_SHA (Given)));
Result := Failure;
end if;
end Verify;
function Get_Byte (Index : Test_Index) return Byte;
function Get_Byte (Index : Test_Index) return Byte is
Result : Byte := 0;
begin
for I in 0 .. Test_Index (8 - 1) loop
Result := Result * 2;
if Buffer (I + Index) then
Result := Result + 1;
end if;
end loop;
return Result;
end Get_Byte;
function Get_Word (Index : Test_Index) return Word;
function Get_Word (Index : Test_Index) return Word is
Result : Word := 0;
begin
for I in 0 .. Test_Index (16 - 1) loop
Result := Result * 2;
if Buffer (I + Index) then
Result := Result + 1;
end if;
end loop;
return Result;
end Get_Word;
function Get_Long (Index : Test_Index) return Long;
function Get_Long (Index : Test_Index) return Long is
Result : Long := 0;
begin
for I in 0 .. Test_Index (32 - 1) loop
Result := Result * 2;
if Buffer (I + Index) then
Result := Result + 1;
end if;
end loop;
return Result;
end Get_Long;
function Get_Integer (Index : Test_Index; Size : Positive)
return Unsigned_32;
function Get_Integer (Index : Test_Index; Size : Positive)
return Unsigned_32 is
Result : Unsigned_32 := 0;
begin
for I in Index .. Index + Test_Index (Size - 1) loop
Result := Result * 2;
if Buffer (I + Index) then
Result := Result + 1;
end if;
end loop;
return Result;
end Get_Integer;
procedure Put_Byte (Index : Test_Index; Given : Unsigned_8);
procedure Put_Byte (Index : Test_Index; Given : Unsigned_8) is
begin
for I in 0 .. 7 loop
Buffer (Test_Index (I) + Index) := (Given and 2 ** (7 - I)) /= 0;
end loop;
end Put_Byte;
procedure Set_Bit (Which : Boolean);
procedure Set_Bit (Which : Boolean) is
begin
if Which then Add (Bit (1)); else Add (Bit (0)); end if;
end Set_Bit;
begin
Put_Line ("SHA.Process_Data test [Secure Hash Algorithm] starting ...");
Put_Line (" Testing SHA from FIPS 180-1 first test");
Actual := Digest_A_String ("abc");
Verify (Expected, Actual);
-- But that doesn't test the padding and flushing code...
Put (" Testing SHA-1 second test from standard ...");
Actual := Digest_A_String
("abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq");
Verify (Expected_Second_Test, Actual);
-- We've now tested a string that forced us to go over the block boundary.
-- So, it is probably right...
-- -- -- Third test from SHA-1 standard tests.
Put (" Testing SHA-1 million ""a""'s test (takes a while) ...");
Initialize;
for I in 1 .. 1000000 loop
Add (Byte'(Character'Pos ('a')));
end loop;
Finalize (Actual);
Verify (Expected_Third_Test, Actual);
-- This test forced use of a count larger than 32K, and exercised most
-- things very completely. It is almost impossible to imagine something
-- that could pass all three tests and not be correct.
-- -- ------------------- Individual bit tests. --------------------------
-- Since my package has the ability to hash arbitrary bit strings, and the
-- tests above are only byte oriented, there is code that has not been
-- tested. We will now test using the primatives that add individual
-- bits so that we can force tests of all alignments.
Put (" === Support routines alignment checks:");
-- What should the answer be?
Initialize;
for I in 0 .. 255 loop
Add (Byte (I));
end loop;
Finalize (Actual);
-- We've just tested the byte versions, so we will use them as a reference.
-- Ok, Fill in the bits.
for I in 0 .. 255 loop
Put_Byte (Test_Index (I * 8), Unsigned_8 (I));
end loop;
Put_Line (" (Reference initialized)");
-- And what do we get with just adding bits?
Initialize;
Put (" Testing hash of single bits...");
for I in Test_Index loop
Set_Bit (Buffer (I));
end loop;
Finalize (Computed);
Verify (Actual, Computed);
-- If this worked, we know that the main bit add on works... at lease somewhat
Put (" Testing hash of generated bytes...");
Initialize;
for I in Test_Index'First .. Test_Index'Last / 8 loop
Add (Get_Byte (I * 8));
end loop;
Finalize (Computed);
Verify (Actual, Computed);
-- We know know that the byte primitives in this file work.
Put (" Testing hash of generated words...");
Initialize;
for I in Test_Index'First .. Test_Index'Last / 16 loop
Add (Get_Word (I * 16));
end loop;
Finalize (Computed);
Verify (Actual, Computed);
-- We know that the word primitives work.
Put (" Testing hash of generated Long...");
Initialize;
for I in Test_Index'First .. Test_Index'Last / 32 loop
Add (Get_Long (I * 32));
end loop;
Finalize (Computed);
Verify (Actual, Computed);
-- OK, without partical word alignment the longs work too...
-- OK, now for the acid test. Do part word operations all work correctly?
-- We will force all alignments on byte operations.
Put_Line (" Testing Byte offsets:");
for I in 0 .. Test_Index (8 - 1) loop
Put (" Testing byte with offset of ");
Put (Integer'Image (Integer (I)));
Put (" ...");
Initialize;
for J in 0 .. I - 1 loop
Set_Bit (Buffer (J));
end loop;
for J in 0 .. Test_Index'Last / 8 - 1 loop
Add (Get_Byte (I + J * 8));
end loop;
for J in Test_Index'Last - Test_Index (8 - I) + 1 .. Test_Index'Last loop
Set_Bit (Buffer (J));
end loop;
Finalize (Computed);
Verify (Actual, Computed);
end loop;
-- And word offsets.
Put_Line (" Testing Word Alignments:");
for I in 0 .. Test_Index (16 - 1) loop
Put (" Testing word with offset of ");
Put (Integer'Image (Integer (I)));
Put (" ...");
Initialize;
for J in 0 .. I - 1 loop
Set_Bit (Buffer (J));
end loop;
for J in 0 .. Test_Index'Last / 16 - 1 loop
Add (Get_Word (I + J * 16));
end loop;
for J in Test_Index'Last - Test_Index (16 - I) + 1 ..
Test_Index'Last loop
Set_Bit (Buffer (J));
end loop;
Finalize (Computed);
Verify (Actual, Computed);
end loop;
-- And long word offsets
Put_Line (" Testing Long Word Alignments:");
for I in 0 .. Test_Index (32 - 1) loop
Put (" Testing Long Word with offset of ");
Put (Integer'Image (Integer (I)));
Put (" ...");
Initialize;
for J in 0 .. I - 1 loop
Set_Bit (Buffer (J));
end loop;
for J in 0 .. Test_Index'Last / 32 - 1 loop
Add (Get_Long (I + J * 32));
end loop;
for J in Test_Index'Last - Test_Index (32 - I) + 1 ..
Test_Index'Last loop
Set_Bit (Buffer (J));
end loop;
Finalize (Computed);
Verify (Actual, Computed);
end loop;
-- -- ------------------- Cleanup. -----------------
Put ("SHA.Process_Data test ");
if Result = Success then
Put ("Passed!");
else
Put ("*** FAILED ****");
end if;
New_Line;
Set_Exit_Status (Result);
end SHA_Process_Data_TEST;
This page is http://www.cc.utah.edu/~nahaj/ada/sha/sha_process_data_test.adb.html
© Copyright 2000 by John Halleck, All Rights Reserved.
This snapshot was last modified on August 31st, 2000
And the underlying file was last modified on August 24th, 2000