This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[gfortran] Support integer <-> logical conversion as GNU extension
- From: Roger Sayle <roger at eyesopen dot com>
- To: fortran at gcc dot gnu dot org
- Cc: gcc-patches at gcc dot gnu dot org
- Date: Sun, 6 Feb 2005 14:33:53 -0700 (MST)
- Subject: [gfortran] Support integer <-> logical conversion as GNU extension
The following patch adds the ability to implicitly convert between integer
and logical types to the gfortran front-end as a GNU extension. This
functionality is commonly supported by several compilers including IRIX's
f77 and g77 when using the -fugly-logint command line option. Without
this functionality, gfortran is unable to build some dusty-deck codes,
such as the semi-empirical quantum mechanics program MOPAC, which compiles
without warnings using SGI's MIPSPro f77 compiler.
One possibility was to add support for g77's -fugly-logint to gfortran,
however a much cleaner solution is to treat it as an extension using
gfortran's standard handling mechanism. This allows us to automatically
generate errors when compiling against the f95 and f2003 standards, and
issue warnings when the user specifies "-pedantic".
It's also an idiom that C/C++ programs have been able to use for years :)
The following patch has been tested on i686-pc-linux-gnu with a full
"make bootstrap", including gfortran, and regression tested with a
top-level "make -k check" with no new failures (there were previously
no tests that we issued a diagnostic in this case). The patch below
also includes three new testcases that check that these implicit
conversions are allowed by default, generate warnings with "-pedantic"
and generate errors with "-std=f95".
Ok for mainline?
2005-02-06 Roger Sayle <roger@eyesopen.com>
* intrinsic.c (add_conv): No longer take a "simplify" argument as
its always gfc_convert_constant, instead take a "standard" argument.
(add_conversions): Change all existing calls of add_conv to pass
GFC_STD_F77 as appropriate. Additionally, if we're allowing GNU
extensions support integer-logical and logical-integer conversions.
(gfc_convert_type_warn): Warn about use the use of these conversions
as a extension when appropriate, i.e. with -pedantic.
* simplify.c (gfc_convert_constant): Add support for integer to
logical and logical to integer conversions, using gfc_int2log and
gfc_log2int.
* arith.c (gfc_log2int, gfc_int2log): New functions.
* arith.h (gfc_log2int, gfc_int2log): Prototype here.
* gfortran.dg/logint-1.f: New test case.
* gfortran.dg/logint-2.f: Likewise.
* gfortran.dg/logint-3.f: Likewise.
Index: intrinsic.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/intrinsic.c,v
retrieving revision 1.38
diff -c -3 -p -r1.38 intrinsic.c
*** intrinsic.c 29 Jan 2005 17:46:31 -0000 1.38
--- intrinsic.c 6 Feb 2005 17:20:15 -0000
*************** add_subroutines (void)
*** 2129,2136 ****
/* Add a function to the list of conversion symbols. */
static void
! add_conv (bt from_type, int from_kind, bt to_type, int to_kind,
! gfc_expr * (*simplify) (gfc_expr *, bt, int))
{
gfc_typespec from, to;
--- 2129,2135 ----
/* Add a function to the list of conversion symbols. */
static void
! add_conv (bt from_type, int from_kind, bt to_type, int to_kind, int standard)
{
gfc_typespec from, to;
*************** add_conv (bt from_type, int from_kind, b
*** 2154,2160 ****
strcpy (sym->name, conv_name (&from, &to));
strcpy (sym->lib_name, sym->name);
! sym->simplify.cc = simplify;
sym->elemental = 1;
sym->ts = to;
sym->generic_id = GFC_ISYM_CONVERSION;
--- 2153,2160 ----
strcpy (sym->name, conv_name (&from, &to));
strcpy (sym->lib_name, sym->name);
! sym->simplify.cc = gfc_convert_constant;
! sym->standard = standard;
sym->elemental = 1;
sym->ts = to;
sym->generic_id = GFC_ISYM_CONVERSION;
*************** add_conversions (void)
*** 2179,2185 ****
continue;
add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
! BT_INTEGER, gfc_integer_kinds[j].kind, gfc_convert_constant);
}
/* Integer-Real/Complex conversions. */
--- 2179,2185 ----
continue;
add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
! BT_INTEGER, gfc_integer_kinds[j].kind, GFC_STD_F77);
}
/* Integer-Real/Complex conversions. */
*************** add_conversions (void)
*** 2187,2202 ****
for (j = 0; gfc_real_kinds[j].kind != 0; j++)
{
add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
! BT_REAL, gfc_real_kinds[j].kind, gfc_convert_constant);
add_conv (BT_REAL, gfc_real_kinds[j].kind,
! BT_INTEGER, gfc_integer_kinds[i].kind, gfc_convert_constant);
add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
! BT_COMPLEX, gfc_real_kinds[j].kind, gfc_convert_constant);
add_conv (BT_COMPLEX, gfc_real_kinds[j].kind,
! BT_INTEGER, gfc_integer_kinds[i].kind, gfc_convert_constant);
}
/* Real/Complex - Real/Complex conversions. */
--- 2187,2202 ----
for (j = 0; gfc_real_kinds[j].kind != 0; j++)
{
add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
! BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
add_conv (BT_REAL, gfc_real_kinds[j].kind,
! BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
! BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
add_conv (BT_COMPLEX, gfc_real_kinds[j].kind,
! BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
}
/* Real/Complex - Real/Complex conversions. */
*************** add_conversions (void)
*** 2206,2222 ****
if (i != j)
{
add_conv (BT_REAL, gfc_real_kinds[i].kind,
! BT_REAL, gfc_real_kinds[j].kind, gfc_convert_constant);
add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
! BT_COMPLEX, gfc_real_kinds[j].kind, gfc_convert_constant);
}
add_conv (BT_REAL, gfc_real_kinds[i].kind,
! BT_COMPLEX, gfc_real_kinds[j].kind, gfc_convert_constant);
add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
! BT_REAL, gfc_real_kinds[j].kind, gfc_convert_constant);
}
/* Logical/Logical kind conversion. */
--- 2206,2222 ----
if (i != j)
{
add_conv (BT_REAL, gfc_real_kinds[i].kind,
! BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
! BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
}
add_conv (BT_REAL, gfc_real_kinds[i].kind,
! BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
! BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
}
/* Logical/Logical kind conversion. */
*************** add_conversions (void)
*** 2227,2234 ****
continue;
add_conv (BT_LOGICAL, gfc_logical_kinds[i].kind,
! BT_LOGICAL, gfc_logical_kinds[j].kind, gfc_convert_constant);
}
}
--- 2227,2245 ----
continue;
add_conv (BT_LOGICAL, gfc_logical_kinds[i].kind,
! BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_F77);
}
+
+ /* Integer-Logical and Logical-Integer conversions. */
+ if ((gfc_option.allow_std & GFC_STD_GNU) != 0)
+ for (i=0; gfc_integer_kinds[i].kind; i++)
+ for (j=0; gfc_logical_kinds[j].kind; j++)
+ {
+ add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
+ BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_GNU);
+ add_conv (BT_LOGICAL, gfc_logical_kinds[j].kind,
+ BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_GNU);
+ }
}
*************** gfc_convert_type_warn (gfc_expr * expr,
*** 3044,3050 ****
goto bad;
/* At this point, a conversion is necessary. A warning may be needed. */
! if (wflag && gfc_option.warn_conversion)
gfc_warning_now ("Conversion from %s to %s at %L",
gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
--- 3055,3064 ----
goto bad;
/* At this point, a conversion is necessary. A warning may be needed. */
! if ((gfc_option.warn_std & sym->standard) != 0)
! gfc_warning_now ("Extension: Conversion from %s to %s at %L",
! gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
! else if (wflag && gfc_option.warn_conversion)
gfc_warning_now ("Conversion from %s to %s at %L",
gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
Index: simplify.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/simplify.c,v
retrieving revision 1.17
diff -c -3 -p -r1.17 simplify.c
*** simplify.c 18 Jan 2005 12:11:54 -0000 1.17
--- simplify.c 6 Feb 2005 17:20:15 -0000
*************** gfc_convert_constant (gfc_expr * e, bt t
*** 3675,3680 ****
--- 3675,3683 ----
case BT_COMPLEX:
f = gfc_int2complex;
break;
+ case BT_LOGICAL:
+ f = gfc_int2log;
+ break;
default:
goto oops;
}
*************** gfc_convert_constant (gfc_expr * e, bt t
*** 3716,3724 ****
break;
case BT_LOGICAL:
! if (type != BT_LOGICAL)
! goto oops;
! f = gfc_log2log;
break;
default:
--- 3719,3735 ----
break;
case BT_LOGICAL:
! switch (type)
! {
! case BT_INTEGER:
! f = gfc_log2int;
! break;
! case BT_LOGICAL:
! f = gfc_log2log;
! break;
! default:
! goto oops;
! }
break;
default:
Index: arith.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/arith.c,v
retrieving revision 1.21
diff -c -3 -p -r1.21 arith.c
*** arith.c 23 Jan 2005 22:29:39 -0000 1.21
--- arith.c 6 Feb 2005 17:20:16 -0000
*************** gfc_log2log (gfc_expr * src, int kind)
*** 2246,2248 ****
--- 2246,2271 ----
return result;
}
+
+ /* Convert logical to integer. */
+
+ gfc_expr *
+ gfc_log2int (gfc_expr *src, int kind)
+ {
+ gfc_expr *result;
+ result = gfc_constant_result (BT_INTEGER, kind, &src->where);
+ mpz_set_si (result->value.integer, src->value.logical);
+ return result;
+ }
+
+ /* Convert integer to logical. */
+
+ gfc_expr *
+ gfc_int2log (gfc_expr *src, int kind)
+ {
+ gfc_expr *result;
+ result = gfc_constant_result (BT_LOGICAL, kind, &src->where);
+ result->value.logical = (mpz_cmp_si (src->value.integer, 0) != 0);
+ return result;
+ }
+
Index: arith.h
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/arith.h,v
retrieving revision 1.4
diff -c -3 -p -r1.4 arith.h
*** arith.h 6 Aug 2004 20:36:04 -0000 1.4
--- arith.h 6 Feb 2005 17:20:16 -0000
*************** gfc_expr *gfc_complex2int (gfc_expr *, i
*** 80,85 ****
--- 80,87 ----
gfc_expr *gfc_complex2real (gfc_expr *, int);
gfc_expr *gfc_complex2complex (gfc_expr *, int);
gfc_expr *gfc_log2log (gfc_expr *, int);
+ gfc_expr *gfc_log2int (gfc_expr *, int);
+ gfc_expr *gfc_int2log (gfc_expr *, int);
#endif /* GFC_ARITH_H */
c { dg-do compile }
c { dg-options "-O2" }
LOGICAL*1 l1
LOGICAL*2 l2
LOGICAL*4 l4
INTEGER*1 i1
INTEGER*2 i2
INTEGER*4 i4
i1 = .TRUE.
i2 = .TRUE.
i4 = .TRUE.
i1 = .FALSE.
i2 = .FALSE.
i4 = .FALSE.
i1 = l1
i2 = l1
i4 = l1
i1 = l2
i2 = l2
i4 = l2
i1 = l4
i2 = l4
i4 = l4
l1 = i1
l2 = i1
l4 = i1
l1 = i2
l2 = i2
l4 = i2
l1 = i4
l2 = i4
l4 = i4
END
c { dg-do compile }
c { dg-options "-O2 -std=f95" }
LOGICAL*1 l1
LOGICAL*2 l2
LOGICAL*4 l4
INTEGER*1 i1
INTEGER*2 i2
INTEGER*4 i4
i1 = .TRUE. ! { dg-error "convert" }
i2 = .TRUE. ! { dg-error "convert" }
i4 = .TRUE. ! { dg-error "convert" }
i1 = .FALSE. ! { dg-error "convert" }
i2 = .FALSE. ! { dg-error "convert" }
i4 = .FALSE. ! { dg-error "convert" }
i1 = l1 ! { dg-error "convert" }
i2 = l1 ! { dg-error "convert" }
i4 = l1 ! { dg-error "convert" }
i1 = l2 ! { dg-error "convert" }
i2 = l2 ! { dg-error "convert" }
i4 = l2 ! { dg-error "convert" }
i1 = l4 ! { dg-error "convert" }
i2 = l4 ! { dg-error "convert" }
i4 = l4 ! { dg-error "convert" }
l1 = i1 ! { dg-error "convert" }
l2 = i1 ! { dg-error "convert" }
l4 = i1 ! { dg-error "convert" }
l1 = i2 ! { dg-error "convert" }
l2 = i2 ! { dg-error "convert" }
l4 = i2 ! { dg-error "convert" }
l1 = i4 ! { dg-error "convert" }
l2 = i4 ! { dg-error "convert" }
l4 = i4 ! { dg-error "convert" }
END
c { dg-do compile }
c { dg-options "-O2 -pedantic" }
LOGICAL*1 l1
LOGICAL*2 l2
LOGICAL*4 l4
INTEGER*1 i1
INTEGER*2 i2
INTEGER*4 i4
i1 = .TRUE. ! { dg-warning "Extension: Conversion" }
i2 = .TRUE. ! { dg-warning "Extension: Conversion" }
i4 = .TRUE. ! { dg-warning "Extension: Conversion" }
i1 = .FALSE. ! { dg-warning "Extension: Conversion" }
i2 = .FALSE. ! { dg-warning "Extension: Conversion" }
i4 = .FALSE. ! { dg-warning "Extension: Conversion" }
i1 = l1 ! { dg-warning "Extension: Conversion" }
i2 = l1 ! { dg-warning "Extension: Conversion" }
i4 = l1 ! { dg-warning "Extension: Conversion" }
i1 = l2 ! { dg-warning "Extension: Conversion" }
i2 = l2 ! { dg-warning "Extension: Conversion" }
i4 = l2 ! { dg-warning "Extension: Conversion" }
i1 = l4 ! { dg-warning "Extension: Conversion" }
i2 = l4 ! { dg-warning "Extension: Conversion" }
i4 = l4 ! { dg-warning "Extension: Conversion" }
l1 = i1 ! { dg-warning "Extension: Conversion" }
l2 = i1 ! { dg-warning "Extension: Conversion" }
l4 = i1 ! { dg-warning "Extension: Conversion" }
l1 = i2 ! { dg-warning "Extension: Conversion" }
l2 = i2 ! { dg-warning "Extension: Conversion" }
l4 = i2 ! { dg-warning "Extension: Conversion" }
l1 = i4 ! { dg-warning "Extension: Conversion" }
l2 = i4 ! { dg-warning "Extension: Conversion" }
l4 = i4 ! { dg-warning "Extension: Conversion" }
END
Roger
--
Roger Sayle, E-mail: roger@eyesopen.com
OpenEye Scientific Software, WWW: http://www.eyesopen.com/
Suite 1107, 3600 Cerrillos Road, Tel: (+1) 505-473-7385
Santa Fe, New Mexico, 87507. Fax: (+1) 505-473-0833