summaryrefslogtreecommitdiff
path: root/libgfortran/intrinsics
diff options
context:
space:
mode:
Diffstat (limited to 'libgfortran/intrinsics')
-rw-r--r--libgfortran/intrinsics/cpu_time.c8
-rw-r--r--libgfortran/intrinsics/date_and_time.c6
-rw-r--r--libgfortran/intrinsics/random.c10
-rw-r--r--libgfortran/intrinsics/selected_char_kind.c2
-rw-r--r--libgfortran/intrinsics/selected_real_kind.f9057
-rw-r--r--libgfortran/intrinsics/system_clock.c2
6 files changed, 61 insertions, 24 deletions
diff --git a/libgfortran/intrinsics/cpu_time.c b/libgfortran/intrinsics/cpu_time.c
index 0ac502340ac..3580bba0928 100644
--- a/libgfortran/intrinsics/cpu_time.c
+++ b/libgfortran/intrinsics/cpu_time.c
@@ -78,7 +78,7 @@ void cpu_time_4 (GFC_REAL_4 *time)
{
long sec, usec;
__cpu_time_1 (&sec, &usec);
- *time = sec + usec * (GFC_REAL_4)1.e-6;
+ *time = sec + usec * GFC_REAL_4_LITERAL(1.e-6);
}
iexport(cpu_time_4);
@@ -89,7 +89,7 @@ void cpu_time_8 (GFC_REAL_8 *time)
{
long sec, usec;
__cpu_time_1 (&sec, &usec);
- *time = sec + usec * (GFC_REAL_8)1.e-6;
+ *time = sec + usec * GFC_REAL_8_LITERAL(1.e-6);
}
#ifdef HAVE_GFC_REAL_10
@@ -100,7 +100,7 @@ void cpu_time_10 (GFC_REAL_10 *time)
{
long sec, usec;
__cpu_time_1 (&sec, &usec);
- *time = sec + usec * (GFC_REAL_10)1.e-6;
+ *time = sec + usec * GFC_REAL_10_LITERAL(1.e-6);
}
#endif
@@ -112,7 +112,7 @@ void cpu_time_16 (GFC_REAL_16 *time)
{
long sec, usec;
__cpu_time_1 (&sec, &usec);
- *time = sec + usec * (GFC_REAL_16)1.e-6;
+ *time = sec + usec * GFC_REAL_16_LITERAL(1.e-6);
}
#endif
diff --git a/libgfortran/intrinsics/date_and_time.c b/libgfortran/intrinsics/date_and_time.c
index 647dd9ad7a3..21e4320e134 100644
--- a/libgfortran/intrinsics/date_and_time.c
+++ b/libgfortran/intrinsics/date_and_time.c
@@ -280,8 +280,12 @@ date_and_time (char *__date, char *__time, char *__zone,
delta = GFC_DESCRIPTOR_STRIDE(__values,0);
if (delta == 0)
delta = 1;
+
+ if (unlikely (len < VALUES_SIZE))
+ runtime_error ("Incorrect extent in VALUE argument to"
+ " DATE_AND_TIME intrinsic: is %ld, should"
+ " be >=%ld", (long int) len, (long int) VALUES_SIZE);
- assert (len >= VALUES_SIZE);
/* Cope with different type kinds. */
if (elt_size == 4)
{
diff --git a/libgfortran/intrinsics/random.c b/libgfortran/intrinsics/random.c
index 803049b065f..cbe4f90322b 100644
--- a/libgfortran/intrinsics/random.c
+++ b/libgfortran/intrinsics/random.c
@@ -85,7 +85,7 @@ rnumber_4 (GFC_REAL_4 *f, GFC_UINTEGER_4 v)
#error "GFC_REAL_4_RADIX has unknown value"
#endif
v = v & mask;
- *f = (GFC_REAL_4) v * (GFC_REAL_4) 0x1.p-32f;
+ *f = (GFC_REAL_4) v * GFC_REAL_4_LITERAL(0x1.p-32);
}
static inline void
@@ -100,7 +100,7 @@ rnumber_8 (GFC_REAL_8 *f, GFC_UINTEGER_8 v)
#error "GFC_REAL_8_RADIX has unknown value"
#endif
v = v & mask;
- *f = (GFC_REAL_8) v * (GFC_REAL_8) 0x1.p-64;
+ *f = (GFC_REAL_8) v * GFC_REAL_8_LITERAL(0x1.p-64);
}
#ifdef HAVE_GFC_REAL_10
@@ -117,7 +117,7 @@ rnumber_10 (GFC_REAL_10 *f, GFC_UINTEGER_8 v)
#error "GFC_REAL_10_RADIX has unknown value"
#endif
v = v & mask;
- *f = (GFC_REAL_10) v * (GFC_REAL_10) 0x1.p-64;
+ *f = (GFC_REAL_10) v * GFC_REAL_10_LITERAL(0x1.p-64);
}
#endif
@@ -137,8 +137,8 @@ rnumber_16 (GFC_REAL_16 *f, GFC_UINTEGER_8 v1, GFC_UINTEGER_8 v2)
#error "GFC_REAL_16_RADIX has unknown value"
#endif
v2 = v2 & mask;
- *f = (GFC_REAL_16) v1 * (GFC_REAL_16) 0x1.p-64
- + (GFC_REAL_16) v2 * (GFC_REAL_16) 0x1.p-128;
+ *f = (GFC_REAL_16) v1 * GFC_REAL_16_LITERAL(0x1.p-64)
+ + (GFC_REAL_16) v2 * GFC_REAL_16_LITERAL(0x1.p-128);
}
#endif
/* libgfortran previously had a Mersenne Twister, taken from the paper:
diff --git a/libgfortran/intrinsics/selected_char_kind.c b/libgfortran/intrinsics/selected_char_kind.c
index 35cf453402a..25259979fcb 100644
--- a/libgfortran/intrinsics/selected_char_kind.c
+++ b/libgfortran/intrinsics/selected_char_kind.c
@@ -40,7 +40,7 @@ selected_char_kind (gfc_charlen_type name_len, char *name)
|| (len == 7 && strncasecmp (name, "default", 7) == 0))
return 1;
else if (len == 9 && strncasecmp (name, "iso_10646", 9) == 0)
- return 1;
+ return 4;
else
return -1;
}
diff --git a/libgfortran/intrinsics/selected_real_kind.f90 b/libgfortran/intrinsics/selected_real_kind.f90
index ea3b46aabdd..92708d7205f 100644
--- a/libgfortran/intrinsics/selected_real_kind.f90
+++ b/libgfortran/intrinsics/selected_real_kind.f90
@@ -1,7 +1,7 @@
-! Copyright 2003, 2004, 2009 Free Software Foundation, Inc.
+! Copyright 2003, 2004, 2009, 2010 Free Software Foundation, Inc.
! Contributed by Kejia Zhao <kejia_zh@yahoo.com.cn>
!
-!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!This file is part of the GNU Fortran runtime library (libgfortran).
!
!Libgfortran is free software; you can redistribute it and/or
!modify it under the terms of the GNU General Public
@@ -22,43 +22,74 @@
!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
!<http://www.gnu.org/licenses/>.
-function _gfortran_selected_real_kind (p, r)
+function _gfortran_selected_real_kind2008 (p, r, rdx)
implicit none
- integer, optional, intent (in) :: p, r
- integer :: _gfortran_selected_real_kind
- integer :: i, p2, r2
- logical :: found_p, found_r
+ integer, optional, intent (in) :: p, r, rdx
+ integer :: _gfortran_selected_real_kind2008
+ integer :: i, p2, r2, radix2
+ logical :: found_p, found_r, found_radix
! Real kind_precision_range table
type :: real_info
integer :: kind
integer :: precision
integer :: range
+ integer :: radix
end type real_info
include "selected_real_kind.inc"
- _gfortran_selected_real_kind = 0
+ _gfortran_selected_real_kind2008 = 0
p2 = 0
r2 = 0
+ radix2 = 0
found_p = .false.
found_r = .false.
+ found_radix = .false.
if (present (p)) p2 = p
if (present (r)) r2 = r
+ if (present (rdx)) radix2 = rdx
! Assumes each type has a greater precision and range than previous one.
do i = 1, c
if (p2 <= real_infos (i) % precision) found_p = .true.
if (r2 <= real_infos (i) % range) found_r = .true.
- if (found_p .and. found_r) then
- _gfortran_selected_real_kind = real_infos (i) % kind
+ if (radix2 <= real_infos (i) % radix) found_radix = .true.
+
+ if (p2 <= real_infos (i) % precision &
+ .and. r2 <= real_infos (i) % range &
+ .and. radix2 <= real_infos (i) % radix) then
+ _gfortran_selected_real_kind2008 = real_infos (i) % kind
return
end if
end do
- if (.not. (found_p)) _gfortran_selected_real_kind = _gfortran_selected_real_kind - 1
- if (.not. (found_r)) _gfortran_selected_real_kind = _gfortran_selected_real_kind - 2
+ if (found_radix .and. found_r .and. .not. found_p) then
+ _gfortran_selected_real_kind2008 = -1
+ elseif (found_radix .and. found_p .and. .not. found_r) then
+ _gfortran_selected_real_kind2008 = -2
+ elseif (found_radix .and. .not. found_p .and. .not. found_r) then
+ _gfortran_selected_real_kind2008 = -3
+ elseif (found_radix) then
+ _gfortran_selected_real_kind2008 = -4
+ else
+ _gfortran_selected_real_kind2008 = -5
+ end if
+end function _gfortran_selected_real_kind2008
+
+function _gfortran_selected_real_kind (p, r)
+ implicit none
+ integer, optional, intent (in) :: p, r
+ integer :: _gfortran_selected_real_kind
+
+ interface
+ function _gfortran_selected_real_kind2008 (p, r, rdx)
+ implicit none
+ integer, optional, intent (in) :: p, r, rdx
+ integer :: _gfortran_selected_real_kind2008
+ end function _gfortran_selected_real_kind2008
+ end interface
- return
+ _gfortran_selected_real_kind = _gfortran_selected_real_kind2008 (p, r)
end function
diff --git a/libgfortran/intrinsics/system_clock.c b/libgfortran/intrinsics/system_clock.c
index 7806059ccdf..7cc82d0c8cd 100644
--- a/libgfortran/intrinsics/system_clock.c
+++ b/libgfortran/intrinsics/system_clock.c
@@ -56,6 +56,7 @@ system_clock_4(GFC_INTEGER_4 *count, GFC_INTEGER_4 *count_rate,
GFC_INTEGER_4 mx;
#if defined(HAVE_SYS_TIME_H) && defined(HAVE_GETTIMEOFDAY)
+#undef TCK
#define TCK 1000
struct timeval tp1;
@@ -117,6 +118,7 @@ system_clock_8 (GFC_INTEGER_8 *count, GFC_INTEGER_8 *count_rate,
GFC_INTEGER_8 mx;
#if defined(HAVE_SYS_TIME_H) && defined(HAVE_GETTIMEOFDAY)
+#undef TCK
#define TCK 1000000
struct timeval tp1;
View Lorry Controller Status