-- --
------------------------------------------------------------------------------
--- This utility program is used to test proper operation of the Get_ALFA and
--- Put_ALFA units. To run it, compile any source file with switch -gnatd.E or
--- -gnatd.F to get an ALI file file.ALI containing ALFA information. Then run
+-- This utility program is used to test proper operation of the Get_Alfa and
+-- Put_Alfa units. To run it, compile any source file with switch -gnatd.E or
+-- -gnatd.F to get an ALI file file.ALI containing Alfa information. Then run
-- this utility using:
--- ALFA_Test file.ali
+-- Alfa_Test file.ali
--- This test will read the ALFA information from the ALI file, and use
--- Get_ALFA to store this in binary form in the internal tables in ALFA. Then
--- Put_ALFA is used to write the information from these tables back into text
--- form. This output is compared with the original ALFA information in the ALI
+-- This test will read the Alfa information from the ALI file, and use
+-- Get_Alfa to store this in binary form in the internal tables in Alfa. Then
+-- Put_Alfa is used to write the information from these tables back into text
+-- form. This output is compared with the original Alfa information in the ALI
-- file and the two should be identical. If not an error message is output.
-with Get_ALFA;
-with Put_ALFA;
+with Get_Alfa;
+with Put_Alfa;
-with ALFA; use ALFA;
+with Alfa; use Alfa;
with Types; use Types;
with Ada.Command_Line; use Ada.Command_Line;
with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO;
with Ada.Text_IO;
-procedure ALFA_Test is
+with GNAT.OS_Lib; use GNAT.OS_Lib;
+
+procedure Alfa_Test is
Infile : File_Type;
+ Name1 : String_Access;
Outfile_1 : File_Type;
+ Name2 : String_Access;
Outfile_2 : File_Type;
C : Character;
Stop : exception;
-- Terminate execution
+ Diff_Exec : constant String_Access := Locate_Exec_On_Path ("diff");
+ Diff_Result : Integer;
+
use ASCII;
begin
raise Stop;
end if;
- Create (Outfile_1, Out_File, "log1");
- Create (Outfile_2, Out_File, "log2");
+ Name1 := new String'(Argument (1) & ".1");
+ Name2 := new String'(Argument (1) & ".2");
+
Open (Infile, In_File, Argument (1));
+ Create (Outfile_1, Out_File, Name1.all);
+ Create (Outfile_2, Out_File, Name2.all);
-- Read input file till we get to first 'F' line
procedure Put_Char (F : File_Type; C : Character) is
Item : Stream_Element_Array (1 .. 1);
+
begin
if C /= CR and then C /= EOF then
if C = LF then
end if;
end Put_Char;
- -- Subprograms used by Get_ALFA (these also copy the output to Outfile_1
- -- for later comparison with the output generated by Put_ALFA).
+ -- Subprograms used by Get_Alfa (these also copy the output to Outfile_1
+ -- for later comparison with the output generated by Put_Alfa).
function Getc return Character;
function Nextc return Character;
function Nextc return Character is
C : Character;
+
begin
C := Get_Char (Infile);
C := Getc;
end Skipc;
- -- Subprograms used by Put_ALFA, which write information to Outfile_2
+ -- Subprograms used by Put_Alfa, which write information to Outfile_2
function Write_Info_Col return Positive;
procedure Write_Info_Char (C : Character);
Write_Info_Char (LF);
end Write_Info_Terminate;
- -- Local instantiations of Put_ALFA and Get_ALFA
+ -- Local instantiations of Put_Alfa and Get_Alfa
- procedure Get_ALFA_Info is new Get_ALFA;
- procedure Put_ALFA_Info is new Put_ALFA;
+ procedure Get_Alfa_Info is new Get_Alfa;
+ procedure Put_Alfa_Info is new Put_Alfa;
-- Start of processing for Process
C := Get_Char (Infile);
if C = EOF then
- Ada.Text_IO.Put_Line
- (Argument (1) & ": no SCO found, recompile with -gnateS");
raise Stop;
elsif C = LF or else C = CR then
Set_Index (Infile, Index (Infile) - 1);
- -- Read ALFA information to internal ALFA tables, also copying ALFA info
+ -- Read Alfa information to internal Alfa tables, also copying Alfa info
-- to Outfile_1.
- Initialize_ALFA_Tables;
- Get_ALFA_Info;
+ Initialize_Alfa_Tables;
+ Get_Alfa_Info;
- -- Write ALFA information from internal ALFA tables to Outfile_2
+ -- Write Alfa information from internal Alfa tables to Outfile_2
- Put_ALFA_Info;
+ Put_Alfa_Info;
-- Junk blank line (see comment at end of Lib.Writ)
Write_Info_Terminate;
- -- Now Outfile_1 and Outfile_2 should be identical
-
- Compare_Files : declare
- Line : Natural;
- Col : Natural;
- C1 : Character;
- C2 : Character;
+ -- Flush to disk
- begin
- Reset (Outfile_1, In_File);
- Reset (Outfile_2, In_File);
+ Close (Outfile_1);
+ Close (Outfile_2);
- -- Loop to compare the two files
-
- Line := 1;
- Col := 1;
- loop
- C1 := Get_Char (Outfile_1);
- C2 := Get_Char (Outfile_2);
- exit when C1 = EOF or else C1 /= C2;
-
- if C1 = LF then
- Line := Line + 1;
- Col := 1;
- else
- Col := Col + 1;
- end if;
- end loop;
+ -- Now Outfile_1 and Outfile_2 should be identical
- -- If we reached the end of file, then the files were identical,
- -- otherwise, we have a failure in the comparison.
+ Diff_Result :=
+ Spawn (Diff_Exec.all,
+ Argument_String_To_List
+ ("-u " & Name1.all & " " & Name2.all).all);
- if C1 = EOF then
- -- Success: exit silently
+ if Diff_Result /= 0 then
+ Ada.Text_IO.Put_Line ("diff(1) exit status" & Diff_Result'Img);
+ end if;
- null;
+ OS_Exit (Diff_Result);
- else
- Ada.Text_IO.Put_Line
- (Argument (1) & ": failure, files log1 and log2 differ at line"
- & Line'Img & " column" & Col'Img);
- end if;
- end Compare_Files;
end Process;
exception
when Stop =>
null;
-end ALFA_Test;
+end Alfa_Test;
OSDN Git Service
