From c60d77d4db7aec48e2fb0997400c4d1177b726aa Mon Sep 17 00:00:00 2001 From: "Steven G. Kargl" Date: Sat, 19 Feb 2005 20:07:47 +0000 Subject: [PATCH] check.c (gfc_check_int): improve checking of optional kind * check.c (gfc_check_int): improve checking of optional kind * simplify.c (gfc_simplify_int): Change BT_REAL to BT_INTEGER * gfortran.dg/int_1.f90: New test. From-SVN: r95290 --- gcc/fortran/ChangeLog | 5 ++ gcc/fortran/check.c | 12 ++- gcc/fortran/simplify.c | 2 +- gcc/testsuite/ChangeLog | 4 + gcc/testsuite/gfortran.dg/int_1.f90 | 172 ++++++++++++++++++++++++++++++++++++ 5 files changed, 192 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/int_1.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 54c37ab..f4a3640 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,5 +1,10 @@ 2005-02-19 Steven G. Kargl + * check.c (gfc_check_int): improve checking of optional kind + * simplify.c (gfc_simplify_int): Change BT_REAL to BT_INTEGER + +2005-02-19 Steven G. Kargl + * check.c (gfc_check_achar): New function * intrinsic.h: Prototype it. * intrinsic.c (add_function): Use it. diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 0a26f29..281db88 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -946,10 +946,18 @@ gfc_check_index (gfc_expr * string, gfc_expr * substring, gfc_expr * back) try gfc_check_int (gfc_expr * x, gfc_expr * kind) { - if (numeric_check (x, 0) == FAILURE - || kind_check (kind, 1, BT_INTEGER) == FAILURE) + if (numeric_check (x, 0) == FAILURE) + return FAILURE; + + if (kind != NULL) + { + if (type_check (kind, 1, BT_INTEGER) == FAILURE) return FAILURE; + if (scalar_check (kind, 1) == FAILURE) + return FAILURE; + } + return SUCCESS; } diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index 423f333..0290b84 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -1473,7 +1473,7 @@ gfc_simplify_int (gfc_expr * e, gfc_expr * k) gfc_expr *rpart, *rtrunc, *result; int kind; - kind = get_kind (BT_REAL, k, "INT", gfc_default_real_kind); + kind = get_kind (BT_INTEGER, k, "INT", gfc_default_integer_kind); if (kind == -1) return &gfc_bad_expr; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 8e083a9..1f6d05c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2005-02-19 Steven G. Kargl + + * gfortran.dg/int_1.f90: New test. + 2005-02-19 Devang Patel * gcc.dg/cpp/mac-eol-at-eof.c: New test. diff --git a/gcc/testsuite/gfortran.dg/int_1.f90 b/gcc/testsuite/gfortran.dg/int_1.f90 new file mode 100644 index 0000000..4e38122 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/int_1.f90 @@ -0,0 +1,172 @@ +! { dg-do run } +! +! 13.7.53 INT(A [, KIND]) +! +! Description. Convert to integer type. +! Class. Elemental function. +! Arguments. +! A shall be of type integer, real, or complex, +! or a boz-literal-constant . +! KIND (optional) shall be a scalar integer initialization expression. +! +! Result Characteristics. Integer. If KIND is present, the kind type +! parameter is that specified by the value of KIND; otherwise, the +! kind type parameter is that of default integer type. +! +! Result Value. +! +! Case (1): If A is of type integer, INT (A) = A. +! +! Case (2): If A is of type real, there are two cases: +! (a) if |A| < 1, INT (A) has the value 0 +! (b) if |A| .ge. 1, INT (A) is the integer whose magnitude is the +! largest integer that does not exceed the magnitude of A and +! whose sign is the same as the sign of A. +! +! Case (3): If A is of type complex, INT(A) = INT(REAL(A, KIND(A))). +! +! Case (4): If A is a boz-literal-constant, it is treated as if it were +! an int-literal-constant with a kind-param that specifies the +! representation method with the largest decimal exponent range +! supported by the processor. +! +! Example. INT (­3.7) has the value ­3. +! +module mykinds + integer, parameter :: ik1 = selected_int_kind(2) + integer, parameter :: ik2 = selected_int_kind(4) + integer, parameter :: ik4 = selected_int_kind(9) + integer, parameter :: ik8 = selected_int_kind(18) + integer, parameter :: sp = selected_real_kind(6,30) + integer, parameter :: dp = selected_real_kind(15,300) + integer, parameter :: ck = kind('a') +end module mykinds + +program test_int + + use mykinds + + integer(ik1) i1 + integer(ik2) i2 + integer(ik4) i4 + integer(ik8) i8 + real(sp) r4 + real(dp) r8 + complex(sp) c4 + complex(dp) c8 + ! + ! Case 1 + ! + i1 = int(-3) + i2 = int(-3) + i4 = int(-3) + i8 = int(-3) + if (i1 /= -3_ik1 .or. i2 /= -3_ik2) call abort + if (i4 /= -3_ik4 .or. i8 /= -3_ik8) call abort + + i1 = int(5, ik1) + i2 = int(i1, ik2) + i4 = int(i1, ik4) + i8 = int(i1, ik8) + if (i1 /= 5_ik1 .or. i2 /= 5_ik2) call abort + if (i4 /= 5_ik4 .or. i8 /= 5_ik8) call abort + + i8 = int(10, ik8) + i1 = int(i8, ik1) + i2 = int(i8, ik2) + i4 = int(i8, ik4) + if (i1 /= 10_ik1 .or. i2 /= 10_ik2) call abort + if (i4 /= 10_ik4 .or. i8 /= 10_ik8) call abort + ! + ! case 2(b) + ! + r4 = -3.7_sp + i1 = int(r4, ik1) + i2 = int(r4, ik2) + i4 = int(r4, ik4) + i8 = int(r4, ik8) + if (i1 /= -3_ik1 .or. i2 /= -3_ik2) call abort + if (i4 /= -3_ik4 .or. i8 /= -3_ik8) call abort + + r8 = -3.7_dp + i1 = int(r8, ik1) + i2 = int(r8, ik2) + i4 = int(r8, ik4) + i8 = int(r8, ik8) + if (i1 /= -3_ik1 .or. i2 /= -3_ik2) call abort + if (i4 /= -3_ik4 .or. i8 /= -3_ik8) call abort + ! + ! Case 2(a) + ! + r4 = -3.7E-1_sp + i1 = int(r4, ik1) + i2 = int(r4, ik2) + i4 = int(r4, ik4) + i8 = int(r4, ik8) + if (i1 /= 0_ik1 .or. i2 /= 0_ik2) call abort + if (i4 /= 0_ik4 .or. i8 /= 0_ik8) call abort + + r8 = -3.7E-1_dp + i1 = int(r8, ik1) + i2 = int(r8, ik2) + i4 = int(r8, ik4) + i8 = int(r8, ik8) + if (i1 /= 0_ik1 .or. i2 /= 0_ik2) call abort + if (i4 /= 0_ik4 .or. i8 /= 0_ik8) call abort + ! + ! Case 3 + ! + c4 = (-3.7E-1_sp,3.7E-1_sp) + i1 = int(c4, ik1) + i2 = int(c4, ik2) + i4 = int(c4, ik4) + i8 = int(c4, ik8) + if (i1 /= 0_ik1 .or. i2 /= 0_ik2) call abort + if (i4 /= 0_ik4 .or. i8 /= 0_ik8) call abort + + c8 = (-3.7E-1_dp,3.7E-1_dp) + i1 = int(c8, ik1) + i2 = int(c8, ik2) + i4 = int(c8, ik4) + i8 = int(c8, ik8) + if (i1 /= 0_ik1 .or. i2 /= 0_ik2) call abort + if (i4 /= 0_ik4 .or. i8 /= 0_ik8) call abort + + c4 = (-3.7_sp,3.7_sp) + i1 = int(c4, ik1) + i2 = int(c4, ik2) + i4 = int(c4, ik4) + i8 = int(c4, ik8) + if (i1 /= -3_ik1 .or. i2 /= -3_ik2) call abort + if (i4 /= -3_ik4 .or. i8 /= -3_ik8) call abort + + c8 = (3.7_dp,3.7_dp) + i1 = int(c8, ik1) + i2 = int(c8, ik2) + i4 = int(c8, ik4) + i8 = int(c8, ik8) + if (i1 /= 3_ik1 .or. i2 /= 3_ik2) call abort + if (i4 /= 3_ik4 .or. i8 /= 3_ik8) call abort + ! + ! Case 4 + ! + i1 = int(b'0011', ik1) + i2 = int(b'0011', ik2) + i4 = int(b'0011', ik4) + i8 = int(b'0011', ik8) + if (i1 /= 3_ik1 .or. i2 /= 3_ik2) call abort + if (i4 /= 3_ik4 .or. i8 /= 3_ik8) call abort + i1 = int(o'0011', ik1) + i2 = int(o'0011', ik2) + i4 = int(o'0011', ik4) + i8 = int(o'0011', ik8) + if (i1 /= 9_ik1 .or. i2 /= 9_ik2) call abort + if (i4 /= 9_ik4 .or. i8 /= 9_ik8) call abort + i1 = int(z'0011', ik1) + i2 = int(z'0011', ik2) + i4 = int(z'0011', ik4) + i8 = int(z'0011', ik8) + if (i1 /= 17_ik1 .or. i2 /= 17_ik2) call abort + if (i4 /= 17_ik4 .or. i8 /= 17_ik8) call abort + +end program test_int -- 2.7.4