$sysprog$
{ test file types on HFS }

{
for each type
  make base file
  for each other type
    read type, write other type
    compare files
    delete other type
}

program xxx(input, output);

type
    string40 = string[40];
    names_type = array[1..4] of string40;

var
    max_len, file_lines: integer;
    names: names_type;
    i, j: integer;
    f: text;
    
    
procedure init;
begin
    write('number of lines in file? (suggest 3000) ');
    readln(file_lines);
    write('max length of each line? (suggest 100) ');
    readln(max_len);
    names[1] := 'BASENAME.TEXT';
    names[2] := 'BASENAME.ASC';
    names[3] := 'BASENAME.UX';
    names[4] := 'BASENAME';
end;

procedure make_base_file(name: string40);
const
    alphstr = 'dsfljasdflkdhflkdshflkadsfhadsjfhadsfhadsfjhadslf';
var
    f: text;
    line, line_len: integer;
    chars: string[255];
    i: integer;
begin
    writeln('make new base file ', name);
    rewrite(f, name);
    for line := 1 to file_lines do begin
        line_len := line mod max_len;
        setstrlen(chars, line_len);
        for i := 1 to line_len do
            chars[i] := alphstr[(i mod strlen(alphstr)) + 1];
        writeln(f, chars);
    end;
    close(f, 'save');
end;

procedure read_write(inname, outname: string40);
var
    inf, outf: text;
    linebuf: string[255];
begin
    writeln('copy ', inname, ' to ', outname);
    reset(inf, inname);
    rewrite(outf, outname);
    while not eof(inf) do begin
        readln(inf, linebuf);
        writeln(outf, linebuf);
    end;
    close(inf);
    close(outf, 'save');
end;

procedure compare(name1, name2: string40);
var
    file1, file2: text;
    buf1, buf2: string[255];
begin
    writeln('compare ', name1, ' and ', name2);
    reset(file1, name1);
    reset(file2, name2);
    while not eof(file1) do begin
        readln(file1, buf1);
        readln(file2, buf2);
        if buf1 <> buf2 then begin
            writeln('ERROR: FILES DIFFER -- ', name1, ' vs ', name2);
            escape(0);
        end;
    end;
    if not eof(file2) then begin
        writeln('ERROR: FILE TOO SHORT -- ', name2);
        escape(0);
    end;
end;

procedure delete(name: string40);
var
    f: text;
begin
    reset(f, name);
    close(f, 'purge');
end;

begin
    init;
    for i := 1 to 4 do begin
        make_base_file(names[i]);
        {for j := 1 to 4 do if i <> j then begin}
        for j := i+1 to 4 do begin
            read_write(names[i], names[j]);
            compare(names[i], names[j]);
            delete(names[j]);
        end;
        delete(names[i]);
    end;
    writeln('TTYPE complete -- no errors');
end.



