--****************************************************************************** -- -- Package ALEX is a collection of miscellaneous utility routines. -- --****************************************************************************** with TEXT_IO ; use TEXT_IO ; with ARG ; package ALEX is procedure COPY_STRING (SOURCE: in STRING ; DESTINATION: out STRING) ; function LOCATE (C: in CHARACTER ; STR: in STRING) return INTEGER ; function TRIM (INPUT_STRING: in STRING) return STRING ; function EQUAL (A: in STRING ; B: in STRING) return BOOLEAN ; end ALEX ; package body ALEX is --****************************************************************************** -- -- Procedure COPY_STRING copies a source string into a destination string. -- If the source string is shorter than the destination string, trailing -- blanks are filled in. If the source string is longer than the destination -- string, the source string is truncated. -- --****************************************************************************** procedure COPY_STRING (SOURCE: in STRING; DESTINATION: out STRING) is FIRST, LAST, REST : POSITIVE ; begin if (SOURCE'LENGTH < DESTINATION'LENGTH) then FIRST := DESTINATION'FIRST ; REST := FIRST + SOURCE'LENGTH ; DESTINATION(FIRST..(REST-1)) := SOURCE ; for I in (REST .. DESTINATION'LENGTH) loop DESTINATION(I) := ' ' ; -- Trailing blanks in destination. end loop ; else FIRST := SOURCE'FIRST ; -- Truncate source string. LAST := FIRST + DESTINATION'LENGTH - 1 ; DESTINATION := SOURCE(FIRST..LAST) ; end if ; end COPY_STRING ; --****************************************************************************** -- -- Function LOCATE locates a character in a string and returns its position. -- --****************************************************************************** function LOCATE (C: in CHARACTER ; STR: in STRING) return INTEGER is begin for I in STR'RANGE loop if (STR(I) = C) then return I ; end if ; end loop ; return 0 ; -- Not found. end ; --****************************************************************************** -- -- Function TRIM returns its input string, with trailing blanks removed. -- --****************************************************************************** function TRIM (INPUT_STRING: in STRING) return STRING is FIRST, LAST : POSITIVE ; begin if (INPUT_STRING = "") then return "" ; -- Null input string. end if ; FIRST := INPUT_STRING'FIRST ; LAST := INPUT_STRING'LAST ; for I in reverse INPUT_STRING'RANGE loop LAST := I ; exit when (INPUT_STRING(I) /= ' ') ; end loop ; if (INPUT_STRING(LAST) = ' ') then return "" ; -- Null string. else return INPUT_STRING(FIRST..LAST) ; -- Normal string. end if ; end TRIM ; --****************************************************************************** -- -- Function EQUAL compares two strings and returns TRUE if they're equal -- and FALSE otherwise. The strings can be of differing length and trailing -- blanks are ignored. -- --****************************************************************************** function EQUAL (A: in STRING ; B: in STRING) return BOOLEAN is begin if ((TRIM(A)'LENGTH = TRIM(B)'LENGTH) and then (A = B)) then return TRUE ; else return FALSE ; end if ; end EQUAL ; end ALEX ;