Fortran: add SELECTED_LOGICAL_KIND

gcc/fortran/ChangeLog:
	* expr.cc (check_transformational): Add SELECTED_LOGICAL_KIND
	to allowed functions for Fortran 2023.
	* gfortran.h (GFC_ISYM_SL_KIND): New.
	* gfortran.texi: Mention SELECTED_LOGICAL_KIND.
	* intrinsic.cc (add_functions): Add SELECTED_LOGICAL_KIND.
	(gfc_intrinsic_func_interface): Allow it in initialization
	expressions.
	* intrinsic.h (gfc_simplify_selected_logical_kind): New proto.
	* intrinsic.texi: Add SELECTED_LOGICAL_KIND.
	* simplify.cc (gfc_simplify_selected_logical_kind): New
	function.
	* trans-decl.cc (gfc_build_intrinsic_function_decls): Initialize
	gfor_fndecl_sl_kind.
	* trans-intrinsic.cc (gfc_conv_intrinsic_sl_kind): New function.
	(gfc_conv_intrinsic_function): Call it for GFC_ISYM_SL_KIND.
	* trans.h (gfor_fndecl_sl_kind): New symbol.

gcc/testsuite/ChangeLog:

	* gfortran.dg/selected_logical_kind_1.f90: New test.
	* gfortran.dg/selected_logical_kind_2.f90: New test.
	* gfortran.dg/selected_logical_kind_3.f90: New test.
	* gfortran.dg/selected_logical_kind_4.f90: New test.

libgfortran/ChangeLog:

	* gfortran.map: Add _gfortran_selected_logical_kind.
	* intrinsics/selected_int_kind.f90: Add SELECTED_LOGICAL_KIND.

diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 09d1ebd95d2b9548bc4949b532a0b038ae37ea47..66edad58278a0b3a083014e0a01ccbac22c17910 100644 (file)
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -2885,6 +2885,13 @@ check_transformational (gfc_expr *e)
     "trim", "unpack", "findloc", NULL
   };
 
+  static const char * const trans_func_f2023[] =  {
+    "all", "any", "count", "dot_product", "matmul", "null", "pack",
+    "product", "repeat", "reshape", "selected_char_kind", "selected_int_kind",
+    "selected_logical_kind", "selected_real_kind", "spread", "sum", "transfer",
+    "transpose", "trim", "unpack", "findloc", NULL
+  };
+
   int i;
   const char *name;
   const char *const *functions;
@@ -2895,7 +2902,9 @@ check_transformational (gfc_expr *e)
 
   name = e->symtree->n.sym->name;
 
-  if (gfc_option.allow_std & GFC_STD_F2008)
+  if (gfc_option.allow_std & GFC_STD_F2023)
+    functions = trans_func_f2023;
+  else if (gfc_option.allow_std & GFC_STD_F2008)
     functions = trans_func_f2008;
   else if (gfc_option.allow_std & GFC_STD_F2003)
     functions = trans_func_f2003;

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 58505446bac5d3576b7ea6f191305fd4c9f01442..a7a0fdba3dd3df981948b9c0f6dac024c4c7111f 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -662,6 +662,7 @@ enum gfc_isym_id
   GFC_ISYM_SIND,
   GFC_ISYM_SINH,
   GFC_ISYM_SIZE,
+  GFC_ISYM_SL_KIND,
   GFC_ISYM_SLEEP,
   GFC_ISYM_SIZEOF,
   GFC_ISYM_SNGL,

diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index 371666dcbb60482fa1a447bbc518aa24d7e90c5f..7e8783a36903c5317936c7b343777640b31664ac 100644 (file)
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -862,8 +862,8 @@ data types are:
 The @code{KIND} value matches the storage size in bytes, except for
 @code{COMPLEX} where the storage size is twice as much (or both real and
 imaginary part are a real value of the given size).  It is recommended to use
-the @ref{SELECTED_CHAR_KIND}, @ref{SELECTED_INT_KIND} and
-@ref{SELECTED_REAL_KIND} intrinsics or the @code{INT8}, @code{INT16},
+the @ref{SELECTED_CHAR_KIND}, @ref{SELECTED_INT_KIND}, @ref{SELECTED_LOGICAL_KIND}
+and @ref{SELECTED_REAL_KIND} intrinsics or the @code{INT8}, @code{INT16},
 @code{INT32}, @code{INT64}, @code{REAL32}, @code{REAL64}, and @code{REAL128}
 parameters of the @code{ISO_FORTRAN_ENV} module instead of the concrete values.
 The available kind parameters can be found in the constant arrays
@@ -1272,8 +1272,9 @@ equivalent to the standard-conforming declaration
 @noindent
 where @code{k} is the kind parameter suitable for the intended precision.  As
 kind parameters are implementation-dependent, use the @code{KIND},
-@code{SELECTED_INT_KIND} and @code{SELECTED_REAL_KIND} intrinsics to retrieve
-the correct value, for instance @code{REAL*8 x} can be replaced by:
+@code{SELECTED_INT_KIND}, @code{SELECTED_LOGICAL_KIND} and
+@code{SELECTED_REAL_KIND} intrinsics to retrieve the correct value, for
+instance @code{REAL*8 x} can be replaced by:
 @smallexample
 INTEGER, PARAMETER :: dbl = KIND(1.0d0)
 REAL(KIND=dbl) :: x

diff --git a/gcc/fortran/intrinsic.cc b/gcc/fortran/intrinsic.cc
index c35f2bdd1835d85fd36d39d33f87cca8aaad93c5..40f4c4f4b0bc5e1c24f9d008ceecaf2c4e144280 100644 (file)
--- a/gcc/fortran/intrinsic.cc
+++ b/gcc/fortran/intrinsic.cc
@@ -2952,6 +2952,12 @@ add_functions (void)
 
   make_generic ("selected_int_kind", GFC_ISYM_SI_KIND, GFC_STD_F95);
 
+  add_sym_1 ("selected_logical_kind", GFC_ISYM_SL_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
+            GFC_STD_F2023, /* it has the same requirements */ gfc_check_selected_int_kind,
+            gfc_simplify_selected_logical_kind, NULL, r, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("selected_logical_kind", GFC_ISYM_SL_KIND, GFC_STD_F2023);
+
   add_sym_3 ("selected_real_kind", GFC_ISYM_SR_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
             GFC_STD_F95, gfc_check_selected_real_kind,
             gfc_simplify_selected_real_kind, NULL,
@@ -5003,7 +5009,8 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
       gfc_isym_id id = isym->id;
       if (id != GFC_ISYM_REPEAT && id != GFC_ISYM_RESHAPE
          && id != GFC_ISYM_SI_KIND && id != GFC_ISYM_SR_KIND
-         && id != GFC_ISYM_TRANSFER && id != GFC_ISYM_TRIM
+         && id != GFC_ISYM_SL_KIND && id != GFC_ISYM_TRANSFER
+         && id != GFC_ISYM_TRIM
          && !gfc_notify_std (GFC_STD_F2003, "Transformational function %qs "
                              "at %L is invalid in an initialization "
                              "expression", sym->name, &expr->where))

diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index 438160aad01d2f68389a0681dac921042dfde968..2c287caa6ad59af38032af94d3f16b70332e0bac 100644 (file)
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -399,6 +399,7 @@ gfc_expr *gfc_simplify_scale (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_scan (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_selected_char_kind (gfc_expr *);
 gfc_expr *gfc_simplify_selected_int_kind (gfc_expr *);
+gfc_expr *gfc_simplify_selected_logical_kind (gfc_expr *);
 gfc_expr *gfc_simplify_selected_real_kind (gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_set_exponent (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_sign (gfc_expr *, gfc_expr *);

diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index 0445feaf73a71008d0c3bceeba037c513ba5a715..3d3b9edf8e6563e386ebea1cf4f31fcf5a0f6cb5 100644 (file)
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -281,6 +281,7 @@ Some basic guidelines for editing this document:
 * @code{SECOND}:        SECOND,    CPU time function
 * @code{SELECTED_CHAR_KIND}: SELECTED_CHAR_KIND,  Choose character kind
 * @code{SELECTED_INT_KIND}: SELECTED_INT_KIND,  Choose integer kind
+* @code{SELECTED_LOGICAL_KIND}: SELECTED_LOGICAL_KIND,  Choose logical kind
 * @code{SELECTED_REAL_KIND}: SELECTED_REAL_KIND,  Choose real kind
 * @code{SET_EXPONENT}:  SET_EXPONENT, Set the exponent of the model
 * @code{SHAPE}:         SHAPE,     Determine the shape of an array
@@ -12788,6 +12789,48 @@ end program large_integers
 
 
 
+@node SELECTED_LOGICAL_KIND
+@section @code{SELECTED_LOGICAL_KIND} --- Choose logical kind
+@fnindex SELECTED_LOGICAL_KIND
+@cindex logical kind
+@cindex kind, logical
+
+@table @asis
+@item @emph{Description}:
+@code{SELECTED_LOGICAL_KIND(BITS)} return the kind value of the smallest
+logical type whose storage size in bits is at least @var{BITS}. If there
+is no such logical kind, @code{SELECTED_LOGICAL_KIND} returns @math{-1}.
+
+@item @emph{Standard}:
+Fortran 2023 and later
+
+@item @emph{Class}:
+Transformational function
+
+@item @emph{Syntax}:
+@code{RESULT = SELECTED_LOGICAL_KIND(BITS)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{BITS} @tab Shall be a scalar and of type @code{INTEGER}.
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+program logical_kinds
+  integer, parameter :: k1 = selected_logical_kind(1)
+  integer, parameter :: k40 = selected_logical_kind(40)
+  logical(kind=k1) :: l1    ! At least one bit
+  logical(kind=k40) :: l40  ! At least 40 bits
+
+  ! What is their actual size?
+  print *, storage_size(l1), storage_size(l40)
+end program logical_kinds
+@end smallexample
+@end table
+
+
+
 @node SELECTED_REAL_KIND
 @section @code{SELECTED_REAL_KIND} --- Choose real kind
 @fnindex SELECTED_REAL_KIND

diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index 3043483daa90390aef0c17b5f40e85f62a9f0fab..7a5d31c01a6593a5ad2122389d69f4cb93ad15a3 100644 (file)
--- a/gcc/fortran/simplify.cc
+++ b/gcc/fortran/simplify.cc
@@ -7332,6 +7332,28 @@ gfc_simplify_selected_int_kind (gfc_expr *e)
 }
 
 
+gfc_expr *
+gfc_simplify_selected_logical_kind (gfc_expr *e)
+{
+  int i, kind, bits;
+
+  if (e->expr_type != EXPR_CONSTANT || gfc_extract_int (e, &bits))
+    return NULL;
+
+  kind = INT_MAX;
+
+  for (i = 0; gfc_logical_kinds[i].kind != 0; i++)
+    if (gfc_logical_kinds[i].bit_size >= bits
+       && gfc_logical_kinds[i].kind < kind)
+      kind = gfc_logical_kinds[i].kind;
+
+  if (kind == INT_MAX)
+    kind = -1;
+
+  return gfc_get_int_expr (gfc_default_integer_kind, &e->where, kind);
+}
+
+
 gfc_expr *
 gfc_simplify_selected_real_kind (gfc_expr *p, gfc_expr *q, gfc_expr *rdx)
 {

diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 301439baaf5581daf6c83c5f3161a9fbde7f8f99..dca7779528bb5b099b5405165b4b8f6ae3c70e78 100644 (file)
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -221,6 +221,7 @@ tree gfor_fndecl_is_contiguous0;
 /* Intrinsic functions implemented in Fortran.  */
 tree gfor_fndecl_sc_kind;
 tree gfor_fndecl_si_kind;
+tree gfor_fndecl_sl_kind;
 tree gfor_fndecl_sr_kind;
 
 /* BLAS gemm functions.  */
@@ -3605,6 +3606,12 @@ gfc_build_intrinsic_function_decls (void)
   DECL_PURE_P (gfor_fndecl_si_kind) = 1;
   TREE_NOTHROW (gfor_fndecl_si_kind) = 1;
 
+  gfor_fndecl_sl_kind = gfc_build_library_function_decl_with_spec (
+       get_identifier (PREFIX("selected_logical_kind")), ". R ",
+       gfc_int4_type_node, 1, pvoid_type_node);
+  DECL_PURE_P (gfor_fndecl_sl_kind) = 1;
+  TREE_NOTHROW (gfor_fndecl_sl_kind) = 1;
+
   gfor_fndecl_sr_kind = gfc_build_library_function_decl_with_spec (
        get_identifier (PREFIX("selected_real_kind2008")), ". R R ",
        gfc_int4_type_node, 3, pvoid_type_node, pvoid_type_node,

diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 4e26af21b462cf0d41f768936ff16107af9b2d22..83041183fcbb0f624de5c14538707860eb8b4e49 100644 (file)
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -9187,6 +9187,27 @@ gfc_conv_intrinsic_si_kind (gfc_se *se, gfc_expr *expr)
 }
 
 
+/* Generate code for SELECTED_LOGICAL_KIND (BITS) intrinsic function.  */
+
+static void
+gfc_conv_intrinsic_sl_kind (gfc_se *se, gfc_expr *expr)
+{
+  tree arg, type;
+
+  gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
+
+  /* The argument to SELECTED_LOGICAL_KIND is INTEGER(4).  */
+  type = gfc_get_int_type (4);
+  arg = gfc_build_addr_expr (NULL_TREE, fold_convert (type, arg));
+
+  /* Convert it to the required type.  */
+  type = gfc_typenode_for_spec (&expr->ts);
+  se->expr = build_call_expr_loc (input_location,
+                             gfor_fndecl_sl_kind, 1, arg);
+  se->expr = fold_convert (type, se->expr);
+}
+
+
 /* Generate code for SELECTED_REAL_KIND (P, R, RADIX) intrinsic function.  */
 
 static void
@@ -10618,6 +10639,10 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       gfc_conv_intrinsic_si_kind (se, expr);
       break;
 
+    case GFC_ISYM_SL_KIND:
+      gfc_conv_intrinsic_sl_kind (se, expr);
+      break;
+
     case GFC_ISYM_SR_KIND:
       gfc_conv_intrinsic_sr_kind (se, expr);
       break;

diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 2e10ce1a9b34cf5b08d79d5c5af04338f7fcc7e9..f94fa601400485f27d13ad42ff4ae1798cdedf39 100644 (file)
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -978,6 +978,7 @@ extern GTY(()) tree gfor_fndecl_is_contiguous0;
 /* Implemented in Fortran.  */
 extern GTY(()) tree gfor_fndecl_sc_kind;
 extern GTY(()) tree gfor_fndecl_si_kind;
+extern GTY(()) tree gfor_fndecl_sl_kind;
 extern GTY(()) tree gfor_fndecl_sr_kind;
 
 /* IEEE-related.  */

diff --git a/gcc/testsuite/gfortran.dg/selected_logical_kind_1.f90 b/gcc/testsuite/gfortran.dg/selected_logical_kind_1.f90
new file mode 100644 (file)
index 0000000..18d8ded
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/selected_logical_kind_1.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+
+program selected
+  implicit none
+
+  integer, parameter :: k = max(1, selected_logical_kind(128))
+  logical(kind=k) :: l
+
+  ! This makes assumptions about the targets, but they are true
+  ! for all targets that gfortran supports
+
+  if (selected_logical_kind(1)  /= 1) STOP 1
+  if (selected_logical_kind(8)  /= 1) STOP 2
+  if (selected_logical_kind(9)  /= 2) STOP 3
+  if (selected_logical_kind(16) /= 2) STOP 4
+  if (selected_logical_kind(17) /= 4) STOP 5
+  if (selected_logical_kind(32) /= 4) STOP 6
+  if (selected_logical_kind(33) /= 8) STOP 7
+  if (selected_logical_kind(64) /= 8) STOP 8
+
+  ! This should not exist
+
+  if (selected_logical_kind(17921) /= -1) STOP 9
+
+  ! We test for a kind larger than 64 bits separately
+
+  if (storage_size(l) /= 8 * k) STOP 10
+
+end program

diff --git a/gcc/testsuite/gfortran.dg/selected_logical_kind_2.f90 b/gcc/testsuite/gfortran.dg/selected_logical_kind_2.f90
new file mode 100644 (file)
index 0000000..6f18958
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/selected_logical_kind_2.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! { dg-options "-std=f2018" }
+
+program selected
+  implicit none
+
+  logical(selected_logical_kind(1)) :: l ! { dg-error "has no IMPLICIT type" }
+  print *, selected_logical_kind(1) ! { dg-error "has no IMPLICIT type" }
+end program

diff --git a/gcc/testsuite/gfortran.dg/selected_logical_kind_3.f90 b/gcc/testsuite/gfortran.dg/selected_logical_kind_3.f90
new file mode 100644 (file)
index 0000000..ac948e9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/selected_logical_kind_3.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_integer_16 }
+
+program selected
+  implicit none
+
+  integer, parameter :: k1 = selected_logical_kind(128)
+  logical(kind=k1) :: l
+
+  integer, parameter :: k2 = selected_int_kind(25)
+  integer(kind=k2) :: i
+
+  if (storage_size(l) /= 8 * k1) STOP 1
+  if (storage_size(i) /= 8 * k2) STOP 2
+  if (bit_size(i) /= 8 * k2) STOP 3
+  if (k1 /= k2) STOP 4
+
+end program

diff --git a/gcc/testsuite/gfortran.dg/selected_logical_kind_4.f90 b/gcc/testsuite/gfortran.dg/selected_logical_kind_4.f90
new file mode 100644 (file)
index 0000000..0510991
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/selected_logical_kind_4.f90
@@ -0,0 +1,23 @@
+! { dg-do run }
+
+! Check that SELECTED_LOGICAL_KIND works in a non-constant context
+! (which is rare but allowed)
+
+subroutine foo(i, j)
+  implicit none
+  integer :: i, j
+  if (selected_logical_kind(i) /= j) STOP j
+end subroutine
+
+program selected
+  implicit none
+
+  call foo(1, 1)
+  call foo(8, 1)
+  call foo(9, 2)
+  call foo(16, 2)
+  call foo(17, 4)
+  call foo(32, 4)
+  call foo(33, 8)
+  call foo(64, 8)
+end program

diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map
index db9b86cb183f79e10762518aa4db2fde840fa1c3..4a5a037a906700c73431e9539d501f9f51a8a929 100644 (file)
--- a/libgfortran/gfortran.map
+++ b/libgfortran/gfortran.map
@@ -1765,3 +1765,8 @@ GFORTRAN_13 {
     __ieee_exceptions_MOD_ieee_get_modes;
     __ieee_exceptions_MOD_ieee_set_modes;
 } GFORTRAN_12;
+
+GFORTRAN_14 {
+  global:
+    _gfortran_selected_logical_kind;
+} GFORTRAN_13;

diff --git a/libgfortran/intrinsics/selected_int_kind.f90 b/libgfortran/intrinsics/selected_int_kind.f90
index de657b1a264342dc5b4332327ee7a18c0eae1040..3d63de3e7dd2b1760b27c069bcd0a1cf57f608ac 100644 (file)
--- a/libgfortran/intrinsics/selected_int_kind.f90
+++ b/libgfortran/intrinsics/selected_int_kind.f90
@@ -24,7 +24,7 @@
 
 function _gfortran_selected_int_kind (r)
   implicit none
-  integer, intent (in) :: r
+  integer, intent(in) :: r
   integer :: _gfortran_selected_int_kind
   integer :: i
   ! Integer kind_range table
@@ -36,11 +36,37 @@ function _gfortran_selected_int_kind (r)
   include "selected_int_kind.inc"
 
   do i = 1, c
-    if (r <= int_infos (i) % range) then
-      _gfortran_selected_int_kind = int_infos (i) % kind
+    if (r <= int_infos(i)%range) then
+      _gfortran_selected_int_kind = int_infos(i)%kind
       return
     end if
   end do
   _gfortran_selected_int_kind = -1
   return
 end function
+
+
+! At this time, our logical and integer kinds are the same
+
+function _gfortran_selected_logical_kind (bits)
+  implicit none
+  integer, intent(in) :: bits
+  integer :: _gfortran_selected_logical_kind
+  integer :: i
+  ! Integer kind_range table
+  type :: int_info
+    integer :: kind
+    integer :: range
+  end type int_info
+
+  include "selected_int_kind.inc"
+
+  do i = 1, c
+    if (bits <= 8 * int_infos(i)%kind) then
+      _gfortran_selected_logical_kind = int_infos(i)%kind
+      return
+    end if
+  end do
+  _gfortran_selected_logical_kind = -1
+  return
+end function