From patchwork Sat Oct 12 16:04:15 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Thomas Koenig X-Patchwork-Id: 1996426 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; dkim=pass (2048-bit key; unprotected) header.d=netcologne.de header.i=@netcologne.de header.a=rsa-sha256 header.s=nc1116a header.b=CZw7Lz2o; dkim-atps=neutral Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=8.43.85.97; helo=server2.sourceware.org; envelope-from=gcc-patches-bounces~incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=patchwork.ozlabs.org) Received: from server2.sourceware.org (server2.sourceware.org [8.43.85.97]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (secp384r1) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4XQpGp5SlCz1xv6 for ; Sun, 13 Oct 2024 03:04:49 +1100 (AEDT) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id D94583858430 for ; Sat, 12 Oct 2024 16:04:46 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from cc-smtpout1.netcologne.de (cc-smtpout1.netcologne.de [89.1.8.211]) by sourceware.org (Postfix) with ESMTPS id CFCA63858D20; Sat, 12 Oct 2024 16:04:19 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org CFCA63858D20 Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=netcologne.de Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=netcologne.de ARC-Filter: OpenARC Filter v1.0.0 sourceware.org CFCA63858D20 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=89.1.8.211 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1728749063; cv=none; b=vRaVFM3c4BhufvtubZqlD2BkawTV3WvF0WDIBUD0zfvbeBahs7VOu/MjfUL1E8GGpDLKLNx3Wl0MsjJpaEPY5/jsZC6+xaoy6F8tKA7HdsjaSlzqce96VCQhVYwFM6LBqcU8FziW+Bofg5uZnZ39LFXpH1cRBgJbVbs7ronZA+c= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1728749063; c=relaxed/simple; bh=EwE3juDX/nC9X894RmNJQatoU95n/fBapv24fJv6j1U=; h=DKIM-Signature:Message-ID:Date:MIME-Version:To:From:Subject; b=TsTbDrJSumPDNXpSFXzeWXZ+iXmIFl6O4dbHdfwkpX1jA+AxyCQ1xF02ahlUc0WuA5y7UtJ/J9HJOwVLxTSMV24zNOGWu4jBVJQdZdtpH3/fgEYxkLYnL+UsPQvL6XyHB6iENgdYg05MEUCBYiqkyH+mgHKeanRZ50BTWt4t1GI= ARC-Authentication-Results: i=1; server2.sourceware.org Received: from cc-smtpin3.netcologne.de (cc-smtpin3.netcologne.de [89.1.8.203]) by cc-smtpout1.netcologne.de (Postfix) with ESMTP id 1972C13445; Sat, 12 Oct 2024 18:04:18 +0200 (CEST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=netcologne.de; s=nc1116a; t=1728749058; bh=EwE3juDX/nC9X894RmNJQatoU95n/fBapv24fJv6j1U=; h=Message-ID:Date:To:From:Subject:From; b=CZw7Lz2oDJJkryDfic0iEuJBBFGIxy/BDmqwVdGVjHZZh7UaAGVy2YHh9SFTaOShR U8FTC/mL6CQiWaPCAcI29J20+WM0+l0iENGrx3ZiV4kF9HAuoo/BuzkoqWw/+NUzsD zpcZiRmVuH35OXyGlMxIYDPel8x8vxgiG6pqEkJpMmhHBUcs36vpUYON62DyE/cMqY +YuR9NVaAYJDRJtqK4Xhllm5TUtw7V2URmk5BzG/mX2WKQRX4NLqFc28oVNIBVcEYU 07LiPaXeYGRv/rBjEaxGOGjiWYpBtyO3bmVS6b9I++yop8IagEoUPOmmWWOhKKHHok pjLRYUVmV75xQ== Received: from [IPV6:2a0a:a540:1c23:0:78dd:2944:5cd1:6ce7] (2a0a-a540-1c23-0-78dd-2944-5cd1-6ce7.ipv6dyn.netcologne.de [IPv6:2a0a:a540:1c23:0:78dd:2944:5cd1:6ce7]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by cc-smtpin3.netcologne.de (Postfix) with ESMTPSA id 7418311DCC; Sat, 12 Oct 2024 18:04:16 +0200 (CEST) Message-ID: Date: Sat, 12 Oct 2024 18:04:15 +0200 MIME-Version: 1.0 User-Agent: Mozilla Thunderbird Content-Language: en-US, de-DE To: "fortran@gcc.gnu.org" , gcc-patches From: Thomas Koenig Subject: [patch, Fortran] Unsigned constants for ISO_FORTRAN_ENV and ISO_C_BINDING X-NetCologne-Spam: L X-Rspamd-Queue-Id: 7418311DCC X-Rspamd-Action: no action X-Spamd-Bar: --- X-Spam-Status: No, score=-9.1 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, KAM_ASCII_DIVIDERS, KAM_STOCKGEN, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H3, RCVD_IN_MSPIKE_WL, SPF_HELO_NONE, SPF_PASS, TXREP, T_FILL_THIS_FORM_SHORT autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~incoming=patchwork.ozlabs.org@gcc.gnu.org Hello world, the attached patch implements the constants for UNSIGNED for ISO_FORTRAN_ENV and ISO_C_BINDING. With this, the implementation of UNSIGNED for gfortran should be complete, modulo bugs, of course. OK for trunk? Best regards Thomas gcc/fortran/ChangeLog: * dump-parse-tree.cc (get_c_type_name): Also handle BT_UNSIGNED. * gfortran.h (NAMED_UINTCST): Define before inclusion of iso-c-binding.def and iso-fortran-env.def. (gfc_get_uint_kind_from_width_isofortranenv): Prototype. * gfortran.texi: Mention new constants in iso_c_binding and iso_fortran_env. * iso-c-binding.def: Handle NAMED_UINTCST. Add c_unsigned, c_unsigned_short,c_unsigned_char, c_unsigned_long, c_unsigned_long_long, c_uintmax_t, c_uint8_t, c_uint16_t, c_uint32_t, c_uint64_t, c_uint128_t, c_uint_least8_t, c_uint_least16_t, c_uint_least32_t, c_uint_least64_t, c_uint_least128_t, c_uint_fast8_t, c_uint_fast16_t, c_uint_fast32_t, c_uint_fast64_t and c_uint_fast128_t. * iso-fortran-env.def: Handle NAMED_UINTCST. Add uint8, uint16, uint32 and uint64. * module.cc (parse_integer): Whitespace fix. (write_module): Whitespace fix. (NAMED_UINTCST): Define before inclusion of iso-fortran-evn.def and iso-fortran-env.def. * symbol.cc: Likewise. * trans-types.cc (get_unsigned_kind_from_node): New function. (get_uint_kind_from_name): New function. (gfc_get_uint_kind_from_width_isofortranenv): New function. (get_uint_kind_from_width): New function. (gfc_init_kinds): Initialize gfc_c_uint_kind. gcc/testsuite/ChangeLog: * gfortran.dg/unsigned_36.f90: New test. diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc index 3547d7f8aca..bc8a95a809b 100644 --- a/gcc/fortran/dump-parse-tree.cc +++ b/gcc/fortran/dump-parse-tree.cc @@ -3867,7 +3867,8 @@ get_c_type_name (gfc_typespec *ts, gfc_array_spec *as, const char **pre, *asterisk = false; *post = ""; *type_name = ""; - if (ts->type == BT_REAL || ts->type == BT_INTEGER || ts->type == BT_COMPLEX) + if (ts->type == BT_REAL || ts->type == BT_INTEGER || ts->type == BT_COMPLEX + || ts->type == BT_UNSIGNED) { if (ts->is_c_interop && ts->interop_kind) ret = T_OK; @@ -3895,7 +3896,16 @@ get_c_type_name (gfc_typespec *ts, gfc_array_spec *as, const char **pre, *type_name = "__GFORTRAN_DOUBLE_COMPLEX"; else if (strcmp (*type_name, "long_double_complex") == 0) *type_name = "__GFORTRAN_LONG_DOUBLE_COMPLEX"; - + else if (strcmp (*type_name, "unsigned") == 0) + *type_name = "unsigned int"; + else if (strcmp (*type_name, "unsigned_char") == 0) + *type_name = "unsigned char"; + else if (strcmp (*type_name, "unsigned_short") == 0) + *type_name = "unsigned short int"; + else if (strcmp (*type_name, "unsigned_long") == 0) + *type_name = "unsigned long int"; + else if (strcmp (*type_name, "unsigned_long long") == 0) + *type_name = "unsigned long long int"; break; } } diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 917866a7ef0..4fb6dde2c86 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -754,6 +754,7 @@ enum gfc_param_spec_type #define BBT_HEADER(self) int priority; struct self *left, *right #define NAMED_INTCST(a,b,c,d) a, +#define NAMED_UINTCST(a,b,c,d) a, #define NAMED_KINDARRAY(a,b,c,d) a, #define NAMED_FUNCTION(a,b,c,d) a, #define NAMED_SUBROUTINE(a,b,c,d) a, @@ -765,6 +766,7 @@ enum iso_fortran_env_symbol ISOFORTRANENV_LAST, ISOFORTRANENV_NUMBER = ISOFORTRANENV_LAST }; #undef NAMED_INTCST +#undef NANED_UINTCST #undef NAMED_KINDARRAY #undef NAMED_FUNCTION #undef NAMED_SUBROUTINE @@ -779,6 +781,7 @@ enum iso_fortran_env_symbol #define DERIVED_TYPE(a,b,c) a, #define NAMED_FUNCTION(a,b,c,d) a, #define NAMED_SUBROUTINE(a,b,c,d) a, +#define NAMED_UINTCST(a,b,c,d) a, enum iso_c_binding_symbol { ISOCBINDING_INVALID = -1, @@ -795,6 +798,7 @@ enum iso_c_binding_symbol #undef DERIVED_TYPE #undef NAMED_FUNCTION #undef NAMED_SUBROUTINE +#undef NAMED_UINTCST enum intmod_id { @@ -3496,6 +3500,7 @@ extern bool gfc_seen_div0; /* trans-types.cc */ int gfc_validate_kind (bt, int, bool); int gfc_get_int_kind_from_width_isofortranenv (int size); +int gfc_get_uint_kind_from_width_isofortranenv (int size); int gfc_get_real_kind_from_width_isofortranenv (int size); tree gfc_get_union_type (gfc_symbol *); tree gfc_get_derived_type (gfc_symbol * derived, int codimen = 0); @@ -3509,6 +3514,7 @@ extern int gfc_default_character_kind; extern int gfc_default_logical_kind; extern int gfc_default_complex_kind; extern int gfc_c_int_kind; +extern int gfc_c_uint_kind; extern int gfc_c_intptr_kind; extern int gfc_atomic_int_kind; extern int gfc_atomic_logical_kind; diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi index f0926be26b9..76326e625f8 100644 --- a/gcc/fortran/gfortran.texi +++ b/gcc/fortran/gfortran.texi @@ -2796,7 +2796,21 @@ As of now, the following intrinsics take unsigned arguments: @item @code{MAXVAL} and @code{MINVAL} @item @code{MAXLOC} and @code{MINLOC}. @end itemize -This list will grow in the near future. +The following constants have been added to the intrinsic +@code{ISO_C_BINDING} module: @code{c_unsigned}, +@code{c_unsigned_short}, @code{c_unsigned_char}, +@code{c_unsigned_long}, @code{c_unsigned_long_long}, +@code{c_uintmax_t}, @code{c_uint8_t}, @code{c_uint16_t}, +@code{c_uint32_t}, @code{c_uint64_t}, @code{c_uint128_t}, +@code{c_uint_fast8_t}, @code{c_uint_fast16_t}, @code{c_uint_fast32_t}, +@code{c_uint_fast64_t}, @code{c_uint_fast128_t}, +@code{c_uint_least8_t}, @code{c_uint_least16_t}, @code{c_uint_least32_t}, +@code{c_uint_least64_t} and @code{c_uint_least128_t}. + +The following constants have been added to the intrinsic +@code{ISO_FORTRAN_ENV} module: @code{uint8}, @code{uint16}, +@code{uint32} and @code{uint64}. + @c --------------------------------------------------------------------- @c --------------------------------------------------------------------- @c Mixed-Language Programming diff --git a/gcc/fortran/iso-c-binding.def b/gcc/fortran/iso-c-binding.def index e0c313d6001..e7591d8252f 100644 --- a/gcc/fortran/iso-c-binding.def +++ b/gcc/fortran/iso-c-binding.def @@ -47,6 +47,10 @@ along with GCC; see the file COPYING3. If not see # define NAMED_SUBROUTINE(a,b,c,d) #endif +#ifndef NAMED_UINTCST +# define NAMED_UINTCST(a,b,c,d) +#endif + /* The arguments to NAMED_*CST are: -- an internal name -- the symbol name in the module, as seen by Fortran code @@ -108,6 +112,62 @@ NAMED_INTCST (ISOCBINDING_INT_FAST64_T, "c_int_fast64_t", \ NAMED_INTCST (ISOCBINDING_INT_FAST128_T, "c_int_fast128_t", get_int_kind_from_width (128), GFC_STD_GNU) +/* UNSIGNED. */ +NAMED_UINTCST (ISOCBINDING_UINT, "c_unsigned", gfc_c_uint_kind, \ + GFC_STD_UNSIGNED) +NAMED_UINTCST (ISOCBINDING_USHORT, "c_unsigned_short", \ + get_unsigned_kind_from_node (short_unsigned_type_node), \ + GFC_STD_UNSIGNED) +NAMED_UINTCST (ISOCBINDING_UCHAR, "c_unsigned_char", \ + get_unsigned_kind_from_node (unsigned_char_type_node), \ + GFC_STD_UNSIGNED) +NAMED_UINTCST (ISOCBINDING_ULONG, "c_unsigned_long", \ + get_unsigned_kind_from_node (long_unsigned_type_node), \ + GFC_STD_UNSIGNED) +NAMED_UINTCST (ISOCBINDING_ULONGLONG, "c_unsigned_long_long", \ + get_unsigned_kind_from_node (long_long_unsigned_type_node), \ + GFC_STD_UNSIGNED) +NAMED_UINTCST (ISOCBINDING_UINTMAX_T, "c_uintmax_t", \ + get_uint_kind_from_name (UINTMAX_TYPE), GFC_STD_UNSIGNED) +NAMED_UINTCST (ISOCBINDING_UINT8_T, "c_uint8_t", \ + get_uint_kind_from_name (UINT8_TYPE), GFC_STD_UNSIGNED) +NAMED_UINTCST (ISOCBINDING_UINT16_T, "c_uint16_t", \ + get_uint_kind_from_name (UINT16_TYPE), GFC_STD_UNSIGNED) +NAMED_UINTCST (ISOCBINDING_UINT32_T, "c_uint32_t", \ + get_uint_kind_from_name (UINT32_TYPE), GFC_STD_UNSIGNED) +NAMED_UINTCST (ISOCBINDING_UINT64_T, "c_uint64_t", \ + get_uint_kind_from_name (UINT64_TYPE), GFC_STD_UNSIGNED) +NAMED_UINTCST (ISOCBINDING_UINT128_T, "c_uint128_t", \ + get_uint_kind_from_width (128), GFC_STD_UNSIGNED) +NAMED_UINTCST (ISOCBINDING_UINT_LEAST8_T, "c_uint_least8_t", \ + get_uint_kind_from_name (UINT_LEAST8_TYPE), \ + GFC_STD_UNSIGNED) +NAMED_UINTCST (ISOCBINDING_UINT_LEAST16_T, "c_uint_least16_t", \ + get_uint_kind_from_name (UINT_LEAST16_TYPE), \ + GFC_STD_UNSIGNED) +NAMED_UINTCST (ISOCBINDING_UINT_LEAST32_T, "c_uint_least32_t", \ + get_uint_kind_from_name (UINT_LEAST32_TYPE),\ + GFC_STD_UNSIGNED) +NAMED_UINTCST (ISOCBINDING_UINT_LEAST64_T, "c_uint_least64_t", \ + get_uint_kind_from_name (UINT_LEAST64_TYPE),\ + GFC_STD_UNSIGNED) +NAMED_UINTCST (ISOCBINDING_UINT_LEAST128_T, "c_uint_least128_t", \ + get_uint_kind_from_width (128), GFC_STD_UNSIGNED) +NAMED_UINTCST (ISOCBINDING_UINT_FAST8_T, "c_uint_fast8_t", \ + get_uint_kind_from_name (UINT_FAST8_TYPE), \ + GFC_STD_UNSIGNED) +NAMED_UINTCST (ISOCBINDING_UINT_FAST16_T, "c_uint_fast16_t", \ + get_uint_kind_from_name (UINT_FAST16_TYPE), \ + GFC_STD_UNSIGNED) +NAMED_UINTCST (ISOCBINDING_UINT_FAST32_T, "c_uint_fast32_t", \ + get_uint_kind_from_name (UINT_FAST32_TYPE),\ + GFC_STD_UNSIGNED) +NAMED_UINTCST (ISOCBINDING_UINT_FAST64_T, "c_uint_fast64_t", \ + get_uint_kind_from_name (UINT_FAST64_TYPE),\ + GFC_STD_UNSIGNED) +NAMED_UINTCST (ISOCBINDING_UINT_FAST128_T, "c_uint_fast128_t", \ + get_uint_kind_from_width (128), GFC_STD_UNSIGNED) + NAMED_REALCST (ISOCBINDING_FLOAT, "c_float", \ get_real_kind_from_node (float_type_node), GFC_STD_F2003) NAMED_REALCST (ISOCBINDING_DOUBLE, "c_double", \ @@ -197,6 +257,7 @@ NAMED_FUNCTION (ISOCBINDING_C_SIZEOF, "c_sizeof", \ GFC_ISYM_C_SIZEOF, GFC_STD_F2008) #undef NAMED_INTCST +#undef NAMED_UINTCST #undef NAMED_REALCST #undef NAMED_CMPXCST #undef NAMED_LOGCST diff --git a/gcc/fortran/iso-fortran-env.def b/gcc/fortran/iso-fortran-env.def index 069bbc1fb86..0debb66fe70 100644 --- a/gcc/fortran/iso-fortran-env.def +++ b/gcc/fortran/iso-fortran-env.def @@ -23,6 +23,10 @@ along with GCC; see the file COPYING3. If not see # define NAMED_INTCST(a,b,c,d) #endif +#ifndef NAMED_UINTCST +# define NAMED_UINTCST(a,b,c,d) +#endif + #ifndef NAMED_KINDARRAY # define NAMED_KINDARRAY(a,b,c,d) #endif @@ -99,7 +103,14 @@ NAMED_INTCST (ISOFORTRANENV_FILE_STAT_FAILED_IMAGE, "stat_failed_image", \ GFC_STAT_FAILED_IMAGE, GFC_STD_F2018) NAMED_INTCST (ISOFORTRANENV_FILE_STAT_UNLOCKED, "stat_unlocked", \ GFC_STAT_UNLOCKED, GFC_STD_F2008) - +NAMED_UINTCST (ISOFORTRANENV_UINT8, "uint8", \ + gfc_get_uint_kind_from_width_isofortranenv (8), GFC_STD_UNSIGNED) +NAMED_UINTCST (ISOFORTRANENV_UINT16, "uint16", \ + gfc_get_uint_kind_from_width_isofortranenv (16), GFC_STD_UNSIGNED) +NAMED_UINTCST (ISOFORTRANENV_UINT32, "uint32", \ + gfc_get_uint_kind_from_width_isofortranenv (32), GFC_STD_UNSIGNED) +NAMED_UINTCST (ISOFORTRANENV_UINT64, "uint64", \ + gfc_get_uint_kind_from_width_isofortranenv (64), GFC_STD_UNSIGNED) /* The arguments to NAMED_KINDARRAY are: -- an internal name @@ -144,6 +155,7 @@ NAMED_DERIVED_TYPE (ISOFORTRAN_TEAM_TYPE, "team_type", \ : gfc_default_integer_kind, GFC_STD_F2018) #undef NAMED_INTCST +#undef NAMED_UINTCST #undef NAMED_KINDARRAY #undef NAMED_FUNCTION #undef NAMED_SUBROUTINE diff --git a/gcc/fortran/module.cc b/gcc/fortran/module.cc index bf38127d213..880aef2c7a8 100644 --- a/gcc/fortran/module.cc +++ b/gcc/fortran/module.cc @@ -1353,7 +1353,7 @@ parse_integer (int c) atom_int = 10 * atom_int + c - '0'; } - atom_int *= sign; + atom_int *= sign; } @@ -6346,7 +6346,7 @@ write_module (void) /* Initialize the column counter. */ module_column = 1; - + /* Write the operator interfaces. */ mio_lparen (); @@ -6780,7 +6780,12 @@ import_iso_c_binding_module (void) not_in_std = (gfc_option.allow_std & d) == 0; \ name = b; \ break; -#define NAMED_REALCST(a,b,c,d) \ +#define NAMED_UINTCST(a,b,c,d) \ + case a: \ + not_in_std = (gfc_option.allow_std & d) == 0; \ + name = b; \ + break; +#define NAMED_REALCST(a,b,c,d) \ case a: \ not_in_std = (gfc_option.allow_std & d) == 0; \ name = b; \ @@ -6867,7 +6872,12 @@ import_iso_c_binding_module (void) if ((gfc_option.allow_std & d) == 0) \ continue; \ break; -#define NAMED_REALCST(a,b,c,d) \ +#define NAMED_UINTCST(a,b,c,d) \ + case a: \ + if ((gfc_option.allow_std & d) == 0) \ + continue; \ + break; +#define NAMED_REALCST(a,b,c,d) \ case a: \ if ((gfc_option.allow_std & d) == 0) \ continue; \ @@ -7101,6 +7111,7 @@ use_iso_fortran_env_module (void) intmod_sym symbol[] = { #define NAMED_INTCST(a,b,c,d) { a, b, 0, d }, +#define NAMED_UINTCST(a,b,c,d) { a, b, 0, d }, #define NAMED_KINDARRAY(a,b,c,d) { a, b, 0, d }, #define NAMED_DERIVED_TYPE(a,b,c,d) { a, b, 0, d }, #define NAMED_FUNCTION(a,b,c,d) { a, b, c, d }, @@ -7110,6 +7121,9 @@ use_iso_fortran_env_module (void) i = 0; #define NAMED_INTCST(a,b,c,d) symbol[i++].value = c; +#include "iso-fortran-env.def" + +#define NAMED_UINTCST(a,b,c,d) symbol[i++].value = c; #include "iso-fortran-env.def" /* Generate the symbol for the module itself. */ @@ -7167,6 +7181,15 @@ use_iso_fortran_env_module (void) INTMOD_ISO_FORTRAN_ENV, symbol[i].id); break; +#define NAMED_UINTCST(a,b,c,d) \ + case a: +#include "iso-fortran-env.def" + create_int_parameter (u->local_name[0] ? u->local_name + : u->use_name, + symbol[i].value, mod, + INTMOD_ISO_FORTRAN_ENV, symbol[i].id); + break; + #define NAMED_KINDARRAY(a,b,KINDS,d) \ case a:\ expr = gfc_get_array_expr (BT_INTEGER, \ @@ -7232,6 +7255,13 @@ use_iso_fortran_env_module (void) INTMOD_ISO_FORTRAN_ENV, symbol[i].id); break; +#define NAMED_UINTCST(a,b,c,d) \ + case a: +#include "iso-fortran-env.def" + create_int_parameter (symbol[i].name, symbol[i].value, mod, + INTMOD_ISO_FORTRAN_ENV, symbol[i].id); + break; + #define NAMED_KINDARRAY(a,b,KINDS,d) \ case a:\ expr = gfc_get_array_expr (BT_INTEGER, gfc_default_integer_kind, \ diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc index dd209a22fc1..557bd3bcc34 100644 --- a/gcc/fortran/symbol.cc +++ b/gcc/fortran/symbol.cc @@ -4925,6 +4925,12 @@ std_for_isocbinding_symbol (int id) #include "iso-c-binding.def" #undef NAMED_INTCST +#define NAMED_UINTCST(a,b,c,d) \ + case a:\ + return d; +#include "iso-c-binding.def" +#undef NAMED_UINTCST + #define NAMED_FUNCTION(a,b,c,d) \ case a:\ return d; @@ -5032,6 +5038,7 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s, { #define NAMED_INTCST(a,b,c,d) case a : +#define NAMED_UINTCST(a,b,c,d) case a : #define NAMED_REALCST(a,b,c,d) case a : #define NAMED_CMPXCST(a,b,c,d) case a : #define NAMED_LOGCST(a,b,c) case a : diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc index 05e64b3a8e1..d59c0cc19d4 100644 --- a/gcc/fortran/trans-types.cc +++ b/gcc/fortran/trans-types.cc @@ -119,6 +119,7 @@ int gfc_default_character_kind; int gfc_default_logical_kind; int gfc_default_complex_kind; int gfc_c_int_kind; +int gfc_c_uint_kind; int gfc_c_intptr_kind; int gfc_atomic_int_kind; int gfc_atomic_logical_kind; @@ -226,6 +227,26 @@ get_int_kind_from_name (const char *name) return get_int_kind_from_node (get_typenode_from_name (name)); } +static int +get_unsigned_kind_from_node (tree type) +{ + int i; + + if (!type) + return -2; + + for (i = 0; gfc_unsigned_kinds[i].kind != 0; i++) + if (gfc_unsigned_kinds[i].bit_size == TYPE_PRECISION (type)) + return gfc_unsigned_kinds[i].kind; + + return -1; +} + +static int +get_uint_kind_from_name (const char *name) +{ + return get_unsigned_kind_from_node (get_typenode_from_name (name)); +} /* Get the kind number corresponding to an integer of given size, following the required return values for ISO_FORTRAN_ENV INT* constants: @@ -248,6 +269,26 @@ gfc_get_int_kind_from_width_isofortranenv (int size) return -1; } +/* Same, but for unsigned. */ + +int +gfc_get_uint_kind_from_width_isofortranenv (int size) +{ + int i; + + /* Look for a kind with matching storage size. */ + for (i = 0; gfc_unsigned_kinds[i].kind != 0; i++) + if (gfc_unsigned_kinds[i].bit_size == size) + return gfc_unsigned_kinds[i].kind; + + /* Look for a kind with larger storage size. */ + for (i = 0; gfc_unsigned_kinds[i].kind != 0; i++) + if (gfc_unsigned_kinds[i].bit_size > size) + return -2; + + return -1; +} + /* Get the kind number corresponding to a real of a given storage size. If two real's have the same storage size, then choose the real with @@ -312,6 +353,18 @@ get_int_kind_from_minimal_width (int size) return -2; } +static int +get_uint_kind_from_width (int size) +{ + int i; + + for (i = 0; gfc_unsigned_kinds[i].kind != 0; i++) + if (gfc_integer_kinds[i].bit_size == size) + return gfc_integer_kinds[i].kind; + + return -2; +} + /* Generate the CInteropKind_t objects for the C interoperable kinds. */ @@ -334,6 +387,10 @@ gfc_init_c_interop_kinds (void) strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \ c_interop_kinds_table[a].f90_type = BT_INTEGER; \ c_interop_kinds_table[a].value = c; +#define NAMED_UINTCST(a,b,c,d) \ + strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \ + c_interop_kinds_table[a].f90_type = BT_UNSIGNED; \ + c_interop_kinds_table[a].value = c; #define NAMED_REALCST(a,b,c,d) \ strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \ c_interop_kinds_table[a].f90_type = BT_REAL; \ @@ -746,6 +803,9 @@ gfc_init_kinds (void) /* Pick a kind the same size as the C "int" type. */ gfc_c_int_kind = INT_TYPE_SIZE / 8; + /* UNSIGNED has the same as INT. */ + gfc_c_uint_kind = gfc_c_int_kind; + /* Choose atomic kinds to match C's int. */ gfc_atomic_int_kind = gfc_c_int_kind; gfc_atomic_logical_kind = gfc_c_int_kind; diff --git a/gcc/testsuite/gfortran.dg/unsigned_36.f90 b/gcc/testsuite/gfortran.dg/unsigned_36.f90 new file mode 100644 index 00000000000..a096c045b51 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/unsigned_36.f90 @@ -0,0 +1,36 @@ +! { dg-do compile } +! { dg-options "-funsigned" } +module use_c_binding + use iso_c_binding + implicit none + unsigned(c_unsigned), bind(c) :: a + unsigned(c_unsigned_short), bind(c) :: b + unsigned(c_unsigned_char), bind(c) :: c + unsigned(c_unsigned_long), bind(c) :: d + unsigned(c_unsigned_long_long), bind(c) :: e + unsigned(c_uintmax_t), bind(c) :: f + unsigned(c_uint8_t), bind(c) :: u8 + unsigned(c_uint16_t), bind(c) :: u16 + unsigned(c_uint32_t), bind(c) :: u32 + unsigned(c_uint64_t), bind(c) :: u64 + unsigned(c_uint_fast8_t), bind(c) :: f8 + unsigned(c_uint_fast16_t), bind(c) :: f16 + unsigned(c_uint_fast32_t), bind(c) :: f32 + unsigned(c_uint_fast64_t), bind(c) :: f64 + unsigned(c_uint_least8_t), bind(c) :: l8 + unsigned(c_uint_least16_t), bind(c) :: l16 + unsigned(c_uint_least32_t), bind(c) :: l32 + unsigned(c_uint_least64_t), bind(c) :: l64 + integer, parameter :: c_128 = c_uint128_t + integer, parameter :: fast_128 = c_uint_fast128_t + integer, parameter :: least_128 = c_uint_least128_t +end module use_c_binding + +program memain + use use_c_binding + use iso_fortran_env + unsigned(uint8) :: a8 + unsigned(uint16) :: a16 + unsigned(uint32) :: a32 + unsigned(uint64) :: a64 +end program memain