From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 30157 invoked by alias); 12 Aug 2007 21:23:12 -0000 Received: (qmail 29315 invoked by uid 22791); 12 Aug 2007 21:23:03 -0000 X-Spam-Check-By: sourceware.org Received: from fk-out-0910.google.com (HELO fk-out-0910.google.com) (209.85.128.188) by sourceware.org (qpsmtpd/0.31) with ESMTP; Sun, 12 Aug 2007 21:23:02 +0000 Received: by fk-out-0910.google.com with SMTP id 26so1256458fkx for ; Sun, 12 Aug 2007 14:22:59 -0700 (PDT) Received: by 10.86.70.8 with SMTP id s8mr4215459fga.1186953779051; Sun, 12 Aug 2007 14:22:59 -0700 (PDT) Received: from ?144.82.208.57? ( [144.82.208.57]) by mx.google.com with ESMTPS id k7sm5344666nfh.2007.08.12.14.22.52 (version=TLSv1/SSLv3 cipher=OTHER); Sun, 12 Aug 2007 14:22:53 -0700 (PDT) Mime-Version: 1.0 (Apple Message framework v752.3) In-Reply-To: References: <1186906106.3438.1.camel@meiner.onlinehome.de> Content-Type: multipart/mixed; boundary=Apple-Mail-5-340652786 Message-Id: <66A92A9B-F00A-4FA5-85D7-15F42E91213B@gmail.com> From: FX Coudert Subject: Re: [gfortran,patch] Add KIND argument to a bunch of intrinsics (F2003) Date: Sun, 12 Aug 2007 21:23:00 -0000 To: Thomas Koenig , GNU Fortran , gcc-patches list X-Mailer: Apple Mail (2.752.3) 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 X-SW-Source: 2007-08/txt/msg00790.txt.bz2 --Apple-Mail-5-340652786 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset=US-ASCII; delsp=yes; format=flowed Content-length: 163 After some more thinking, ACHAR is trivial since CHAR is already handled, so I added support for ACHAR. Regtested on x86_64-linux, committed as obvious. FX --Apple-Mail-5-340652786 Content-Transfer-Encoding: 7bit Content-Type: application/octet-stream; x-unix-mode=0644; name=achar_kind.diff Content-Disposition: attachment; filename=achar_kind.diff Content-length: 6481 Index: gcc/fortran/intrinsic.c =================================================================== --- gcc/fortran/intrinsic.c (revision 127380) +++ gcc/fortran/intrinsic.c (working copy) @@ -946,9 +946,10 @@ add_functions (void) make_generic ("access", GFC_ISYM_ACCESS, GFC_STD_GNU); - add_sym_1 ("achar", GFC_ISYM_ACHAR, CLASS_ELEMENTAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95, + add_sym_2 ("achar", GFC_ISYM_ACHAR, CLASS_ELEMENTAL, ACTUAL_NO, + BT_CHARACTER, dc, GFC_STD_F95, gfc_check_achar, gfc_simplify_achar, gfc_resolve_achar, - i, BT_INTEGER, di, REQUIRED); + i, BT_INTEGER, di, REQUIRED, kind, BT_INTEGER, di, OPTIONAL); make_generic ("achar", GFC_ISYM_ACHAR, GFC_STD_F95); Index: gcc/fortran/intrinsic.h =================================================================== --- gcc/fortran/intrinsic.h (revision 127380) +++ gcc/fortran/intrinsic.h (working copy) @@ -32,7 +32,7 @@ try gfc_check_a_p (gfc_expr *, gfc_expr try gfc_check_abs (gfc_expr *); try gfc_check_access_func (gfc_expr *, gfc_expr *); -try gfc_check_achar (gfc_expr *); +try gfc_check_achar (gfc_expr *, gfc_expr *); try gfc_check_all_any (gfc_expr *, gfc_expr *); try gfc_check_allocated (gfc_expr *); try gfc_check_associated (gfc_expr *, gfc_expr *); @@ -185,7 +185,7 @@ try gfc_check_unlink_sub (gfc_expr *, gf /* Simplification functions. */ gfc_expr *gfc_simplify_abs (gfc_expr *); -gfc_expr *gfc_simplify_achar (gfc_expr *); +gfc_expr *gfc_simplify_achar (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_acos (gfc_expr *); gfc_expr *gfc_simplify_acosh (gfc_expr *); gfc_expr *gfc_simplify_adjustl (gfc_expr *); @@ -303,7 +303,7 @@ gfc_expr *gfc_convert_constant (gfc_expr /* Resolution functions. */ void gfc_resolve_abs (gfc_expr *, gfc_expr *); void gfc_resolve_access (gfc_expr *, gfc_expr *, gfc_expr *); -void gfc_resolve_achar (gfc_expr *, gfc_expr *); +void gfc_resolve_achar (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_acos (gfc_expr *, gfc_expr *); void gfc_resolve_acosh (gfc_expr *, gfc_expr *); void gfc_resolve_aimag (gfc_expr *, gfc_expr *); Index: gcc/fortran/ChangeLog =================================================================== --- gcc/fortran/ChangeLog (revision 127383) +++ gcc/fortran/ChangeLog (working copy) @@ -1,5 +1,15 @@ 2007-08-12 Francois-Xavier Coudert + PR fortran/29600 + * intrinsic.c (add_functions): Add optional KIND argument to ACHAR. + * iresolve.c (gfc_resolve_achar): Handle the KIND argument. + * check.c (gfc_check_achar): Check for the optional KIND argument. + * simplify.c (gfc_simplify_achar): Use KIND argument. + * intrinsic.h (gfc_check_achar, gfc_simplify_achar, + gfc_resolve_achar): Adjust prototypes. + +2007-08-12 Francois-Xavier Coudert + PR fortran/30964 PR fortran/33054 * trans-expr.c (gfc_conv_function_call): When no formal argument Index: gcc/fortran/iresolve.c =================================================================== --- gcc/fortran/iresolve.c (revision 127380) +++ gcc/fortran/iresolve.c (working copy) @@ -133,18 +133,19 @@ gfc_resolve_access (gfc_expr *f, gfc_exp void -gfc_resolve_achar (gfc_expr *f, gfc_expr *x) +gfc_resolve_achar (gfc_expr *f, gfc_expr *x, gfc_expr *kind) { - f->ts.type = BT_CHARACTER; - f->ts.kind = gfc_default_character_kind; + f->ts.kind = (kind == NULL) + ? gfc_default_character_kind : mpz_get_si (kind->value.integer); f->ts.cl = gfc_get_charlen (); f->ts.cl->next = gfc_current_ns->cl_list; gfc_current_ns->cl_list = f->ts.cl; f->ts.cl->length = gfc_int_expr (1); - f->value.function.name - = gfc_get_string ("__achar_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); + f->value.function.name = gfc_get_string ("__achar_%d_%c%d", f->ts.kind, + gfc_type_letter (x->ts.type), + x->ts.kind); } Index: gcc/fortran/check.c =================================================================== --- gcc/fortran/check.c (revision 127380) +++ gcc/fortran/check.c (working copy) @@ -443,10 +443,12 @@ gfc_check_abs (gfc_expr *a) try -gfc_check_achar (gfc_expr *a) +gfc_check_achar (gfc_expr *a, gfc_expr *kind) { if (type_check (a, 0, BT_INTEGER) == FAILURE) return FAILURE; + if (kind_check (kind, 1, BT_CHARACTER) == FAILURE) + return FAILURE; return SUCCESS; } Index: gcc/fortran/simplify.c =================================================================== --- gcc/fortran/simplify.c (revision 127380) +++ gcc/fortran/simplify.c (working copy) @@ -257,15 +257,19 @@ gfc_simplify_abs (gfc_expr *e) systems that gfortran currently works on are ASCII. */ gfc_expr * -gfc_simplify_achar (gfc_expr *e) +gfc_simplify_achar (gfc_expr *e, gfc_expr *k) { gfc_expr *result; - int c; + int c, kind; const char *ch; if (e->expr_type != EXPR_CONSTANT) return NULL; + kind = get_kind (BT_CHARACTER, k, "ACHAR", gfc_default_character_kind); + if (kind == -1) + return &gfc_bad_expr; + ch = gfc_extract_int (e, &c); if (ch != NULL) @@ -275,8 +279,7 @@ gfc_simplify_achar (gfc_expr *e) gfc_warning ("Argument of ACHAR function at %L outside of range [0,127]", &e->where); - result = gfc_constant_result (BT_CHARACTER, gfc_default_character_kind, - &e->where); + result = gfc_constant_result (BT_CHARACTER, kind, &e->where); result->value.character.string = gfc_getmem (2); Index: gcc/testsuite/ChangeLog =================================================================== --- gcc/testsuite/ChangeLog (revision 127383) +++ gcc/testsuite/ChangeLog (working copy) @@ -1,5 +1,11 @@ 2007-08-12 Francois-Xavier Coudert + PR fortran/29600 + * gfortran.dg/intrinsics_kind_argument_1.f90: Add test for ACHAR + intrinsic. + +2007-08-12 Francois-Xavier Coudert + PR fortran/30964 PR fortran/33054 * gfortran.dg/random_4.f90: New test. Index: gcc/testsuite/gfortran.dg/intrinsics_kind_argument_1.f90 =================================================================== --- gcc/testsuite/gfortran.dg/intrinsics_kind_argument_1.f90 (revision 127380) +++ gcc/testsuite/gfortran.dg/intrinsics_kind_argument_1.f90 (working copy) @@ -21,6 +21,8 @@ program test call check (ichar (s, k), 117) call check (ichar (s, kind=k), 117) + if (achar(107) /= achar(107,1)) call abort + call check (index (t, s, .true., k), 7) call check (index (t, s, kind=k, back=.false.), 5) --Apple-Mail-5-340652786--