* 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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@95290 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 54c37ab..f4a3640 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,10 @@
 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
+
+2005-02-19  Steven G. Kargl  <kargls@comcast.net>
+  
        * 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 (file)
--- 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 (file)
--- 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 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2005-02-19  Steven G. Kargl  <kargls@comcast.net>
+
+       * gfortran.dg/int_1.f90: New test.
+
 2005-02-19  Devang Patel  <dpatel@apple.com>
 
        * 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 (file)
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