From 7b9c708f1527051df149a21318aff0b6ba531fa8 Mon Sep 17 00:00:00 2001 From: Jakub Jelinek Date: Mon, 27 Mar 2006 14:27:40 +0200 Subject: [PATCH] f95-lang.c (gfc_get_alias_set): New function. * f95-lang.c (gfc_get_alias_set): New function. (LANG_HOOKS_GET_ALIAS_SET): Define. * gfortran.fortran-torture/execute/equiv_5.f: New test. From-SVN: r112416 --- gcc/fortran/ChangeLog | 5 + gcc/fortran/f95-lang.c | 21 ++ gcc/testsuite/ChangeLog | 4 + .../execute/equiv_5.f | 225 ++++++++++++++++++ 4 files changed, 255 insertions(+) create mode 100644 gcc/testsuite/gfortran.fortran-torture/execute/equiv_5.f diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e5245db20f7..b6e4cae77f4 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2006-03-27 Jakub Jelinek + + * f95-lang.c (gfc_get_alias_set): New function. + (LANG_HOOKS_GET_ALIAS_SET): Define. + 2006-03-25 Steven G. Kargl PR fortran/26816 diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c index 6722117dd1b..72579246515 100644 --- a/gcc/fortran/f95-lang.c +++ b/gcc/fortran/f95-lang.c @@ -99,6 +99,7 @@ void insert_block (tree); static void gfc_clear_binding_stack (void); static void gfc_be_parse_file (int); static void gfc_expand_function (tree); +static HOST_WIDE_INT gfc_get_alias_set (tree); #undef LANG_HOOKS_NAME #undef LANG_HOOKS_INIT @@ -116,6 +117,7 @@ static void gfc_expand_function (tree); #undef LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE #undef LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION #undef LANG_HOOKS_CLEAR_BINDING_STACK +#undef LANG_HOOKS_GET_ALIAS_SET #undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE #undef LANG_HOOKS_OMP_PREDETERMINED_SHARING #undef LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR @@ -139,6 +141,7 @@ static void gfc_expand_function (tree); #define LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE gfc_signed_or_unsigned_type #define LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION gfc_expand_function #define LANG_HOOKS_CLEAR_BINDING_STACK gfc_clear_binding_stack +#define LANG_HOOKS_GET_ALIAS_SET gfc_get_alias_set #define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE gfc_omp_privatize_by_reference #define LANG_HOOKS_OMP_PREDETERMINED_SHARING gfc_omp_predetermined_sharing #define LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR gfc_omp_disregard_value_expr @@ -694,6 +697,24 @@ gfc_mark_addressable (tree exp) } } +/* Return the typed-based alias set for T, which may be an expression + or a type. Return -1 if we don't do anything special. */ + +static HOST_WIDE_INT +gfc_get_alias_set (tree t) +{ + tree u; + + /* Permit type-punning when accessing an EQUIVALENCEd variable or + mixed type entry master's return value. */ + for (u = t; handled_component_p (u); u = TREE_OPERAND (u, 0)) + if (TREE_CODE (u) == COMPONENT_REF + && TREE_CODE (TREE_TYPE (TREE_OPERAND (u, 0))) == UNION_TYPE) + return 0; + + return -1; +} + /* press the big red button - garbage (ggc) collection is on */ int ggc_p = 1; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 2d03afbad6f..23585329300 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2006-03-27 Jakub Jelinek + + * gfortran.fortran-torture/execute/equiv_5.f: New test. + 2006-03-26 Jerry DeLisle PR libgfortran/26661 diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/equiv_5.f b/gcc/testsuite/gfortran.fortran-torture/execute/equiv_5.f new file mode 100644 index 00000000000..b20797ee3f7 --- /dev/null +++ b/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 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 SMALL(2) + INTEGER LARGE(2) + INTEGER RIGHT(2) + INTEGER DIVER(2) + INTEGER LOG10(2) + INTEGER 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 INTEGERS. +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 +*#include +*#include +*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 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