Test suite results for test file webtbs/tw0754.pp

Test run data :

Free Pascal Compiler Test Suite Results

View Test suite results

Please specify search criteria:
File:
Operating system:
Processor:
Version
Date
Submitter
Machine
Comment
Limit
Cond
Category
Only failed tests
Hide skipped tests
List all tests

Test file "webtbs/tw0754.pp" information:

t_id 685
t_adddate 2003/10/03
t_result 0
t_knownrunerror 0

Detailed test run results:

Record count: 50

Total = 50

OK=50 Percentage= 100.00

Result type Cat. Count Percentage First date Last Date
Successfully run 50 100.0 2024/05/21 01:22:00 34 2024/05/21 02:32:00 35
i386 14 28.0 2024/05/21 01:22:00 34 2024/05/21 02:32:00 27
x86_64 33 66.0 2024/05/21 01:33:00 15 2024/05/21 02:32:00 35
aarch64 3 6.0 2024/05/21 01:42:00 32 2024/05/21 02:25:00 0
linux 49 98.0 2024/05/21 01:22:00 34 2024/05/21 02:32:00 35
win32 1 2.0 2024/05/21 02:04:00 34 2024/05/21 02:04:00 34
3.3.1 28 56.0 2024/05/21 01:33:00 15 2024/05/21 02:32:00 27
3.2.3 22 44.0 2024/05/21 01:22:00 34 2024/05/21 02:32:00 35

Source:

program test_open_files;

const
   MaxOpenTest = 150;

var
   f : array [1..MaxOpenTest] of text;
   i,count : longint;
   error : word;
   s : string;
   storeexit : pointer;
   Max : longint;

procedure Errorexit;
begin
  exitproc:=storeexit;
  if errorcode=4 then
    begin
       if count<=15 then
         begin
           Writeln('The program could not open more than 15 files !');
           Writeln('Retry after addition of the following line to config.sys file');
           Writeln('FILES=60');
           Writeln('If it still does not work after this change');
           Writeln('you probably use a too old RTL version');
           Writeln('that does not support more than 15 files');
           Writeln('open at the same time');
         end
       else
         begin
           Writeln('The program was able to open ',count,' files simultaneously');
           Writeln('If you need to be able to have more opened files');
           Writeln('Try to increase the FILES=XX value in config.sys file');
           { This is not a RTL error anymore
             as we increased the size over the ordinary 15 limit }
           erroraddr:=nil;
           errorcode:=0;
           exitcode:=0;
         end;
       { close all left open files }
       for i:=count downto 1 do
         begin
           close(f[i]);
           erase(f[i]);
         end;
    end;
end;

begin
  StoreExit:=exitproc;
  ExitProc:=@ErrorExit;
  Max:=MaxOpenTest;
  if paramcount>0 then
    begin
      val(paramstr(1),count,error);
      if error = 0 then
        Max:=count;
      count:=0;
    end;

  for i:=1 to Max do
    begin
      str(i,s);
      s:='file'+s+'.tmp';
      assign(f[i],s);
      rewrite(f[i]);
      count:=i;
      Writeln(f[i],'This is file ',i);
      Writeln(i,' files open');
      { no closing so they are finally all open }
    end;

  for i:=Max downto 1 do
    begin
      close(f[i]);
      erase(f[i]);
    end;
end.

Link to SVN view of webtbs/tw0754.pp source.