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

4 files changed, 56 insertions, 14 deletions

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 129841b..3c2c75c 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,5 +1,15 @@
 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>
+
 	* runtime/compile_options.c (init_compile_options): Update
 	compile_options.allow_std for GFC_STD_F2008_OBS.
 	* io/transfer.c (formatted_transfer_scalar_read,
diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map
index 3e854eb..ce5aa77 100644
--- a/libgfortran/gfortran.map
+++ b/libgfortran/gfortran.map
@@ -1106,6 +1106,7 @@ GFORTRAN_1.3 {
 GFORTRAN_1.4 {
   global:
     _gfortran_error_stop_numeric;
+    _gfortran_selected_real_kind2008;
 } GFORTRAN_1.3; 
 
 F2C_1.0 {
diff --git a/libgfortran/intrinsics/selected_real_kind.f90 b/libgfortran/intrinsics/selected_real_kind.f90
index ea3b46a..92708d7 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/mk-srk-inc.sh b/libgfortran/mk-srk-inc.sh
index 10c428f..402441c 100755
--- a/libgfortran/mk-srk-inc.sh
+++ b/libgfortran/mk-srk-inc.sh
@@ -22,7 +22,7 @@ echo "  type (real_info), parameter :: real_infos(c) = (/ &"
 i=0
 for k in $kinds; do
   # echo -n is not portable
-  str="    real_info ($k, precision(0.0_$k), range(0.0_$k))"
+  str="    real_info ($k, precision(0.0_$k), range(0.0_$k), radix(0.0_$k))"
   i=`expr $i + 1`
   if [ $i -lt $c ]; then
     echo "$str, &"