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