-------- SIMTEL20 Ada Software Repository Prologue ------------ -- -* -- Unit name : generic package File_Compare_Utilities -- Version : 1.2 (SAPR196) -- Author : Geoffrey O. Mendal -- : Stanford University -- : Computer Systems Laboratory -- : Stanford, CA 94305 -- : (415) 723-1414 or 723-1175 -- DDN Address : Mendal@SU-SIERRA.ARPA -- Copyright : (c) 1985, 1986 Geoffrey O. Mendal -- Date created : Sat 28 Dec 85 -- Release date : Sun 29 Dec 85 -- Last update : MENDAL Sat 19 Apr 86 -- Machine/System Compiled/Run on : DG MV10000, ROLM ADE -- VAX 11/780, DEC ACS -- RATIONAL R1000 -- Dependent Units : package TEXT_IO -- package CALENDAR -- package TOD_Utilities -- -* --------------------------------------------------------------- -- -* -- Keywords : COMPARE ----------------: FILE COMPARE -- -- Abstract : This generic package contains routines to ----------------: compare two ASCII files. It produces as ----------------: output a side-by-side listing of both files, ----------------: showing their differences in a very readable ----------------: format, and also produces an update deck which ----------------: can be used to provide a mapping between the ----------------: two files. This update deck is meant to be ----------------: input for a revision control package, called ----------------: Context_Directed_Update_Utilities. -- -* ------------------ Revision history --------------------------- -- -* -- DATE VERSION AUTHOR HISTORY -- 12/29/85 1.0 (SAEC285) Mendal Initial Release -- 01/24/86 1.1 (FRAN246) Mendal Bug fixes, enhancements -- 04/19/86 1.2 (SAPR196) Mendal Enhancements -- -* ------------------ Distribution and Copyright ----------------- -- -* -- This prologue must be included in all copies of this software. -- -- This software is copyright by the author. -- -- This software is released to the Ada community. -- This software is released to the Public Domain (note: -- software released to the Public Domain is not subject -- to copyright protection). -- Restrictions on use or distribution: NONE -- -* ------------------ Disclaimer --------------------------------- -- -* -- This software and its documentation are provided "AS IS" and -- without any expressed or implied warranties whatsoever. -- No warranties as to performance, merchantability, or fitness -- for a particular purpose exist. -- -- Because of the diversity of conditions and hardware under -- which this software may be used, no warranty of fitness for -- a particular purpose is offered. The user is advised to -- test the software thoroughly before relying on it. The user -- must assume the entire risk and liability of using this -- software. -- -- In no event shall any person or organization of people be -- held responsible for any direct, indirect, consequential -- or inconsequential damages or lost profits. -- -* -------------------END-PROLOGUE-------------------------------- -- File_Compare_Utilities is an ASCII file comparison package. It -- takes two files as input and produces a list file and context -- directed update deck as output. Several options are available -- which control what output is to be produced and how the files -- should be compared. The context directed update deck provides -- a mapping from the "old" file to the "new" one, and can be used -- as input to the Context_Directed_Update_Utilities package to -- derive the "new" file given the "old" file and the CDUPDATE deck. -- Hence, this package can be used as a means of revision control. -- The package body performs its own garbage collection, which increases -- the speed of the algorithm. Doing so, however, requires that the -- package maintain a global free list. Hence, use of this package -- in concurrent environments is discouraged. The package reads in -- a maximum number of lines for each file. This number is controlled -- by means of a lookahead value which constrains the algorithm in -- finding synchronization points in both files. One may notice on the -- side-by-side listings and CDUPDATE decks that a maximum number of -- lines in a group (equal, insertion, deletion) is less than that -- of the true number in a group. This is due to the constrained -- lookahead value. A user may alter this lookahead value, but -- is strongly discouraged from doing so (see below for details). -- This package has been formally annotated using the ANNA specification -- language. For more information, contact the author at the above -- address. with TEXT_IO; -- predefined I/O package generic Maximum_File_Name_Length : in POSITIVE := 100; Maximum_Line_Length : in POSITIVE := 256; -- The above values are used to specify the maximum length -- of strings. Such strings are used in the package body. with procedure Get_A_Line ( File : in TEXT_IO.FILE_TYPE; Line : out STRING; Length : out NATURAL) is TEXT_IO.GET_LINE; --| where TEXT_IO.IS_OPEN (File), --| TEXT_IO.MODE (File) = TEXT_IO.OUT_FILE, --| raise TEXT_IO.END_ERROR => FALSE, --| Line'FIRST = 1 and Line'LAST = Maxmimum_Line_Length, --| out (0 <= Length <= Maxmimum_Line_Length) --| out (for all I : NATURAL range 1 .. Length => --| Line (I)'DEFINED); -- The above subprogram allows a user to override the line -- entry method of TEXT_IO.GET_LINE and instead write a routine -- that returns a string resulting from a user-defined "line". -- For all user-defined actual subrprograms, the bounds of -- the returned "Line" string value must be exactly that of -- (1 .. Maximum_Line_Length), else CONSTRAINT_ERROR will be -- propagated to this package, and this package will then -- raise Line_Length_Error to the caller. A user should -- return the true last character of "Line" by means of the -- "Length" parameter, that is, it will be assumed that -- Line (1 .. Length) contains the line to be compared. package File_Compare_Utilities is File_Compare_Utilities_Version : constant STRING := "1.2 (SAPR196)"; -- The following type can be used to specify the case of CDUPDATE -- deck commands in the CDUPDATE deck file. type Type_Set is (Upper_Case, Lower_Case, Mixed_Case); -- The following type can be used to retrieve statistics generated -- by the Compare subprograms. type Statistics_Type is record Files_Equal : BOOLEAN; -- TRUE if files are equal, FALSE otherwise Number_Old_Lines, -- number of lines in the old file Number_New_Lines, -- number of lines in the new file Total_Equal_Lines, -- number of equal lines found Total_Insertions, -- number of insertions found Total_Deletions, -- number of deletions found Total_Minor_Changes : NATURAL; -- number of minor changes found end record; -- The following type can be used to specify options to the Compare -- subprograms. Note that a default options record is provided below. type Options_Type is record Produce_Listing, -- print a side-by-side listing -- of both files Summarize, -- summarizes equal lines, -- insertions, and deletions -- in the listing (groups them) Wide_Listing, -- line printer style listing Produce_Deck, -- generate a CDUPDATE deck Verbose_Deck, -- spell out everything in full Produce_Statistics, -- generate statistics Check_Minor_Changes, -- check for minor changes in lines Case_Sensitive : BOOLEAN; -- distinguish between upper and -- lower case Deck_Command_Case : Type_Set; -- case of deck commands Lookahead : POSITIVE; -- synchronization point constraint Minimum_Group : POSITIVE range 3 .. POSITIVE'LAST; -- minimum number of lines on which end record; -- Summarize has an effect Default_Options : Options_Type := (Produce_Listing => TRUE, Summarize => TRUE, Wide_Listing => TRUE, Produce_Deck => TRUE, Verbose_Deck => TRUE, Produce_Statistics => TRUE, Check_Minor_Changes => TRUE, Case_Sensitive => TRUE, Deck_Command_Case => Mixed_Case, Lookahead => 500, Minimum_Group => 3); -- Notes on the Options: -- (1) Summarize will cause just the first and last lines in a -- group of equal lines, insertions, or deletions to be printed. -- In addition, a special notation will be made on the listing -- stating the total number of lines in the group. This is -- useful for summarizing the differences in the files. -- Otherwise, each and every line is printed in full on the -- listing. The user can control how many lines determine -- a "group", and hence has some control in producing summarized -- output. (See the Minimum_Group option for details.) -- (2) Wide_Listing will cause the list file to print correctly -- for a line printer (132 column printer). If this option -- is set to FALSE, the listing will print correctly for -- a terminal screen (80 column screen) or printer that -- can only print a maximum of 80 columns per line. -- (3) Verbose_Deck causes Delete commands to appear -- explicitly in the CDUPDATE deck. Such commands are not -- really required. The Context Directed Update utility will -- delete any lines not explicitly accounted for in a -- CDUPDATE deck. Hence, Delete commands are an aid for the -- programmer. This option can be set to FALSE so as to save -- space (albeit not much) in the CDUPDATE deck. With this -- option set to FALSE, commands are also abbreviated to -- their fullest, "noise word" parameters are eliminated, -- some extra spacing is condensed between parameters, -- and no comment commands are produced. -- (4) Check_Minor_Changes causes thew algorithm to check each -- line for minor changes. By setting this value to FALSE, -- the speed of the algorithm can be increased at the expense -- of a more brute force comparison approach. -- (5) Case_Sensitive causes lines to be compared with regard -- for upper and lower case. If a case insensitive comparison -- is desired, this option should be set to FALSE. If this -- option is set to FALSE and a minor change is found, an -- Edit command in the CDUPDATE deck will still be generated -- with case sensitive parameters. -- (6) If the Produce_Listing and/or Produce_Deck options are set -- to FALSE, a user need not provide their file names to the -- Compare subprograms. Instead, a user can provide null -- strings. (The strings will be ignored in such cases anyway.) -- (7) If the Produce_Statistics option is set to FALSE, then -- the result returned by the Compare subprograms is -- undeterministic; do not rely on the values of this record -- in such cases. -- (8) The Lookahead value provided to the Compare subprograms -- establishes the maximum number of lines to read in for -- EACH file. A larger lookahead will of course make finding -- synchronization points easier, but will also consume more -- memory. Hence, users are cautioned in altering this -- Lookahead value. It is possible that STORAGE_ERROR will -- be propagated to the caller if too large a Lookahead is -- provided. Providing a smaller Lookahead may solve this -- problem. -- (9) The Minimum_Group value determines the minimum number -- of lines in a group (insertions, deletions, or equal lines) -- on which the Summarize option will have an effect. This -- option only has an effect of Summarize is set to TRUE. Line_Length_Error, File_Name_Length_Error, Old_File_Open_Error, New_File_Open_Error, List_File_Create_Error, Deck_File_Create_Error : exception; -- Notes on the exceptions: -- (1) The Line_Length_Error exception is propagated -- when a user-defined Get_A_Line subprogram returns a -- Line string whose bounds are not exactly that specified -- by (1 .. Maximum_Line_Length). -- (2) The "Open_Error" exceptions are propagated when the -- subprograms perform TEXT_IO.OPENs on the old and -- new files as TEXT_IO.IN_FILEs but a TEXT_IO exception -- was raised. The most probable error is that the file -- doesn't exist or access to it is not allowed. -- (3) The "Create_Error" exceptions are propagated when the -- subprograms perform TEXT_IO.CREATEs on the list and deck -- files as TEXT_IO.OUT_FILEs but a TEXT_IO exception was -- raised. -- (4) Once the files have been successfully OPENed and CREATEd, -- no more exception trapping is performed. If a TEXT_IO -- operation fails, the TEXT_IO exception will be propagated -- immediately to the caller. -- (5) The File_Name_Length_Error exception is propagated when a -- subprogram is called, and the length of any file name -- is greater than that of Maximum_File_Name_Length. -- The following characters are used as codes in the listing -- and CDUPDATE deck files. The subtype allows for only non- -- blank printable characters. subtype Code_Character_Type is CHARACTER range '!' .. '~'; Equal_Lines_Code : Code_Character_Type := '='; Minor_Change_Code : Code_Character_Type := '*'; Insertion_Code : Code_Character_Type := '+'; Deletion_Code : Code_Character_Type := '-'; Command_Code : Code_Character_Type := '/'; -- The following subprogram takes an old, new, list, and deck file -- name as input, and (depending on the options set), returns -- statistics, a side-by-side listing, and a CDUPDATE deck. -- The old and new file names will be OPENed, and the list and -- deck files will be CREATed (if the list and/or deck files already -- exist, they will be overwritten). All files will be CLOSEd -- upon normal termination. --: function Can_Open_File (F : in STRING) return BOOLEAN; --: function Can_Create_File (F : in STRING) return BOOLEAN; procedure Compare ( Old_File_Name, New_File_Name, List_File_Name, Deck_File_Name : in STRING; Statistics : out Statistics_Type; Options : in Options_Type := Default_Options); --| where Old_File_Name > Maximum_File_Length or --| New_File_Name > Maximum_File_Length or --| List_File_Name > Maximum_File_Length or --| Deck_File_Name > Maximum_File_Length => --| raise File_Name_Length_Error, --| not Can_Open_File (Old_File_Name) => --| raise Old_File_Open_Error, --| not Can_Open_File (New_File_Name) => --| raise New_File_Open_Error, --| not Can_Create_File (List_File_Name) and --| Options.Produce_Listing => --| raise List_File_Create_Error, --| not Can_Create_File (Deck_File_Name) and --| Options.Produce_Deck => --| raise Deck_File_Create_Error, --| out Statistics'DEFINED; -- The following overloading should be used when no statistics -- are required. Note that if the Produce_Statistics and -- Produce_Listing options are both set to TRUE, statistics -- will still be printed on the listing. See above for detailed -- semantics on the file operations. procedure Compare ( Old_File_Name, New_File_Name, List_File_Name, Deck_File_Name : in STRING; Options : in Options_Type := Default_Options); -- The following subprogram performs only a quick comparison -- of the old and new files. Only a boolean result is returned. -- TRUE is returned if the files are equal, otherwise FALSE -- is returned. This subprogram uses a different and more -- efficient algorithm in comparing the files, since it does not -- have to generate a side-by-side listing nor a CDUPDATE deck. -- The same semantics with file operations apply as above. function Quick_Compare ( Old_File_Name, New_File_Name : in STRING; Case_Sensitive : in BOOLEAN := TRUE) return BOOLEAN; --| where not Can_Open_File (Old_File_Name) => --| raise Old_File_Open_Error, --| not Can_Open_File (New_File_Name) => --| raise New_File_Open_Error; end File_Compare_Utilities; ------------------------------------------------------------------------ -- Example uses: -- Example #1: Compare two files for equality -- with File_Compare_Utilities, TEXT_IO; -- procedure Main is -- package Compare_Utilities is new File_Compare_Utilities; -- begin -- TEXT_IO.PUT ("Files F1 and F2 are "); -- -- if not Compare_Utilities.Quick_Compare ("F1","F2") then -- TEXT_IO.PUT ("not "); -- end if; -- -- TEXT_IO.PUT_LINE ("equal."); -- end Main; -- --------------------------------------------------------------------- -- Example #2: Compare two files and generate all possible output -- with File_Compare_Utilities; -- procedure Main is -- Statistics : File_Compare_Utilities.Statistics_Type; -- package Compare_Utilities is new File_Compare_Utilities; -- begin -- Compare_Utilities.Compare ("Main.Bak","Main.Ada", -- "Listing","Cdupdate_Deck",Statistics); -- end Main; -- --------------------------------------------------------------------- -- Example #3: Compare two files, alter the maximum line length, -- and modify the character code objects, and options. -- with File_Compare_Utilities; -- procedure Main is -- package Compare_Utilities is new File_Compare_Utilities ( -- Maximum_Line_Length => 80); -- begin -- Compare_Utilities.Equal_Lines_Code := 'E'; -- Compare_Utilities.Command_Code := '#'; -- Compare_Utilities.Default_Options.Produce_Deck := FALSE; -- Compare_Utilities.Default_Options.Wide_Listing := FALSE; -- Compare_Utilities.Default_Options.Lookahead := 50; -- Compare_Utilities.Compare ("F1","F2","L",""); -- end Main; -- --------------------------------------------------------------------- -- Example #4: Compare two files, using a user-defined Get_A_Line -- subprogram. -- with File_Compare_Utilities, TEXT_IO; -- procedure Main is -- procedure My_Get_Line ( -- F : in TEXT_IO.FILE_TYPE; -- S : out STRING; -- N : out NATURAL); -- package Compare_Utilities is new File_Compare_Utilities ( -- Get_A_Line => My_Get_Line); -- procedure My_Get_Line ( -- F : in TEXT_IO.FILE_TYPE; -- S : out STRING; -- N : out NATURAL) is -- Str : STRING (1 .. 500) := (others => ASCII.NUL); -- Len : NATURAL; -- begin -- -- read in a line, stripping off the first five characters -- TEXT_IO.GET_LINE (F,Str,Len); -- Str (1 .. Len - 5) := Str (6 .. Len); -- S := Str (1 .. 256); -- if Len > 261 then -- N := 256; -- else -- N := Len - 5; -- end if; -- end My_Get_Line; -- begin -- Compare_Utilities.Compare ("F1","F2","L","D"); -- end Main; with CALENDAR, -- predefined time of day package TOD_Utilities; -- GOM time of day utility package package body File_Compare_Utilities is -- Global constants used throughout the package body follow. -- They eliminate magic numbers and frequently used character -- literals, making the code more readable and reliable. List_Line_Num_Max_Length : constant POSITIVE := 4; Small_Margin : constant POSITIVE := 31; Large_Margin : constant POSITIVE := 57; Squote : constant CHARACTER := '''; Dquote : constant CHARACTER := '"'; Blank : constant CHARACTER := ' '; Uc_Lc_Offset : constant POSITIVE := CHARACTER'POS (ASCII.LC_A) - CHARACTER'POS ('A'); subtype Set_of_Upper_Case_Letters is CHARACTER range 'A' .. 'Z'; subtype Set_of_Lower_Case_Letters is CHARACTER range ASCII.LC_A .. ASCII.LC_Z; subtype File_Name_Type is STRING (1 .. Maximum_File_Name_Length); type Files_Type is -- a composite of information on files used record Old_File_Name, New_File_Name, List_File_Name, Deck_File_Name : File_Name_Type; Old_File_Length, New_File_Length, List_File_Length, Deck_File_Length : NATURAL; Old_File, New_File, List_File, Deck_File : TEXT_IO.FILE_TYPE; end record; subtype Line_Type is STRING (1 .. Maximum_Line_Length); -- a line of data type Data_Line_Type is -- a composite of a line of data and its length record Line : Line_Type; Length : NATURAL; end record; type Data_Type; type Data_Ptr_Type is access Data_Type; type Data_Type is -- an element of a linked list of lines in a file record Data_Line : Data_Line_Type; Line_Number : NATURAL; Next_Line : Data_Ptr_Type; end record; type Dispose_Record_Type is -- a composite of garbage collection info record Old_File, New_File : NATURAL; end record; type Minor_Change_Found_Type is (No_Minor_Change_Found, Insertion_Found, Deletion_Found, Replacement_Found, Transposition_Found); Authors_List : constant STRING := "Geoff Mendal, Stanford University (CSL)"; Free_List_Head, Free_List_Tail : Data_Ptr_Type := null; -- global free list pointers Old_Delimiter, New_Delimiter : CHARACTER; -- used for parameters on /EDIT commands Text_Max_Length : POSITIVE; -- used for wide/compressed list file output package Int_IO is new TEXT_IO.INTEGER_IO (NATURAL); --: function Can_Open_File (F : in STRING) return BOOLEAN is --: File : TEXT_IO.FILE_TYPE; --: begin --: TEXT_IO.OPEN (File, TEXT_IO.IN_FILE, F); --: TEXT_IO.CLOSE (File); --: return TRUE; --: exception --: when others => --: return FALSE; --: end Can_Open_File; --: function Can_Create_File (F : in STRING) return BOOLEAN is --: File : TEXT_IO.FILE_TYPE; --: begin --: TEXT_IO.CREATE (File, TEXT_IO.OUT_FILE, F); --: TEXT_IO.DELETE (File); --: return TRUE; --: exception --: when others => --: return FALSE; --: end Can_Create_File; -- The following function converts a string into either -- upper case, lower case, or mixed case. It assumes that -- strings are passed into it in mixed case. function Case_Conversion ( Str : in STRING; Convert_To : in Type_Set) return STRING is Str_Copy : STRING (Str'RANGE) := Str; begin case Convert_To is when Mixed_Case => null; when Upper_Case => for I in Str'RANGE loop if Str (I) in Set_of_Lower_Case_Letters then Str_Copy (I) := CHARACTER'VAL (CHARACTER'POS (Str (I)) - Uc_Lc_Offset); end if; end loop; when Lower_Case => for I in Str'RANGE loop if Str (I) in Set_of_Upper_Case_Letters then Str_Copy (I) := CHARACTER'VAL (CHARACTER'POS (Str (I)) + Uc_Lc_Offset); end if; end loop; end case; return Str_Copy; end Case_Conversion; ---------------------------------------------------------------------- -- The following procedure outputs header info to the list and -- deck files. procedure Headings ( Options : in Options_Type; Files : in out Files_Type) is TOD : STRING (1 .. TOD_Utilities.External_TOD_Representation_Type'LAST + 3) := (others => Blank); TOD_Length : POSITIVE; -- The following inner procedure is used to truncate file -- names which are too long to fit on the output files. -- Such truncation is only used for output purposes and -- has no side effects. Note that truncation is taken from -- the beginning of the string, not the end as is normal. procedure Set_Printable_File_Length ( File_Name : in out File_Name_Type; File_Length : in out NATURAL) is begin if File_Length > Text_Max_Length then File_Name (File_Name'FIRST .. File_Name'FIRST + Text_Max_Length - 1) := "..." & File_Name (File_Name'FIRST + File_Length - Text_Max_Length + 3 .. File_Name'FIRST + File_Length - 1); File_Length := Text_Max_Length; end if; end Set_Printable_File_Length; -- The following inner procedure removes extra blanks in -- the time-of-day string returned by GOM's time-of-day -- conversion utility. procedure Compress ( Str : in out STRING; Compressed_Length : out POSITIVE) is Str_Copy : STRING (Str'RANGE) := (others => Blank); Str_Ptr, Str_Ptr_Copy : POSITIVE := Str'FIRST; begin while (Str_Ptr <= Str'LAST) and then (Str (Str_Ptr) = Blank) loop Str_Ptr := Str_Ptr + 1; end loop; while (Str_Ptr <= Str'LAST - 2) loop if (Str (Str_Ptr) = Blank) and (Str (Str_Ptr + 1) = Blank) and (Str (Str_Ptr + 2) = Blank) then Str_Ptr := Str_Ptr + 2; elsif (Str (Str_Ptr) = Blank) and (Str (Str_Ptr + 1) = Blank) then Str_Ptr := Str_Ptr + 2; Str_Ptr_Copy := Str_Ptr_Copy + 1; elsif (Str (Str_Ptr) = Blank) then Str_Ptr := Str_Ptr + 1; Str_Ptr_Copy := Str_Ptr_Copy + 1; else Str_Copy (Str_Ptr_Copy) := Str (Str_Ptr); Str_Ptr := Str_Ptr + 1; Str_Ptr_Copy := Str_Ptr_Copy + 1; end if; end loop; if (Str'FIRST + Str'LAST - 1 >= 3) and then ((Str (Str'LAST - 2) /= Blank) and (Str (Str'LAST - 1) = Blank) and (Str (Str'LAST) /= Blank)) then Str_Ptr_Copy := Str_Ptr_Copy + 1; end if; if (Str'FIRST + Str'LAST - 1) >= 2 and then (Str (Str'LAST - 1) /= Blank) then Str_Copy (Str_Ptr_Copy) := Str (Str'LAST - 1); Str_Ptr_Copy := Str_Ptr_Copy + 1; end if; if (Str'FIRST + Str'LAST - 1 >= 1) and then (Str (Str'FIRST) /= Blank) then Str_Copy (Str_Ptr_Copy) := Str (Str'LAST); Str_Ptr_Copy := Str_Ptr_Copy + 1; end if; Str := Str_Copy; Compressed_Length := Str_Ptr_Copy - Str'FIRST; end Compress; begin -- Headings Set_Printable_File_Length (Files.Old_File_Name, Files.Old_File_Length); Set_Printable_File_Length (Files.New_File_Name, Files.New_File_Length); Set_Printable_File_Length (Files.List_File_Name, Files.List_File_Length); Set_Printable_File_Length (Files.Deck_File_Name, Files.Deck_File_Length); Files.Old_File_Name (1 .. Files.Old_File_Length) := Case_Conversion (Files.Old_File_Name (1 .. Files.Old_File_Length), Upper_Case); Files.New_File_Name (1 .. Files.New_File_Length) := Case_Conversion (Files.New_File_Name (1 .. Files.New_File_Length), Upper_Case); TOD (1 .. TOD_Utilities.External_TOD_Representation_Type'LAST) := TOD_Utilities.Convert_Internal_TOD_to_External_TOD ( CALENDAR.CLOCK,TOD_Utilities.Mixed_Case); TOD (29 .. TOD'LAST) := "at " & TOD (29 .. 38); Compress (TOD,TOD_Length); TOD (TOD_Length - 1) := CHARACTER'VAL ( CHARACTER'POS (TOD (TOD_Length - 1)) + Uc_Lc_Offset); if Options.Produce_Deck then if not Options.Verbose_Deck then TEXT_IO.PUT_LINE (Files.Deck_File,Command_Code & Case_Conversion ("B",Options.Deck_Command_Case)); else TEXT_IO.PUT_LINE (Files.Deck_File,Command_Code & Case_Conversion ("Begin",Options.Deck_Command_Case)); TEXT_IO.PUT_LINE (Files.Deck_File,Command_Code & "-- CDUPDATE deck " & "generated by FILE COMPARE on " & TOD (1 .. TOD_Length)); TEXT_IO.PUT_LINE (Files.Deck_File,Command_Code & "-- FILE COMPARE -- " & "Version " & File_Compare_Utilities_Version); TEXT_IO.PUT_LINE (Files.Deck_File,Command_Code & "-- Written by " & Authors_List); TEXT_IO.PUT_LINE (Files.Deck_File,Command_Code & "-- This deck " & "provides a mapping from " & Files.Old_File_Name (1 .. Files.Old_File_Length) & " to " & Files.New_File_Name (1 .. Files.New_File_Length)); TEXT_IO.PUT (Files.Deck_File,Command_Code & "-- This comparison is being performed with"); if not Options.Case_Sensitive then TEXT_IO.PUT (Files.Deck_File,"out"); end if; TEXT_IO.PUT_LINE (Files.Deck_File," respect for case sensitivity"); end if; end if; if Options.Produce_Listing then if Options.Wide_Listing then TEXT_IO.PUT (Files.List_File," "); end if; TEXT_IO.PUT_LINE (Files.List_File, " F I L E C O M P A R E P R O G R A M " & "L I S T I N G"); TEXT_IO.NEW_LINE (Files.List_File); TEXT_IO.PUT_LINE (Files.List_File,"FILE COMPARE -- Version " & File_Compare_Utilities_Version); TEXT_IO.PUT_LINE (Files.List_File,"Written by " & Authors_List); TEXT_IO.NEW_LINE (Files.List_File); TEXT_IO.PUT_LINE (Files.List_File,"Comparison generated on " & TOD (1 .. TOD_Length)); TEXT_IO.NEW_LINE (Files.List_File); TEXT_IO.PUT (Files.List_File,"This comparison is being performed with"); if not Options.Case_Sensitive then TEXT_IO.PUT (Files.List_File,"out"); end if; TEXT_IO.PUT_LINE (Files.List_File," respect for case sensitivity"); TEXT_IO.NEW_LINE (Files.List_File,2); TEXT_IO.PUT (Files.List_File,"C Line " & Files.Old_File_Name (1 .. Files.Old_File_Length)); for I in 1 .. (Text_Max_Length - Files.Old_File_Length) loop TEXT_IO.PUT (Files.List_File,Blank); end loop; TEXT_IO.PUT (Files.List_File," | " & Files.New_File_Name (1 .. Files.New_File_Length)); for I in 1 .. (Text_Max_Length - Files.New_File_Length) loop TEXT_IO.PUT (Files.List_File,Blank); end loop; TEXT_IO.PUT_LINE (Files.List_File," Line C"); if Options.Wide_Listing then TEXT_IO.PUT_LINE (Files.List_File, "-----------------------------------------------------------------+" & "-----------------------------------------------------------------"); else TEXT_IO.PUT_LINE (Files.List_File, "---------------------------------------+" & "---------------------------------------"); end if; end if; end Headings; ---------------------------------------------------------------------- -- The following procedure is the hub of all input operations. -- It makes use of this package's own garbage collection too. procedure Read_File ( Max_Lines_to_Read : in NATURAL; Line_Number : in out POSITIVE; A_File : in out TEXT_IO.FILE_TYPE; File_Head_Ptr : in out Data_Ptr_Type) is Curr_Ptr, Tail_Ptr : Data_Ptr_Type := File_Head_Ptr; Number_Lines : NATURAL := 1; begin -- Position the tail pointer at the end of the linked list -- for the file. if Tail_Ptr /= null then while Tail_Ptr.Next_Line /= null loop Tail_Ptr := Tail_Ptr.Next_Line; end loop; end if; -- Read in data while (not TEXT_IO.END_OF_FILE (A_File)) and (Number_Lines <= Max_Lines_to_Read) loop if Free_List_Head = null then Curr_Ptr := new Data_Type; else Curr_Ptr := Free_List_Head; Free_List_Head := Free_List_Head.Next_Line; end if; begin Get_A_Line (A_File,Curr_Ptr.Data_Line.Line, Curr_Ptr.Data_Line.Length); exception when CONSTRAINT_ERROR => raise Line_Length_Error; end; -- Blank the remainder of the string, even though it -- is never referenced. for I in Curr_Ptr.Data_Line.Length + 1 .. Curr_Ptr.Data_Line.Line'LAST loop Curr_Ptr.Data_Line.Line (I) := Blank; end loop; Number_Lines := Number_Lines + 1; -- Hook up the line in the linked list if Tail_Ptr = null then File_Head_Ptr := Curr_Ptr; else Tail_Ptr.Next_Line := Curr_Ptr; end if; Curr_Ptr.Line_Number := Line_Number; Line_Number := Line_Number + 1; Tail_Ptr := Curr_Ptr; Curr_Ptr.Next_Line := null; end loop; if Free_List_Head = null then Free_List_Tail := null; end if; end Read_File; ---------------------------------------------------------------------- -- The following procedure prints lines on the list file. The first -- and last lines are passed, and this procedure iterates over all -- lines from first to last inclusive. procedure Print_Listing ( Change_Code : in CHARACTER; First_Old, Last_Old, First_New, Last_New : in Data_Ptr_Type; Files : in out Files_Type) is Curr : POSITIVE; Bool1, Bool2 : BOOLEAN; First_Old_Copy : Data_Ptr_Type := First_Old; First_New_Copy : Data_Ptr_Type := First_New; begin loop if First_Old_Copy = null then TEXT_IO.PUT (Files.List_File,Change_Code & " "); else TEXT_IO.PUT (Files.List_File,Change_Code & Blank); Int_IO.PUT (Files.List_File,First_Old_Copy.Line_Number, List_Line_Num_Max_Length); TEXT_IO.PUT (Files.List_File,Blank); end if; Curr := 1; loop if First_Old_Copy = null then for I in 1 .. Text_Max_Length loop TEXT_IO.PUT (Files.List_File,Blank); end loop; else for I in 1 .. Text_Max_Length loop if Curr + I - 1 > First_Old_Copy.Data_Line.Length then TEXT_IO.PUT (Files.List_File,Blank); else TEXT_IO.PUT (Files.List_File, First_Old_Copy.Data_Line.Line (Curr+I-1)); end if; end loop; end if; TEXT_IO.PUT (Files.List_File," | "); if First_New_Copy /= null then for I in 1 .. Text_Max_Length loop if Curr + I - 1 > First_New_Copy.Data_Line.Length then TEXT_IO.PUT (Files.List_File,Blank); else TEXT_IO.PUT (Files.List_File, First_New_Copy.Data_Line.Line (Curr+I-1)); end if; end loop; end if; Curr := Curr + Text_Max_Length; if First_Old_Copy = null then Bool1 := FALSE; else Bool1 := (Curr <= First_Old_Copy.Data_Line.Length); end if; if First_New_Copy = null then Bool2 := FALSE; else Bool2 := (Curr <= First_New_Copy.Data_Line.Length); end if; if Bool1 or Bool2 then TEXT_IO.NEW_LINE (Files.List_File); TEXT_IO.PUT (Files.List_File," "); end if; if First_Old_Copy = null then Bool1 := TRUE; else Bool1 := (Curr > First_Old_Copy.Data_Line.Length); end if; if First_New_Copy = null then Bool2 := TRUE; else Bool2 := (Curr > First_New_Copy.Data_Line.Length); end if; exit when Bool1 and Bool2; end loop; if First_New_Copy = null then for I in 1 .. Text_Max_Length loop TEXT_IO.PUT (Files.List_File,Blank); end loop; TEXT_IO.PUT_LINE (Files.List_File," " & Change_Code); else TEXT_IO.PUT (Files.List_File,Blank); Int_IO.PUT (Files.List_File,First_New_Copy.Line_Number, List_Line_Num_Max_Length); TEXT_IO.PUT_LINE (Files.List_File,Blank & Change_Code); end if; exit when (First_Old_Copy = Last_Old) and (First_New_Copy = Last_New); if First_Old_Copy /= Last_Old then First_Old_Copy := First_Old_Copy.Next_Line; end if; if First_New_Copy /= Last_New then First_New_Copy := First_New_Copy.Next_Line; end if; end loop; end Print_Listing; ---------------------------------------------------------------------- -- The following procedure converts lines of data to upper case. procedure Convert_to_Upper_Case (Line : in out Data_Line_Type) is begin for I in 1 .. Line.Length loop if Line.Line (I) in Set_of_Lower_Case_Letters then Line.Line (I) := CHARACTER'VAL (CHARACTER'POS (Line.Line (I)) - Uc_Lc_Offset); end if; end loop; end Convert_to_Upper_Case; ---------------------------------------------------------------------- -- The following procedure maintains garbage collection for the package. procedure Dispose_Lines ( First_Old, Last_Old, First_New, Last_New : in Data_Ptr_Type; Dispose_Record : out Dispose_Record_Type) is procedure Do_Dispose ( First_Ptr, Last_Ptr : in Data_Ptr_Type; Lines_to_Dispose : out NATURAL) is Curr_Ptr : Data_Ptr_Type; begin if First_Ptr = null then Lines_to_Dispose := 0; else Lines_to_Dispose := (Last_Ptr.Line_Number - First_Ptr.Line_Number) + 1; if Free_List_Head = null then Free_List_Head := First_Ptr; Free_List_Tail := Last_Ptr; else Free_List_Tail.Next_Line := First_Ptr; Free_List_Tail := Last_Ptr; end if; Free_List_Tail.Next_Line := null; end if; end Do_Dispose; begin Do_Dispose (First_Old,Last_Old,Dispose_Record.Old_File); Do_Dispose (First_New,Last_New,Dispose_Record.New_File); end Dispose_Lines; ---------------------------------------------------------------------- -- The following procedure prints statistics on the list file. procedure Print_Statistics ( Statistics : in Statistics_Type; Files : in out Files_Type) is begin TEXT_IO.NEW_LINE (Files.List_File); TEXT_IO.PUT_LINE (Files.List_File,"FILE COMPARE statistics:"); TEXT_IO.NEW_LINE (Files.List_File); if Statistics.Number_Old_Lines = 0 then TEXT_IO.PUT_LINE (Files.List_File,"Old file " & Files.Old_File_Name (1 .. Files.Old_File_Length) & " has no lines."); elsif Statistics.Number_Old_Lines = 1 then TEXT_IO.PUT_LINE (Files.List_File,"Old file " & Files.Old_File_Name (1 .. Files.Old_File_Length) & " has 1 line."); else TEXT_IO.PUT_LINE (Files.List_File,"Old file " & Files.Old_File_Name (1 .. Files.Old_File_Length) & " has" & NATURAL'IMAGE (Statistics.Number_Old_Lines) & " lines."); end if; if Statistics.Number_New_Lines = 0 then TEXT_IO.PUT_LINE (Files.List_File,"New file " & Files.New_File_Name (1 .. Files.New_File_Length) & " has no lines."); elsif Statistics.Number_New_Lines = 1 then TEXT_IO.PUT_LINE (Files.List_File,"New file " & Files.New_File_Name (1 .. Files.New_File_Length) & " has 1 line."); else TEXT_IO.PUT_LINE (Files.List_File,"New file " & Files.New_File_Name (1 .. Files.New_File_Length) & " has" & NATURAL'IMAGE (Statistics.Number_New_Lines) & " lines."); end if; if Statistics.Files_Equal then TEXT_IO.PUT_LINE (Files.List_File,"Files are equal."); else if Statistics.Total_Equal_Lines = 0 then TEXT_IO.PUT_LINE (Files.List_File,"There were no equal lines."); elsif Statistics.Total_Equal_Lines = 1 then TEXT_IO.PUT_LINE (Files.List_File,"There was 1 equal line."); else TEXT_IO.PUT_LINE (Files.List_File,"There were" & NATURAL'IMAGE (Statistics.Total_Equal_Lines) & " equal lines."); end if; if Statistics.Total_Minor_Changes = 0 then TEXT_IO.PUT_LINE (Files.List_File, "There were no lines with minor changes."); elsif Statistics.Total_Minor_Changes = 1 then TEXT_IO.PUT_LINE (Files.List_File, "There was 1 line with minor changes."); else TEXT_IO.PUT_LINE (Files.List_File,"There were" & NATURAL'IMAGE (Statistics.Total_Minor_Changes) & " lines with minor changes."); end if; if Statistics.Total_Insertions = 0 then TEXT_IO.PUT_LINE (Files.List_File,"There were no lines inserted."); elsif Statistics.Total_Insertions = 1 then TEXT_IO.PUT_LINE (Files.List_File,"There was 1 line inserted."); else TEXT_IO.PUT_LINE (Files.List_File,"There were" & NATURAL'IMAGE (Statistics.Total_Insertions) & " lines inserted."); end if; if Statistics.Total_Deletions = 0 then TEXT_IO.PUT_LINE (Files.List_File,"There were no lines deleted."); elsif Statistics.Total_Deletions = 1 then TEXT_IO.PUT_LINE (Files.List_File,"There was 1 line deleted."); else TEXT_IO.PUT_LINE (Files.List_File,"There were" & NATURAL'IMAGE (Statistics.Total_Deletions) & " lines deleted."); end if; end if; end Print_Statistics; ---------------------------------------------------------------------- -- The following function performs a generic equality comparison of -- data lines. It takes into account the option of a case -- insensitive compare operation. function Lines_Are_Equal ( Line1, Line2 : in Data_Line_Type; Case_Sensitive : in BOOLEAN) return BOOLEAN is Line1_Copy : Data_Line_Type := Line1; Line2_Copy : Data_Line_Type := Line2; begin if not Case_Sensitive then Convert_to_Upper_Case (Line1_Copy); Convert_to_Upper_Case (Line2_Copy); end if; return Line1_Copy.Line (1 .. Line1_Copy.Length) = Line2_Copy.Line (1 .. Line2_Copy.Length); end Lines_Are_Equal; -- The following procedure analyzes the files, looking for -- equal lines (synchronization points). If the current lines -- are not equal, it simply terminates. Otherwise it keeps -- looking until it finds lines that differ. procedure Analyze_Equal ( Options : in Options_Type; Old_File_Head_Ptr, New_File_Head_Ptr : in out Data_Ptr_Type; Files : in out Files_Type; Tot_Equal_Lines : in out NATURAL; Found : out BOOLEAN; Dispose_Record : out Dispose_Record_Type) is First_Old, First_New, Last_Old, Last_New : Data_Ptr_Type; Local_Dispose_Record : Dispose_Record_Type := (0,0); -- The following inner procedure outputs a group of equal -- lines to the list file. procedure Print_Summary_Equal ( First_Old, Last_Old, First_New, Last_New : in Data_Ptr_Type; Files : in out Files_Type) is begin Print_Listing (Equal_Lines_Code,First_Old,First_Old,First_New,First_New,Files); if (First_Old.Line_Number + 1) < Last_Old.Line_Number then TEXT_IO.PUT (Files.List_File,Equal_Lines_Code & Blank); for I in 1 .. Text_Max_Length - 2 loop TEXT_IO.PUT (Files.List_File,Equal_Lines_Code); end loop; Int_IO.PUT (Files.List_File, (Last_Old.Line_Number - First_Old.Line_Number - 1), List_Line_Num_Max_Length); TEXT_IO.PUT (Files.List_File," equal line"); if (Last_Old.Line_Number - First_Old.Line_Number - 1) = 1 then TEXT_IO.PUT (Files.List_File,Blank); else TEXT_IO.PUT (Files.List_File,'s'); end if; TEXT_IO.PUT (Files.List_File,Blank); for I in 1 .. Text_Max_Length - 2 loop TEXT_IO.PUT (Files.List_File,Equal_Lines_Code); end loop; TEXT_IO.PUT_LINE (Files.List_File,Blank & Equal_Lines_Code); end if; if First_Old /= Last_Old then Print_Listing (Equal_Lines_Code,Last_Old,Last_Old,Last_New,Last_New,Files); end if; end Print_Summary_Equal; -- The following inner procedure outputs a Copy command -- to the deck file. procedure Cdupdate_Equal ( First_Old, Last_Old : in Data_Ptr_Type; Files : in out Files_Type) is begin if Options.Verbose_Deck then TEXT_IO.PUT (Files.Deck_File,Command_Code & Case_Conversion("Copy ",Options.Deck_Command_Case)); else TEXT_IO.PUT (Files.Deck_File,Command_Code & Case_Conversion("C ",Options.Deck_Command_Case)); end if; Int_IO.PUT (Files.Deck_File, First_Old.Line_Number,List_Line_Num_Max_Length); if First_Old /= Last_Old then if Options.Verbose_Deck then TEXT_IO.PUT (Files.Deck_File," .. "); else TEXT_IO.PUT (Files.Deck_File,Blank); end if; Int_IO.PUT (Files.Deck_File, Last_Old.Line_Number,List_Line_Num_Max_Length); end if; TEXT_IO.NEW_LINE (Files.Deck_File); end Cdupdate_Equal; begin -- Analyze_Equal if not Lines_Are_Equal (Old_File_Head_Ptr.Data_Line, New_File_Head_Ptr.Data_Line,Options.Case_Sensitive) then Found := FALSE; -- current lines are different else Found := TRUE; -- current lines equal, keep looking below First_Old := Old_File_Head_Ptr; First_New := New_File_Head_Ptr; loop -- iterate until lines differ Last_Old := Old_File_Head_Ptr; Last_New := New_File_Head_Ptr; Old_File_Head_Ptr := Old_File_Head_Ptr.Next_Line; New_File_Head_Ptr := New_File_Head_Ptr.Next_Line; exit when ((Old_File_Head_Ptr = null) or (New_File_Head_Ptr = null)) or else (not Lines_Are_Equal (Old_File_Head_Ptr.Data_Line, New_File_Head_Ptr.Data_Line,Options.Case_Sensitive)); end loop; if Options.Produce_Statistics then Tot_Equal_Lines := Tot_Equal_Lines + (Last_New.Line_Number - First_New.Line_Number + 1); end if; if Options.Produce_Listing then if Options.Summarize and (Last_New.Line_Number - First_New.Line_Number + 1 >= Options.Minimum_Group) then Print_Summary_Equal (First_Old,Last_Old,First_New, Last_New,Files); else Print_Listing (Equal_Lines_Code,First_Old,Last_Old,First_New,Last_New, Files); end if; end if; if Options.Produce_Deck then Cdupdate_Equal (First_Old,Last_Old,Files); end if; Dispose_Lines (First_Old,Last_Old,First_New,Last_New, Local_Dispose_Record); end if; Dispose_Record := Local_Dispose_Record; end Analyze_Equal; ---------------------------------------------------------------------- -- The following procedure finds a minor change in the current -- lines, and returns the position and type of minor change -- found. If no minor change is found, the position 0 is returned. -- The minor change algorithms were originally written by Spencer -- Peterson, in Pascal pseudo-code. The author has adopted and -- slightly modified these algorithms. procedure Minor_Change ( Case_Sensitive : in BOOLEAN; Str1, Str2 : in Data_Line_Type; Pos : out NATURAL; Result : out Minor_Change_Found_Type) is Local_Result : Minor_Change_Found_Type; Str1_Copy : Data_Line_Type := Str1; Str2_Copy : Data_Line_Type := Str2; -- The following inner procedure finds a one character difference -- in the current lines. procedure Find_One_Char ( Str1, Str2 : in Data_Line_Type; Pos : out NATURAL; Found : out BOOLEAN) is Count1, Count2, Diff_Count : NATURAL; begin Count1 := 1; Count2 := 1; Diff_Count := 0; Pos := 0; while (Diff_Count < 2) and (Count1 <= Str1.Length) loop if Str1.Line (Count1) /= Str2.Line (Count2) then if Diff_Count = 1 then Diff_Count := 2; Pos := 0; else Pos := Count2; Count2 := Count2 + 1; Diff_Count := 1; end if; else Count1 := Count1 + 1; Count2 := Count2 + 1; end if; end loop; if Diff_Count = 0 then Diff_Count := 1; Pos := Str2.Length; end if; Found := Diff_Count = 1; end Find_One_Char; -- The following inner procedure finds a one-character insertion -- in the current lines. procedure One_Char_Insert ( Str1, Str2 : in Data_Line_Type; Pos : out NATURAL; Result : out Minor_Change_Found_Type) is Local_Pos : NATURAL; Found : BOOLEAN; begin Find_One_Char (Str1,Str2,Local_Pos,Found); Pos := Local_Pos; if not Found then Result := No_Minor_Change_Found; else Old_Delimiter := Squote; if Str2.Line (Local_Pos) = Squote then New_Delimiter := Dquote; else New_Delimiter := Squote; end if; Result := Insertion_Found; end if; end One_Char_Insert; -- The following inner procedure finds a one-character deletion -- in the current lines. procedure One_Char_Delete ( Str1, Str2 : in Data_Line_Type; Pos : out NATURAL; Result : out Minor_Change_Found_Type) is Local_Pos : NATURAL; Found : BOOLEAN; begin Find_One_Char (Str2,Str1,Local_Pos,Found); Pos := Local_Pos; if not Found then Result := No_Minor_Change_Found; else New_Delimiter := Squote; if Str1.Line (Local_Pos) = Squote then Old_Delimiter := Dquote; else Old_Delimiter := Squote; end if; Result := Deletion_Found; end if; end One_Char_Delete; -- The following inner procedure finds a one character replacement -- in the current lines. procedure One_Char_Replace ( Str1, Str2 : in Data_Line_Type; Pos : out NATURAL; Result : out Minor_Change_Found_Type) is Count, Diff_Count, Local_Pos : NATURAL; begin Count := 1; Diff_Count := 0; Local_Pos := 0; while (Diff_Count < 2) and (Count <= Str1.Length) loop if Str1.Line (Count) /= Str2.Line (Count) then Diff_Count := Diff_Count + 1; Local_Pos := Count; end if; Count := Count + 1; end loop; Pos := Local_Pos; if Diff_Count /= 1 then Result := No_Minor_Change_Found; else if Str1.Line (Local_Pos) = Squote then Old_Delimiter := Dquote; else Old_Delimiter := Squote; end if; if Str2.Line (Local_Pos) = Squote then New_Delimiter := Dquote; else New_Delimiter := Squote; end if; Result := Replacement_Found; end if; end One_Char_Replace; -- The following inner procedure finds a two-character -- tranposition in the current lines. Since only two -- delimiters for the Edit command are supported (single -- quote and double quote), a special case is needed to see -- if these two characters are being transposed. procedure Two_Char_Transpose ( Str1, Str2 : in Data_Line_Type; Pos : out NATURAL; Result : out Minor_Change_Found_Type) is I, Diff_Count, Local_Pos : NATURAL := 0; Found, Mismatched : BOOLEAN; -- The following inner function checks for the delimiter -- special-case transposition. function Both_Quotes_Found ( Line : in Data_Line_Type; Pos : in NATURAL) return BOOLEAN is Found_Squote, Found_Dquote : BOOLEAN; begin Found_Squote := FALSE; Found_Dquote := FALSE; for I in Pos .. Pos + 1 loop if Line.Line (I) = Squote then Found_Squote := TRUE; elsif Line.Line (I) = Dquote then Found_Dquote := TRUE; end if; end loop; return (Found_Squote and Found_Dquote); end Both_Quotes_Found; begin -- Two_Char_Transpose Found := FALSE; Mismatched := FALSE; I := 1; while I < Str1.Length loop if Str1.Line (I) /= Str2.Line (I) then if Found then Mismatched := TRUE; exit; elsif (Str1.Line (I) = Str2.Line (I+1)) and (Str1.Line (I+1) = Str2.Line (I)) then Local_Pos := I; Found := TRUE; I := I + 1; else Mismatched := TRUE; exit; end if; end if; I := I + 1; end loop; Pos := Local_Pos; if ((not Found) or Mismatched) or else (Both_Quotes_Found (Str1,Local_Pos) or Both_Quotes_Found (Str2,Local_Pos)) then Result := No_Minor_Change_Found; else if (Str1.Line (Local_Pos) = Squote) or (Str1.Line (Local_Pos+1) = Squote) then Old_Delimiter := Dquote; else Old_Delimiter := Squote; end if; if (Str2.Line (Local_Pos) = Squote) or (Str2.Line (Local_Pos+1) = Squote) then New_Delimiter := Dquote; else New_Delimiter := Squote; end if; Result := Transposition_Found; end if; end Two_Char_Transpose; begin -- Minor_Change if Case_Sensitive then Convert_to_Upper_Case (Str1_Copy); Convert_to_Upper_Case (Str2_Copy); end if; -- Find a minor change. Try all appropriate possibilities. if abs (Str1_Copy.Length - Str2_Copy.Length) > 1 then Result := No_Minor_Change_Found; Pos := 0; elsif Str1_Copy.Length < Str2_Copy.Length then One_Char_Insert (Str1_Copy,Str2_Copy,Pos,Result); elsif Str1_Copy.Length > Str2_Copy.Length then One_Char_Delete (Str1_Copy,Str2_Copy,Pos,Result); else One_Char_Replace (Str1_Copy,Str2_Copy,Pos,Local_Result); if Local_Result = No_Minor_Change_Found then Two_Char_Transpose (Str1_Copy,Str2_Copy,Pos,Result); else Result := Local_Result; end if; end if; end Minor_Change; ---------------------------------------------------------------------- -- The following function simply returns TRUE if the current lines -- contain a minor change, and FALSE otherwise. It is used as an -- iteration terminator for other analysis routines. function Find_Minor_Change_Only ( Old_Line, New_Line : in Data_Line_Type; Options : in Options_Type) return BOOLEAN is Dummy_Pos : NATURAL; Result : Minor_Change_Found_Type; begin if not Options.Check_Minor_Changes then return FALSE; else Minor_Change (Options.Case_Sensitive,Old_line,New_Line,Dummy_Pos, Result); return Result /= No_Minor_Change_Found; end if; end Find_Minor_Change_Only; ---------------------------------------------------------------------- -- The following procedure analyzes and processes all minor change -- requests. procedure Analyze_Minor_Change ( Options : in Options_Type; Old_File_Head_Ptr, New_File_Head_Ptr : in out Data_Ptr_Type; Files : in out Files_Type; Tot_Minor_Changes : in out NATURAL; Found : out BOOLEAN; Dispose_Record : out Dispose_Record_Type) is Pos : NATURAL; Minor_Change_Found : Minor_Change_Found_Type; Curr_Old, Curr_New : Data_Ptr_Type; Local_Found : BOOLEAN; Local_Dispose_Record : Dispose_Record_Type := (0,0); -- The following inner procedure emits an Edit command on the -- deck file. procedure Cdupdate_Minor_Change ( Old_File_Head_Ptr, New_File_Head_Ptr : in Data_Ptr_Type; Minor_Change_Found : in Minor_Change_Found_Type; Pos : in NATURAL; Files : in out Files_Type) is procedure Print_Chars_in_Quotes ( Str : in Data_Line_Type; Pos, Num_Chars_to_Print : in NATURAL; Files : in out Files_Type) is begin for I in 1 .. Num_Chars_to_Print loop TEXT_IO.PUT (Files.Deck_File,Str.Line (I+Pos-1)); end loop; end Print_Chars_in_Quotes; begin if Options.Verbose_Deck then TEXT_IO.PUT (Files.Deck_File,Command_Code & Case_Conversion("Edit ",Options.Deck_Command_Case)); else TEXT_IO.PUT (Files.Deck_File,Command_Code & Case_Conversion("Ed ",Options.Deck_Command_Case)); end if; Int_IO.PUT (Files.Deck_File, Old_File_Head_Ptr.Line_Number,List_Line_Num_Max_Length); if Options.Verbose_Deck then TEXT_IO.PUT (Files.Deck_File, Case_Conversion(" At ",Options.Deck_Command_Case)); else TEXT_IO.PUT (Files.Deck_File,Blank); end if; Int_IO.PUT (Files.Deck_File,Pos,3); TEXT_IO.PUT (Files.Deck_File,Blank & Old_Delimiter); case Minor_Change_Found is when Deletion_Found | Replacement_Found => Print_Chars_in_Quotes (Old_File_Head_Ptr.Data_Line,Pos,1, Files); when Transposition_Found => Print_Chars_in_Quotes (Old_File_Head_Ptr.Data_Line,Pos,2, Files); when others => null; end case; if Options.Verbose_Deck then TEXT_IO.PUT (Files.Deck_File,Old_Delimiter & Case_Conversion(" Becomes ",Options.Deck_Command_Case) & New_Delimiter); else TEXT_IO.PUT (Files.Deck_File,Old_Delimiter & Blank & New_Delimiter); end if; case Minor_Change_Found is when Insertion_Found | Replacement_Found => Print_Chars_in_Quotes (New_File_Head_Ptr.Data_Line,Pos,1, Files); when Transposition_Found => Print_Chars_in_Quotes (New_File_Head_Ptr.Data_Line,Pos,2, Files); when others => null; end case; TEXT_IO.PUT (Files.Deck_File,New_Delimiter); TEXT_IO.NEW_LINE (Files.Deck_File); end Cdupdate_Minor_Change; begin -- Analyze_Minor_Change -- Determine if a minor change exists if not Options.Check_Minor_Changes then Local_Found := FALSE; else Minor_Change (Options.Case_Sensitive,Old_File_Head_Ptr.Data_Line, New_File_Head_Ptr.Data_Line,Pos,Minor_Change_Found); Local_Found := (Minor_Change_Found /= No_Minor_Change_Found); end if; Found := Local_Found; -- If a minor change has been located, process it below. if Local_Found then if Options.Produce_Statistics then Tot_Minor_Changes := Tot_Minor_Changes + 1; end if; if Options.Produce_Listing then Print_Listing (Minor_Change_Code,Old_File_Head_Ptr,Old_File_Head_Ptr, New_File_Head_Ptr,New_File_Head_Ptr,Files); end if; if Options.Produce_Deck then Cdupdate_Minor_Change (Old_File_Head_Ptr,New_File_Head_Ptr, Minor_Change_Found,Pos,Files); end if; Curr_Old := Old_File_Head_Ptr; Curr_New := New_File_Head_Ptr; Old_File_Head_Ptr := Old_File_Head_Ptr.Next_Line; New_File_Head_Ptr := New_File_Head_Ptr.Next_Line; Dispose_Lines (Curr_Old,Curr_Old,Curr_New,Curr_New, Local_Dispose_Record); end if; Dispose_Record := Local_Dispose_Record; end Analyze_Minor_Change; ---------------------------------------------------------------------- -- The following procedure analyzes and processes all insertion -- requests. procedure Analyze_Insertion ( At_Tail_of_Old, At_Tail_of_New : in BOOLEAN; Options : in Options_Type; Old_File_Head_Ptr : in Data_Ptr_Type; New_File_Head_Ptr : in out Data_Ptr_Type; Files : in out Files_Type; Tot_Insertions : in out NATURAL; Found : in out BOOLEAN; Dispose_Record : in out Dispose_Record_Type) is First_New, Last_New, Next_New : Data_Ptr_Type; Local_Dispose_Record : Dispose_Record_Type := (0,0); -- The following inner procedure outputs a group of insertions -- to the list file. procedure Print_Summary_Insertion ( First_New, Last_New : in Data_Ptr_Type; Files : in out Files_Type) is begin Print_Listing (Insertion_Code,null,null,First_New,First_New,Files); if (First_New.Line_Number + 1) < Last_New.Line_Number then TEXT_IO.PUT (Files.List_File,Insertion_Code & Blank); for I in 1 .. Text_Max_Length - 2 loop TEXT_IO.PUT (Files.List_File,Insertion_Code); end loop; Int_IO.PUT (Files.List_File, (Last_New.Line_Number - First_New.Line_Number - 1), List_Line_Num_Max_Length); TEXT_IO.PUT (Files.List_File," inserted line"); if (Last_New.Line_Number - First_New.Line_Number - 1) = 1 then TEXT_IO.PUT (Files.List_File,Blank); else TEXT_IO.PUT (Files.List_File,'s'); end if; TEXT_IO.PUT (Files.List_File,Blank); for I in 1 .. Text_Max_Length - 5 loop TEXT_IO.PUT (Files.List_File,Insertion_Code); end loop; TEXT_IO.PUT_LINE (Files.List_File,Blank & Insertion_Code); end if; if First_New /= Last_New then Print_Listing (Insertion_Code,null,null,Last_New,Last_New,Files); end if; end Print_Summary_Insertion; -- The following inner procedure emits insertion lines to the -- deck file. If an insertion line begins with the same character -- as Command_Code, then an extra Command_Code character is -- emitted at the beginning (so that the CDUPDATE utility can -- distinguish it from a normal command). procedure Cdupdate_Insertion ( First_New, Last_New : in Data_Ptr_Type; Files : in out Files_Type) is Local_First_New : Data_Ptr_Type := First_New; begin loop if (Local_First_New.Data_Line.Length /= 0) and then (Local_First_New.Data_Line.Line (1) = Command_Code) then TEXT_IO.PUT (Files.Deck_File,Command_Code); end if; TEXT_IO.PUT_LINE (Files.Deck_File, Local_First_New.Data_Line.Line (1 .. Local_First_New.Data_Line.Length)); if Local_First_New = Last_New then exit; end if; Local_First_New := Local_First_New.Next_Line; end loop; end Cdupdate_Insertion; begin -- Analyze_Insertion -- Two cases: if the old file is exhausted, then an insertion -- definitely exists; else analysis must be performed. if Old_File_Head_Ptr = null then Found := TRUE; First_New := New_File_Head_Ptr; Last_New := New_File_Head_Ptr; New_File_Head_Ptr := null; while Last_New.Next_Line /= null loop Last_New := Last_New.Next_Line; end loop; if Options.Produce_Statistics then Tot_Insertions := Tot_Insertions + (Last_New.Line_Number - First_New.Line_Number + 1); end if; if Options.Produce_Listing then if Options.Summarize and (Last_New.Line_Number - First_New.Line_Number + 1 >= Options.Minimum_Group) then Print_Summary_Insertion (First_New,Last_New,Files); else Print_Listing (Insertion_Code,null,null,First_New,Last_New,Files); end if; end if; if Options.Produce_Deck then Cdupdate_Insertion (First_New,Last_New,Files); end if; Dispose_Lines (null,null,First_New,Last_New,Local_Dispose_Record); else First_New := New_File_Head_Ptr; Last_New := New_File_Head_Ptr; Next_New := Last_New.Next_Line; while Next_New /= null loop if Lines_Are_Equal (Old_File_Head_Ptr.Data_Line, Next_New.Data_Line,Options.Case_Sensitive) or Find_Minor_Change_Only (Old_File_Head_Ptr.Data_Line, Next_New.Data_Line,Options) then exit; end if; Last_New := Next_New; Next_New := Next_New.Next_Line; end loop; if ((Next_New = null) and (not At_Tail_of_Old)) or ((Next_New = null) and (At_Tail_of_New)) then Found := FALSE; else Found := TRUE; New_File_Head_Ptr := Next_New; if Options.Produce_Statistics then Tot_Insertions := Tot_Insertions + (Last_New.Line_Number - First_New.Line_Number + 1); end if; if Options.Produce_Listing then if Options.Summarize and (Last_New.Line_Number - First_New.Line_Number + 1 >= Options.Minimum_Group) then Print_Summary_Insertion (First_New,Last_New,Files); else Print_Listing (Insertion_Code,null,null,First_New,Last_New,Files); end if; end if; if Options.Produce_Deck then Cdupdate_Insertion (First_New,Last_New,Files); end if; Dispose_Lines (null,null,First_New,Last_New,Local_Dispose_Record); end if; end if; Dispose_Record := Local_Dispose_Record; end Analyze_Insertion; ---------------------------------------------------------------------- -- The following procedure analyzes and processes all deletion -- requests. This routine is only called when the current line -- is definitely known to be a deletion. procedure Analyze_Deletion ( Options : in Options_Type; Old_File_Head_Ptr : in out Data_Ptr_Type; New_File_Head_Ptr : in Data_Ptr_Type; Files : in out Files_Type; Tot_Deletions : in out NATURAL; Dispose_Record : out Dispose_Record_Type) is First_Old, Last_Old, Prev_Old, Curr_New : Data_Ptr_Type; Local_Dispose_Record : Dispose_Record_Type := (0,0); -- The following inner procedure outputs a group of deleted lines -- to the list file. procedure Print_Summary_Deletion ( First_Old, Last_Old : in Data_Ptr_Type; Files : in out Files_Type) is begin Print_Listing (Deletion_Code,First_Old,First_Old,null,null,Files); if (First_Old.Line_Number + 1) < Last_Old.Line_Number then TEXT_IO.PUT (Files.List_File,Deletion_Code & Blank); for I in 1 .. Text_Max_Length - 2 loop TEXT_IO.PUT (Files.List_File,Deletion_Code); end loop; Int_IO.PUT (Files.List_File, (Last_Old.Line_Number - First_Old.Line_Number - 1), List_Line_Num_Max_Length); TEXT_IO.PUT (Files.List_File," deleted line"); if (Last_Old.Line_Number - First_Old.Line_Number - 1) = 1 then TEXT_IO.PUT (Files.List_File,Blank); else TEXT_IO.PUT (Files.List_File,'s'); end if; TEXT_IO.PUT (Files.List_File,Blank & Deletion_Code); for I in 1 .. Text_Max_Length - 5 loop TEXT_IO.PUT (Files.List_File,Deletion_Code); end loop; TEXT_IO.PUT_LINE (Files.List_File,Blank & Deletion_Code); end if; if First_Old /= Last_Old then Print_Listing (Deletion_Code,Last_Old,Last_Old,null,null,Files); end if; end Print_Summary_Deletion; -- The following inner procedure emits a Delete command to -- the deck file. This procedure is only called when the -- Verbose_Deck option is requested. procedure Cdupdate_Deletion ( First_Old, Last_Old : in Data_Ptr_Type; Files : in out Files_Type) is begin TEXT_IO.PUT (Files.Deck_File,Command_Code & Case_Conversion("Delete ",Options.Deck_Command_Case)); Int_IO.PUT (Files.Deck_File, First_Old.Line_Number,List_Line_Num_Max_Length); if First_Old /= Last_Old then TEXT_IO.PUT (Files.Deck_File," .. "); Int_IO.PUT (Files.Deck_File, Last_Old.Line_Number,List_Line_Num_Max_Length); end if; TEXT_IO.NEW_LINE (Files.Deck_File); end Cdupdate_Deletion; begin -- Analyze_Deletion if New_File_Head_Ptr = null then First_Old := Old_File_Head_Ptr; Last_Old := Old_File_Head_Ptr; Old_File_Head_Ptr := null; while Last_Old.Next_Line /= null loop Last_Old := Last_Old.Next_Line; end loop; if Options.Produce_Statistics then Tot_Deletions := Tot_Deletions + (Last_Old.Line_Number - First_Old.Line_Number + 1); end if; if Options.Produce_Listing then if Options.Summarize and (Last_Old.Line_Number - First_Old.Line_Number + 1 >= Options.Minimum_Group) then Print_Summary_Deletion (First_Old,Last_Old,Files); else Print_Listing (Deletion_Code,First_Old,Last_Old,null,null,Files); end if; end if; if Options.Produce_Deck and Options.Verbose_Deck then Cdupdate_Deletion (First_Old,Last_Old,Files); end if; Dispose_Lines (First_Old,Last_Old,null,null,Local_Dispose_Record); else First_Old := Old_File_Head_Ptr; Last_Old := Old_File_Head_Ptr; Prev_Old := Old_File_Head_Ptr; Curr_New := New_File_Head_Ptr; Outer_While_Loop : -- used to distinguish between the inner loop below while (Curr_New /= null) loop if Lines_Are_Equal (Last_Old.Data_Line,Curr_New.Data_Line, Options.Case_Sensitive) or Find_Minor_Change_Only (Last_Old.Data_Line, Curr_New.Data_Line,Options) then exit; end if; while Last_Old.Next_Line /= null loop Prev_Old := Last_Old; Last_Old := Last_Old.Next_Line; if Lines_Are_Equal (Last_Old.Data_Line,Curr_New.Data_Line, Options.Case_Sensitive) or Find_Minor_Change_Only (Last_Old.Data_Line, Curr_New.Data_Line,Options) then exit Outer_While_Loop; end if; end loop; Curr_New := Curr_New.Next_Line; Last_Old := Old_File_Head_Ptr; Prev_Old := Old_File_Head_Ptr; end loop Outer_While_Loop; if Curr_New /= null then Old_File_Head_Ptr := Last_Old; Last_Old := Prev_Old; else Old_File_Head_Ptr := null; while Last_Old.Next_Line /= null loop Last_Old := Last_Old.Next_Line; end loop; end if; if Options.Produce_Statistics then Tot_Deletions := Tot_Deletions + (Last_Old.Line_Number - First_Old.Line_Number + 1); end if; if Options.Produce_Listing then if Options.Summarize and (Last_Old.Line_Number - First_Old.Line_Number + 1 >= Options.Minimum_Group) then Print_Summary_Deletion (First_Old,Last_Old,Files); else Print_Listing (Deletion_Code,First_Old,Last_Old,null,null,Files); end if; end if; if Options.Produce_Deck and Options.Verbose_Deck then Cdupdate_Deletion (First_Old,Last_Old,Files); end if; Dispose_Lines (First_Old,Last_Old,null,null,Local_Dispose_Record); end if; Dispose_Record := Local_Dispose_Record; end Analyze_Deletion; -- The following procedure assigns file names to strings used -- internally in this package body. This complicated assignment -- is required due to the nature of strings in Ada (length bounds -- checks). procedure Assign ( In_File : in STRING; Out_File : in out STRING; Length : out NATURAL) is begin if In_File'LENGTH > Out_File'LENGTH then Out_File := In_File (In_File'FIRST .. In_File'FIRST + Out_File'LENGTH - 1); Length := Out_File'LENGTH; else Out_File (1 .. In_File'LENGTH) := In_File; Length := In_File'LENGTH; end if; end Assign; ---------------------------------------------------------------------- -- The following procedure acts as a supervisor for comparing two -- files. It controls the complete iteration. procedure Compare_File ( Files : in out Files_Type; Statistics : out Statistics_Type; Options : in Options_Type) is Old_File_Head_Ptr, New_File_Head_Ptr : Data_Ptr_Type := null; Dispose_Record : Dispose_Record_Type := (Options.Lookahead,Options.Lookahead); Stats : Statistics_Type := (TRUE, 1, 1, 0, 0, 0, 0); -- The following inner procedure acts as a driver for analysis -- of the current lines. procedure Analyze_Lines ( Options : in Options_Type; Files : in out Files_Type; Old_File_Head_Ptr, New_File_Head_Ptr : in out Data_Ptr_Type; Statistics : in out Statistics_Type; Dispose_Record : in out Dispose_Record_Type) is Found : BOOLEAN; begin if Old_File_Head_Ptr = null then Analyze_Insertion (TEXT_IO.END_OF_FILE (Files.Old_File), TEXT_IO.END_OF_FILE (Files.New_File),Options, Old_File_Head_Ptr,New_File_Head_Ptr,Files, Statistics.Total_Insertions,Found,Dispose_Record); elsif New_File_Head_Ptr = null then Analyze_Deletion (Options,Old_File_Head_Ptr,New_File_Head_Ptr, Files,Statistics.Total_Deletions,Dispose_Record); else Analyze_Equal (Options,Old_File_Head_Ptr,New_File_Head_Ptr, Files,Statistics.Total_Equal_Lines,Found,Dispose_Record); if not Found then Analyze_Minor_Change (Options,Old_File_Head_Ptr, New_File_Head_Ptr,Files,Statistics.Total_Minor_Changes, Found,Dispose_Record); if not Found then Analyze_Insertion (TEXT_IO.END_OF_FILE (Files.Old_File), TEXT_IO.END_OF_FILE (Files.New_File),Options, Old_File_Head_Ptr,New_File_Head_Ptr,Files, Statistics.Total_Insertions,Found,Dispose_Record); if not Found then Analyze_Deletion (Options,Old_File_Head_Ptr, New_File_Head_Ptr,Files,Statistics.Total_Deletions, Dispose_Record); end if; end if; end if; end if; end Analyze_Lines; begin -- Compare_File Headings (Options,Files); Read_File (Dispose_Record.Old_File,Stats.Number_Old_Lines, Files.Old_File,Old_File_Head_Ptr); Read_File (Dispose_Record.New_File,Stats.Number_New_Lines, Files.New_File,New_File_Head_Ptr); while (Old_File_Head_Ptr /= null) or (New_File_Head_Ptr /= null) loop Analyze_Lines (Options,Files,Old_File_Head_Ptr,New_File_Head_Ptr, Stats,Dispose_Record); Read_File (Dispose_Record.Old_File,Stats.Number_Old_Lines, Files.Old_File,Old_File_Head_Ptr); Read_File (Dispose_Record.New_File,Stats.Number_New_Lines, Files.New_File,New_File_Head_Ptr); end loop; if Options.Produce_Deck then if Options.Verbose_Deck then TEXT_IO.PUT_LINE (Files.Deck_File,Command_Code & Case_Conversion ("End",Options.Deck_Command_Case)); else TEXT_IO.PUT_LINE (Files.Deck_File,Command_Code & Case_Conversion ("En",Options.Deck_Command_Case)); end if; end if; if not Options.Produce_Statistics then Stats.Number_Old_Lines := 0; Stats.Number_New_Lines := 0; else Stats.Files_Equal := (Stats.Total_Minor_Changes + Stats.Total_Insertions + Stats.Total_Deletions) = 0; Stats.Number_Old_Lines := Stats.Number_Old_Lines - 1; Stats.Number_New_Lines := Stats.Number_New_Lines - 1; if Options.Produce_Listing then Print_Statistics (Stats,Files); end if; end if; Statistics := Stats; end Compare_File; ---------------------------------------------------------------------- -- The following procedure is visible to all users, and is used -- for normal compare operations, where a statistics record is -- requested. procedure Compare ( Old_File_Name, New_File_Name, List_File_Name, Deck_File_Name : in STRING; Statistics : out Statistics_Type; Options : in Options_Type := Default_Options) is Files : Files_Type; begin if (Old_File_Name'LENGTH > Maximum_File_Name_Length) or (New_File_Name'LENGTH > Maximum_File_Name_Length) or (List_File_Name'LENGTH > Maximum_File_Name_Length) or (Deck_File_Name'LENGTH > Maximum_File_Name_Length) then raise File_Name_Length_Error; end if; Assign (Old_File_Name,Files.Old_File_Name,Files.Old_File_Length); Assign (New_File_Name,Files.New_File_Name,Files.New_File_Length); Assign (List_File_Name,Files.List_File_Name,Files.List_File_Length); Assign (Deck_File_Name,Files.Deck_File_Name,Files.Deck_File_Length); begin TEXT_IO.OPEN (Files.Old_File,TEXT_IO.IN_FILE, Files.Old_File_Name (1 .. Files.Old_File_Length)); exception when TEXT_IO.STATUS_ERROR | TEXT_IO.NAME_ERROR | TEXT_IO.USE_ERROR => raise Old_File_Open_Error; end; begin TEXT_IO.OPEN (Files.New_File,TEXT_IO.IN_FILE, Files.New_File_Name (1 .. Files.New_File_Length)); exception when TEXT_IO.STATUS_ERROR | TEXT_IO.NAME_ERROR | TEXT_IO.USE_ERROR => raise New_File_Open_Error; end; if Options.Produce_Listing then begin TEXT_IO.CREATE (Files.List_File,TEXT_IO.OUT_FILE, Files.List_File_Name (1 .. Files.List_File_Length)); exception when TEXT_IO.STATUS_ERROR | TEXT_IO.NAME_ERROR | TEXT_IO.USE_ERROR => raise List_File_Create_Error; end; else Files.List_File_Name := (others => Blank); Files.List_File_Length := 0; end if; if Options.Produce_Deck then begin TEXT_IO.CREATE (Files.Deck_File,TEXT_IO.OUT_FILE, Files.Deck_File_Name (1 .. Files.Deck_File_Length)); exception when TEXT_IO.STATUS_ERROR | TEXT_IO.NAME_ERROR | TEXT_IO.USE_ERROR => raise Deck_File_Create_Error; end; else Files.Deck_File_Name := (others => Blank); Files.Deck_File_Length := 0; end if; if Options.Wide_Listing then Text_Max_Length := Large_Margin; else Text_Max_Length := Small_Margin; end if; Compare_File (Files,Statistics,Options); TEXT_IO.CLOSE (Files.Old_File); TEXT_IO.CLOSE (Files.New_File); if Options.Produce_Listing then TEXT_IO.CLOSE (Files.List_File); end if; if Options.Produce_Deck then TEXT_IO.CLOSE (Files.Deck_File); end if; end Compare; ---------------------------------------------------------------------- -- The following procedure is visible to all users, and is used for -- normal compare operations where a statistics record is not -- required. Statistics may still be printed on the list file, -- if the user selects that option. procedure Compare ( Old_File_Name, New_File_Name, List_File_Name, Deck_File_Name : in STRING; Options : in Options_Type := Default_Options) is Dummy_Statistics : Statistics_Type; begin Compare (Old_File_Name,New_File_Name,List_File_Name,Deck_File_Name, Dummy_Statistics,Options); end Compare; ---------------------------------------------------------------------- -- The following procedure acts as a supervisor for the quick -- compare operation. procedure Quick_Compare_File ( Case_Sensitive : in BOOLEAN; Files : in out Files_Type; Files_Equal : out BOOLEAN) is Old_Line, New_Line : Line_Type; Old_Length, New_Length : NATURAL; begin while (not TEXT_IO.END_OF_FILE (Files.Old_File)) and (not TEXT_IO.END_OF_FILE (Files.New_File)) loop begin Get_A_Line (Files.Old_File,Old_Line,Old_Length); Get_A_Line (Files.New_File,New_Line,New_Length); exception when CONSTRAINT_ERROR => raise Line_Length_Error; end; if (TEXT_IO.END_OF_FILE (Files.Old_File) or TEXT_IO.END_OF_FILE (Files.New_File)) or else (not Lines_Are_Equal ((Old_Line,Old_Length), (New_Line,New_Length),Case_Sensitive)) then exit; end if; end loop; Files_Equal := (TEXT_IO.END_OF_FILE (Files.Old_File) and TEXT_IO.END_OF_FILE (Files.New_File)) and then Lines_Are_Equal ((Old_Line,Old_Length), (New_Line,New_Length),Case_Sensitive); end Quick_Compare_File; ---------------------------------------------------------------------- -- The following procedure is visible to all users, and is used for -- quick compare operations. function Quick_Compare ( Old_File_Name, New_File_Name : in STRING; Case_Sensitive : in BOOLEAN := TRUE) return BOOLEAN is Files : Files_Type; Result : BOOLEAN; begin if (Old_File_Name'LENGTH > Maximum_File_Name_Length) or (New_File_Name'LENGTH > Maximum_File_Name_Length) then raise File_Name_Length_Error; end if; Assign (Old_File_Name,Files.Old_File_Name,Files.Old_File_Length); Assign (New_File_Name,Files.New_File_Name,Files.New_File_Length); begin TEXT_IO.OPEN (Files.Old_File,TEXT_IO.IN_FILE, Files.Old_File_Name (1 .. Files.Old_File_Length)); exception when TEXT_IO.STATUS_ERROR | TEXT_IO.NAME_ERROR | TEXT_IO.USE_ERROR => raise Old_File_Open_Error; end; begin TEXT_IO.OPEN (Files.New_File,TEXT_IO.IN_FILE, Files.New_File_Name (1 .. Files.New_File_Length)); exception when TEXT_IO.STATUS_ERROR | TEXT_IO.NAME_ERROR | TEXT_IO.USE_ERROR => raise New_File_Open_Error; end; Quick_Compare_File (Case_Sensitive,Files,Result); TEXT_IO.CLOSE (Files.Old_File); TEXT_IO.CLOSE (Files.New_File); return Result; end Quick_Compare; end File_Compare_Utilities;