diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc index 09d1ebd95d2..66edad58278 100644 --- 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 58505446bac..a7a0fdba3dd 100644 --- 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 371666dcbb6..7e8783a3690 100644 --- 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 c35f2bdd183..40f4c4f4b0b 100644 --- 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 438160aad01..2c287caa6ad 100644 --- 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 0445feaf73a..3d3b9edf8e6 100644 --- 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 3043483daa9..7a5d31c01a6 100644 --- 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 301439baaf5..dca7779528b 100644 --- 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 4e26af21b46..83041183fcb 100644 --- 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 2e10ce1a9b3..f94fa601400 100644 --- 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 index 00000000000..18d8dedd50e --- /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 index 00000000000..6f18958eb37 --- /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 index 00000000000..ac948e9c252 --- /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 index 00000000000..0510991b165 --- /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 db9b86cb183..4a5a037a906 100644 --- 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 de657b1a264..3d63de3e7dd 100644 --- 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