* intrinsic.h: Prototype it.
* intrinsic.c (add_function): Use it.
* simplify (gfc_simplify_ceiling,gfc_simplify_floor): Change
BT_REAL to BT_INTEGER and use gfc_default_integer_kind.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@95291
138bc75d-0d04-0410-961f-
82ee72b054a4
2005-02-19 Steven G. Kargl <kargls@comcast.net>
+ * check.c (gfc_check_selected_int_kind): New function.
+ * intrinsic.h: Prototype it.
+ * intrinsic.c (add_function): Use it.
+ * simplify (gfc_simplify_ceiling,gfc_simplify_floor): Change
+ BT_REAL to BT_INTEGER and use gfc_default_integer_kind.
+
+2005-02-19 Steven G. Kargl <kargls@comcast.net>
+
* check.c (gfc_check_int): improve checking of optional kind
* simplify.c (gfc_simplify_int): Change BT_REAL to BT_INTEGER
try
+gfc_check_selected_int_kind (gfc_expr * r)
+{
+
+ if (type_check (r, 0, BT_INTEGER) == FAILURE)
+ return FAILURE;
+
+ if (scalar_check (r, 0) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+}
+
+
+try
gfc_check_selected_real_kind (gfc_expr * p, gfc_expr * r)
{
if (p == NULL && r == NULL)
make_generic ("second", GFC_ISYM_SECOND, GFC_STD_GNU);
add_sym_1 ("selected_int_kind", 0, 1, BT_INTEGER, di, GFC_STD_F95,
- NULL, gfc_simplify_selected_int_kind, NULL,
+ gfc_check_selected_int_kind, gfc_simplify_selected_int_kind, NULL,
r, BT_INTEGER, di, REQUIRED);
make_generic ("selected_int_kind", GFC_ISYM_SI_KIND, GFC_STD_F95);
try gfc_check_scale (gfc_expr *, gfc_expr *);
try gfc_check_scan (gfc_expr *, gfc_expr *, gfc_expr *);
try gfc_check_second_sub (gfc_expr *);
+try gfc_check_selected_int_kind (gfc_expr *);
try gfc_check_selected_real_kind (gfc_expr *, gfc_expr *);
try gfc_check_set_exponent (gfc_expr *, gfc_expr *);
try gfc_check_shape (gfc_expr *);
gfc_expr *ceil, *result;
int kind;
- kind = get_kind (BT_REAL, k, "CEILING", gfc_default_real_kind);
+ kind = get_kind (BT_INTEGER, k, "CEILING", gfc_default_integer_kind);
if (kind == -1)
return &gfc_bad_expr;
mpfr_t floor;
int kind;
- kind = get_kind (BT_REAL, k, "FLOOR", gfc_default_real_kind);
+ kind = get_kind (BT_INTEGER, k, "FLOOR", gfc_default_integer_kind);
if (kind == -1)
gfc_internal_error ("gfc_simplify_floor(): Bad kind");