program tsttrunc; %include 'ex:[22,320]string.pkg'; type typ1 = packed array [1..15] of char; typ0 = packed array [0..15] of char; ch3 = packed array [1..3] of char; var typ1string,string : typ1; typ0string : typ0; end_check : ch3; len,i : integer; begin writeln; writeln; writeln('begin type1 test of Strunc.'); writeln; repeat write('enter a string with trailing blanks : '); Sclear(typ1string); Sread(INPUT,typ1string); for i := 1 to 3 do end_check[i] := typ1string[i]; if (end_check <> 'end') and (end_check <> 'END') then begin write('"',typ1string,'", truncated, is "'); Strunc(typ1string); write(typ1string,'"'); writeln; end else writeln('end of type1 test of Strunc.'); until (end_check = 'end') or (end_check = 'END'); writeln; writeln('begin type0 test of Strunc.'); writeln; repeat write('enter a string with trailing blanks : '); Sclear(typ0string); Sclear(string); Sread(INPUT,typ0string); len := Slen(typ0string); for i := 1 to len do string[i] := typ0string[i]; for i := 1 to 3 do end_check[i] := typ0string[i]; if (end_check <> 'end') and (end_check <> 'END') then begin write('"',string,'", truncated, is "'); Strunc(typ0string); Sclear(string); len := Slen(typ0string); for i:= 1 to len do string[i] := typ0string[i]; write(string,'"'); writeln; end else writeln('end of type0 test of Strunc.'); until (end_check = 'end') or (end_check = 'END'); writeln; writeln('end of Strunc test.'); end.