C
C COMMENT SECTION
C
C FM056
C
C FM056 IS A MAIN WHICH TESTS THE ARGUMENT PASSING LINKAGE OF
C A 2 LEVEL NESTED SUBROUTINE AND AN EXTERNAL FUNCTION REFERENCE.
C THE MAIN PROGRAM FM056 CALLS SUBROUTINE FS057 PASSING ONE
C ARGUMENT. SUBROUTINE FS057 CALLS SUBROUTINE FS058 PASSING TWO
C ARGUMENTS. SUBROUTINE FS058 REFERENCES EXTERNAL FUNCTION FF059
C PASSING 3 ARGUMENTS. FUNCTION FF059 ADDS THE VALUES OF THE 3
C ARGUMENTS TOGETHER. SUBROUTINE FS057 AND FS058 THEN MERELY
C RETURN THE RESULT TO FM056 IN THE FIRST ARGUMENT.
C
C THE VALUES OF THE ARGUMENTS THAT ARE PASSED TO EACH
C SUBPROGRAM AND FUNCTION, AND RETURNED TO THE CALLING OR
C REFERENCING PROGRAM ARE SAVED IN AN INTEGER ARRAY. FM056 THEN
C USES THESE VALUES TO TEST THE COMPILER'S ARGUMENT PASSING
C CAPABILITIES.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 15.6.2, SUBROUTINE REFERENCE
COMMON IACN11 (12)
C
C **********************************************************
C
C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE
C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD
C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE
C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER
C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED
C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN
C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC
C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT
C OF EXECUTING THESE TESTS.
C
C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES
C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.
C
C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -
C
C DEPARTMENT OF THE NAVY
C FEDERAL COBOL COMPILER TESTING SERVICE
C WASHINGTON, D.C. 20376
C
C **********************************************************
C
C
C
C INITIALIZATION SECTION
C
C INITIALIZE CONSTANTS
C **************
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.
I01 = 5
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.
I02 = 6
C SYSTEM ENVIRONMENT SECTION
C
CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5
C (UNIT NUMBER FOR CARD READER).
CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD.
C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.
C
CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6
C (UNIT NUMBER FOR PRINTER).
CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.
C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL
C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.
C
IVPASS=0
IVFAIL=0
IVDELE=0
ICZERO=0
C
C WRITE PAGE HEADERS
WRITE (I02,90000)
WRITE (I02,90001)
WRITE (I02,90002)
WRITE (I02, 90002)
WRITE (I02,90003)
WRITE (I02,90002)
WRITE (I02,90004)
WRITE (I02,90002)
WRITE (I02,90011)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90005)
WRITE (I02,90006)
WRITE (I02,90002)
C
C TEST SECTION
C
C SUBROUTINE SUBPROGRAM
C
IVON01 = 5
CALL FS057 (IVON01)
IACN11 (12) = IVON01
IVTNUM = 430
C
C **** TEST 430 ****
C
C TEST 430 TESTS THE VALUE OF THE ARGUMENT RECEIVED BY FS057 FROM
C A FM056 CALL TO FS057
C
IF (ICZERO) 34300, 4300, 34300
4300 CONTINUE
IVCOMP = IACN11 (1)
GO TO 44300
34300 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44300, 4311, 44300
44300 IF (IVCOMP - 5) 24300,14300,24300
14300 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4311
24300 IVFAIL = IVFAIL + 1
IVCORR = 5
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4311 CONTINUE
IVTNUM = 431
C
C **** TEST 431 ****
C
C TEST 431 TESTS THE VALUE OF THE SECOND ARGUMENT THAT WAS PASSED
C FROM A FS057 CALL TO FS058
C
C
IF (ICZERO) 34310, 4310, 34310
4310 CONTINUE
IVCOMP = IACN11 (2)
GO TO 44310
34310 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44310, 4321, 44310
44310 IF (IVCOMP - 4) 24310,14310,24310
14310 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4321
24310 IVFAIL = IVFAIL + 1
IVCORR = 4
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4321 CONTINUE
IVTNUM = 432
C
C **** TEST 432 ****
C
C TEST 432 TESTS THE VALUE OF THE FIRST ARGUMENT RECEIVED BY FS058
C FROM A FS057 CALL TO FS058
C
C
IF (ICZERO) 34320, 4320, 34320
4320 CONTINUE
IVCOMP = IACN11 (3)
GO TO 44320
34320 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44320, 4331, 44320
44320 IF (IVCOMP - 5) 24320,14320,24320
14320 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4331
24320 IVFAIL = IVFAIL + 1
IVCORR = 5
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4331 CONTINUE
IVTNUM = 433
C
C **** TEST 433 ****
C
C TEST 433 TESTS THE VALUE OF THE SECOND ARGUMENT RECEIVED BY FS058
C FROM A FS057 CALL TO FS058
C
C
IF (ICZERO) 34330, 4330, 34330
4330 CONTINUE
IVCOMP = IACN11 (4)
GO TO 44330
34330 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44330, 4341, 44330
44330 IF (IVCOMP - 4) 24330,14330,24330
14330 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4341
24330 IVFAIL = IVFAIL + 1
IVCORR = 4
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4341 CONTINUE
IVTNUM = 434
C
C **** TEST 434 ****
C
C TEST 434 TESTS THE VALUE OF THE THIRD ARGUMENT THAT WAS PASSED
C FROM A FS058 REFERENCE OF FUNCTION FF059
C
C
IF (ICZERO) 34340, 4340, 34340
4340 CONTINUE
IVCOMP = IACN11 (5)
GO TO 44340
34340 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44340, 4351, 44340
44340 IF (IVCOMP - 3) 24340,14340,24340
14340 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4351
24340 IVFAIL = IVFAIL + 1
IVCORR = 3
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4351 CONTINUE
IVTNUM = 435
C
C **** TEST 435 ****
C
C TEST 435 TESTS THE VALUE OF THE FIRST ARGUMENT RECEIVED BY FF059
C FROM A FS058 REFERENCE OF FUNCTION FF059
C
C
IF (ICZERO) 34350, 4350, 34350
4350 CONTINUE
IVCOMP = IACN11 (6)
GO TO 44350
34350 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44350, 4361, 44350
44350 IF (IVCOMP - 5) 24350,14350,24350
14350 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4361
24350 IVFAIL = IVFAIL + 1
IVCORR = 5
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4361 CONTINUE
IVTNUM = 436
C
C **** TEST 436 ****
C
C TEST 436 TESTS THE VALUE OF THE SECOND ARGUMENT RECEIVED BY FF059
C FROM A FS058 REFERENCE OF FUNCTION FF059
C
C
IF (ICZERO) 34360, 4360, 34360
4360 CONTINUE
IVCOMP = IACN11 (7)
GO TO 44360
34360 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44360, 4371, 44360
44360 IF (IVCOMP - 4) 24360,14360,24360
14360 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4371
24360 IVFAIL = IVFAIL + 1
IVCORR = 4
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4371 CONTINUE
IVTNUM = 437
C
C **** TEST 437 ****
C
C TEST 437 TESTS THE VALUE OF THE THIRD ARGUMENT RECEIVED BY FF059
C FROM A FS058 REFERENCE OF FUNCTION FF059
C
C
IF (ICZERO) 34370, 4370, 34370
4370 CONTINUE
IVCOMP = IACN11 (8)
GO TO 44370
34370 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44370, 4381, 44370
44370 IF (IVCOMP - 3) 24370,14370,24370
14370 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4381
24370 IVFAIL = IVFAIL + 1
IVCORR = 3
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4381 CONTINUE
IVTNUM = 438
C
C **** TEST 438 ****
C
C TEST 438 TESTS THE VALUE OF THE FUNCTION DETERMINED BY FF059
C
C
IF (ICZERO) 34380, 4380, 34380
4380 CONTINUE
IVCOMP = IACN11 (9)
GO TO 44380
34380 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44380, 4391, 44380
44380 IF (IVCOMP - 12) 24380,14380,24380
14380 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4391
24380 IVFAIL = IVFAIL + 1
IVCORR = 12
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4391 CONTINUE
IVTNUM = 439
C
C **** TEST 439 ****
C
C TEST 439 TESTS THE VALUE OF THE FUNCTION RETURNED TO FS058 BY
C FF059
C
C
IF (ICZERO) 34390, 4390, 34390
4390 CONTINUE
IVCOMP = IACN11 (10)
GO TO 44390
34390 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44390, 4401, 44390
44390 IF (IVCOMP - 12) 24390,14390,24390
14390 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4401
24390 IVFAIL = IVFAIL + 1
IVCORR = 12
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4401 CONTINUE
IVTNUM = 440
C
C **** TEST 440 ****
C
C TEST 440 TESTS THE VALUE OF THE FIRST ARGUMENT RETURNED TO FS057
C BY FS058
C
IF (ICZERO) 34400, 4400, 34400
4400 CONTINUE
IVCOMP = IACN11 (11)
GO TO 44400
34400 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44400, 4411, 44400
44400 IF (IVCOMP - 12) 24400,14400,24400
14400 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4411
24400 IVFAIL = IVFAIL + 1
IVCORR = 12
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4411 CONTINUE
IVTNUM = 441
C
C **** TEST 441 ****
C
C TEST 441 TESTS THE VALUE OF THE FIRST ARGUMENT RETURNED TO FM056
C BY FS057
C
C
IF (ICZERO) 34410, 4410, 34410
4410 CONTINUE
IVCOMP = IACN11 (12)
GO TO 44410
34410 IVDELE = IVDELE + 1
WRITE (I02,80003) IVTNUM
IF (ICZERO) 44410, 4421, 44410
44410 IF (IVCOMP - 12) 24410,14410,24410
14410 IVPASS = IVPASS + 1
WRITE (I02,80001) IVTNUM
GO TO 4421
24410 IVFAIL = IVFAIL + 1
IVCORR = 12
WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR
4421 CONTINUE
C
C WRITE PAGE FOOTINGS AND RUN SUMMARIES
99999 CONTINUE
WRITE (I02,90002)
WRITE (I02,90006)
WRITE (I02,90002)
WRITE (I02,90002)
WRITE (I02,90007)
WRITE (I02,90002)
WRITE (I02,90008) IVFAIL
WRITE (I02,90009) IVPASS
WRITE (I02,90010) IVDELE
C
C
C TERMINATE ROUTINE EXECUTION
STOP
C
C FORMAT STATEMENTS FOR PAGE HEADERS
90000 FORMAT (1H1)
90002 FORMAT (1H )
90001 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM)
90003 FORMAT (1H ,21X,11HVERSION 1.0)
90004 FORMAT (1H ,10X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978)
90005 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL, 5X,8HCOMPUTED,8X,7HCORRECT)
90006 FORMAT (1H ,5X,46H----------------------------------------------)
90011 FORMAT (1H ,18X,17HSUBSET LEVEL TEST)
C
C FORMAT STATEMENTS FOR RUN SUMMARIES
90008 FORMAT (1H ,15X,I5,19H ERRORS ENCOUNTERED)
90009 FORMAT (1H ,15X,I5,13H TESTS PASSED)
90010 FORMAT (1H ,15X,I5,14H TESTS DELETED)
C
C FORMAT STATEMENTS FOR TEST RESULTS
80001 FORMAT (1H ,4X,I5,7X,4HPASS)
80002 FORMAT (1H ,4X,I5,7X,4HFAIL)
80003 FORMAT (1H ,4X,I5,7X,7HDELETED)
80004 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6)
80005 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5)
C
90007 FORMAT (1H ,20X,20HEND OF PROGRAM FM056)
END
C
C COMMENT SECTION
C
C FS057
C
C THIS SUBROUTINE IS CALLED BY THE MAIN PROGRAM FM056. THE
C SINGLE ARGUMENT PASSED FROM FM056 ALONG WITH A SECOND PARAMETER
C CREATED IN FS057 ARE THEN PASSED VIA A CALL TO SUBROUTINE FS058.
C A RESULT FROM AN ARITHMETIC OPERATION IS RETURNED FROM FS058 IN
C THE FIRST ARGUMENT. FS057 ACCEPTS THIS RESULT AND RETURNS CONTROL
C TO FM056 WITHOUT ANY ADDITIONAL PROCESSING.
C
C THE VALUES OF THE ARGUMENTS THAT ARE PASSED FROM FM056 TO
C FS057 AND RETURNED ARE SAVED IN AN INTEGER ARRAY FOR LATER
C VERIFICATION BY THE MAIN PROGRAM.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 15.6, SUBROUTINES
C SECTION 15.6.2, SUBROUTINE REFERENCE
C SECTION 15.8, RETURN STATEMENT
C
C TEST SECTION
C
C SUBROUTINE SUBPROGRAM
C
SUBROUTINE FS057 (IVON01)
COMMON IACN11 (12)
IACN11 (1) = IVON01
IVON02 = 4
IACN11 (2) = IVON02
CALL FS058 (IVON01,IVON02)
IACN11 (11) = IVON01
RETURN
END
C
C COMMENT SECTION
C
C FS058
C
C THIS SUBROUTINE IS CALLED BY SUBROUTINE FS057. THE TWO
C ARGUMENTS PASSED FROM FS057 ALONG WITH A THIRD PARAMETER CREATED
C IN FS058 ARE THEN PASSED TO FUNCTION FF059 WHERE THEY ARE USED IN
C AN ARITHMETIC OPERATION. FS058 THEN SAVES THE RESULT OF THIS
C OPERATION IN THE FIRST ARGUMENT AND RETURNS CONTROL TO FS057
C WITHOUT ANY ADDITIONAL PROCESSING.
C
C THE VALUES OF THE ARGUMENTS THAT ARE PASSED FROM FS057 TO
C FS058 AND RETURNED ARE SAVED IN AN INTEGER ARRAY FOR LATER
C VERIFICATION BY THE MAIN PROGRAM.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 15.5.2, REFERENCING EXTERNAL FUNCTIONS
C SECTION 15.6, SUBROUTINES
C SECTION 15.8, RETURN STATEMENT
C
C TEST SECTION
C
C SUBROUTINE SUBPROGRAM
C
SUBROUTINE FS058 (IVON01,IVON02)
COMMON IACN11 (12)
INTEGER FF059
IVON03 = 3
IACN11 (3) = IVON01
IACN11 (4) = IVON02
IACN11 (5) = IVON03
IVON01 = FF059 (IVON01,IVON02,IVON03)
IACN11 (10) = IVON01
RETURN
END
C
C COMMENT SECTION
C
C FF059
C
C THIS EXTERNAL FUNCTION IS REFERENCED WITHIN SUBROUTINE FS058.
C THE THREE ARGUMENTS THAT ARE PASSED ARE SIMPLY ADDED TOGETHER AND
C THE RESULT SUBSTITUTED FOR THE ORIGINAL REFERENCE. CONTROL IS
C THEN RETURNED TO FS058.
C
C THE VALUES OF THE ARGUMENTS THAT ARE PASSED FROM FS058 TO
C FF059 AND THE RESULT THAT IS RETURNED ARE SAVED IN AN INTEGER
C ARRAY FOR LATER VERIFICATION BY THE MAIN PROGRAM.
C
C REFERENCES
C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,
C X3.9-1978
C
C SECTION 15.5.1, FUNCTION SUBPROGRAM AND FUNCTION STATEMENT
C SECTION 15.8, RETURN STATEMENT
C TEST SECTION
C
C FUNCTION SUBPROGRAM
C
INTEGER FUNCTION FF059 (IVON01,IVON02,IVON03)
COMMON IACN11 (12)
IACN11 (6) = IVON01
IACN11 (7) = IVON02
IACN11 (8) = IVON03
FF059 = IVON01 + IVON02 + IVON03
IACN11 (9) = IVON01 + IVON02 + IVON03
RETURN
END