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=48 Percentage= 96.00

Result type Cat. Count Percentage First date Last Date
Failed to run 2 4.0 2024/10/19 09:39:00 55 2024/10/19 10:27:00 65
i386 2 100.0 2024/10/19 09:39:00 55 2024/10/19 10:27:00 65
go32v2 2 100.0 2024/10/19 09:39:00 55 2024/10/19 10:27:00 65
3.3.1 2 100.0 2024/10/19 09:39:00 55 2024/10/19 10:27:00 65
Successfully run 48 96.0 2024/10/19 07:29:00 50 2024/10/19 13:36:00 24
i386 1 2.1 2024/10/19 10:08:00 202 2024/10/19 10:08:00 202
m68k 3 6.3 2024/10/19 07:29:00 50 2024/10/19 10:22:00 40
sparc 3 6.3 2024/10/19 08:05:00 45 2024/10/19 11:16:00 40
powerpc 7 14.6 2024/10/19 08:40:00 51 2024/10/19 13:26:00 65
arm 2 4.2 2024/10/19 09:36:00 32 2024/10/19 10:03:00 32
x86_64 12 25.0 2024/10/19 08:27:00 30 2024/10/19 13:36:00 24
powerpc64 9 18.8 2024/10/19 08:43:00 65 2024/10/19 10:59:00 68
mips 1 2.1 2024/10/19 10:28:00 38 2024/10/19 10:28:00 38
mipsel 1 2.1 2024/10/19 10:35:00 142 2024/10/19 10:35:00 142
aarch64 4 8.3 2024/10/19 08:15:00 27 2024/10/19 09:57:00 26
sparc64 2 4.2 2024/10/19 09:25:00 118 2024/10/19 11:33:00 117
riscv64 2 4.2 2024/10/19 10:25:00 33 2024/10/19 11:10:00 26
loongarch64 1 2.1 2024/10/19 10:17:00 30 2024/10/19 10:17:00 30
linux 32 66.7 2024/10/19 07:29:00 50 2024/10/19 11:38:00 25
solaris 8 16.7 2024/10/19 13:22:00 24 2024/10/19 13:36:00 24
aix 8 16.7 2024/10/19 08:40:00 51 2024/10/19 13:26:00 65
3.3.1 28 58.3 2024/10/19 08:05:00 45 2024/10/19 13:26:00 65
3.2.3 20 41.7 2024/10/19 07:29:00 50 2024/10/19 13:36:00 24

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.