-- FB20A00.A -- -- Grant of Unlimited Rights -- -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained -- unlimited rights in the software and documentation contained herein. -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making -- this public release, the Government intends to confer upon all -- recipients unlimited rights equal to those held by the Government. -- These rights include rights to use, duplicate, release or disclose the -- released technical data and computer software in whole or in part, in -- any manner and for any purpose whatsoever, and to have or permit others -- to do so. -- -- DISCLAIMER -- -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A -- PARTICULAR PURPOSE OF SAID MATERIAL. --* -- -- FOUNDATION DESCRIPTION: -- This test performs a search for the first instance of a specified -- substring within a specified string, returning boolean result. -- (Case insensitive analysis) Both the string and the substring are -- made upper case. Successive slices are taken from the input string -- and compared with the substring. If a match is found, the search is -- terminated immediately. The search continues until the last index -- position from which a substring-length slice can be constructed is -- passed. -- -- CHANGE HISTORY: -- 06 Dec 94 SAIC ACVC 2.0 -- --! package FB20A00 is function Find ( Str : in String ; Sub : in String ) return Boolean; end FB20A00; --=================================================================-- package body FB20A00 is function Find ( Str : in String ; Sub : in String ) return Boolean is New_Str : String (Str'First .. Str'Last); New_Sub : String (Sub'First .. Sub'Last); Pos : Integer := Str'First ; -- Character index. function Upper_Case (Str : in String) return String is subtype Upper is Character range 'A' .. 'Z' ; subtype Lower is Character range 'a' .. 'z' ; Ret : String (Str'First .. Str'Last) ; Pos : Integer; begin for I in Str'Range loop if ( Str (I) in Lower ) then Pos := Upper'Pos (Upper'First) + ( Lower'Pos (Str(I)) - Lower'Pos(Lower'First) ) ; Ret (I) := Upper'Val (Pos) ; else Ret (I) := Str (I); end if ; end loop ; return (Ret) ; end Upper_Case; begin New_Str := Upper_Case (Str); -- Convert Str and Sub to upper New_Sub := Upper_Case (Sub); -- case for comparison. while ( Pos <= New_Str'Last-New_Sub'Length+1 ) -- Search until no more and then -- sub-string-length ( New_Str ( Pos .. Pos+New_Sub'Length-1 ) /= New_Sub ) -- slices -- remain. loop Pos := Pos + 1 ; end loop ; if ( Pos > New_Str'Last-New_Sub'Length+1 ) then -- Substring not found. return (False); else return (True); end if ; end Find; end FB20A00;