This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[gfortran] Support INTEGER<->LOGICAL conversion as GNU extension


This patch is a ping/repost/take #2 of my post from February:
http://gcc.gnu.org/ml/gcc-patches/2005-02/msg00213.html

In addition to some minor clean-ups, it allows implicit conversion
between LOGICALs and INTEGERs as supported by many compilers including
g77 (using -fugly-logint) and SGI's MIPSPro f77.  The only comment to
my original post, was that GNU extensions should be documented in the
gfortran manual, and this revised patch below includes that requested
documentation.

The following patch has been tested on i686-pc-linux-gnu with a bootstrap
including f95, and regression tested with a top-level "make -k check" with
no regressions.

OK for mainline?


2005-05-27  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.texi: Document this new GNU extension.

	* 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.46
diff -c -3 -p -r1.46 intrinsic.c
*** intrinsic.c	25 Apr 2005 00:08:59 -0000	1.46
--- intrinsic.c	27 May 2005 21:14:53 -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_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,
*** 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	27 May 2005 21:14:54 -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	27 May 2005 21:14:54 -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	27 May 2005 21:14:54 -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	27 May 2005 21:14:54 -0000
*************** meaning.
*** 630,635 ****
--- 630,636 ----
  * 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 ****
--- 787,808 ----
         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" }
       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
--


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]