-- pattern_match_knuth_morris_pratt_test.adb an implementation for fixed strings-- Written by Wikibob, 2004, from notes on the Knuth_Morris_Pratt pattern match algorithm-- adapted to fixed strings of characters.-- It is in the public domain.-- If you are using GNAT, use gnatmake to compile and link this program.-- To use the pattern match functions in your own software extract-- the inner package's specification and body into separate files.-- This program is self-contained and demonstrates a particular-- implementation of the Knuth_Morris_Pratt algorithm applied to-- fixed strings, with the following restrictions:-- * the search pattern is limited to a maximum of 256 characters-- * the caller must first call the function Pre_Compute on a pattern-- to obtain a context variable containing the pre-computed pattern.-- There is no limit to the number of contexts.-- * the caller must handle the exception Pattern_Error that will-- be raised if function Find_Location was unable to find the-- pattern in the given string.-- Suggested improvements to the inner package are:-- * add type Result_T is record Location : Index; Found : Boolean; end record;-- and use it instead of raising Pattern_Error.-- * produce a version that dispenses with the Context and has Find_Location-- perform the Pre_process internally.-- References:http://ww0.java3.datastructures.net/handouts/PatternMatching.pdfprocedure Pattern_Match_Knuth_Morris_Pratt_Fixed_Testis-- You may extract this spec into file pattern_match.adspackage Pattern_Matchis Max_Pattern_Length:constant Positive:= 256;type Contextisprivate;function Pre_Compute(Pattern:in String)return Context;-- precomputes the table of skips for the Pattern.function Find_Location(Of_Context:in Context; In_Text:in String)return Positive; Pattern_Error:exception;-- alternative is return Natural and use 0 to mean not found.privatesubtype Pattern_Length_Tis Positiverange 1..Max_Pattern_Length;type Failure_Function_Tisarray(Pattern_Length_T)of Positive;subtype Slided_Pattern_Tis String(1.. Max_Pattern_Length);type Contextisrecord Failure_Function: Failure_Function_T; M_Pattern: Slided_Pattern_T; Pattern_Length: Positive;endrecord;end Pattern_Match;-- Variables and data for testing. IFPLID_Context: Pattern_Match.Context; SRC_Context: Pattern_Match.Context; Text_Test1:constant String:= "IMCHG DLH5877 -BEGIN ADDR -IFPLID AT05428113 -SRC FPL -RFL F330"; Text_Test2:constant String:= "IMCHG DLH5877 EDDKCLHD -BEGIN ADDR -FAC CFMUTACT AA05428113 FPL -STAR WLD5M -SRC "; IFPLID_Pos: Positive; IFPLID_Pos_2: Positive:= 1; SRC_Pos: Positive; SRC_Pos_2: Positive;-- You may extract this spec into file pattern_match.adbpackagebody Pattern_Matchisfunction Pre_Compute(Pattern:in String)return Contextis I, J: Positive; Pattern_Context: Context;beginif Pattern= ""thenraise Pattern_Error;endif; Pattern_Context.M_Pattern(1..Pattern'Length):= Pattern; Pattern_Context.Pattern_Length:= Pattern'Length; Pattern_Context.Failure_Function(1):= 1; I:= 2; J:= 1;while I<= Pattern_Context.Pattern_Lengthloopif Pattern(I)= Pattern(J)then-- we have matched J + 1 chars. Pattern_Context.Failure_Function(I):= J+ 1; I:= I+ 1; J:= J+ 1;elsif J> 1then-- use failure function to shift Pattern J:= Pattern_Context.Failure_Function(J- 1);else Pattern_Context.Failure_Function(I):= 1; I:= I+ 1;endif;endloop;return Pattern_Context;end Pre_Compute;function Find_Location(Of_Context:in Context; In_Text:in String)return Positiveissubtype Slided_Text_Tis String(1.. In_Text'Length); Slided_Text:constant Slided_Text_T:= Slided_Text_T(In_Text); I, J: Positive;begin I:= 1; J:= 1;while I<= Slided_Text'Lastloopif Slided_Text(I)= Of_Context.M_Pattern(J)thenif J= Of_Context.Pattern_Lengththenreturn I- J+ 1;else I:= I+ 1; J:= J+ 1;endif;elsif J> 1then J:= Of_Context.Failure_Function(J- 1);else I:= I+ 1;endif;endloop;raise Pattern_Error;-- Or change function to return Natural and return 0.end Find_Location;end Pattern_Match;-- You may extract the rest of this file into file pattern_match_test.adb-- and modify accordingly.procedure Check_Pattern_Found(Pattern:in String; At_Location:in Positive; In_Text:in String)issubtype Slided_Text_Tis String(1.. Pattern'Length); Slided_Pattern:constant Slided_Text_T:= Slided_Text_T(Pattern);beginif At_Location> In_Text'Lastorelse At_Location+ Pattern'Length- 1> In_Text'Lastorelse Slided_Text_T(In_Text(At_Location.. At_Location+ Pattern'Length- 1))/= Slided_Patternthen-- We expected Find_Location to return the location of the pattern, as it did not there is a program error.raise Program_Error;endif;end Check_Pattern_Found;begin IFPLID_Context:= Pattern_Match.Pre_Compute("-IFPLID "); SRC_Context:= Pattern_Match.Pre_Compute("-SRC "); Expect_Pattern_Found:begin IFPLID_Pos:= Pattern_Match.Find_Location(Of_Context=> IFPLID_Context, In_Text=> Text_Test1);exceptionwhen Pattern_Match.Pattern_Error=>-- We expected Find_Location to find the pattern, but it did not so there is a program error.raise Program_Error;end Expect_Pattern_Found; Check_Pattern_Found(Pattern=> "-IFPLID ", At_Location=> IFPLID_Pos, In_Text=> Text_Test1); Expect_Pattern_Not_Found:begin IFPLID_Pos_2:= Pattern_Match.Find_Location(Of_Context=> IFPLID_Context, In_Text=> Text_Test2);-- We expected Find_Location to NOT find the pattern, but it did so there is a program error.raise Program_Error;exceptionwhen Pattern_Match.Pattern_Error=>-- We expected Find_Location to NOT find the pattern, and it did not so there is no error.null;end Expect_Pattern_Not_Found;if IFPLID_Pos_2/= 1then-- We expected Find_Location to NOT return a result, so there is a program error.raise Program_Error;endif; Expect_Second_Pattern_Found:begin SRC_Pos:= Pattern_Match.Find_Location(Of_Context=> SRC_Context, In_Text=> Text_Test1);exceptionwhen Pattern_Match.Pattern_Error=>-- We expected Find_Location to find the pattern, but it did not so there is a program error.raise Program_Error;end Expect_Second_Pattern_Found; Check_Pattern_Found(Pattern=> "-SRC ", At_Location=> SRC_Pos, In_Text=> Text_Test1); Expect_Second_Pattern_Found_At_End:begin SRC_Pos_2:= Pattern_Match.Find_Location(Of_Context=> SRC_Context, In_Text=> Text_Test2);exceptionwhen Pattern_Match.Pattern_Error=>-- We expected Find_Location to find the pattern, but it did not so there is a program error.raise Program_Error;end Expect_Second_Pattern_Found_At_End; Check_Pattern_Found(Pattern=> "-SRC ", At_Location=> SRC_Pos_2, In_Text=> Text_Test2);end Pattern_Match_Knuth_Morris_Pratt_Fixed_Test;
