This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[gfortran] Support INTEGER<->LOGICAL conversion (take 3)
- From: Roger Sayle <roger at eyesopen dot com>
- To: Paul Brook <paul at codesourcery dot com>
- Cc: fortran at gcc dot gnu dot org, <gcc-patches at gcc dot gnu dot org>
- Date: Sat, 28 May 2005 15:47:12 -0600 (MDT)
- Subject: [gfortran] Support INTEGER<->LOGICAL conversion (take 3)
Although Paul Brook had already approved the previous version of this
patch, support for it wasn't universal amongst gfortran maintainers,
and even his approval was conditional on resolving the on-by-default
issues.
Now that the GFC_STD_LEGACY infrastructure has been approved for
the gfortran front-end, this a resubmission of my patch treating
implicit logical to/from integer conversion as a "legacy" extension
for which we warn by default, and prohibit when compiling against
any official standard.
The patch is mostly identical except for changing GFC_STD_GNU to
GFC_STD_LEGACY in a few places, and permuting the dg-options
annotations in the three test programs, that check we generate no
warning with -std=legacy, hard errors with -std=f95 and warnings
by default.
To address Tobias' concerns about possible adverse interactions with
fortran's arithmetic if I've double checked that there's run-time
testing of this construct in gfortran.fortran-torture/arithmeticif.f90
and gfortran.dg/pr17229.f, and that both of these tests continue to
pass with this patch.
The following patch has been tested on i686-pc-linux-gnu, as before.
Ok for mainline, if everybody's happy?
2005-05-28 Roger Sayle <roger@eyesopen.com>
* gfortran.h (GFC_STD_LEGACY): New "standard" macro. Reindent.
* options.c (gfc_init_options): By default, allow legacy extensions
but warn about them.
(gfc_post_options): Make -pedantic warn about legacy extensions
even with -std=legacy.
(gfc_handle_option): Make -std=gnu follow the default behaviour
of warning about legacy extensions, but allowing them. Make the
new -std=legacy accept everything and warn about nothing.
* lang.opt (std=legacy): New F95 command line option.
* invoke.texi: Document both -std=f2003 and -std=legacy.
* gfortran.texi: Explain the two types of extensions and document
how they are affected by the various -std= command line options.
Index: intrinsic.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/intrinsic.c,v
retrieving revision 1.46
diff -c -3 -p -r1.46 intrinsic.c
*** intrinsic.c 25 Apr 2005 00:08:59 -0000 1.46
--- intrinsic.c 28 May 2005 20:31:27 -0000
*************** add_subroutines (void)
*** 2227,2234 ****
/* 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;
--- 2227,2233 ----
/* 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
*** 2250,2258 ****
sym = conversion + nconv;
! sym->name = conv_name (&from, &to);
sym->lib_name = sym->name;
! sym->simplify.cc = simplify;
sym->elemental = 1;
sym->ts = to;
sym->generic_id = GFC_ISYM_CONVERSION;
--- 2249,2258 ----
sym = conversion + nconv;
! sym->name = conv_name (&from, &to);
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)
*** 2277,2283 ****
continue;
add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
! BT_INTEGER, gfc_integer_kinds[j].kind, gfc_convert_constant);
}
/* Integer-Real/Complex conversions. */
--- 2277,2283 ----
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)
*** 2285,2300 ****
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. */
--- 2285,2300 ----
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)
*** 2304,2320 ****
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. */
--- 2304,2320 ----
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)
*** 2325,2332 ****
continue;
add_conv (BT_LOGICAL, gfc_logical_kinds[i].kind,
! BT_LOGICAL, gfc_logical_kinds[j].kind, gfc_convert_constant);
}
}
--- 2325,2343 ----
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_LEGACY) != 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_LEGACY);
+ add_conv (BT_LOGICAL, gfc_logical_kinds[j].kind,
+ BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
+ }
}
*************** gfc_convert_type_warn (gfc_expr * expr,
*** 3142,3148 ****
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);
--- 3153,3162 ----
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.25
diff -c -3 -p -r1.25 simplify.c
*** simplify.c 14 Apr 2005 16:29:31 -0000 1.25
--- simplify.c 28 May 2005 20:31:28 -0000
*************** gfc_convert_constant (gfc_expr * e, bt t
*** 3659,3664 ****
--- 3659,3667 ----
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
*** 3700,3708 ****
break;
case BT_LOGICAL:
! if (type != BT_LOGICAL)
! goto oops;
! f = gfc_log2log;
break;
default:
--- 3703,3719 ----
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.26
diff -c -3 -p -r1.26 arith.c
*** arith.c 14 Apr 2005 16:29:31 -0000 1.26
--- arith.c 28 May 2005 20:31:28 -0000
*************** gfc_log2log (gfc_expr * src, int kind)
*** 2158,2160 ****
--- 2158,2183 ----
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 28 May 2005 20:31:28 -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 */
Index: gfortran.texi
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/gfortran.texi,v
retrieving revision 1.13
diff -c -3 -p -r1.13 gfortran.texi
*** gfortran.texi 23 May 2005 03:20:19 -0000 1.13
--- gfortran.texi 28 May 2005 20:31:28 -0000
*************** Variable for swapping Endianness during
*** 618,624 ****
@command{gfortran} implements a number of extensions over standard
Fortran. This chapter contains information on their syntax and
! meaning.
@menu
* Old-style kind specifications::
--- 618,631 ----
@command{gfortran} implements a number of extensions over standard
Fortran. This chapter contains information on their syntax and
! meaning. There are currently two categories of @command{gfortran}
! extensions, those that provide functionality beyond that provided
! by any standard, and those that are supported by @command{gfortran}
! purely for backward compatability with legacy compilers. By default,
! @option{-std=gnu} allows the compiler to accept both types of
! extensions, but to warn about the use of the latter. Specifying
! either @option{-std=f95} or @option{-std=f2003} disables both types
! of extensions, and @option{-std=legacy} allows both without warning.
@menu
* Old-style kind specifications::
*************** meaning.
*** 630,635 ****
--- 637,643 ----
* Hexadecimal constants::
* Real array indices::
* Unary operators::
+ * Implicitly interconvert LOGICAL and INTEGER::
@end menu
@node Old-style kind specifications
*************** operators without the need for parenthes
*** 786,791 ****
--- 794,815 ----
X = Y * -Z
@end smallexample
+ @node Implicitly interconvert LOGICAL and INTEGER
+ @section Implicitly interconvert LOGICAL and INTEGER
+ @cindex Implicitly interconvert LOGICAL and INTEGER
+
+ As a GNU extension for backwards compatability with other compilers,
+ @command{gfortran} allows the implicit conversion of LOGICALs to INTEGERs
+ and vice versa. When converting from a LOGICAL to an INTEGER, the numeric
+ value of @code{.FALSE.} is zero, and that of @code{.TRUE.} is one. When
+ converting from INTEGER to LOGICAL, the value zero is interpreted as
+ @code{.FALSE.} and any non-zero value is interpreted as @code{.TRUE.}.
+
+ @smallexample
+ INTEGER*4 i
+ i = .FALSE.
+ @end smallexample
+
@include intrinsic.texi
@c ---------------------------------------------------------------------
@c Contributing
c { dg-do compile }
c { dg-options "-O2 -std=legacy" }
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" }
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
--