C****************************************************************************) C ) C Main Test Program for Syslib Test Routines ) C ) C----------------------------------------------------------------------------) C ) C Program : Library Test/ LibTst.For ) C Purpose : To test the system library functions ) C Language : Fortran 77 ) C Date : June 1986 ) C Author : John Malcolmson ) C ) C----------------------------------------------------------------------------) C ) C Notes : ) C o. None of the programs in this package should ever be ) C compiled with bounds checking turned on. ) C o. The logical BIN must be assigned for the test package ) C to work. ) C o. Once the files have been loaded and built only the .SAV, ) C .TST, and .COM files in the BIN directory are ) C required if only running the package is desired. ) C o. If space is a concern and relinking the package with ) C other SYSLIBs is desired, then the entire BIN ) C directory and the .COM and TSTLIB.OBJ from LIB are ) C all that is really needed. ) C o. The following devices are expected to be on the system: ) C NL, LD, DU ) C o. DU is expected to be the system device. ) C o. The partitioning for the DU device is expected to be as ) C follows: ) C DU4 - Second to last partition. ) C DU5 - Last partition, which must not contain any ) C files. The test program writes in the space ) C without regard to the file structure. ) C o. The SJ monitor must have timer support to function. ) C However, SJ is not recommended as a test base. ) C o. Support is provided for the future VBGEXE with chain ) C ability. The actual code is commented out, but the ) C data structure that is passed in the chain area takes) C this chaining method into account. It will be ) C required to run on the PRO series systems. ) C ) C**************************************************************************** C****************************************************************************) C ) C Description of Program Structure: ) C ) C The test package is broken down into 3 layers. One the top ) C layer we find the LibTst program itself. This program's job ) C is to maintain a list of the vaild test classes and ) C coordinate test sequences on them. The actual handling of ) C a class itself is done on the second level by the T'filename') C Type files which are the test controllers. These files ) C maintain a list of the current syslib function which fall ) C under that catagory and make the calls to the appropriate ) C test routines. The test routines fall onto the third layer. ) C Here they are generally broken down by class, but this is ) C not neccesary because the routines are kept in a general ) C library of test-routines for the purpose of easy linking ) C when creating a test package on a new system. ) C Thus the layers look like this: ) C ) C ) C +-----------------------+ ) C | | ) C | LibTst.Sav | ) C | Main Controller | ) C | | ) C +-----------------------+ ) C / /\ \ ) C / / \ \ ) C / / \ \ ) C / / \ \ ) C +--------------+ / \ +--------------+ ) C | | / \ | | ) C | Test | | | | | | | | | | | | Test | ) C | Controller | | | | | | | | | | | | Controller | ) C | | | | ) C +--------------+ +--------------+ ) C || || ) C +=====================================+ ) C ||| ) C +=======================+ ) C | | ) C | TstLib.Obj | ) C | Test Library | ) C | | ) C +=======================+ ) C ) C ) C ) C ) C**************************************************************************** C****************************************************************************) C ) C Adding new tests: ) C ) C The easiest way to add a new test is to include it within an ) C already existing Test Class. To do this one needs to write ) C the new routine following the same pattern as the others. ) C (This is to assure desired operation & performance) Then add ) C the test routine to the Test Library, and extend the list ) C of calls in Test Controller to now include the new test. ) C When this has been accomplished, add the name of the routine ) C into the command file link-line for that test controller. ) C Now everything should be ready to recompile and relink ) C that Test Controller and the job is done. ) C ) C To add a new Test Class however is a little bit more difficult. ) C First one needs to construct the test routines for the ) C library. (Observing the above caution.) Then one needs to ) C construct a complete test controller following the pattern ) C of the other controllers exactly. Then Libtst itself must ) C be updated to so that it is aware of the new routine. ) C This involves updating its Class info tables and ) C incrementing the MaxCls variable appropriatly. ) C Once this has been done, then a new link-line command file ) C needs to be constructed that will link the test controller ) C together issuing the correct overlaying directives. ) C ) C Either of the above should guide one on the path to modifying ) C the test package. One should take care however, because ) C the interface between the different modules is rather ) C fragile and a tad complicated at first glance and so great ) C care should be taken to preserve it when making additions ) C or adjustments. Any problems with the inter-program ) C interface could lead to loss of data, inaccurate reporting, ) C or in the worst case, destruction of files. ) C ) C****************************************************************************) C****************************************************************************) C ) C Description of the Class status array: ) C ) C 1. -9, -8 : 8 Bytes defining VBG chaining under XM. ) C 2. -7,-6,-5,-4 : 14 Bytes containing the output destination.) C 3. -3 : Contains the output control codes. ) C 4. -2 : Query on return & starting class number. ) C 5. -1 : Contains the termination class or 0. ) C 6. 0 : Contains the current class. ) C 7. 1-17 : Class status codes. (4 free classes) ) C 8. 18 : Always an Integer*4 -1. Paranoid Words. ) C ) C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -) C ) C 1. These 8 bytes are the radix 50 encoded filename of the ) C program to be chained to. This is for vbgexe chain support. ) C When using the vbgexe chain support, the first 8 bytes of ) C of the chain area must be sacraficed for this purpose. ) C However, vbgexe recognizes that it was chained to and when ) C an Rchain is performed the job reads the data as though the ) C the radix 50 filename was never there. This makes using ) C the vbgexe chain option transparent to the chained to file. ) C ) C 2. This is a standard fortran ascii string stored in this ) C part of the array as bytes. This string contains the output ) C destination of the test. It may be either a device or a file) C If it is a file and no device was specified for it then the ) C device BIN is assumed. If this specification turns out to be) C for an unknown device then the device DK: is assumed and the ) C file specification will be FOR003.DAT. The append and Paging) C options may not be correctly set for a file if some type of ) C printing device was intended, so care should be taken. ) C ) C 3. This contains the controls codes which are used to specify ) C the attributes of the output. It is here that the flags are ) C stored as well as the page number of the last completed page.) C ) C 4. This contains the number of the class that the output is to ) C start at. If this value should be negative then it signifies) C that the "Press enter to continue" query will be displayed ) C following the return to LibTst. ) C ) C 5. This contains the class at which proccessing is to stop. ) C If the all parameter was specified then this location will ) C be zero. ) C ) C 6. This location contains the counter which indicates to the ) C the libtst program which class to call next. It is also ) C compared with the ending class in order to determine when to ) C stop. ) C ) C 7. These are the status codes returned from the Report procedure) C The report procedure breaks down the binary coded test ) C results and prints a report, then it sends back a packed ) C integer containing the number of system service calls that ) C failed in each class as well as a number indicating the ) C amount of passes that were failed for that class. ) C There are four free classes for future expansion. ) C ) C 8. This is word with all bits set. It is tested after each ) C chain operation to ensure that no data was lost. ) C Since the chain area is in the way of the stack, it is ) C possible that the stack could crush the chain area, thus ) C it is important to ensure one knows when that happens. ) C ) C ) C**************************************************************************** PROGRAM LibraryTest C-------------------------- Variable Declarations ---------------------------) Integer*4 MaxCls Character*30 ClsLabl( 17 ), labl, action Character*12 ClsFiln( 17 ) Character*65 OutStr Integer*4 ClsStat(-9:18) Integer*2 Flag, Ichan, Dev, i, formt(3) Integer*2 Stts(4) Real*8 Spec, VSpec Logical*2 Error Equivalence (VSpec, ClsStat(-9)) C---------------------------------------------------------------------------- C||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||) C|||||||||||||||||||||||||||||| Main Code |||||||||||||||||||||||||||||||||||) C||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||) C BEGIN C----------------------------------------------------------------------------) C The filenames and descriptions of the classes are ) C loaded into the tables here. ) C----------------------------------------------------------------------------) ClsLabl(01) = 'Arithmetic Sprt\' ClsFiln(01) = 'BINTARITHSAV' ClsLabl(02) = 'Charactr String\' ClsFiln(02) = 'BINTSTRNGSAV' ClsLabl(03) = 'Channel Support\' ClsFiln(03) = 'BINTCHANOSAV' ClsLabl(04) = 'Data Transfer \' ClsFiln(04) = 'BINTDATATSAV' ClsLabl(05) = 'Device Specfctn\' ClsFiln(05) = 'BINTDEVISSAV' ClsLabl(06) = 'File Support \' ClsFiln(06) = 'BINTFILEOSAV' ClsLabl(07) = 'Graphics Supprt\' Clsfiln(07) = 'BINIGIDISSAV' ClsLabl(08) = 'Miscellaneous \' ClsFiln(08) = 'BINTMISC SAV' ClsLabl(09) = 'MultiTerminal \' ClsFiln(09) = 'BINTMTERMSAV' ClsLabl(10) = 'Radix-50 Supprt\' ClsFiln(10) = 'BINTRADIXSAV' ClsLabl(11) = 'RT-11 Services \' ClsFiln(11) = 'BINTRT11 SAV' ClsLabl(12) = 'Timer Support \' ClsFiln(12) = 'BINTTIMERSAV' ClsLabl(13) = 'Not Implemented\' ClsFiln(13) = 'BINT ' ClsLabl(14) = 'Not Implemented\' ClsFiln(14) = 'BINT ' ClsLabl(15) = 'Not Implemented\' ClsFiln(15) = 'BINT ' ClsLabl(16) = 'Date Support \' ! Added Aug. 17, 1988 ClsFiln(16) = 'BINTDATESSAV' ! Added Aug. 17, 1988 ClsLabl(17) = 'User Intractive\' ClsFiln(17) = 'BINTUSERISAV' MaxCls = 12 ! Left out User ! Interactive and Date ! Support Classes. ! Both require inter- ! action at the term. C----------------------------------------------------------------------------) C MaxCls determines where the ALL command stops executing. ) C Since 'User Interactive' class requires attention at the ) C console terminal at the very least, it was left out of the ) C ALL command. However, if it is specified as the end of a ) C range then it will in fact be executed. ) C For those who missed it, this is a feature. ^ ) C----------------------------------------------------------------------------) Call Rchain( Flag, ClsStat(-7), 52 ) Call OpenOutput( 'TT:', .FALSE. ) 10 IF (flag .ge. 0) THEN IF (flag .eq. 0) THEN Call CheckC( Error, action ) IF ( Error .eq. .TRUE. ) THEN IF (action(1:1).ne.'N') THEN c Call Setcmd( Action ) write (5, 1001) action 1001 format(' ?LIBTST-F-Program recommends "',A,'"') c c call EXIT END IF Call CloseOutput Goto 9999 END IF DO 15 i = 1, 18 ClsStat(i) = -1 15 Continue ELSE IF (ClsStat(18) .ne. -1) Goto 999 END IF IF ((flag .eq. 1).and.(ClsStat(-2) .gt. 0)) THEN c c write(5,222) flag, ClsStat(-2), ClsStat(0) c222 format(' Flag =',I2,' ClsStat(-2) =',I4,' ClsStat(0) =',I4) Call Query('Press to continue \') END IF Call Startup( ClsStat ) c c write(5,223) ClsStat(0), ClsStat(-1), ClsStat(18) c223 format(' ClsStat(0) =',I4,' ClsStat(-1) =',I4,' ClsStat(18) =',I4) c c IF (ClsStat(0) .eq. 0) THEN Call Cls Goto 9999 END IF IF (ABS(ClsStat(0)) .eq. 19) THEN ClsStat(-2) = ClsStat(-2)/ABS(ClsStat(-2)) ClsStat(-1) = MaxCls ClsStat(0) = MaxCls Call Summary( ClsStat, ClsLabl, 17 ) Flag = 1 Goto 10 END IF IF (ABS(ClsStat(0)) .eq. 20) THEN Call Help Flag = 1 Goto 10 END IF IF (ClsStat(-1) .eq. 0) ClsStat(-1) = MaxCls ELSE IF (ClsStat(18) .ne. -1) Goto 999 IF (ClsStat(0) .lt. 0) THEN Flag = 1 Goto 10 END IF ClsStat(0) = ClsStat(0) + 1 IF (ClsStat(0) .gt. ClsStat(-1)) THEN Call Summary( ClsStat, ClsLabl, 17 ) Flag = 1 Goto 10 END IF END IF i = ABS(ClsStat(0)) IF (ClsFiln(i)(12:12) .eq. ' ') THEN Flag = -1 Goto 10 END IF CALL IRAD50( 12, ClsFiln(i), Spec ) 200 Ichan = IgetC() IF (Ichan .lt. 0) Goto 200 Call Closec( Ichan ) IF (Lookup( Ichan, Spec ) .lt. 1) THEN ClsStat(i) = -1 Labl = ClsLabl(i) Call Concat('The ',Labl,OutStr,19) Call Concat(OutStr,' Test Controller is not available\',OutStr,53) IF (ClsStat(-2) .lt. 0 ) THEN Call WriteString( OutStr, 0, 0 ) ELSE Call CenterString( OutStr ) Call WriteLn END IF Call WriteLn Call Closec( Ichan ) Call Ifreec( Ichan ) flag = -1 Goto 10 END IF Call Closec( Ichan ) Call Ifreec( Ichan ) Labl = ClsLabl(i) Call Concat('Processing the ',Labl,OutStr,30) Call Concat(OutStr,' Test Controller\',OutStr,47) IF (ClsStat(-2) .lt. 0) THEN Call WriteString( OutStr, 0, 0 ) Call WriteLn END IF Call CloseOutput IF (i .eq. 11) THEN Call Irad50( 2, 'NL', dev ) Call Idstat( dev, stts ) formt(1) = stts(3)+6 formt(2) = '260'O formt(3) = 0 Call Device( formt ) END IF IF (IIAND(Ispy('300'O),2**12) .ne. 2**12) THEN C C The code bellow is for activating the vbgexe with C chaining support in conjunction with the package. C Remove the uncommented line and insert the commented C ones. This will need to be caried out in other C T class files. TEND.FOR, to begin with and then others C C VSpec = Spec C Call Irad50( 12, 'SY VBGCHNSAV', Spec ) C Call Chain( Spec, ClsStat, 56 ) Call Chain( Spec, ClsStat(-7), 52 ) ELSE Call Chain( Spec, ClsStat(-7), 52 ) END IF Goto 9999 999 DO 1000 i = 1, 18 Call Write2Int( i, 5 ) Call WriteOct( Iaddr(ClsStat(i)), 15 ) Call WriteOct( ClsStat(i), 15 ) Call WriteLn 1000 Continue Stop '- Fatal Error : The Chain Data Has Been Corrupted' 9999 END C||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||