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

1 files changed, 44 insertions, 13 deletions

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