diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 8 | ||||
| -rw-r--r-- | gcc/fortran/intrinsic.c | 2 | ||||
| -rw-r--r-- | gcc/fortran/intrinsic.h | 1 | ||||
| -rw-r--r-- | gcc/fortran/iresolve.c | 9 | ||||
| -rw-r--r-- | gcc/fortran/trans-intrinsic.c | 30 |
5 files changed, 49 insertions, 1 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index a89e197..ef2dc36 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,5 +1,13 @@ 2012-06-18 Tobias Burnus <burnus@net-b.de> + * intrinsic.h (gfc_resolve_rank): New prototype. + * intrinsic.c (add_functions): Use gfc_resolve_rank. + * iresolve.c (add_functions): New function. + * trans-intrinsic.c (gfc_conv_intrinsic_rank): New function. + (gfc_conv_intrinsic_function): Call it. + +2012-06-18 Tobias Burnus <burnus@net-b.de> + PR fortran/53692 * trans-array.c (set_loop_bounds): Don't scalarize via absent optional arrays. diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 38bcb27..88d4636 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -2434,7 +2434,7 @@ add_functions (void) make_generic ("range", GFC_ISYM_RANGE, GFC_STD_F95); add_sym_1 ("rank", GFC_ISYM_RANK, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, - GFC_STD_F2008_TS, gfc_check_rank, gfc_simplify_rank, NULL, + GFC_STD_F2008_TS, gfc_check_rank, gfc_simplify_rank, gfc_resolve_rank, a, BT_REAL, dr, REQUIRED); make_generic ("rank", GFC_ISYM_RANK, GFC_STD_F2008_TS); diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h index bfc2455..2635ba6 100644 --- a/gcc/fortran/intrinsic.h +++ b/gcc/fortran/intrinsic.h @@ -486,6 +486,7 @@ void gfc_resolve_long (gfc_expr *, gfc_expr *); void gfc_resolve_ior (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_iparity (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_isatty (gfc_expr *, gfc_expr *); +void gfc_resolve_rank (gfc_expr *, gfc_expr *); void gfc_resolve_rshift (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_lshift (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_ishft (gfc_expr *, gfc_expr *, gfc_expr *); diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index 9d94e3b..2a49455 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -2006,6 +2006,15 @@ gfc_resolve_product (gfc_expr *f, gfc_expr *array, gfc_expr *dim, void +gfc_resolve_rank (gfc_expr *f, gfc_expr *array ATTRIBUTE_UNUSED) +{ + f->ts.type = BT_INTEGER; + f->ts.kind = gfc_default_integer_kind; + f->value.function.name = gfc_get_string ("__rank"); +} + + +void gfc_resolve_real (gfc_expr *f, gfc_expr *a, gfc_expr *kind) { f->ts.type = BT_REAL; diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 8cce427..c74e81a 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -1316,6 +1316,32 @@ trans_num_images (gfc_se * se) } +static void +gfc_conv_intrinsic_rank (gfc_se *se, gfc_expr *expr) +{ + gfc_se argse; + gfc_ss *ss; + tree dtype, tmp; + + ss = gfc_walk_expr (expr->value.function.actual->expr); + gcc_assert (ss != gfc_ss_terminator); + gfc_init_se (&argse, NULL); + argse.data_not_needed = 1; + argse.want_pointer = 1; + + gfc_conv_expr_descriptor (&argse, expr->value.function.actual->expr, ss); + gfc_add_block_to_block (&se->pre, &argse.pre); + gfc_add_block_to_block (&se->post, &argse.post); + argse.expr = build_fold_indirect_ref_loc (input_location, argse.expr); + argse.expr = build_fold_indirect_ref_loc (input_location, argse.expr); + dtype = gfc_conv_descriptor_dtype (argse.expr); + tmp = build_int_cst (TREE_TYPE (dtype), GFC_DTYPE_RANK_MASK); + tmp = fold_build2_loc (input_location, BIT_AND_EXPR, TREE_TYPE (dtype), + dtype, tmp); + se->expr = fold_convert (gfc_get_int_type (gfc_default_integer_kind), tmp); +} + + /* Evaluate a single upper or lower bound. */ /* TODO: bound intrinsic generates way too much unnecessary code. */ @@ -6710,6 +6736,10 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr) gfc_conv_intrinsic_arith (se, expr, MULT_EXPR, false); break; + case GFC_ISYM_RANK: + gfc_conv_intrinsic_rank (se, expr); + break; + case GFC_ISYM_RRSPACING: gfc_conv_intrinsic_rrspacing (se, expr); break; |