* 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
2007-08-12 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+ 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 <fxcoudert@gcc.gnu.org>
+
PR fortran/30964
PR fortran/33054
* trans-expr.c (gfc_conv_function_call): When no formal argument
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;
}
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);
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 *);
/* 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 *);
/* 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 *);
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);
}
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)
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);
2007-08-12 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+ PR fortran/29600
+ * gfortran.dg/intrinsics_kind_argument_1.f90: Add test for ACHAR
+ intrinsic.
+
+2007-08-12 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+
PR fortran/30964
PR fortran/33054
* gfortran.dg/random_4.f90: New 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)