From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 13084 invoked by alias); 6 Aug 2015 16:11:43 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Received: (qmail 12972 invoked by uid 89); 6 Aug 2015 16:11:42 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-2.6 required=5.0 tests=BAYES_00,FREEMAIL_FROM,RCVD_IN_DNSWL_LOW,SPF_PASS autolearn=ham version=3.3.2 X-Spam-User: qpsmtpd, 2 recipients X-HELO: mail-wi0-f171.google.com Received: from mail-wi0-f171.google.com (HELO mail-wi0-f171.google.com) (209.85.212.171) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES128-GCM-SHA256 encrypted) ESMTPS; Thu, 06 Aug 2015 16:11:41 +0000 Received: by wibhh20 with SMTP id hh20so31002544wib.0; Thu, 06 Aug 2015 09:11:37 -0700 (PDT) X-Received: by 10.194.97.196 with SMTP id ec4mr4847770wjb.3.1438877497822; Thu, 06 Aug 2015 09:11:37 -0700 (PDT) Received: from [192.168.1.22] (ALyon-654-1-299-23.w90-53.abo.wanadoo.fr. [90.53.67.23]) by smtp.gmail.com with ESMTPSA id mc4sm4041880wic.6.2015.08.06.09.11.36 (version=TLSv1 cipher=ECDHE-RSA-RC4-SHA bits=128/128); Thu, 06 Aug 2015 09:11:37 -0700 (PDT) From: FX Content-Type: multipart/mixed; boundary="Apple-Mail=_353D620E-9FBD-4210-8363-87759837F0D4" Subject: [fortran,patch] Allow some IEEE functions in constant and specification expressions Date: Thu, 06 Aug 2015 16:11:00 -0000 Message-Id: Cc: GNU GFortran To: GCC Patches Mime-Version: 1.0 (Mac OS X Mail 8.2 \(2102\)) X-SW-Source: 2015-08/txt/msg00360.txt.bz2 --Apple-Mail=_353D620E-9FBD-4210-8363-87759837F0D4 Content-Transfer-Encoding: quoted-printable Content-Type: text/plain; charset=utf-8 Content-length: 1331 The attached patch fixes the only remaining IEEE bug (to my knowledge) in g= fortran. A Fortran 2008 interpretation request was submitted two years ago about whi= ch of the IEEE functions were supposed to be used in constant and specifica= tion expressions. The interp, voted on by J3 in Nov 2014, made corrections = to the standard (see my comment at https://gcc.gnu.org/bugzilla/show_bug.cg= i?id=3D64104#c3 for the detail of this). This front-end patch makes gfortra= n conforming with the standard. There is a minor caveat: since support for various kinds (results of the IE= EE_SELECTED_REAL_KIND, IEEE_SUPPORT_ROUNDING, IEEE_SUPPORT_FLAG and IEEE_SU= PPORT_HALTING functions) are detected at runtime, we need in the future a m= echanism to communication the support detected in libgfortran back to the f= ront-end. The current approach does not do that, but instead assumes that i= f IEEE modules are present, support is enabled for all flags and rounding m= odes. This is true on the common platforms (x86 and x86_64), so I guess it= =E2=80=99s good enough to enable it now. In the meantime, I=E2=80=99m think= ing about how best to achieve the long-term goal (spec file? secret logical= constants in the IEEE modules?) for the future. Bootstrapped and regtested on x86_64-apple-darwin14. OK to commit to trunk? FX --Apple-Mail=_353D620E-9FBD-4210-8363-87759837F0D4 Content-Disposition: attachment; filename=ieee.ChangeLog Content-Type: application/octet-stream; x-unix-mode=0644; name="ieee.ChangeLog" Content-Transfer-Encoding: 7bit Content-length: 690 2015-08-06 Francois-Xavier Coudert PR fortran/64104 * expr.c (gfc_check_init_expr): Allow some IEEE functions in constant expressions. (external_spec_function): Allow some IEEE functions in specification expressions. * simplify.c (gfc_simplify_ieee_selected_real_kind): Remove. (simplify_ieee_selected_real_kind, simplify_ieee_support, matches_ieee_function_name, gfc_simplify_ieee_functions): New functions. * gfortran.h (gfc_simplify_ieee_selected_real_kind): Remove prototype. (gfc_simplify_ieee_functions): Add prototype. 2015-08-06 Francois-Xavier Coudert PR fortran/64104 * gfortran.dg/ieee/ieee_8.f90: New test. --Apple-Mail=_353D620E-9FBD-4210-8363-87759837F0D4 Content-Disposition: attachment; filename=ieee.diff Content-Type: application/octet-stream; x-unix-mode=0644; name="ieee.diff" Content-Transfer-Encoding: 7bit Content-length: 10248 Index: gcc/fortran/expr.c =================================================================== --- gcc/fortran/expr.c (revision 226632) +++ gcc/fortran/expr.c (working copy) @@ -2474,13 +2474,14 @@ gfc_check_init_expr (gfc_expr *e) gfc_intrinsic_sym* isym; gfc_symbol* sym = e->symtree->n.sym; - /* Special case for IEEE_SELECTED_REAL_KIND from the intrinsic - module IEEE_ARITHMETIC, which is allowed in initialization - expressions. */ - if (!strcmp(sym->name, "ieee_selected_real_kind") - && sym->from_intmod == INTMOD_IEEE_ARITHMETIC) + /* Simplify here the intrinsics from the IEEE_ARITHMETIC and + IEEE_EXCEPTIONS modules. */ + int mod = sym->from_intmod; + if (mod == INTMOD_NONE && sym->generic) + mod = sym->generic->sym->from_intmod; + if (mod == INTMOD_IEEE_ARITHMETIC || mod == INTMOD_IEEE_EXCEPTIONS) { - gfc_expr *new_expr = gfc_simplify_ieee_selected_real_kind (e); + gfc_expr *new_expr = gfc_simplify_ieee_functions (e); if (new_expr) { gfc_replace_expr (e, new_expr); @@ -2738,6 +2739,29 @@ external_spec_function (gfc_expr *e) f = e->value.function.esym; + /* IEEE functions allowed are "a reference to a transformational function + from the intrinsic module IEEE_ARITHMETIC or IEEE_EXCEPTIONS", and + "inquiry function from the intrinsic modules IEEE_ARITHMETIC and + IEEE_EXCEPTIONS". */ + if (f->from_intmod == INTMOD_IEEE_ARITHMETIC + || f->from_intmod == INTMOD_IEEE_EXCEPTIONS) + { + if (!strcmp (f->name, "ieee_selected_real_kind") + || !strcmp (f->name, "ieee_support_rounding") + || !strcmp (f->name, "ieee_support_flag") + || !strcmp (f->name, "ieee_support_halting") + || !strcmp (f->name, "ieee_support_datatype") + || !strcmp (f->name, "ieee_support_denormal") + || !strcmp (f->name, "ieee_support_divide") + || !strcmp (f->name, "ieee_support_inf") + || !strcmp (f->name, "ieee_support_io") + || !strcmp (f->name, "ieee_support_nan") + || !strcmp (f->name, "ieee_support_sqrt") + || !strcmp (f->name, "ieee_support_standard") + || !strcmp (f->name, "ieee_support_underflow_control")) + goto function_allowed; + } + if (f->attr.proc == PROC_ST_FUNCTION) { gfc_error ("Specification function %qs at %L cannot be a statement " @@ -2766,6 +2790,7 @@ external_spec_function (gfc_expr *e) return false; } +function_allowed: return restricted_args (e->value.function.actual); } Index: gcc/fortran/gfortran.h =================================================================== --- gcc/fortran/gfortran.h (revision 226632) +++ gcc/fortran/gfortran.h (working copy) @@ -2881,8 +2881,6 @@ gfc_formal_arglist *gfc_sym_get_dummy_ar /* intrinsic.c -- true if working in an init-expr, false otherwise. */ extern bool gfc_init_expr_flag; -gfc_expr *gfc_simplify_ieee_selected_real_kind (gfc_expr *); - /* Given a symbol that we have decided is intrinsic, mark it as such by placing it into a special module that is otherwise impossible to read or write. */ @@ -3245,6 +3243,7 @@ int gfc_code_walker (gfc_code **, walk_c /* simplify.c */ void gfc_convert_mpz_to_signed (mpz_t, int); +gfc_expr *gfc_simplify_ieee_functions (gfc_expr *); /* trans-array.c */ Index: gcc/fortran/simplify.c =================================================================== --- gcc/fortran/simplify.c (revision 226632) +++ gcc/fortran/simplify.c (working copy) @@ -5553,20 +5553,6 @@ gfc_simplify_selected_real_kind (gfc_exp gfc_expr * -gfc_simplify_ieee_selected_real_kind (gfc_expr *expr) -{ - gfc_actual_arglist *arg = expr->value.function.actual; - gfc_expr *p = arg->expr, *q = arg->next->expr, - *rdx = arg->next->next->expr; - - /* Currently, if IEEE is supported and this module is built, it means - all our floating-point types conform to IEEE. Hence, we simply handle - IEEE_SELECTED_REAL_KIND like SELECTED_REAL_KIND. */ - return gfc_simplify_selected_real_kind (p, q, rdx); -} - - -gfc_expr * gfc_simplify_set_exponent (gfc_expr *x, gfc_expr *i) { gfc_expr *result; @@ -6955,3 +6941,62 @@ gfc_simplify_compiler_version (void) return gfc_get_character_expr (gfc_default_character_kind, &gfc_current_locus, buffer, len); } + +/* Simplification routines for intrinsics of IEEE modules. */ + +gfc_expr * +simplify_ieee_selected_real_kind (gfc_expr *expr) +{ + gfc_actual_arglist *arg = expr->value.function.actual; + gfc_expr *p = arg->expr, *q = arg->next->expr, + *rdx = arg->next->next->expr; + + /* Currently, if IEEE is supported and this module is built, it means + all our floating-point types conform to IEEE. Hence, we simply handle + IEEE_SELECTED_REAL_KIND like SELECTED_REAL_KIND. */ + return gfc_simplify_selected_real_kind (p, q, rdx); +} + +gfc_expr * +simplify_ieee_support (gfc_expr *expr) +{ + /* We consider that if the IEEE modules are loaded, we have full support + for flags, halting and rounding, which are the three functions + (IEEE_SUPPORT_{FLAG,HALTING,ROUNDING}) allowed in constant + expressions. One day, we will need libgfortran to detect support and + communicate it back to us, allowing for partial support. */ + + return gfc_get_logical_expr (gfc_default_logical_kind, &expr->where, + true); +} + +bool +matches_ieee_function_name (gfc_symbol *sym, const char *name) +{ + int n = strlen(name); + + if (!strncmp(sym->name, name, n)) + return true; + + /* If a generic was used and renamed, we need more work to find out. + Compare the specific name. */ + if (sym->generic && !strncmp(sym->generic->sym->name, name, n)) + return true; + + return false; +} + +gfc_expr * +gfc_simplify_ieee_functions (gfc_expr *expr) +{ + gfc_symbol* sym = expr->symtree->n.sym; + + if (matches_ieee_function_name(sym, "ieee_selected_real_kind")) + return simplify_ieee_selected_real_kind (expr); + else if (matches_ieee_function_name(sym, "ieee_support_flag") + || matches_ieee_function_name(sym, "ieee_support_halting") + || matches_ieee_function_name(sym, "ieee_support_rounding")) + return simplify_ieee_support (expr); + else + return NULL; +} Index: gcc/testsuite/gfortran.dg/ieee/ieee_8.f90 =================================================================== --- gcc/testsuite/gfortran.dg/ieee/ieee_8.f90 (revision 0) +++ gcc/testsuite/gfortran.dg/ieee/ieee_8.f90 (working copy) @@ -0,0 +1,114 @@ +! { dg-do run } + +module foo + use :: ieee_exceptions + use :: ieee_arithmetic +end module foo + +module bar + use foo + use :: ieee_arithmetic, yyy => ieee_support_rounding + use :: ieee_arithmetic, zzz => ieee_selected_real_kind +end module + +program test + use :: bar + use :: ieee_arithmetic, xxx => ieee_support_rounding + implicit none + + ! IEEE functions allowed in constant expressions + + integer, parameter :: n1 = ieee_selected_real_kind(0, 0) + logical, parameter :: l1 = ieee_support_halting(ieee_overflow) + logical, parameter :: l2 = ieee_support_flag(ieee_overflow) + logical, parameter :: l3 = ieee_support_flag(ieee_overflow, 0.) + logical, parameter :: l4 = ieee_support_rounding(ieee_to_zero) + logical, parameter :: l5 = ieee_support_rounding(ieee_to_zero, 0.d0) + + logical, parameter :: l6 = xxx(ieee_to_zero, 0.d0) + logical, parameter :: l7 = yyy(ieee_to_zero, 0.d0) + integer, parameter :: n2 = zzz(0, 0) + + call gee(8, ieee_to_zero, ieee_overflow) + +end + +! IEEE functions allowed in specification expressions + +subroutine gee(n, rounding, flag) + use :: bar + implicit none + + integer :: n + type(ieee_round_type) :: rounding + type(ieee_flag_type) :: flag + + character(len=ieee_selected_real_kind(n)) :: s1 + character(len=ieee_selected_real_kind(n,2*n)) :: s2 + character(len=ieee_selected_real_kind(n,2*n,2)) :: s3 + + character(len=merge(4,2,ieee_support_rounding(rounding))) :: s4 + character(len=merge(4,2,ieee_support_rounding(rounding, 0.d0))) :: s5 + + character(len=merge(4,2,ieee_support_flag(flag))) :: s6 + character(len=merge(4,2,ieee_support_flag(flag, 0.))) :: s7 + + character(len=merge(4,2,ieee_support_halting(flag))) :: s8 + + character(len=merge(4,2,ieee_support_datatype())) :: s9 + character(len=merge(4,2,ieee_support_datatype(0.))) :: s10 + + character(len=merge(4,2,ieee_support_denormal())) :: s11 + character(len=merge(4,2,ieee_support_denormal(0.))) :: s12 + + character(len=merge(4,2,ieee_support_divide())) :: s13 + character(len=merge(4,2,ieee_support_divide(0.))) :: s14 + + character(len=merge(4,2,ieee_support_inf())) :: s15 + character(len=merge(4,2,ieee_support_inf(0.))) :: s16 + + character(len=merge(4,2,ieee_support_io())) :: s17 + character(len=merge(4,2,ieee_support_io(0.))) :: s18 + + character(len=merge(4,2,ieee_support_nan())) :: s19 + character(len=merge(4,2,ieee_support_nan(0.))) :: s20 + + character(len=merge(4,2,ieee_support_sqrt())) :: s21 + character(len=merge(4,2,ieee_support_sqrt(0.))) :: s22 + + character(len=merge(4,2,ieee_support_standard())) :: s23 + character(len=merge(4,2,ieee_support_standard(0.))) :: s24 + + character(len=merge(4,2,ieee_support_underflow_control())) :: s25 + character(len=merge(4,2,ieee_support_underflow_control(0.))) :: s26 + + ! Now, check that runtime values match compile-time constants + ! (for those that are allowed) + + integer, parameter :: x1 = ieee_selected_real_kind(8) + integer, parameter :: x2 = ieee_selected_real_kind(8,2*8) + integer, parameter :: x3 = ieee_selected_real_kind(8,2*8,2) + + integer, parameter :: x4 = merge(4,2,ieee_support_rounding(rounding)) + integer, parameter :: x5 = merge(4,2,ieee_support_rounding(rounding, 0.d0)) + + integer, parameter :: x6 = merge(4,2,ieee_support_flag(ieee_overflow)) + integer, parameter :: x7 = merge(4,2,ieee_support_flag(ieee_overflow, 0.)) + + integer, parameter :: x8 = merge(4,2,ieee_support_halting(ieee_overflow)) + + if (len(s1) /= x1) call abort + if (len(s2) /= x2) call abort + if (len(s3) /= x3) call abort + + if (len(s4) /= x4) call abort + if (len(s5) /= x5) call abort + + if (len(s6) /= x6) call abort + if (len(s7) /= x7) call abort + + if (len(s8) /= x8) call abort + +end subroutine + +! { dg-final { cleanup-modules "foo bar" } } --Apple-Mail=_353D620E-9FBD-4210-8363-87759837F0D4--