diff options
| author | fxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4> | 2007-08-12 21:21:08 +0000 |
|---|---|---|
| committer | fxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4> | 2007-08-12 21:21:08 +0000 |
| commit | 6857f4014271eb74bf22bb86d493f923095083b9 (patch) | |
| tree | a2bdf7d08832c0e14a6d1fee214ec771d5c64b09 /gcc/fortran/simplify.c | |
| parent | 3d3b790db32448aed311a1df5c182f639ee7ec97 (diff) | |
| download | gcc-6857f4014271eb74bf22bb86d493f923095083b9.tar.gz | |
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.
* gfortran.dg/intrinsics_kind_argument_1.f90: Add test for ACHAR
intrinsic.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@127385 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/fortran/simplify.c')
| -rw-r--r-- | gcc/fortran/simplify.c | 11 |
1 files changed, 7 insertions, 4 deletions
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index c3c23cb9215..a395b04a599 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -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); |