diff options
Diffstat (limited to 'gcc/fortran/iresolve.c')
-rw-r--r-- | gcc/fortran/iresolve.c | 43 |
1 files changed, 43 insertions, 0 deletions
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index 9bf767dbaf6..6565187423e 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -416,6 +416,45 @@ gfc_resolve_besn (gfc_expr *f, gfc_expr *n, gfc_expr *x) void +gfc_resolve_bessel_n2 (gfc_expr *f, gfc_expr *n1, gfc_expr *n2, gfc_expr *x) +{ + gfc_typespec ts; + gfc_clear_ts (&ts); + + f->ts = x->ts; + f->rank = 1; + if (n1->expr_type == EXPR_CONSTANT && n2->expr_type == EXPR_CONSTANT) + { + f->shape = gfc_get_shape (1); + mpz_init (f->shape[0]); + mpz_sub (f->shape[0], n2->value.integer, n1->value.integer); + mpz_add_ui (f->shape[0], f->shape[0], 1); + } + + if (n1->ts.kind != gfc_c_int_kind) + { + ts.type = BT_INTEGER; + ts.kind = gfc_c_int_kind; + gfc_convert_type (n1, &ts, 2); + } + + if (n2->ts.kind != gfc_c_int_kind) + { + ts.type = BT_INTEGER; + ts.kind = gfc_c_int_kind; + gfc_convert_type (n2, &ts, 2); + } + + if (f->value.function.isym->id == GFC_ISYM_JN2) + f->value.function.name = gfc_get_string (PREFIX ("bessel_jn_r%d"), + f->ts.kind); + else + f->value.function.name = gfc_get_string (PREFIX ("bessel_yn_r%d"), + f->ts.kind); +} + + +void gfc_resolve_btest (gfc_expr *f, gfc_expr *i, gfc_expr *pos) { f->ts.type = BT_LOGICAL; @@ -883,6 +922,10 @@ gfc_resolve_extends_type_of (gfc_expr *f, gfc_expr *a, gfc_expr *mo) f->ts.type = BT_LOGICAL; f->ts.kind = 4; + + f->value.function.isym->formal->ts = a->ts; + f->value.function.isym->formal->next->ts = mo->ts; + /* Call library function. */ f->value.function.name = gfc_get_string (PREFIX ("is_extension_of")); } |