OSDN Git Service

testsuite
authorsteven <steven@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 2 Oct 2008 18:51:12 +0000 (18:51 +0000)
committersteven <steven@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 2 Oct 2008 18:51:12 +0000 (18:51 +0000)
* gfortran.fortran-torture/execute/intrinsic_leadz.f90: New test.
* gfortran.fortran-torture/execute/intrinsic_trailz.f90: New test.

fortran/
PR fortran/37635
* intrinsic.c (add_functions): Add LEADZ and TRAILZ as generics.
* intrinsic.h (gfc_simplify_leadz, gfc_simplify_trailz): New protos.
* gfortran.h <enum gfc_isym_id>: (GFC_ISYM_LEADZ, GFC_ISYM_TRAILZ): New.
* f95-lang (gfc_init_builtin_functions): Add BUILT_IN_CLZ,
BUILT_IN_CLZL, BUILT_IN_CLZLL, BUILT_IN_CTZ, BUILT_IN_CTZL, and
BUILT_IN_CTZLL.
* trans-intrinsic.c (gfc_conv_intrinsic_leadz,
gfc_conv_intrinsic_trails): New code-generation functions for LEADZ
and TRAILZ intrinsics.
(gfc_conv_intrinsic_function): Use them
* intrinsic.texi: Add documentation for LEADZ and TRAILZ.
* simplify.c (gfc_simplify_leadz, gfc_simplify_trailz): New functions.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@140837 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog
gcc/fortran/f95-lang.c
gcc/fortran/gfortran.h
gcc/fortran/intrinsic.c
gcc/fortran/intrinsic.h
gcc/fortran/intrinsic.texi
gcc/fortran/simplify.c
gcc/fortran/trans-intrinsic.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_leadz.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_trailz.f90 [new file with mode: 0644]

index 253caa2..869cd89 100644 (file)
@@ -1,3 +1,19 @@
+2008-10-02  Steven Bosscher  <steven@gcc.gnu.org>
+
+       PR fortran/37635
+       * intrinsic.c (add_functions): Add LEADZ and TRAILZ as generics.
+       * intrinsic.h (gfc_simplify_leadz, gfc_simplify_trailz): New protos.
+       * gfortran.h <enum gfc_isym_id>: (GFC_ISYM_LEADZ, GFC_ISYM_TRAILZ): New.
+       * f95-lang (gfc_init_builtin_functions): Add BUILT_IN_CLZ,
+       BUILT_IN_CLZL, BUILT_IN_CLZLL, BUILT_IN_CTZ, BUILT_IN_CTZL, and
+       BUILT_IN_CTZLL.
+       * trans-intrinsic.c (gfc_conv_intrinsic_leadz,
+       gfc_conv_intrinsic_trails): New code-generation functions for LEADZ
+       and TRAILZ intrinsics.
+       (gfc_conv_intrinsic_function): Use them
+       * intrinsic.texi: Add documentation for LEADZ and TRAILZ.
+       * simplify.c (gfc_simplify_leadz, gfc_simplify_trailz): New functions.
+
 2008-09-30  Janus Weil  <janus@gcc.gnu.org>
 
        PR fortran/36592
 2008-09-30  Janus Weil  <janus@gcc.gnu.org>
 
        PR fortran/36592
index 30cc98e..cf0dc2d 100644 (file)
@@ -1003,6 +1003,37 @@ gfc_init_builtin_functions (void)
                          BUILT_IN_SINCOSF, "sincosf", false);
     }
 
                          BUILT_IN_SINCOSF, "sincosf", false);
     }
 
+  /* For LEADZ / TRAILZ.  */
+  tmp = tree_cons (NULL_TREE, unsigned_type_node, void_list_node);
+  ftype = build_function_type (integer_type_node, tmp);
+  gfc_define_builtin ("__builtin_clz", ftype, BUILT_IN_CLZ,
+                     "__builtin_clz", true);
+
+  tmp = tree_cons (NULL_TREE, long_unsigned_type_node, void_list_node);
+  ftype = build_function_type (integer_type_node, tmp);
+  gfc_define_builtin ("__builtin_clzl", ftype, BUILT_IN_CLZL,
+                     "__builtin_clzl", true);
+
+  tmp = tree_cons (NULL_TREE, long_long_unsigned_type_node, void_list_node);
+  ftype = build_function_type (integer_type_node, tmp);
+  gfc_define_builtin ("__builtin_clzll", ftype, BUILT_IN_CLZLL,
+                     "__builtin_clzll", true);
+
+  tmp = tree_cons (NULL_TREE, unsigned_type_node, void_list_node);
+  ftype = build_function_type (integer_type_node, tmp);
+  gfc_define_builtin ("__builtin_ctz", ftype, BUILT_IN_CTZ,
+                     "__builtin_ctz", true);
+
+  tmp = tree_cons (NULL_TREE, long_unsigned_type_node, void_list_node);
+  ftype = build_function_type (integer_type_node, tmp);
+  gfc_define_builtin ("__builtin_ctzl", ftype, BUILT_IN_CTZL,
+                     "__builtin_ctzl", true);
+
+  tmp = tree_cons (NULL_TREE, long_long_unsigned_type_node, void_list_node);
+  ftype = build_function_type (integer_type_node, tmp);
+  gfc_define_builtin ("__builtin_ctzll", ftype, BUILT_IN_CTZLL,
+                     "__builtin_ctzll", true);
+
   /* Other builtin functions we use.  */
 
   tmp = tree_cons (NULL_TREE, long_integer_type_node, void_list_node);
   /* Other builtin functions we use.  */
 
   tmp = tree_cons (NULL_TREE, long_integer_type_node, void_list_node);
index 4e9959e..60d9bac 100644 (file)
@@ -417,6 +417,7 @@ enum gfc_isym_id
   GFC_ISYM_KILL,
   GFC_ISYM_KIND,
   GFC_ISYM_LBOUND,
   GFC_ISYM_KILL,
   GFC_ISYM_KIND,
   GFC_ISYM_LBOUND,
+  GFC_ISYM_LEADZ,
   GFC_ISYM_LEN,
   GFC_ISYM_LEN_TRIM,
   GFC_ISYM_LGAMMA,
   GFC_ISYM_LEN,
   GFC_ISYM_LEN_TRIM,
   GFC_ISYM_LGAMMA,
@@ -503,6 +504,7 @@ enum gfc_isym_id
   GFC_ISYM_TIME,
   GFC_ISYM_TIME8,
   GFC_ISYM_TINY,
   GFC_ISYM_TIME,
   GFC_ISYM_TIME8,
   GFC_ISYM_TINY,
+  GFC_ISYM_TRAILZ,
   GFC_ISYM_TRANSFER,
   GFC_ISYM_TRANSPOSE,
   GFC_ISYM_TRIM,
   GFC_ISYM_TRANSFER,
   GFC_ISYM_TRANSPOSE,
   GFC_ISYM_TRIM,
index 9b11db4..035aef7 100644 (file)
@@ -1781,6 +1781,13 @@ add_functions (void)
 
   make_generic ("lbound", GFC_ISYM_LBOUND, GFC_STD_F95);
 
 
   make_generic ("lbound", GFC_ISYM_LBOUND, GFC_STD_F95);
 
+  add_sym_1 ("leadz", GFC_ISYM_LEADZ, CLASS_ELEMENTAL, ACTUAL_NO,
+            BT_INTEGER, di, GFC_STD_F2008,
+            gfc_check_i, gfc_simplify_leadz, NULL,
+            i, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("leadz", GFC_ISYM_LEADZ, GFC_STD_F2008);
+
   add_sym_2 ("len", GFC_ISYM_LEN, CLASS_INQUIRY, ACTUAL_YES,
             BT_INTEGER, di, GFC_STD_F77,
             gfc_check_len_lentrim, gfc_simplify_len, gfc_resolve_len,
   add_sym_2 ("len", GFC_ISYM_LEN, CLASS_INQUIRY, ACTUAL_YES,
             BT_INTEGER, di, GFC_STD_F77,
             gfc_check_len_lentrim, gfc_simplify_len, gfc_resolve_len,
@@ -2388,6 +2395,13 @@ add_functions (void)
 
   make_generic ("tiny", GFC_ISYM_TINY, GFC_STD_F95);
 
 
   make_generic ("tiny", GFC_ISYM_TINY, GFC_STD_F95);
 
+  add_sym_1 ("trailz", GFC_ISYM_TRAILZ, CLASS_ELEMENTAL, ACTUAL_NO,
+            BT_INTEGER, di, GFC_STD_F2008,
+            gfc_check_i, gfc_simplify_trailz, NULL,
+            i, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("trailz", GFC_ISYM_TRAILZ, GFC_STD_F2008);
+
   add_sym_3 ("transfer", GFC_ISYM_TRANSFER, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
             gfc_check_transfer, gfc_simplify_transfer, gfc_resolve_transfer,
             src, BT_REAL, dr, REQUIRED, mo, BT_REAL, dr, REQUIRED,
   add_sym_3 ("transfer", GFC_ISYM_TRANSFER, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
             gfc_check_transfer, gfc_simplify_transfer, gfc_resolve_transfer,
             src, BT_REAL, dr, REQUIRED, mo, BT_REAL, dr, REQUIRED,
index 5994cf6..02eff46 100644 (file)
@@ -259,6 +259,7 @@ gfc_expr *gfc_simplify_ishft (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_ishftc (gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_kind (gfc_expr *);
 gfc_expr *gfc_simplify_lbound (gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_ishftc (gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_kind (gfc_expr *);
 gfc_expr *gfc_simplify_lbound (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_leadz (gfc_expr *);
 gfc_expr *gfc_simplify_len (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_len_trim (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_lgamma (gfc_expr *);
 gfc_expr *gfc_simplify_len (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_len_trim (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_lgamma (gfc_expr *);
@@ -310,6 +311,7 @@ gfc_expr *gfc_simplify_sqrt (gfc_expr *);
 gfc_expr *gfc_simplify_tan (gfc_expr *);
 gfc_expr *gfc_simplify_tanh (gfc_expr *);
 gfc_expr *gfc_simplify_tiny (gfc_expr *);
 gfc_expr *gfc_simplify_tan (gfc_expr *);
 gfc_expr *gfc_simplify_tanh (gfc_expr *);
 gfc_expr *gfc_simplify_tiny (gfc_expr *);
+gfc_expr *gfc_simplify_trailz (gfc_expr *);
 gfc_expr *gfc_simplify_transfer (gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_trim (gfc_expr *);
 gfc_expr *gfc_simplify_ubound (gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_transfer (gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_trim (gfc_expr *);
 gfc_expr *gfc_simplify_ubound (gfc_expr *, gfc_expr *, gfc_expr *);
index 8337f74..3418d05 100644 (file)
@@ -164,6 +164,7 @@ Some basic guidelines for editing this document:
 * @code{KILL}:          KILL,      Send a signal to a process
 * @code{KIND}:          KIND,      Kind of an entity
 * @code{LBOUND}:        LBOUND,    Lower dimension bounds of an array
 * @code{KILL}:          KILL,      Send a signal to a process
 * @code{KIND}:          KIND,      Kind of an entity
 * @code{LBOUND}:        LBOUND,    Lower dimension bounds of an array
+* @code{LEADZ}:         LEADZ,     Number of leading zero bits of an integer
 * @code{LEN}:           LEN,       Length of a character entity
 * @code{LEN_TRIM}:      LEN_TRIM,  Length of a character entity without trailing blank characters
 * @code{LOG_GAMMA}:     LOG_GAMMA, Logarithm of the Gamma function
 * @code{LEN}:           LEN,       Length of a character entity
 * @code{LEN_TRIM}:      LEN_TRIM,  Length of a character entity without trailing blank characters
 * @code{LOG_GAMMA}:     LOG_GAMMA, Logarithm of the Gamma function
@@ -252,6 +253,7 @@ Some basic guidelines for editing this document:
 * @code{TIME}:          TIME,      Time function
 * @code{TIME8}:         TIME8,     Time function (64-bit)
 * @code{TINY}:          TINY,      Smallest positive number of a real kind
 * @code{TIME}:          TIME,      Time function
 * @code{TIME8}:         TIME8,     Time function (64-bit)
 * @code{TINY}:          TINY,      Smallest positive number of a real kind
+* @code{TRAILZ}:        TRAILZ,    Number of trailing zero bits of an integer
 * @code{TRANSFER}:      TRANSFER,  Transfer bit patterns
 * @code{TRANSPOSE}:     TRANSPOSE, Transpose an array of rank two
 * @code{TRIM}:          TRIM,      Remove trailing blank characters of a string
 * @code{TRANSFER}:      TRANSFER,  Transfer bit patterns
 * @code{TRANSPOSE}:     TRANSPOSE, Transpose an array of rank two
 * @code{TRIM}:          TRIM,      Remove trailing blank characters of a string
@@ -6504,6 +6506,46 @@ dimension, the lower bound is taken to be 1.
 
 
 
 
 
 
+@node LEADZ
+@section @code{LEADZ} --- Number of leading zero bits of an integer
+@fnindex LEADZ
+@cindex zero bits
+
+@table @asis
+@item @emph{Description}:
+@code{LEADZ} returns the number of leading zero bits of an integer.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = LEADZ(I)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab Shall be of type @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+The type of the return value is the default @code{INTEGER}.
+If all the bits of @code{I} are zero, the result value is @code{BIT_SIZE(I)}.
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_leadz
+  WRITE (*,*) LEADZ(1)  ! prints 8 if BITSIZE(I) has the value 32
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+@ref{BIT_SIZE}, @ref{TRAILZ}
+@end table
+
+
+
 @node LEN
 @section @code{LEN} --- Length of a character entity
 @fnindex LEN
 @node LEN
 @section @code{LEN} --- Length of a character entity
 @fnindex LEN
@@ -10642,6 +10684,46 @@ See @code{HUGE} for an example.
 
 
 
 
 
 
+@node TRAILZ
+@section @code{TRAILZ} --- Number of trailing zero bits of an integer
+@fnindex TRAILZ
+@cindex zero bits
+
+@table @asis
+@item @emph{Description}:
+@code{TRAILZ} returns the number of trailing zero bits of an integer.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = TRAILZ(I)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab Shall be of type @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+The type of the return value is the default @code{INTEGER}.
+If all the bits of @code{I} are zero, the result value is @code{BIT_SIZE(I)}.
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_trailz
+  WRITE (*,*) TRAILZ(8)  ! prints 3
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+@ref{BIT_SIZE}, @ref{LEADZ}
+@end table
+
+
+
 @node TRANSFER
 @section @code{TRANSFER} --- Transfer bit patterns
 @fnindex TRANSFER
 @node TRANSFER
 @section @code{TRANSFER} --- Transfer bit patterns
 @fnindex TRANSFER
index c0ac026..429c515 100644 (file)
@@ -2400,6 +2400,30 @@ gfc_simplify_lbound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
 
 
 gfc_expr *
 
 
 gfc_expr *
+gfc_simplify_leadz (gfc_expr *e)
+{
+  gfc_expr *result;
+  unsigned long lz, bs;
+  int i;
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  i = gfc_validate_kind (e->ts.type, e->ts.kind, false);
+  bs = gfc_integer_kinds[i].bit_size;
+  if (mpz_cmp_si (e->value.integer, 0) == 0)
+    lz = bs;
+  else
+    lz = bs - mpz_sizeinbase (e->value.integer, 2);
+
+  result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind, &e->where);
+  mpz_set_ui (result->value.integer, lz);
+
+  return result;
+}
+
+
+gfc_expr *
 gfc_simplify_len (gfc_expr *e, gfc_expr *kind)
 {
   gfc_expr *result;
 gfc_simplify_len (gfc_expr *e, gfc_expr *kind)
 {
   gfc_expr *result;
@@ -4338,6 +4362,27 @@ gfc_simplify_tiny (gfc_expr *e)
 
 
 gfc_expr *
 
 
 gfc_expr *
+gfc_simplify_trailz (gfc_expr *e)
+{
+  gfc_expr *result;
+  unsigned long tz, bs;
+  int i;
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  i = gfc_validate_kind (e->ts.type, e->ts.kind, false);
+  bs = gfc_integer_kinds[i].bit_size;
+  tz = mpz_scan1 (e->value.integer, 0);
+
+  result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind, &e->where);
+  mpz_set_ui (result->value.integer, MIN (tz, bs));
+
+  return result;
+}
+
+
+gfc_expr *
 gfc_simplify_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size)
 {
   gfc_expr *result;
 gfc_simplify_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size)
 {
   gfc_expr *result;
index f5f9922..ffe1e5b 100644 (file)
@@ -2653,6 +2653,141 @@ gfc_conv_intrinsic_ishftc (gfc_se * se, gfc_expr * expr)
   se->expr = fold_build3 (COND_EXPR, type, tmp, args[0], rrot);
 }
 
   se->expr = fold_build3 (COND_EXPR, type, tmp, args[0], rrot);
 }
 
+/* LEADZ (i) = (i == 0) ? BIT_SIZE (i)
+                       : __builtin_clz(i) - (BIT_SIZE('int') - BIT_SIZE(i))
+
+   The conditional expression is necessary because the result of LEADZ(0)
+   is defined, but the result of __builtin_clz(0) is undefined for most
+   targets.
+
+   For INTEGER kinds smaller than the C 'int' type, we have to subtract the
+   difference in bit size between the argument of LEADZ and the C int.  */
+static void
+gfc_conv_intrinsic_leadz (gfc_se * se, gfc_expr * expr)
+{
+  tree arg;
+  tree arg_type;
+  tree cond;
+  tree result_type;
+  tree leadz;
+  tree bit_size;
+  tree tmp;
+  int arg_kind;
+  int i, n, s;
+
+  gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
+
+  /* Which variant of __builtin_clz* should we call?  */
+  arg_kind = expr->value.function.actual->expr->ts.kind;
+  i = gfc_validate_kind (BT_INTEGER, arg_kind, false);
+  switch (arg_kind)
+    {
+      case 1:
+      case 2:
+      case 4:
+        arg_type = unsigned_type_node;
+       n = BUILT_IN_CLZ;
+       break;
+
+      case 8:
+        arg_type = long_unsigned_type_node;
+       n = BUILT_IN_CLZL;
+       break;
+
+      case 16:
+        arg_type = long_long_unsigned_type_node;
+       n = BUILT_IN_CLZLL;
+       break;
+
+      default:
+        gcc_unreachable ();
+    }
+
+  /* Convert the actual argument to the proper argument type for the built-in
+     function.  But the return type is of the default INTEGER kind.  */
+  arg = fold_convert (arg_type, arg);
+  result_type = gfc_get_int_type (gfc_default_integer_kind);
+
+  /* Compute LEADZ for the case i .ne. 0.  */
+  s = TYPE_PRECISION (arg_type) - gfc_integer_kinds[i].bit_size;
+  tmp = fold_convert (result_type, build_call_expr (built_in_decls[n], 1, arg));
+  leadz = fold_build2 (MINUS_EXPR, result_type,
+                      tmp, build_int_cst (result_type, s));
+
+  /* Build BIT_SIZE.  */
+  bit_size = build_int_cst (result_type, gfc_integer_kinds[i].bit_size);
+
+  /* ??? For some combinations of targets and integer kinds, the condition
+        can be avoided if CLZ_DEFINED_VALUE_AT_ZERO is used.  Later.  */
+  cond = fold_build2 (EQ_EXPR, boolean_type_node,
+                     arg, build_int_cst (arg_type, 0));
+  se->expr = fold_build3 (COND_EXPR, result_type, cond, bit_size, leadz);
+}
+
+/* TRAILZ(i) = (i == 0) ? BIT_SIZE (i) : __builtin_ctz(i)
+
+   The conditional expression is necessary because the result of TRAILZ(0)
+   is defined, but the result of __builtin_ctz(0) is undefined for most
+   targets.  */
+static void
+gfc_conv_intrinsic_trailz (gfc_se * se, gfc_expr *expr)
+{
+  tree arg;
+  tree arg_type;
+  tree cond;
+  tree result_type;
+  tree trailz;
+  tree bit_size;
+  int arg_kind;
+  int i, n;
+
+  gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
+
+  /* Which variant of __builtin_clz* should we call?  */
+  arg_kind = expr->value.function.actual->expr->ts.kind;
+  i = gfc_validate_kind (BT_INTEGER, arg_kind, false);
+  switch (expr->ts.kind)
+    {
+      case 1:
+      case 2:
+      case 4:
+        arg_type = unsigned_type_node;
+       n = BUILT_IN_CTZ;
+       break;
+
+      case 8:
+        arg_type = long_unsigned_type_node;
+       n = BUILT_IN_CTZL;
+       break;
+
+      case 16:
+        arg_type = long_long_unsigned_type_node;
+       n = BUILT_IN_CTZLL;
+       break;
+
+      default:
+        gcc_unreachable ();
+    }
+
+  /* Convert the actual argument to the proper argument type for the built-in
+     function.  But the return type is of the default INTEGER kind.  */
+  arg = fold_convert (arg_type, arg);
+  result_type = gfc_get_int_type (gfc_default_integer_kind);
+
+  /* Compute TRAILZ for the case i .ne. 0.  */
+  trailz = fold_convert (result_type, build_call_expr (built_in_decls[n], 1, arg));
+
+  /* Build BIT_SIZE.  */
+  bit_size = build_int_cst (result_type, gfc_integer_kinds[i].bit_size);
+
+  /* ??? For some combinations of targets and integer kinds, the condition
+        can be avoided if CTZ_DEFINED_VALUE_AT_ZERO is used.  Later.  */
+  cond = fold_build2 (EQ_EXPR, boolean_type_node,
+                     arg, build_int_cst (arg_type, 0));
+  se->expr = fold_build3 (COND_EXPR, result_type, cond, bit_size, trailz);
+}
 
 /* Process an intrinsic with unspecified argument-types that has an optional
    argument (which could be of type character), e.g. EOSHIFT.  For those, we
 
 /* Process an intrinsic with unspecified argument-types that has an optional
    argument (which could be of type character), e.g. EOSHIFT.  For those, we
@@ -4482,6 +4617,14 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       gfc_conv_intrinsic_ishftc (se, expr);
       break;
 
       gfc_conv_intrinsic_ishftc (se, expr);
       break;
 
+    case GFC_ISYM_LEADZ:
+      gfc_conv_intrinsic_leadz (se, expr);
+      break;
+
+    case GFC_ISYM_TRAILZ:
+      gfc_conv_intrinsic_trailz (se, expr);
+      break;
+
     case GFC_ISYM_LBOUND:
       gfc_conv_intrinsic_bound (se, expr, 0);
       break;
     case GFC_ISYM_LBOUND:
       gfc_conv_intrinsic_bound (se, expr, 0);
       break;
index ab9b741..7894386 100644 (file)
@@ -1,3 +1,9 @@
+2008-10-02  Steven Bosscher  <steven@gcc.gnu.org>
+
+       PR fortran/37635
+       * gfortran.fortran-torture/execute/intrinsic_leadz.f90: New test.
+       * gfortran.fortran-torture/execute/intrinsic_trailz.f90: New test.
+
 2008-10-02  Janis Johnson  <janis187@us.ibm.com>
 
        * gcc.dg/torture/pr36891.c: Ignore an irrelevant warning.
 2008-10-02  Janis Johnson  <janis187@us.ibm.com>
 
        * gcc.dg/torture/pr36891.c: Ignore an irrelevant warning.
diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_leadz.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_leadz.f90
new file mode 100644 (file)
index 0000000..80b61c8
--- /dev/null
@@ -0,0 +1,46 @@
+program test_intrinsic_leadz
+   implicit none
+
+   call test_leadz(0_1,0_2,0_4,0_8,1_1,1_2,1_4,1_8,8_1,8_2,8_4,8_8)
+   stop
+
+   contains
+
+        subroutine test_leadz(z1,z2,z4,z8,i1,i2,i4,i8,e1,e2,e4,e8)
+           integer(kind=1) :: z1, i1, e1
+           integer(kind=2) :: z2, i2, e2
+           integer(kind=4) :: z4, i4, e4
+           integer(kind=8) :: z8, i8, e8
+
+           if (leadz(0_1) /=  8) call abort()
+           if (leadz(0_2) /= 16) call abort()
+           if (leadz(0_4) /= 32) call abort()
+           if (leadz(0_8) /= 64) call abort()
+
+           if (leadz(1_1) /=  7) call abort()
+           if (leadz(1_2) /= 15) call abort()
+           if (leadz(1_4) /= 31) call abort()
+           if (leadz(1_8) /= 63) call abort()
+
+           if (leadz(8_1) /=  4) call abort()
+           if (leadz(8_2) /= 12) call abort()
+           if (leadz(8_4) /= 28) call abort()
+           if (leadz(8_8) /= 60) call abort()
+
+           if (leadz(z1) /=  8) call abort()
+           if (leadz(z2) /= 16) call abort()
+           if (leadz(z4) /= 32) call abort()
+           if (leadz(z8) /= 64) call abort()
+
+           if (leadz(i1) /=  7) call abort()
+           if (leadz(i2) /= 15) call abort()
+           if (leadz(i4) /= 31) call abort()
+           if (leadz(i8) /= 63) call abort()
+
+           if (leadz(e1) /=  4) call abort()
+           if (leadz(e2) /= 12) call abort()
+           if (leadz(e4) /= 28) call abort()
+           if (leadz(e8) /= 60) call abort()
+        end subroutine test_leadz
+
+end program
diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_trailz.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_trailz.f90
new file mode 100644 (file)
index 0000000..948c806
--- /dev/null
@@ -0,0 +1,46 @@
+program test_intrinsic_trailz
+   implicit none
+
+   call test_trailz(0_1,0_2,0_4,0_8,1_1,1_2,1_4,1_8,8_1,8_2,8_4,8_8)
+   stop
+
+   contains
+
+        subroutine test_trailz(z1,z2,z4,z8,i1,i2,i4,i8,e1,e2,e4,e8)
+           integer(kind=1) :: z1, i1, e1
+           integer(kind=2) :: z2, i2, e2
+           integer(kind=4) :: z4, i4, e4
+           integer(kind=8) :: z8, i8, e8
+
+           if (trailz(0_1) /=  8) call abort()
+           if (trailz(0_2) /= 16) call abort()
+           if (trailz(0_4) /= 32) call abort()
+           if (trailz(0_8) /= 64) call abort()
+
+           if (trailz(1_1) /=  0) call abort()
+           if (trailz(1_2) /=  0) call abort()
+           if (trailz(1_4) /=  0) call abort()
+           if (trailz(1_8) /=  0) call abort()
+
+           if (trailz(8_1) /=  3) call abort()
+           if (trailz(8_2) /=  3) call abort()
+           if (trailz(8_4) /=  3) call abort()
+           if (trailz(8_8) /=  3) call abort()
+
+           if (trailz(z1) /=  8) call abort()
+           if (trailz(z2) /= 16) call abort()
+           if (trailz(z4) /= 32) call abort()
+           if (trailz(z8) /= 64) call abort()
+
+           if (trailz(i1) /=  0) call abort()
+           if (trailz(i2) /=  0) call abort()
+           if (trailz(i4) /=  0) call abort()
+           if (trailz(i8) /=  0) call abort()
+
+           if (trailz(e1) /=  3) call abort()
+           if (trailz(e2) /=  3) call abort()
+           if (trailz(e4) /=  3) call abort()
+           if (trailz(e8) /=  3) call abort()
+        end subroutine test_trailz
+
+end program