{ File: [22,311]TSTCPKTAS.PAS     Last edit: 9-MAY-1989 17:54:59 

  History:  Philip Hannay  21-Apr-88.  Created.

}

Program TSTCPKTAS;

%include pas$ext:general.typ;
%include pas$ext:packed.typ;

%include pas$ext:string.pkg;
%include pas$ext:cpktas.ext;

Var
  char_set: packed array [1..16] of packed_decimal;
  asc: packed array [0..80] of char;
  asc1: ch80;
  asc2: packed array [5..35] of char;
  pk: pk6;
  pk1: packed array [1..5] of packed_decimal;
  i: integer;

Begin
Writeln('Begin CPKTAS test');
Writeln;

{ create test packed decimal array "0123456789*+,-./" }
for i:= 1 to 16 do 
  begin
  if i mod 2 = 0
    then char_set[i]:= i-2
    else char_set[i]:= i;
  end;

writeln('First testing with type0 output string');
writeln;

writeln('Write out packed character set using conversion');

sclear(asc);
cpktas(char_set,asc,0);
write('using pos=0: "');
swrite(output,asc);
writeln('"');
writeln(' (should have been 16 chars "0123456789*+,-./")');
writeln;

sassign(asc,'==============================');
cpktas(char_set,asc,5);
write('using pos=5: "');
swrite(output,asc);
writeln('"');
writeln(' (should have been "====0123456789*+,-./==========")');
writeln;

sassign(asc,'==============================');
cpktas(char_set,asc,-25);
write('using pos=-25: "');
swrite(output,asc);
writeln('"');
writeln(' (should have been "=========0123456789*+,-./=====")');
writeln;

sassign(asc,'==========');
cpktas(char_set,asc,0);
write('using pos=0: "');
swrite(output,asc);
writeln('"');
writeln(' (should have been "==========0123456789*+,-./")');
writeln;

writeln(' Next some truncations, still type0 output string');
writeln;

sassign(asc,'==========');
cpktas(char_set,asc,5);
write('using pos=5: "');
swrite(output,asc);
writeln('"');
writeln(' (should have been "====012345")');
writeln;

sassign(asc,'==========');
cpktas(char_set,asc,-22);
write('using pos=-22: "');
swrite(output,asc);
writeln('"');
writeln(' (should have been "======0123")');
writeln;

writeln(' Next some errors, still type0 output string');
writeln;

sassign(asc,'==========');
cpktas(char_set,asc,20);
write('using pos=20: "');
swrite(output,asc);
writeln('"');
writeln(' (should have been warning -1, and "==========")');
writeln;

sassign(asc,'==========');
cpktas(char_set,asc,-40);
write('using pos=-40: "');
swrite(output,asc);
writeln('"');
writeln(' (should have been warning -1, and "==========")');
writeln;

sassign(asc,'==========');
cpktas(char_set,asc,-5);
write('using pos=-5: "');
swrite(output,asc);
writeln('"');
writeln(' (should have been warning -1, and "==========")');
writeln;

{ create odd numbered Packed_decimal array - not valid }
pk[2]:=0;
pk[1]:=1;
pk[4]:=2;
pk[3]:=3;
pk[5]:=5;
sassign(asc,'==========');
cpktas(pk1,asc,2);
write('using pos=2: "');
swrite(output,asc);
writeln('"');
writeln(' (should have been warning -2, and "==========")');
writeln;

writeln;
writeln(' Now with a type1 output string...');
writeln;

writeln('Write out packed character set using conversion');

sclear(asc1);
cpktas(char_set,asc1,0);
write('using pos=0: "');
swrite(output,asc1);
writeln('"');
writeln(' (should have been 16 chars "0123456789*+,-./")');
writeln;

sassign(asc1,'==============================');
cpktas(char_set,asc1,5);
write('using pos=5: "');
swrite(output,asc1);
writeln('"');
writeln(' (should have been "====0123456789*+,-./==========")');
writeln;

sassign(asc1,'==============================');
cpktas(char_set,asc1,-25);
write('using pos=-25: "');
swrite(output,asc1);
writeln('"');
writeln(' (should have been "=========0123456789*+,-./=====")');
writeln;

sassign(asc1,'==========');
cpktas(char_set,asc1,0);
write('using pos=0: "');
swrite(output,asc1);
writeln('"');
writeln(' (should have been "==========0123456789*+,-./")');
writeln;

writeln(' Next some truncations, still type1 output string');
writeln;

sassign(asc1,'==========');
cpktas(char_set,asc1,5);
write('using pos=5: "');
swrite(output,asc1);
writeln('"');
writeln(' (should have been "====012345")');
writeln;

sassign(asc1,'==========');
cpktas(char_set,asc1,-22);
write('using pos=-22: "');
swrite(output,asc1);
writeln('"');
writeln(' (should have been "======0123")');
writeln;

writeln(' Next some errors, still type1 output string');
writeln;

sassign(asc1,'==========');
cpktas(char_set,asc1,20);
write('using pos=20: "');
swrite(output,asc1);
writeln('"');
writeln(' (should have been warning -1, and "==========")');
writeln;

sassign(asc1,'==========');
cpktas(char_set,asc1,-40);
write('using pos=-40: "');
swrite(output,asc1);
writeln('"');
writeln(' (should have been warning -1, and "==========")');
writeln;

sassign(asc1,'==========');
cpktas(char_set,asc1,-5);
write('using pos=-5: "');
swrite(output,asc1);
writeln('"');
writeln(' (should have been warning -1, and "==========")');
writeln;

writeln;
writeln('And finally, a non type0 or type1 string');
writeln;

for i:= 5 to 35 do asc2[i]:= '=';
cpktas(char_set,asc2,-5);
write('using pos=5: "');
for i:= 5 to 35 do write(asc2[i]);
writeln('"');
writeln(' (should have been SLEN warning -1, and unpredicable results)');
writeln;

writeln;
writeln('Now test with smaller character set "22.583"');
writeln;

pk[2]:= 2;
pk[1]:= 2;
pk[4]:= 14;
pk[3]:= 5;
pk[6]:= 8;
pk[5]:= 3;

sclear(asc);
cpktas(pk,asc,0);
write('using pos=0: "');
swrite(output,asc);
writeln('"');
writeln(' (should have been 6 chars "22.583")');
writeln;

sassign(asc,'==============================');
cpktas(pk,asc,5);
write('using pos=5: "');
swrite(output,asc);
writeln('"');
writeln(' (should have been "====22.583====================")');
writeln;

sassign(asc,'==============================');
cpktas(pk,asc,-25);
write('using pos=-25: "');
swrite(output,asc);
writeln('"');
writeln(' (should have been "===================22.583=====")');
writeln;

sassign(asc,'==========');
cpktas(pk,asc,0);
write('using pos=0: "');
swrite(output,asc);
writeln('"');
writeln(' (should have been "==========22.583")');
writeln;

writeln;
writeln('Done with test');
writeln;
end.