!* Title : XII
!* Version : I
!* Date : 29 June 1984
!* Description: Tests the ability to raise events within a program
!* both in the standard procedures etc and by the user.
Begin
Switch Trap (0 : 15)
Integer Sub
owninteger failures=0
routine pass
printstring("Pass: ")
end
routine fail
printstring("FAIL: ")
failures = failures+1
end
On Event 0, 10, 13, 15 Start
Sub = Event_Sub {Event}
-> Trap (Event_Event)
Trap(10): { Trap an event raised inside a %On block
{ Raised inside local routine 'Eventful'.
If Sub = 116 c
then Print String ("Trapped an event inside an %ON block") c
else Print String ("Error in _Sub Event field for event 10")
New Line
-> Resume2
Trap(15): { Trapping events inside routines.
Print String ("Trapped event inside a ")
If Sub = 115 then Start
Print String ("local routine.")
New Line
If Event_Info{Extra} = 20 then pass else fail
Print String ("Event_Extra field correctly assigned.")
New Line
-> Resume3
Finish else if Sub = 118 then start
Print String ("nested, deeply recursed routine.")
New Line
-> Resume4
Finish
TRAP(*):
Print String("FAIL: Unexpected event")
write(event_event,1); newline
stop
Finish
Routine Test Standard Events
!* This routine forces the standard events to be raised to
!* test their validity.
Label Catch
Integer J
Integer K
Integer C
Integer A
Integer Start = 0
Integer Zero = 0
Integer Minus = -1
Integer Unassigned
String(255) S, T
Switch EN (0 : 100) { Event Number = Event * 10 + Sub
On Event 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 Start
Select Output ({1}0) if K = 90 { Revert back to old stream.
If Event_Event = K // 10 and Event_Sub {Event} = Rem (K, 10) Start
Print String ("Successfully trapped: Event =")
Write (K // 10, 1)
Print String (" Sub =")
Write (Rem (K, 10), 1)
New Line
finish else start
Print String ("Should have trapped: Event =")
Write (K // 10, 1)
Print String (" Sub =")
Write (Rem (K, 10), 1)
New Line
Print String ("Instead trapped: Event =")
Write (Event_Event, 1)
Print String (" Sub =")
Write (Event_Sub {Event}, 1)
New Line
Finish
Start = K + 1
Finish
For K = Start, 1, 100 cycle
write(k,1);newline
-> EN(K)
EN(0): { Normal Termination by the %STOP Instruction.
Stop
-> Catch
EN(11): { Integer Overflow
J = 2147483600 { Two to the power of 32.
C = J * 3
-> Catch
EN(13): { String Overflow.
S = "1234567890"
T = ""
T = T . S for J = 1, 1, 30
-> Catch
EN(14): { Division by zero.
J = Minus // Zero
-> Catch
EN(21): { Store Space Exhausted
Begin
Integer Array Temp (1 : 10000000)
J = 10000000
Temp (J) = 1
End
-> Catch
EN(33): { Failure to open a file.
Open Input (2, "ZZZZZ.ZZZ") { Non-existent?
-> Catch
EN(41): { Non-numeric char for numeric input.
Open Input (2, "Char.dat")
Select Input (2)
Read (J)
-> Catch
EN(51): { Inconsistent combination of values for %For loop.
J = 0
A = 0
For C = 2, 1, J cycle
A = A + 1
Exit if A = 10 { Break an infinite loop.
Repeat
-> Catch
EN(52): { Illegal exponent for exponentiation.
J = -4
C = 2 ^^ J
-> Catch
EN(53): { Upper bound less than lower in array declaration.
J = 20
Begin
Integer Array Temp (40 : J)
J = 35
Temp(J) = 10
End
-> Catch
EN(54): { First index greater than second for SUB STRING.
S = "1234567890"
J = 20
S = Sub String (S, J, 5)
-> Catch
EN(62): { Array index out of bounds.
J = 20
Begin
Integer Array Temp (0 : J)
Temp (J + 5) = 29
End
-> Catch
EN(65): { CHAR NO index out of range 1 to max string length.
S = "1234567890"
J = 20
C = Char No (S, J)
-> Catch
EN(66): { Value out of range for TO STRING.
S = To String (Minus)
-> Catch
EN(67): { Value out of range of OPEN and SELECT.
SELECT INPUT (20)
-> Catch
EN(70): { String Resolution error.
S = "ABCD"
S -> S.("EFGH")
-> Catch
EN(81): { Unassigned variable.
J = Unassigned
-> Catch
EN(90): { End of Input
Open Output (2, "Null.dat")
Select Output (2)
Close Output
Open Input (2, "Null.dat")
Select Input (2)
Read (J)
-> Catch
Catch: Print String ("FAILED to trap: Event =")
Write (K // 10, 1)
Print String (" Sub =")
Write (Rem (K, 10), 1)
New Line
EN(*):
Repeat
End { of Test Standard Events
Routine Eventful (Integer Trap)
!* Tests the trapping of events within a routine block.
!* Does the control fall through the bottom of the %On
!* block? If a trap is not present will control be passed
!* to the parent block?
Integer E = 14
On Event 14 Start
Signal Event 10, 116 if E = 14 and Trap = 1
E = E + 1
Finish
Signal Event 14 if E = 14
Signal Event 15, 115, 20 { Test the _Extra field.
End { of Eventful
!* The following set of routines test various aspects of
!* procedures. Firstly, it checks whether routines nested
!* to depth four can be handled. Then it checks %Routine %Specs
!* and mutual recursion. Finally, at a very deep recursion and
!* level of nesting, the signalling of an event. This severe
!* test checks the possibility of stack corruption and automatic
!* %Return from a great, complex depth.
Routine Spec Inc (Integer D)
Routine Inc2 (Integer D)
Routine Inc3 (Integer D)
Routine Inc4 (Integer D)
Routine Inc5 (Integer D)
If D > 400 then Start
Signal Event 15, 118
Print String ("FAIL: To raise a deep event.")
New Line
Return
Finish
Inc (D+1) { Mutual Recursion.
End { of Inc5
Inc5 (D+1)
End { of Inc4
Inc4 (D+1)
End { of Inc3
Inc3 (D+1)
End { of Inc2
Routine Inc (Integer D)
Inc2 (D+1)
End { of Inc
if cliparam = "" start
Open Output (1, "/tmp/EVENTS.out")
else
print string("Writing to ".cliparam); newline
Open Output (1, cliparam)
finish
Select Output (1)
New Lines (3)
Print String ("Test the Ability to Raise Standard Events"); New Line
Print String ("-----------------------------------------")
New Lines (2)
Test Standard Events
New Lines (2)
Eventful(1)
Resume2: Eventful(0)
Resume3: Inc (1)
Resume4:
Print String ("Returned from a depth correctly.")
New Lines (2)
select output(0)
write(failures,1); printstring(" failure(s)"); newline
End of Program