1
0
mirror of https://github.com/gryf/tagbar.git synced 2026-01-31 04:55:46 +01:00

Add tests to repository

This commit is contained in:
Jan Larres
2013-03-28 00:16:03 +13:00
parent b6f47e4020
commit db9404ca1a
128 changed files with 54624 additions and 0 deletions

200
tests/cobol/Acme99.cbl Normal file
View File

@@ -0,0 +1,200 @@
$ SET SOURCEFORMAT"FREE"
IDENTIFICATION DIVISION.
PROGRAM-ID. ACME99.
AUTHOR. Michael Coughlan.
*CS431399R-EXAM.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT ORDER-FILE ASSIGN TO "ORDERS.DAT"
ORGANIZATION IS LINE SEQUENTIAL.
SELECT STOCK-FILE ASSIGN TO "STOCK.DAT"
ORGANIZATION IS RELATIVE
ACCESS MODE IS DYNAMIC
RELATIVE KEY IS STOCK-REC-POINTER-WB
FILE STATUS IS STOCK-STATUS-WB.
SELECT MANF-FILE ASSIGN TO "MANF.DAT"
ORGANIZATION IS INDEXED
ACCESS MODE IS RANDOM
RECORD KEY IS MANF-CODE-FC
ALTERNATE RECORD KEY IS MANF-NAME-FC
WITH DUPLICATES
FILE STATUS IS MANF-STATUS-WB.
DATA DIVISION.
FILE SECTION.
FD ORDER-FILE.
01 ORDER-REC-FA.
02 ITEM-DESC-FA PIC X(30).
02 MANF-NAME-FA PIC X(30).
02 QTY-REQUIRED-FA PIC 9(6).
02 COST-OF-ITEMS-FA PIC 9(5)V99.
02 POSTAGE-FA PIC 99V99.
FD STOCK-FILE.
01 STOCK-REC-FB.
02 STOCK-NUM-FB PIC 9(5).
02 MANF-CODE-FB PIC X(4).
02 ITEM-DESC-FB PIC X(30).
02 QTY-IN-STOCK-FB PIC 9(6).
02 REORDER-LEVEL-FB PIC 999.
02 REORDER-QTY-FB PIC 9(6).
02 ITEM-COST-FB PIC 9(5).
02 ITEM-WEIGHT-FB PIC 9(5).
02 ON-ORDER-FB PIC X.
88 NOT-ON-ORDER VALUE "N".
88 ON-ORDER VALUE "Y".
FD MANF-FILE.
01 MANF-REC-FC.
02 MANF-CODE-FC PIC X(4).
02 MANF-NAME-FC PIC X(30).
02 MANF-ADDRESS-FC PIC X(70).
WORKING-STORAGE SECTION.
01 CALL-ITEMS-WA.
02 POST-CHARGE-WA PIC 99V99.
02 POST-NUM-WA PIC 99.
01 FILE-DATA-WB.
02 STOCK-REC-POINTER-WB PIC 9(5).
02 STOCK-STATUS-WB PIC XX.
02 MANF-STATUS-WB PIC XX.
02 FILLER PIC 9 VALUE 0.
88 END-OF-FILE VALUE 1.
01 UNSTRING-DATA-WC.
02 UNSTRING-POINTER-WC PIC 99.
88 END-OF-ADDRESS VALUE 71.
02 HOLD-STRING-WC PIC X(10).
02 COUNTY-WC PIC X(9).
88 NORTHERN-COUNTY
VALUE "ANTRIM", "ARMAGH", "DERRY", "DOWN",
"FERMANAGH", "TYRONE".
02 COUNTRY-WC PIC X(10).
88 EEC-COUNTRY
VALUE "AUSTRIA", "BELGIUM", "DENMARK", "ENGLAND", "FINLAND",
"FRANCE", "GERMANY", "GREECE", "IRELAND", "ITALY",
"LUXEMBOURG", "PORTUGAL", "SCOTLAND", "SPAIN",
"SWEDEN", "WALES".
88 IRELAND VALUE "IRELAND".
02 COUNTRY-FLAGS-WC PIC 9.
88 OTHER-EEC VALUE 1.
88 REPUBLIC VALUE 0.
01 POSTAGE-DATA-WD.
02 TOTAL-WEIGHT-WD PIC 9(5).
88 OVER-WEIGHT VALUE 50001 THRU 99999.
PROCEDURE DIVISION.
CREATE-REORDER-FILE.
OPEN I-O STOCK-FILE.
OPEN INPUT MANF-FILE.
OPEN OUTPUT ORDER-FILE.
READ STOCK-FILE NEXT RECORD
AT END SET END-OF-FILE TO TRUE
END-READ.
PERFORM UNTIL END-OF-FILE
IF (QTY-IN-STOCK-FB NOT GREATER THAN REORDER-LEVEL-FB)
AND (NOT-ON-ORDER)
PERFORM CREATE-REORDER-RECORD
PERFORM UPDATE-STOCK-RECORD
END-IF
READ STOCK-FILE NEXT RECORD
AT END SET END-OF-FILE TO TRUE
END-READ
END-PERFORM.
CLOSE STOCK-FILE, MANF-FILE, ORDER-FILE.
STOP RUN.
CREATE-REORDER-RECORD.
MOVE MANF-CODE-FB TO MANF-CODE-FC.
READ MANF-FILE
KEY IS MANF-CODE-FC
INVALID KEY DISPLAY "CRR MANF STATUS = "
MANF-STATUS-WB "CODE = " MANF-CODE-FC
END-READ.
PERFORM EXTRACT-ADDRESS-ITEMS.
MOVE ZEROS TO POSTAGE-FA, COST-OF-ITEMS-FA.
IF EEC-COUNTRY
PERFORM GET-POSTAGE
MULTIPLY ITEM-COST-FB BY REORDER-QTY-FB
GIVING COST-OF-ITEMS-FA
MOVE POST-CHARGE-WA TO POSTAGE-FA
END-IF.
MOVE ITEM-DESC-FB TO ITEM-DESC-FA.
MOVE MANF-NAME-FC TO MANF-NAME-FA.
MOVE REORDER-QTY-FB TO QTY-REQUIRED-FA.
WRITE ORDER-REC-FA.
GET-POSTAGE.
IF IRELAND AND NOT NORTHERN-COUNTY
SET REPUBLIC TO TRUE
ELSE
SET OTHER-EEC TO TRUE
END-IF.
MULTIPLY ITEM-WEIGHT-FB BY REORDER-QTY-FB
GIVING TOTAL-WEIGHT-WD
ON SIZE ERROR MOVE 99999 TO TOTAL-WEIGHT-WD.
EVALUATE TOTAL-WEIGHT-WD ALSO REPUBLIC ALSO OTHER-EEC
WHEN 1 THRU 500 ALSO TRUE ALSO FALSE MOVE 1 TO POST-NUM-WA
WHEN 1 THRU 500 ALSO FALSE ALSO TRUE MOVE 2 TO POST-NUM-WA
WHEN 501 THRU 1000 ALSO TRUE ALSO FALSE MOVE 3 TO POST-NUM-WA
WHEN 501 THRU 1000 ALSO FALSE ALSO TRUE MOVE 4 TO POST-NUM-WA
WHEN 1001 THRU 3000 ALSO TRUE ALSO FALSE MOVE 5 TO POST-NUM-WA
WHEN 1001 THRU 3000 ALSO FALSE ALSO TRUE MOVE 6 TO POST-NUM-WA
WHEN 3001 THRU 5000 ALSO TRUE ALSO FALSE MOVE 7 TO POST-NUM-WA
WHEN 3001 THRU 5000 ALSO FALSE ALSO TRUE MOVE 8 TO POST-NUM-WA
WHEN 5001 THRU 10000 ALSO TRUE ALSO FALSE MOVE 9 TO POST-NUM-WA
WHEN 5001 THRU 10000 ALSO FALSE ALSO TRUE MOVE 10 TO POST-NUM-WA
WHEN 10001 THRU 50000 ALSO TRUE ALSO FALSE MOVE 11 TO POST-NUM-WA
WHEN 10001 THRU 50000 ALSO FALSE ALSO TRUE MOVE 12 TO POST-NUM-WA
WHEN 50001 THRU 99999 ALSO ANY ALSO ANY MOVE ZEROS
TO POST-CHARGE-WA
WHEN OTHER DISPLAY "EVALUATE WRONG:- WEIGHT = " TOTAL-WEIGHT-WD
" COUNTRY FLAG = " COUNTRY-FLAGS-WC
END-EVALUATE.
IF NOT OVER-WEIGHT
CALL "POSTAGE-RATE"
USING BY CONTENT POST-NUM-WA
BY REFERENCE POST-CHARGE-WA
END-IF.
UPDATE-STOCK-RECORD.
MOVE "Y" TO ON-ORDER-FB.
REWRITE STOCK-REC-FB
INVALID KEY DISPLAY "STOCK REWRITE STATUS = " STOCK-STATUS-WB
END-REWRITE.
EXTRACT-ADDRESS-ITEMS.
MOVE 1 TO UNSTRING-POINTER-WC.
PERFORM UNTIL END-OF-ADDRESS
MOVE HOLD-STRING-WC TO COUNTY-WC
UNSTRING MANF-ADDRESS-FC DELIMITED BY ","
INTO HOLD-STRING-WC
WITH POINTER UNSTRING-POINTER-WC
END-PERFORM.
MOVE HOLD-STRING-WC TO COUNTRY-WC.
*debugging displays
DISPLAY "COUNTY = " COUNTY-WC.
DISPLAY "COUNTRY = " COUNTRY-WC.

132
tests/cobol/DriverProg.cbl Normal file
View File

@@ -0,0 +1,132 @@
$ SET SOURCEFORMAT"FREE"
IDENTIFICATION DIVISION.
PROGRAM-ID. DriverProg.
AUTHOR. Michael Coughlan.
* This program demonstrates the use of the CALL verb
* it calls three external sub-programs that help to demonstrate
* some of the features of the CALL.
* The "MultiplyNums" sub-program takes five parameters. The first two
* are the numbers to be multiplied, the second two are strings to
* demonstrate that strings can be passed as parameters and the
* last is the returned result of multiplying the two numbers.
* The "Fickle" sub-program demonstrates a program that exhibits
* State Memory.
* The "Steadfast" sub-program demonstrates how a sub-program that
* uses the IS INITIAL phrase can avoid State Memory.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 UserNumber PIC 99.
01 PrnResult PIC 9(6).
* field declared as COMP cannot be DISPLAYed
* it is necessary to move it to a DISPLAY field.
* DISPLAY is the default value for a field and
* need not be declared.
* Parameters must be either 01-level's or elementry
* data-items.
01 Parameters.
02 Number1 PIC 9(3).
02 Number2 PIC 9(3).
02 FirstString PIC X(19) VALUE "First parameter = ".
02 SecondString PIC X(19) VALUE "Second parameter = ".
02 Result PIC 9(6) COMP.
* I've made this a COMP field to demonstrate that COMP
* items can be passed as parameters but a COMP field cannot
* be DISPLAYed and so is moved to a DISPLAY field before DISPLAYing it.
PROCEDURE DIVISION.
Begin.
PERFORM CallMultiplyNums.
PERFORM CallFickle
PERFORM CallSteadfast
PERFORM MakeFickleSteadfast.
STOP RUN.
CallMultiplyNums.
DISPLAY "Input 2 numbers (3 digits each) to be multiplied"
DISPLAY "First number - " WITH NO ADVANCING
ACCEPT Number1
DISPLAY "Second number - " WITH NO ADVANCING
ACCEPT Number2.
DISPLAY "The first string is " FirstString.
DISPLAY "The second string is " SecondString.
DISPLAY ">>>>>>>>> Calling the sub-program now".
CALL "MultiplyNums"
USING BY CONTENT Number1, Number2, FirstString,
BY REFERENCE SecondString, Result.
* The USING phrase specifies the parameters to be passed to the
* sub-program. The order of the parameters is important as the
* sub-program recognizes them by relative location not by name
*
* Parameters should be passed BY CONTENT when you are not expecting
* them to get a value from the called program. We have not passed
* SecondString by content and you can see that its value is
* overwritten by the called program.
DISPLAY "Back in the main program now <<<<<<<<<<<".
MOVE Result to PrnResult.
DISPLAY Number1 " multiplied by " Number2 " is = " PrnResult.
DISPLAY "The first string is " FirstString.
DISPLAY "The second string is " SecondString.
CallFickle.
DISPLAY SPACE
DISPLAY "------------------- Calling Fickle ---------"
MOVE 10 TO UserNumber
CALL "Fickle" USING BY CONTENT UserNumber
MOVE 10 TO UserNumber
CALL "Fickle" USING BY CONTENT UserNumber
MOVE 10 TO UserNumber
CALL "Fickle" USING BY CONTENT UserNumber.
* Every time I call Fickle with the same value
* produces a different result. This is because
* it remembers its state from one call to the next.
* It has "State Memory".
CallSteadFast.
DISPLAY SPACE
DISPLAY "------------------- Calling Steadfast ---------"
MOVE 10 TO UserNumber
CALL "Steadfast" USING BY CONTENT UserNumber
MOVE 10 TO UserNumber
CALL "Steadfast" USING BY CONTENT UserNumber
MOVE 10 TO UserNumber
CALL "Steadfast" USING BY CONTENT UserNumber.
* Every time I call Steadfast with the same value
* it produces the same result. We have eliminated
* State Memory by using the IS INITIAL phrase in
* Steadfast
MakeFickleSteadfast.
DISPLAY SPACE
DISPLAY "----- Making fickle act like Steadfast -------"
CANCEL "Fickle"
MOVE 10 TO UserNumber
CALL "Fickle" USING BY CONTENT UserNumber
CANCEL "Fickle"
MOVE 10 TO UserNumber
CALL "Fickle" USING BY CONTENT UserNumber
CANCEL "Fickle"
MOVE 10 TO UserNumber
CALL "Fickle" USING BY CONTENT UserNumber.
* We can make Fickle act like Steadfast by using
* the CANCEL verb to set it into its initial state
* each time we call it