aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/execute/equiv_5.f
diff options
context:
space:
mode:
Diffstat (limited to 'gcc-4.9/gcc/testsuite/gfortran.fortran-torture/execute/equiv_5.f')
-rw-r--r--gcc-4.9/gcc/testsuite/gfortran.fortran-torture/execute/equiv_5.f225
1 files changed, 225 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/execute/equiv_5.f b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/execute/equiv_5.f
new file mode 100644
index 000000000..61f374c55
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/gfortran.fortran-torture/execute/equiv_5.f
@@ -0,0 +1,225 @@
+C This testcase was miscompiled on i?86/x86_64, the scheduler
+C swapped write to DMACH(1) with following read from SMALL(1),
+C at -O2+, as the front-end didn't signal in any way this kind
+C of type punning is ok.
+C The testcase is from blas, http://www.netlib.org/blas/d1mach.f
+
+ DOUBLE PRECISION FUNCTION D1MACH(I)
+ INTEGER*4 I
+C
+C DOUBLE-PRECISION MACHINE CONSTANTS
+C D1MACH( 1) = B**(EMIN-1), THE SMALLEST POSITIVE MAGNITUDE.
+C D1MACH( 2) = B**EMAX*(1 - B**(-T)), THE LARGEST MAGNITUDE.
+C D1MACH( 3) = B**(-T), THE SMALLEST RELATIVE SPACING.
+C D1MACH( 4) = B**(1-T), THE LARGEST RELATIVE SPACING.
+C D1MACH( 5) = LOG10(B)
+C
+ INTEGER*4 SMALL(2)
+ INTEGER*4 LARGE(2)
+ INTEGER*4 RIGHT(2)
+ INTEGER*4 DIVER(2)
+ INTEGER*4 LOG10(2)
+ INTEGER*4 SC, CRAY1(38), J
+ COMMON /D9MACH/ CRAY1
+ SAVE SMALL, LARGE, RIGHT, DIVER, LOG10, SC
+ DOUBLE PRECISION DMACH(5)
+ EQUIVALENCE (DMACH(1),SMALL(1))
+ EQUIVALENCE (DMACH(2),LARGE(1))
+ EQUIVALENCE (DMACH(3),RIGHT(1))
+ EQUIVALENCE (DMACH(4),DIVER(1))
+ EQUIVALENCE (DMACH(5),LOG10(1))
+C THIS VERSION ADAPTS AUTOMATICALLY TO MOST CURRENT MACHINES.
+C R1MACH CAN HANDLE AUTO-DOUBLE COMPILING, BUT THIS VERSION OF
+C D1MACH DOES NOT, BECAUSE WE DO NOT HAVE QUAD CONSTANTS FOR
+C MANY MACHINES YET.
+C TO COMPILE ON OLDER MACHINES, ADD A C IN COLUMN 1
+C ON THE NEXT LINE
+ DATA SC/0/
+C AND REMOVE THE C FROM COLUMN 1 IN ONE OF THE SECTIONS BELOW.
+C CONSTANTS FOR EVEN OLDER MACHINES CAN BE OBTAINED BY
+C mail netlib@research.bell-labs.com
+C send old1mach from blas
+C PLEASE SEND CORRECTIONS TO dmg OR ehg@bell-labs.com.
+C
+C MACHINE CONSTANTS FOR THE HONEYWELL DPS 8/70 SERIES.
+C DATA SMALL(1),SMALL(2) / O402400000000, O000000000000 /
+C DATA LARGE(1),LARGE(2) / O376777777777, O777777777777 /
+C DATA RIGHT(1),RIGHT(2) / O604400000000, O000000000000 /
+C DATA DIVER(1),DIVER(2) / O606400000000, O000000000000 /
+C DATA LOG10(1),LOG10(2) / O776464202324, O117571775714 /, SC/987/
+C
+C MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING
+C 32-BIT INTEGER*4S.
+C DATA SMALL(1),SMALL(2) / 8388608, 0 /
+C DATA LARGE(1),LARGE(2) / 2147483647, -1 /
+C DATA RIGHT(1),RIGHT(2) / 612368384, 0 /
+C DATA DIVER(1),DIVER(2) / 620756992, 0 /
+C DATA LOG10(1),LOG10(2) / 1067065498, -2063872008 /, SC/987/
+C
+C MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES.
+C DATA SMALL(1),SMALL(2) / O000040000000, O000000000000 /
+C DATA LARGE(1),LARGE(2) / O377777777777, O777777777777 /
+C DATA RIGHT(1),RIGHT(2) / O170540000000, O000000000000 /
+C DATA DIVER(1),DIVER(2) / O170640000000, O000000000000 /
+C DATA LOG10(1),LOG10(2) / O177746420232, O411757177572 /, SC/987/
+C
+C ON FIRST CALL, IF NO DATA UNCOMMENTED, TEST MACHINE TYPES.
+ IF (SC .NE. 987) THEN
+ DMACH(1) = 1.D13
+ IF ( SMALL(1) .EQ. 1117925532
+ * .AND. SMALL(2) .EQ. -448790528) THEN
+* *** IEEE BIG ENDIAN ***
+ SMALL(1) = 1048576
+ SMALL(2) = 0
+ LARGE(1) = 2146435071
+ LARGE(2) = -1
+ RIGHT(1) = 1017118720
+ RIGHT(2) = 0
+ DIVER(1) = 1018167296
+ DIVER(2) = 0
+ LOG10(1) = 1070810131
+ LOG10(2) = 1352628735
+ ELSE IF ( SMALL(2) .EQ. 1117925532
+ * .AND. SMALL(1) .EQ. -448790528) THEN
+* *** IEEE LITTLE ENDIAN ***
+ SMALL(2) = 1048576
+ SMALL(1) = 0
+ LARGE(2) = 2146435071
+ LARGE(1) = -1
+ RIGHT(2) = 1017118720
+ RIGHT(1) = 0
+ DIVER(2) = 1018167296
+ DIVER(1) = 0
+ LOG10(2) = 1070810131
+ LOG10(1) = 1352628735
+ ELSE IF ( SMALL(1) .EQ. -2065213935
+ * .AND. SMALL(2) .EQ. 10752) THEN
+* *** VAX WITH D_FLOATING ***
+ SMALL(1) = 128
+ SMALL(2) = 0
+ LARGE(1) = -32769
+ LARGE(2) = -1
+ RIGHT(1) = 9344
+ RIGHT(2) = 0
+ DIVER(1) = 9472
+ DIVER(2) = 0
+ LOG10(1) = 546979738
+ LOG10(2) = -805796613
+ ELSE IF ( SMALL(1) .EQ. 1267827943
+ * .AND. SMALL(2) .EQ. 704643072) THEN
+* *** IBM MAINFRAME ***
+ SMALL(1) = 1048576
+ SMALL(2) = 0
+ LARGE(1) = 2147483647
+ LARGE(2) = -1
+ RIGHT(1) = 856686592
+ RIGHT(2) = 0
+ DIVER(1) = 873463808
+ DIVER(2) = 0
+ LOG10(1) = 1091781651
+ LOG10(2) = 1352628735
+ ELSE IF ( SMALL(1) .EQ. 1120022684
+ * .AND. SMALL(2) .EQ. -448790528) THEN
+* *** CONVEX C-1 ***
+ SMALL(1) = 1048576
+ SMALL(2) = 0
+ LARGE(1) = 2147483647
+ LARGE(2) = -1
+ RIGHT(1) = 1019215872
+ RIGHT(2) = 0
+ DIVER(1) = 1020264448
+ DIVER(2) = 0
+ LOG10(1) = 1072907283
+ LOG10(2) = 1352628735
+ ELSE IF ( SMALL(1) .EQ. 815547074
+ * .AND. SMALL(2) .EQ. 58688) THEN
+* *** VAX G-FLOATING ***
+ SMALL(1) = 16
+ SMALL(2) = 0
+ LARGE(1) = -32769
+ LARGE(2) = -1
+ RIGHT(1) = 15552
+ RIGHT(2) = 0
+ DIVER(1) = 15568
+ DIVER(2) = 0
+ LOG10(1) = 1142112243
+ LOG10(2) = 2046775455
+ ELSE
+ DMACH(2) = 1.D27 + 1
+ DMACH(3) = 1.D27
+ LARGE(2) = LARGE(2) - RIGHT(2)
+ IF (LARGE(2) .EQ. 64 .AND. SMALL(2) .EQ. 0) THEN
+ CRAY1(1) = 67291416
+ DO 10 J = 1, 20
+ CRAY1(J+1) = CRAY1(J) + CRAY1(J)
+ 10 CONTINUE
+ CRAY1(22) = CRAY1(21) + 321322
+ DO 20 J = 22, 37
+ CRAY1(J+1) = CRAY1(J) + CRAY1(J)
+ 20 CONTINUE
+ IF (CRAY1(38) .EQ. SMALL(1)) THEN
+* *** CRAY ***
+ CALL I1MCRY(SMALL(1), J, 8285, 8388608, 0)
+ SMALL(2) = 0
+ CALL I1MCRY(LARGE(1), J, 24574, 16777215, 16777215)
+ CALL I1MCRY(LARGE(2), J, 0, 16777215, 16777214)
+ CALL I1MCRY(RIGHT(1), J, 16291, 8388608, 0)
+ RIGHT(2) = 0
+ CALL I1MCRY(DIVER(1), J, 16292, 8388608, 0)
+ DIVER(2) = 0
+ CALL I1MCRY(LOG10(1), J, 16383, 10100890, 8715215)
+ CALL I1MCRY(LOG10(2), J, 0, 16226447, 9001388)
+ ELSE
+ WRITE(*,9000)
+ STOP 779
+ END IF
+ ELSE
+ WRITE(*,9000)
+ STOP 779
+ END IF
+ END IF
+ SC = 987
+ END IF
+* SANITY CHECK
+ IF (DMACH(4) .GE. 1.0D0) STOP 778
+ IF (I .LT. 1 .OR. I .GT. 5) THEN
+ WRITE(*,*) 'D1MACH(I): I =',I,' is out of bounds.'
+ STOP
+ END IF
+ D1MACH = DMACH(I)
+ RETURN
+ 9000 FORMAT(/' Adjust D1MACH by uncommenting data statements'/
+ *' appropriate for your machine.')
+* /* Standard C source for D1MACH -- remove the * in column 1 */
+*#include <stdio.h>
+*#include <float.h>
+*#include <math.h>
+*double d1mach_(long *i)
+*{
+* switch(*i){
+* case 1: return DBL_MIN;
+* case 2: return DBL_MAX;
+* case 3: return DBL_EPSILON/FLT_RADIX;
+* case 4: return DBL_EPSILON;
+* case 5: return log10((double)FLT_RADIX);
+* }
+* fprintf(stderr, "invalid argument: d1mach(%ld)\n", *i);
+* exit(1); return 0; /* some compilers demand return values */
+*}
+ END
+ SUBROUTINE I1MCRY(A, A1, B, C, D)
+**** SPECIAL COMPUTATION FOR OLD CRAY MACHINES ****
+ INTEGER*4 A, A1, B, C, D
+ A1 = 16777216*B + C
+ A = 16777216*A1 + D
+ END
+
+ PROGRAM MAIN
+ DOUBLE PRECISION D1MACH
+ EXTERNAL D1MACH
+ PRINT *,D1MACH(1)
+ PRINT *,D1MACH(2)
+ PRINT *,D1MACH(3)
+ PRINT *,D1MACH(4)
+ PRINT *,D1MACH(5)
+ END