Return to t6.6.3.4-2.p CVS log

Up to [CSRG BSD Unix] / 43BSDTahoe / ucb / pascal / tstpx / src

Annotation of 43BSDTahoe/ucb/pascal/tstpx/src/t6.6.3.4-2.p, revision 1.1.1.1

1.1       root        1: {TEST 6.6.3.4-2, CLASS=CONFORMANCE}
                      2: 
                      3: { This program tests that the environment of procedure
                      4:   parameters is as stated in the Pascal Standard.
                      5:   The compiler fails if the program does not compile, or
                      6:   the program states that this is so. }
                      7: 
                      8: program t6p6p3p4d2(output);
                      9: var
                     10:    globalone, globaltwo : integer;
                     11: procedure p(procedure f(procedure a; procedure b);procedure g);
                     12:    var
                     13:       localtop : integer;
                     14:    procedure r;
                     15:       begin
                     16:          if globalone=1 then
                     17:          begin
                     18:             if (globaltwo<>2) or (localtop<>1) then
                     19:                writeln(' FAIL1...6.6.3.4-2')
                     20:          end
                     21:          else
                     22:             if globalone=2 then
                     23:             begin
                     24:                if (globaltwo<>2) or (localtop<>2) then
                     25:                   writeln(' FAIL2...6.6.3.4-2')
                     26:                else
                     27:                   writeln(' PASS...6.6.3.4-2')
                     28:             end
                     29:             else
                     30:                writeln(' FAIL3...6.6.3.4-2');
                     31:          globalone:=globalone+1;
                     32:       end;     { of r }
                     33:    begin    { of p }
                     34:       globaltwo:=globaltwo+1;
                     35:       localtop:=globaltwo;
                     36:       if globaltwo=1 then
                     37:          p(f,r)
                     38:       else
                     39:          f(g,r)
                     40:    end;     { of p }
                     41: procedure q(procedure f; procedure g);
                     42:    begin
                     43:       f;
                     44:       g
                     45:    end;
                     46: procedure dummy;
                     47: begin
                     48:    writeln(' FAIL4...6.6.3.4-2')
                     49: end;
                     50: 
                     51: begin
                     52:    globalone:=1;
                     53:    globaltwo:=0;
                     54:    p(q,dummy)
                     55: end.

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.