diff options
| author | Tobias Burnus <burnus@net-b.de> | 2010-06-25 21:40:37 +0200 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2010-06-25 21:40:37 +0200 |
| commit | 01349049e8a5e3d82ea0344c7628024a7c936a3a (patch) | |
| tree | 0227f439c097f371c197a8473efb939d6bb3803b /gcc/fortran/simplify.c | |
| parent | 849cab7b758a2da9c739de3af5d42bb252a1db5f (diff) | |
| download | gcc-01349049e8a5e3d82ea0344c7628024a7c936a3a.zip gcc-01349049e8a5e3d82ea0344c7628024a7c936a3a.tar.gz gcc-01349049e8a5e3d82ea0344c7628024a7c936a3a.tar.bz2 | |
intrinsic.h (gfc_check_selected_real_kind, [...]): Update prototypes.
2010-06-25 Tobias Burnus <burnus@net-b.de>
* intrinsic.h (gfc_check_selected_real_kind,
gfc_simplify_selected_real_kind): Update prototypes.
* intrinsic.c (add_functions): Add radix support to
selected_real_kind.
* check.c (gfc_check_selected_real_kind): Ditto.
* simplify.c (gfc_simplify_selected_real_kind): Ditto.
* trans-decl.c (gfc_build_intrinsic_function_decls):
Change call from selected_real_kind to selected_real_kind2008.
* intrinsic.texi (SELECTED_REAL_KIND): Update for radix.
(PRECISION, RANGE, RADIX): Add cross @refs.
2010-06-25 Tobias Burnus <burnus@net-b.de>
* intrinsics/selected_real_kind.f90
(_gfortran_selected_real_kind2008): Add function.
(_gfortran_selected_real_kind): Stub which calls
_gfortran_selected_real_kind2008.
* gfortran.map (GFORTRAN_1.4): Add
_gfortran_selected_real_kind2008.
* mk-srk-inc.sh: Save also RADIX.
2010-06-25 Tobias Burnus <burnus@net-b.de>
* selected_real_kind_2.f90: New.
* selected_real_kind_3.f90: New.
From-SVN: r161411
Diffstat (limited to 'gcc/fortran/simplify.c')
| -rw-r--r-- | gcc/fortran/simplify.c | 46 |
1 files changed, 36 insertions, 10 deletions
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index 743c463..7356625 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -4589,9 +4589,11 @@ gfc_simplify_selected_int_kind (gfc_expr *e) gfc_expr * -gfc_simplify_selected_real_kind (gfc_expr *p, gfc_expr *q) +gfc_simplify_selected_real_kind (gfc_expr *p, gfc_expr *q, gfc_expr *rdx) { - int range, precision, i, kind, found_precision, found_range; + int range, precision, radix, i, kind, found_precision, found_range, + found_radix; + locus *loc = &gfc_current_locus; if (p == NULL) precision = 0; @@ -4600,6 +4602,7 @@ gfc_simplify_selected_real_kind (gfc_expr *p, gfc_expr *q) if (p->expr_type != EXPR_CONSTANT || gfc_extract_int (p, &precision) != NULL) return NULL; + loc = &p->where; } if (q == NULL) @@ -4609,11 +4612,27 @@ gfc_simplify_selected_real_kind (gfc_expr *p, gfc_expr *q) if (q->expr_type != EXPR_CONSTANT || gfc_extract_int (q, &range) != NULL) return NULL; + + if (!loc) + loc = &q->where; + } + + if (rdx == NULL) + radix = 0; + else + { + if (rdx->expr_type != EXPR_CONSTANT + || gfc_extract_int (rdx, &radix) != NULL) + return NULL; + + if (!loc) + loc = &rdx->where; } kind = INT_MAX; found_precision = 0; found_range = 0; + found_radix = 0; for (i = 0; gfc_real_kinds[i].kind != 0; i++) { @@ -4623,23 +4642,30 @@ gfc_simplify_selected_real_kind (gfc_expr *p, gfc_expr *q) if (gfc_real_kinds[i].range >= range) found_range = 1; + if (gfc_real_kinds[i].radix >= radix) + found_radix = 1; + if (gfc_real_kinds[i].precision >= precision - && gfc_real_kinds[i].range >= range && gfc_real_kinds[i].kind < kind) + && gfc_real_kinds[i].range >= range + && gfc_real_kinds[i].radix >= radix && gfc_real_kinds[i].kind < kind) kind = gfc_real_kinds[i].kind; } if (kind == INT_MAX) { - kind = 0; - - if (!found_precision) + if (found_radix && found_range && !found_precision) kind = -1; - if (!found_range) - kind -= 2; + else if (found_radix && found_precision && !found_range) + kind = -2; + else if (found_radix && !found_precision && !found_range) + kind = -3; + else if (found_radix) + kind = -4; + else + kind = -5; } - return gfc_get_int_expr (gfc_default_integer_kind, - p ? &p->where : &q->where, kind); + return gfc_get_int_expr (gfc_default_integer_kind, loc, kind); } |