PROGRAM FM204 C C C THIS ROUTINE CONTINUES THE TESTING OF CHARACTER VARIABLES AND C CHARACTER ARRAYS OF LENGTH ONE. THE CHARACTER FEATURES TESTED IN C FM202 AND FM203 ARE USED IN THE TESTS IN THIS ROUTINE. THE C FOLLOWING CHARACTER FEATURES ARE TESTED C C (1) INITIAL DEFINITION OF CHARACTER ENTITIES OF LENGTH ONE BY C SPECIFYING THEM IN A DATA STATEMENT. C C (2) THE SUBSET FORTRAN LANGUAGE SPECIFIES THE FOLLOWING C COLLATING SEQUENCE RULES. C C A LESS THAN B ... LESS THAN Z, C 0 LESS THAN 1 ... LESS THAN 9, C ALL OF THE DIGITS PRECEDE A OR ALL OF THE DIGITS FOLLOW C Z, C BLANK IS LESS THAN THE LETTER A AND BLANK IS LESS THAN C THE DIGIT ZERO. C C (3) THE VALUE OF THE INTRINSIC FUNCTION ICHAR IS AN INTEGER C IN THE RANGE (0, N-1), WHERE N IS THE NUMBER OF CHARACTERS IN C THE COLLATING SEQUENCE FOR THE PROCESSOR. FOR ANY CHARACTERS C C1 AND C2 CAPABLE OF REPRESENTATION IN THE PROCESSOR, C1 .LE. C2 C IS TRUE IF AND ONLY IF ICHAR(C1) .LE. ICHAR(C2) IS TRUE; AND C C1 .EQ. C2 IF AND ONLY IF ICHAR(C1) .EQ. ICHAR(C2). C C REFERENCES C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, C X3.9-1978 C C SECTION 3.1.5, COLLATING SEQUENCE AND GRAPHICS C SECTION 4.8, CHARACTER TYPE C SECTION 6.2, CHARACTER EXPRESSIONS C SECTION 6.3.4, CHARACTER RELATIONAL EXPRESSIONS C SECTION 6.3.5, INTERPRETATION OF CHARACTER RELATIONAL C EXPRESSIONS C SECTION 8.4.2, CHARACTER TYPE-STATEMENT C SECTION 9.4, CHARACTER CONSTANT IN A DATA STATEMENT C SECTION 10.4, CHARACTER ASSIGNMENT STATEMENT C SECTION 15.3, INTRINSIC FUNCTIONS C SECTION 15.10, TABLE 5 INTRINSIC FUNCTIONS C C C ****************************************************************** C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING C THE RESULT OF EXECUTING THESE TESTS. C C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES C FOUND IN THE SUBSET LEVEL OF THE STANDARD. C C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO C DEPARTMENT OF THE NAVY C FEDERAL COBOL COMPILER TESTING SERVICE C WASHINGTON, D.C. 20376 C C ****************************************************************** C C IMPLICIT LOGICAL (L) IMPLICIT CHARACTER*14 (C) C CHARACTER*1 CATN11(47), CATN12(26), CATN13(10) CHARACTER CVTN10*1, CATN14(6)*1, CVTN01 DIMENSION IAON11(47) DATA CATN11/'A','B','C','D','E','F','G','H','I','J','K','L','M', 1 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z','0','1', 2 '2','3','4','5','6','7','8','9',' ','=','+','-','*','/','(', 3 ')',',','.',''''/ DATA CATN12/'A','B','C','D','E','F','G','H','I','J','K','L','M', 1 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z'/ DATA CATN14(1),CATN14(2),CATN14(3),CATN14(4),CATN14(5),CATN14(6) 1 /6*'V'/,IAON11/47*7/, CATN13/'0','1','2','3','4','5','6', 2 '7','8','9'/,CVTN10/' '/ 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 PEPLACED 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 PEPLACED 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 OUT PAGE HEADERS C WRITE (I02,90002) WRITE (I02,90006) WRITE (I02,90008) WRITE (I02,90004) WRITE (I02,90010) WRITE (I02,90004) WRITE (I02,90016) WRITE (I02,90001) WRITE (I02,90004) WRITE (I02,90012) WRITE (I02,90014) WRITE (I02,90004) C C C TEST 61 THROUGH TEST 73 VERIFY THE CONTENTS OF CHARACTER ARRAY C ELEMENTS AND CHARACTER VARIABLES WHICH WERE INITIALLY DEFINED IN C A DATA STATEMENT. C C TEST 61 THROUGH TEST 65 VERIFY THE CONTENTS OF SELECTED C ELEMENTS OF THE ARRAY CATN11 WHICH WAS INITIALLY SET EQUAL TO THE C 47 CHARACTERS OF THE FORTRAN SUBSET LANGUAGE CHARACTER SET. C C C **** FCVS PROGRAM 204 - TEST 061 **** C C IVTNUM = 61 IF (ICZERO) 30610, 0610, 30610 0610 CONTINUE IVCOMP = 0 IVCORR = 1 IF (CATN11(1) .EQ. 'A') IVCOMP = 1 40610 IF (IVCOMP - 1) 20610, 10610, 20610 30610 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10610, 0621, 20610 10610 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0621 20610 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0621 CONTINUE C C **** FCVS PROGRAM 204 - TEST 062 **** C C IVTNUM = 62 IF (ICZERO) 30620, 0620, 30620 0620 CONTINUE IVCOMP = 0 IVCORR = 1 IF (CATN11(47) .EQ. '''') IVCOMP = 1 40620 IF (IVCOMP - 1) 20620, 10620, 20620 30620 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10620, 0631, 20620 10620 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0631 20620 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0631 CONTINUE C C **** FCVS PROGRAM 204 - TEST 063 **** C C IVTNUM = 63 IF (ICZERO) 30630, 0630, 30630 0630 CONTINUE IVCOMP = 0 IVCORR = 1 IF (CATN11(46) .EQ. '.') IVCOMP = 1 40630 IF (IVCOMP - 1) 20630, 10630, 20630 30630 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10630, 0641, 20630 10630 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0641 20630 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0641 CONTINUE C C **** FCVS PROGRAM 204 - TEST 064 **** C C IVTNUM = 64 IF (ICZERO) 30640, 0640, 30640 0640 CONTINUE IVCOMP = 0 IVCORR = 1 IF (CATN11(27) .EQ. '0') IVCOMP = 1 40640 IF (IVCOMP - 1) 20640, 10640, 20640 30640 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10640, 0651, 20640 10640 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0651 20640 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0651 CONTINUE C C **** FCVS PROGRAM 204 - TEST 065 **** C C IVTNUM = 65 IF (ICZERO) 30650, 0650, 30650 0650 CONTINUE IVCOMP = 0 IVCORR = 1 IF (CATN11(36) .EQ. '9') IVCOMP = 1 40650 IF (IVCOMP - 1) 20650, 10650, 20650 30650 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10650, 0661, 20650 10650 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0661 20650 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0661 CONTINUE C C TEST 66 THROUGH TEST 68 VERIFY THE CONTENTS OF SELECTED C ELEMENTS OF THE ARRAY CATN12 WHICH WAS INITIALLY SET EQUAL TO THE C 26 LETTERS OF THE ALPHABET. C C C **** FCVS PROGRAM 204 - TEST 066 **** C C IVTNUM = 66 IF (ICZERO) 30660, 0660, 30660 0660 CONTINUE IVCOMP = 0 IVCORR = 1 IF (CATN12(1) .EQ. 'A') IVCOMP = 1 40660 IF (IVCOMP - 1) 20660, 10660, 20660 30660 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10660, 0671, 20660 10660 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0671 20660 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0671 CONTINUE C C **** FCVS PROGRAM 204 - TEST 067 **** C C IVTNUM = 67 IF (ICZERO) 30670, 0670, 30670 0670 CONTINUE IVCOMP = 0 IVCORR = 1 IF (CATN12(26) .EQ. 'Z') IVCOMP = 1 40670 IF (IVCOMP - 1) 20670, 10670, 20670 30670 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10670, 0681, 20670 10670 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0681 20670 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0681 CONTINUE C C **** FCVS PROGRAM 204 - TEST 068 **** C C IVTNUM = 68 IF (ICZERO) 30680, 0680, 30680 0680 CONTINUE IVCOMP = 0 IVCORR = 1 IF (CATN12(20) .EQ. 'T') IVCOMP = 1 40680 IF (IVCOMP - 1) 20680, 10680, 20680 30680 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10680, 0691, 20680 10680 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0691 20680 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0691 CONTINUE C C TEST 69 AND TEST 70 VERIFY THE CONTENTS OF SELECTED ELEMENTS C OF THE ARRAY CATN13 WHICH WAS INITIALLY SET EQUAL TO THE TEN C NUMERIC DIGITS. C C C **** FCVS PROGRAM 204 - TEST 069 **** C C IVTNUM = 69 IF (ICZERO) 30690, 0690, 30690 0690 CONTINUE IVCOMP = 0 IVCORR = 1 IF (CATN13(1) .EQ. '0') IVCOMP = 1 40690 IF (IVCOMP - 1) 20690, 10690, 20690 30690 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10690, 0701, 20690 10690 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0701 20690 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0701 CONTINUE C C **** FCVS PROGRAM 204 - TEST 070 **** C C IVTNUM = 70 IF (ICZERO) 30700, 0700, 30700 0700 CONTINUE IVCOMP = 0 IVCORR = 1 IF (CATN13(10) .EQ. '9') IVCOMP = 1 40700 IF (IVCOMP - 1) 20700, 10700, 20700 30700 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10700, 0711, 20700 10700 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0711 20700 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0711 CONTINUE C C **** FCVS PROGRAM 204 - TEST 071 **** C C TEST 71 VERIFIES THE CONTENTS OF THE VARIABLE CVTN10 WHICH C WAS INITIALLY SET EQUAL TO BLANK. C IVTNUM = 71 IF (ICZERO) 30710, 0710, 30710 0710 CONTINUE IVCOMP = 0 IVCORR = 1 IF (CVTN10 .EQ. ' ') IVCOMP = 1 40710 IF (IVCOMP - 1) 20710, 10710, 20710 30710 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10710, 0721, 20710 10710 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0721 20710 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0721 CONTINUE C C **** FCVS PROGRAM 204 - TEST 072 **** C C TEST 72 VERIFIES THE CONTENTS OF THE ARRAY CATN14 WHICH WAS C INITIALLY SET EQUAL TO ALL V'S. C IVTNUM = 72 IF (ICZERO) 30720, 0720, 30720 0720 CONTINUE IVCOMP = 0 IVCORR = 6 DO 722, I= 1,6 IF (CATN14(I) .EQ. 'V') IVCOMP = IVCOMP + 1 722 CONTINUE 40720 IF (IVCOMP - 6) 20720, 10720, 20720 30720 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10720, 0731, 20720 10720 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0731 20720 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0731 CONTINUE C C **** FCVS PROGRAM 204 - TEST 073 **** C C TEST 73 VERIFIES THE CONTENTS OF THE ARRAY IAON11 WHICH WAS C INITIALLY SET EQUAL TO ALL 7'S. C IVTNUM = 73 IF (ICZERO) 30730, 0730, 30730 0730 CONTINUE IVCOMP = 0 IVCORR = 47 DO 732, I= 1,47 IF (IAON11(I) - 7) 732, 733, 732 733 IVCOMP = IVCOMP + 1 732 CONTINUE 40730 IF (IVCOMP - 47) 20730, 10730, 20730 30730 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10730, 0741, 20730 10730 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0741 20730 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0741 CONTINUE C C TEST 74 THROUGH TEST 79 VERIFY THE COLLATING SEQUENCE C SPECIFICATIONS FOR THE FORTRAN SUBSET LANGUAGE. C C TEST 74 AND TEST 75 VERIFY THE COLLATING SEQUENCE FOR LETTERS. C C C **** FCVS PROGRAM 204 - TEST 074 **** C C IVTNUM = 74 IF (ICZERO) 30740, 0740, 30740 0740 CONTINUE IVCOMP = 1 IVCORR = 210 IF ('A' .LT. 'B') IVCOMP = IVCOMP * 2 IF ('B' .LT. 'M') IVCOMP = IVCOMP * 3 IF ('M' .LT. 'V') IVCOMP = IVCOMP * 5 IF ('V' .LT. 'Z') IVCOMP = IVCOMP * 7 40740 IF (IVCOMP - 210) 20740, 10740, 20740 30740 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10740, 0751, 20740 10740 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0751 20740 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0751 CONTINUE C C **** FCVS PROGRAM 204 - TEST 075 **** C C IVTNUM = 75 IF (ICZERO) 30750, 0750, 30750 0750 CONTINUE IVCOMP = 0 IVCORR = 25 DO 752, I=1,25 J= I + 1 IF (CATN12(J) .GT. CATN12(I)) IVCOMP = IVCOMP + 1 752 CONTINUE 40750 IF (IVCOMP - 25) 20750, 10750, 20750 30750 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10750, 0761, 20750 10750 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0761 20750 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0761 CONTINUE C C TEST 76 AND TEST 77 VERIFY THE COLLATING SEQUENCE FOR DIGITS. C C C **** FCVS PROGRAM 204 - TEST 076 **** C C IVTNUM = 76 IF (ICZERO) 30760, 0760, 30760 0760 CONTINUE IVCOMP = 1 IVCORR = 30 IF ('0' .LT. '1') IVCOMP = IVCOMP * 2 IF ('1' .LT. '5') IVCOMP = IVCOMP * 3 IF ('5' .LT. '9') IVCOMP = IVCOMP * 5 40760 IF (IVCOMP - 30) 20760, 10760, 20760 30760 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10760, 0771, 20760 10760 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0771 20760 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0771 CONTINUE C C **** FCVS PROGRAM 204 - TEST 077 **** C C IVTNUM = 77 IF (ICZERO) 30770, 0770, 30770 0770 CONTINUE IVCOMP = 0 IVCORR = 9 DO 772, I=1,9 J = I + 1 IF (CATN13(I) .LT. CATN13(J)) IVCOMP = IVCOMP + 1 772 CONTINUE 40770 IF (IVCOMP - 9) 20770, 10770, 20770 30770 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10770, 0781, 20770 10770 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0781 20770 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0781 CONTINUE C C **** FCVS PROGRAM 204 - TEST 078 **** C C TEST 78 VERIFIES THAT BLANK IS LESS THAN THE LETTER A AND BLANK C IS LESS THAN THE DIGIT ZERO. C IVTNUM = 78 IF (ICZERO) 30780, 0780, 30780 0780 CONTINUE IVCOMP = 1 IVCORR = 6 IF (' ' .LT. 'A') IVCOMP = IVCOMP * 2 IF (' ' .LT. '0') IVCOMP = IVCOMP * 3 40780 IF (IVCOMP - 6) 20780, 10780, 20780 30780 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10780, 0791, 20780 10780 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0791 20780 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0791 CONTINUE C C **** FCVS PROGRAM 204 - TEST 079 **** C C TEST 79 VERIFIES THAT THE DIGITS AND LETTERS ARE NOT INTERMIXED C IN THE COLLATING SEQUENCE. EITHER ALL OF THE DIGITS MUST PRECEDE C A OR ALL OF THE DIGITS MUST FOLLOW Z. C IVTNUM = 79 IF (ICZERO) 30790, 0790, 30790 0790 CONTINUE IVCOMP = 0 IVCORR = 10 IF ('0' .NE. 'A') GO TO 792 IVCOMP = 111 GO TO 40790 792 IF ('0' .GT. 'A') GO TO 793 C C ZERO IS LESS THAN LETTER A, SO ALL DIGITS MUST BE LESS THAN A C DO 794, I= 1,10 IF (CATN13(I) .LT. 'A') IVCOMP = IVCOMP + 1 794 CONTINUE GO TO 40790 C C ZERO IS GREATER THAN LETTER A, SO ALL DIGITS MUST BE GREATER C THAN LETTER Z. C 793 DO 795 I=1,10 IF (CATN13(I) .GT. 'Z') IVCOMP = IVCOMP + 1 795 CONTINUE 40790 IF (IVCOMP - 10) 20790,10790, 20790 30790 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10790, 0801, 20790 10790 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0801 20790 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0801 CONTINUE C C TEST 80 THROUGH TEST 85 PERFORM THE SAME COMPARISONS AS TEST 74 C THROUGH TEST 79 EXCEPT THAT THE ICHAR INTRINSIC FUNCTION IS USED C IN PLACE OF THE INDIVIDUAL CHARACTERS. C C TEST 80 AND TEST 81 VERIFY THE COLLATING SEQUENCE FOR LETTERS C USING THE ICHAR INTRINSIC FUNCTION. C C C **** FCVS PROGRAM 204 - TEST 080 **** C C IVTNUM = 80 IF (ICZERO) 30800, 0800, 30800 0800 CONTINUE IVCOMP = 1 IVCORR = 210 IVON01 = ICHAR('A') IVON02 = ICHAR('B') IVON03 = ICHAR('M') IVON04 = ICHAR('V') IVON05 = ICHAR('Z') IF (IVON01 .LT. IVON02) IVCOMP = IVCOMP * 2 IF (IVON02 .LT. IVON03) IVCOMP = IVCOMP * 3 IF (IVON03 .LT. IVON04) IVCOMP = IVCOMP * 5 IF (IVON04 .LT. IVON05) IVCOMP = IVCOMP * 7 40800 IF (IVCOMP - 210) 20800, 10800, 20800 30800 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10800, 0811, 20800 10800 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0811 20800 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0811 CONTINUE C C **** FCVS PROGRAM 204 - TEST 081 **** C C IVTNUM = 81 IF (ICZERO) 30810, 0810, 30810 0810 CONTINUE IVON01 = 0 IVON02 = 0 IVCOMP = 0 IVCORR = 25 DO 812, I=1,25 J= I + 1 IVON01 = ICHAR(CATN12(J)) IVON02 = ICHAR(CATN12(I)) IF (IVON01 .GT. IVON02) IVCOMP = IVCOMP + 1 812 CONTINUE 40810 IF (IVCOMP - 25) 20810, 10810, 20810 30810 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10810, 0821, 20810 10810 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0821 20810 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0821 CONTINUE C C TEST 82 AND TEST 83 VERIFY THE COLLATING SEQUENCE FOR DIGITS C USING THE ICHAR INTRINSIC FUNCTION. C C C **** FCVS PROGRAM 204 - TEST 082 **** C C IVTNUM = 82 IF (ICZERO) 30820, 0820, 30820 0820 CONTINUE IVCOMP = 1 IVCORR = 30 IF (ICHAR('0') .LT. ICHAR('1')) IVCOMP = IVCOMP *2 IF (ICHAR('1') .LT. ICHAR('5')) IVCOMP = IVCOMP * 3 IF (ICHAR('5') .LT. ICHAR('9')) IVCOMP = IVCOMP * 5 40820 IF (IVCOMP - 30) 20820, 10820, 20820 30820 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10820, 0831, 20820 10820 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0831 20820 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0831 CONTINUE C C **** FCVS PROGRAM 204 - TEST 083 **** C C IVTNUM = 83 IF (ICZERO) 30830, 0830, 30830 0830 CONTINUE IVON01 = 0 IVON02 = 0 IVCOMP = 0 IVCORR = 9 DO 832, I=1,9 J = I + 1 IVON01 = ICHAR(CATN13(J)) IVON02 = ICHAR(CATN13(I)) IF (IVON02 .LT. IVON01) IVCOMP = IVCOMP + 1 832 CONTINUE 40830 IF (IVCOMP -9) 20830, 10830, 20830 30830 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10830, 0841, 20830 10830 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0841 20830 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0841 CONTINUE C C **** FCVS PROGRAM 204 - TEST 084 **** C C TEST 84 VERIFIES THAT BLANK IS LESS THAN THE LETTER A AND BLANK C IS LESS THAN THE DIGIT ZERO. THE INTRINSIC FUNCTION ICHAR IS C USED IN THIS TEST. C IVTNUM = 84 IF (ICZERO) 30840, 0840, 30840 0840 CONTINUE IVCOMP = 1 IVCORR = 6 IF (ICHAR(' ') .LT. ICHAR('A')) IVCOMP = IVCOMP * 2 IF (ICHAR(' ') .LT. ICHAR('0')) IVCOMP = IVCOMP * 3 40840 IF (IVCOMP - 6) 20840, 10840, 20840 30840 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10840, 0851, 20840 10840 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0851 20840 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0851 CONTINUE C C **** FCVS PROGRAM 204 - TEST 085 **** C C TEST 85 VERIFIES THAT THE DIGITS AND LETTERS ARE NOT INTERMIXED C IN THE COLLATING SEQUENCE. THE ICHAR INTRINSIC FUNCTION IS USED C TO VERIFY THAT EITHER ALL OF THE DIGITS PRECEDE A OR ALL OF THE C DIGITS FOLLOW Z. C IVTNUM = 85 IF (ICZERO) 30850, 0850, 30850 0850 CONTINUE IVCOMP = 0 IVCORR = 10 IF (ICHAR('0') .NE. ICHAR('A')) GO TO 852 IVCOMP = 111 GO TO 40850 852 IF (ICHAR('0') .GT. ICHAR('A')) GO TO 853 C C ZERO IS LESS THAN LETTER A ACCORDING TO ICHAR INTRINSIC C FUNCTION VALUE. THUS, THE ICHAR VALUE FOR ALL DIGITS MUST BE C LESS THAN ICHAR VALUE FOR LETTER A. C DO 854, I=1,10 IF (ICHAR(CATN13(I)) .LT. ICHAR('A')) IVCOMP = IVCOMP + 1 854 CONTINUE GO TO 40850 C C ZERO IS GREATER THAN LETTER A ACCORDING TO ICHAR INTRINSIC C FUNCTION VALUE. THUS, THE ICHAR VALUE FOR ALL DIGITS MUST BE C GREATER THAN ICHAR VALUE FOR LETTER Z. C 853 DO 855, I=1,10 IF (ICHAR(CATN13(I)).GT. ICHAR('Z')) IVCOMP = IVCOMP + 1 855 CONTINUE 40850 IF (IVCOMP - 10) 20850, 10850, 20850 30850 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10850, 0861, 20850 10850 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0861 20850 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0861 CONTINUE C C **** FCVS PROGRAM 204 - TEST 086 **** C C THE ARRAY IAON11 IS SET EQUAL TO THE ICHAR INTRINSIC FUNCTION C VALUE OF THE CORRESPONDING ELEMENT IN THE CATN11 ARRAY. THE C IAON11 ARRAY IS THEN SORTED IN ASCENDING ORDER, AND ENTRIES IN C THE CATN11 ARRAY ARE ARRANGED ACCORDING TO THE ASCENDING SORT C ORDER IN IAON11. THE RESULTING ORDER OF THE CATN11 ARRAY GIVES C THE PROCESSOR'S COLLATING SEQUENCE FOR THE FORTRAN SUBSET LANGUAGE C CHARACTER SET. THE CATN11 ARRAY IS PRINTED AND MUST BE VISUALLY C CHECKED TO DETERMINE IF THE COLLATING SEQUENCE RULES ARE FOLLOWED C BY THE COMPILER. C IVTNUM = 86 IF (ICZERO) 30860, 0860, 30860 0860 CONTINUE IVCOMP = 0 C C INITIALIZE IAON11 TO ZERO. DO 862 I=1,47 IAON11(I) = 0 862 CONTINUE C C PLACE ICHAR INTRINSIC VALUE IN IAON11. C DO 863, I= 1,47 IAON11(I) = ICHAR(CATN11(I)) 863 CONTINUE C C SORT FORTRAN CHARACTERS ACCORDING TO THEIR POSITION IN THE C COLLATING SEQUENCE. C DO 864, I=1,46 J=I N = I + 1 DO 865 K = N,47 IF (IAON11(J) .LT. IAON11(K)) GO TO 865 J=K 865 CONTINUE IVON01 = IAON11(J) IAON11(J)= IAON11(I) IAON11(I)= IVON01 CVTN01 = CATN11(J) CATN11(J) = CATN11(I) CATN11(I) = CVTN01 864 CONTINUE WRITE (I02, 866) CATN11 WRITE (I02, 867) IAON11 866 FORMAT (3X,'FORTRAN CHARACTER SET IN ASCENDING ORDER',3X,/ 1 3X, 'VISUAL VERIFICATION REQUIRED' //,3X, 12(A1,3X)/ 2 3X, 12(A1,3X)/ 3X, 12(A1,3X)/ 3X, 11(A1,3X)) 867 FORMAT ( 3X/3X, 'ICHAR INTRINSIC FUNCTION VALUES FOR FORTRAN ', 1 'CHARACTER SET'// 3X, 12I4/ 3X, 12I4/ 3X, 12I4/ 2 3X,11I4//) IVCOMP = 1 IVCORR = 1 40860 IF (IVCOMP - 1) 20860, 10860, 20860 30860 IVDELE = IVDELE + 1 WRITE (I02,80000) IVTNUM IF (ICZERO) 10860, 0871, 20860 10860 IVPASS = IVPASS + 1 WRITE (I02,80002) IVTNUM GO TO 0871 20860 IVFAIL = IVFAIL + 1 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 0871 CONTINUE C C C WRITE OUT TEST SUMMARY C WRITE (I02,90004) WRITE (I02,90014) WRITE (I02,90004) WRITE (I02,90000) WRITE (I02,90004) WRITE (I02,90020) IVFAIL WRITE (I02,90022) IVPASS WRITE (I02,90024) IVDELE STOP 90001 FORMAT (1H ,24X,5HFM204) 90000 FORMAT (1H ,20X,20HEND OF PROGRAM FM204) C C FORMATS FOR TEST DETAIL LINES C 80000 FORMAT (1H ,4X,I5,6X,7HDELETED) 80002 FORMAT (1H ,4X,I5,7X,4HPASS) 80010 FORMAT (1H ,4X,I5,7X,4HFAIL,10X,I6,9X,I6) 80012 FORMAT (1H ,4X,I5,7X,4HFAIL,4X,E12.5,3X,E12.5) 80018 FORMAT (1H ,4X,I5,7X,4HFAIL,2X,A14,1X,A14) C C FORMAT STATEMENTS FOR PAGE HEADERS C 90002 FORMAT (1H1) 90004 FORMAT (1H ) 90006 FORMAT (1H ,10X,34HFORTRAN COMPILER VALIDATION SYSTEM) 90008 FORMAT (1H ,21X,11HVERSION 1.0) 90010 FORMAT (1H ,8X,38HFOR OFFICIAL USE ONLY - COPYRIGHT 1978) 90012 FORMAT (1H ,5X,4HTEST,5X,9HPASS/FAIL,5X,8HCOMPUTED,8X,7HCORRECT) 90014 FORMAT (1H ,5X,46H----------------------------------------------) 90016 FORMAT (1H ,18X,17HSUBSET LEVEL TEST) C C FORMAT STATEMENTS FOR RUN SUMMARY C 90020 FORMAT (1H ,19X,I5,13H TESTS FAILED) 90022 FORMAT (1H ,19X,I5,13H TESTS PASSED) 90024 FORMAT (1H ,19X,I5,14H TESTS DELETED) END