re PR fortran/48820 (TR 29113: Implement parts needed for MPI 3)

2011-05-27  Tobias Burnus  <burnus@net-b.de>

        PR fortran/48820
        * gfortran.h (gfc_isym_id): Add GFC_ISYM_RANK.
        * intrinsic.c (add_functions): Add rank intrinsic.
        (gfc_check_intrinsic_standard): Handle GFC_STD_F2008_TR.
        * intrinsic.h (gfc_simplify_rank, gfc_check_rank): Add
        * prototypes.
        * simplify.c (gfc_simplify_rank): New function.
        * intrinsic.texi (RANK): Add description for rank intrinsic.
        * check.c (gfc_check_rank): New function.

2011-05-27  Tobias Burnus  <burnus@net-b.de>

        PR fortran/48820
        * gfortran.dg/rank_3.f90: New.
        * gfortran.dg/rank_4.f90: New.

From-SVN: r174348

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 304c887f2220853122a74b500c9b75886ec134d4..63ff7dbf0b185d24478202a3b88e04e25fe23b88 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,14 @@
+2011-05-27  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/48820
+       * gfortran.h (gfc_isym_id): Add GFC_ISYM_RANK.
+       * intrinsic.c (add_functions): Add rank intrinsic.
+       (gfc_check_intrinsic_standard): Handle GFC_STD_F2008_TR.
+       * intrinsic.h (gfc_simplify_rank, gfc_check_rank): Add prototypes.
+       * simplify.c (gfc_simplify_rank): New function.
+       * intrinsic.texi (RANK): Add description for rank intrinsic.
+       * check.c (gfc_check_rank): New function.
+
 2011-05-26  Paul Thomas  <pault@gcc.gnu.org>
            Thomas Koenig  <tkoenig@gcc.gnu.org>
 

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 864114206731c2cc99fba1240eaf0b3c734504d8..01651cb5a23baa42f3c782c87241d34cbde33858 100644 (file)
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -2830,6 +2830,33 @@ gfc_check_range (gfc_expr *x)
 }
 
 
+gfc_try
+gfc_check_rank (gfc_expr *a ATTRIBUTE_UNUSED)
+{
+  /* Any data object is allowed; a "data object" is a "constant (4.1.3),
+     variable (6), or subobject of a constant (2.4.3.2.3)" (F2008, 1.3.45).  */
+
+  bool is_variable = true;
+
+  /* Functions returning pointers are regarded as variable, cf. F2008, R602. */
+  if (a->expr_type == EXPR_FUNCTION) 
+    is_variable = a->value.function.esym
+                 ? a->value.function.esym->result->attr.pointer
+                 : a->symtree->n.sym->result->attr.pointer;
+
+  if (a->expr_type == EXPR_OP || a->expr_type == EXPR_NULL
+      || a->expr_type == EXPR_COMPCALL|| a->expr_type == EXPR_PPC
+      || !is_variable)
+    {
+      gfc_error ("The argument of the RANK intrinsic at %L must be a data "
+                "object", &a->where);
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
 /* real, float, sngl.  */
 gfc_try
 gfc_check_real (gfc_expr *a, gfc_expr *kind)

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 6d9eb88a116c1c0e6e873d265c0b552eef3bfe25..752a07139cad183e5baa260f8ad9cc82dca850e3 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -472,6 +472,7 @@ enum gfc_isym_id
   GFC_ISYM_RANDOM_NUMBER,
   GFC_ISYM_RANDOM_SEED,
   GFC_ISYM_RANGE,
+  GFC_ISYM_RANK,
   GFC_ISYM_REAL,
   GFC_ISYM_RENAME,
   GFC_ISYM_REPEAT,

diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index c0eeb6dd297818170d105028161e521952326672..6151db77edadf87bb3316b3525724623e713284f 100644 (file)
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -2433,6 +2433,11 @@ add_functions (void)
 
   make_generic ("range", GFC_ISYM_RANGE, GFC_STD_F95);
 
+  add_sym_1 ("rank", GFC_ISYM_RANK, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di,
+            GFC_STD_F2008_TR, gfc_check_rank, gfc_simplify_rank, NULL,
+            a, BT_REAL, dr, REQUIRED);
+  make_generic ("rank", GFC_ISYM_RANK, GFC_STD_F2008_TR);
+
   add_sym_2 ("real", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
             gfc_check_real, gfc_simplify_real, gfc_resolve_real,
             a, BT_UNKNOWN, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
@@ -3972,6 +3977,10 @@ gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym,
       symstd_msg = "new in Fortran 2008";
       break;
 
+    case GFC_STD_F2008_TR:
+      symstd_msg = "new in TR 29113";
+      break;
+
     case GFC_STD_GNU:
       symstd_msg = "a GNU Fortran extension";
       break;

diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index 033bae0f68cc7a5bd158c80f80432597c7a063f6..88ce008485638c77c3cb774f717d9c61d2241220 100644 (file)
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -122,6 +122,7 @@ gfc_try gfc_check_product_sum (gfc_actual_arglist *);
 gfc_try gfc_check_radix (gfc_expr *);
 gfc_try gfc_check_rand (gfc_expr *);
 gfc_try gfc_check_range (gfc_expr *);
+gfc_try gfc_check_rank (gfc_expr *);
 gfc_try gfc_check_real (gfc_expr *, gfc_expr *);
 gfc_try gfc_check_rename (gfc_expr *, gfc_expr *);
 gfc_try gfc_check_repeat (gfc_expr *, gfc_expr *);
@@ -345,6 +346,7 @@ gfc_expr *gfc_simplify_precision (gfc_expr *);
 gfc_expr *gfc_simplify_product (gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_radix (gfc_expr *);
 gfc_expr *gfc_simplify_range (gfc_expr *);
+gfc_expr *gfc_simplify_rank (gfc_expr *);
 gfc_expr *gfc_simplify_real (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_realpart (gfc_expr *);
 gfc_expr *gfc_simplify_repeat (gfc_expr *, gfc_expr *);

diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index 804b31f8f49d20170a832ea44ef17dede3324ee7..2ea4fc5271d990c01dc10286aa99f23e0aa41e1a 100644 (file)
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -236,6 +236,7 @@ Some basic guidelines for editing this document:
 * @code{RANDOM_SEED}:   RANDOM_SEED, Initialize a pseudo-random number sequence
 * @code{RAND}:          RAND,      Real pseudo-random number
 * @code{RANGE}:         RANGE,     Decimal exponent range
+* @code{RANK} :         RANK,      Rank of a data object
 * @code{RAN}:           RAN,       Real pseudo-random number
 * @code{REAL}:          REAL,      Convert to real type 
 * @code{RENAME}:        RENAME,    Rename a file
@@ -10115,6 +10116,47 @@ See @code{PRECISION} for an example.
 
 
 
+@node RANK
+@section @code{RANK} --- Rank of a data object
+@fnindex RANK
+@cindex rank
+
+@table @asis
+@item @emph{Description}:
+@code{RANK(A)} returns the rank of a scalar or array data object.
+
+@item @emph{Standard}:
+Technical Report (TR) 29113
+
+@item @emph{Class}:
+Inquiry function
+
+@item @emph{Syntax}:
+@code{RESULT = RANGE(A)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{A} @tab can be of any type
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER} and of the default integer
+kind. For arrays, their rank is returned; for scalars zero is returned.
+
+@item @emph{Example}:
+@smallexample
+program test_rank
+  integer :: a
+  real, allocatable :: b(:,:)
+
+  print *, rank(a), rank(b) ! Prints:  0  3
+end program test_rank
+@end smallexample
+
+@end table
+
+
+
 @node REAL
 @section @code{REAL} --- Convert to real type 
 @fnindex REAL

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 4c91563389cbb898e0db16671ce70af6046e4952..79b383a46db905bcb8db7a10c0b6b09f06d24d27 100644 (file)
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -4821,6 +4821,13 @@ gfc_simplify_range (gfc_expr *e)
 }
 
 
+gfc_expr *
+gfc_simplify_rank (gfc_expr *e)
+{
+  return gfc_get_int_expr (gfc_default_integer_kind, &e->where, e->rank);
+}
+
+
 gfc_expr *
 gfc_simplify_real (gfc_expr *e, gfc_expr *k)
 {

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index ee518dc55b6226ce0254bfcaf0c0fd7b83c17980..bb23b71195f60a4a0dc066c5b3afd33755ee2934 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2011-05-27  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/48820
+       * gfortran.dg/rank_3.f90: New.
+       * gfortran.dg/rank_4.f90: New.
+
 2011-05-27  Janis Johnson  <janisjo@codesourcery.com>
 
        * g++.dg/tree-ssa-pr43411.C: Rename function to be inlined and

diff --git a/gcc/testsuite/gfortran.dg/rank_3.f90 b/gcc/testsuite/gfortran.dg/rank_3.f90
new file mode 100644 (file)
index 0000000..fac2185
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/rank_3.f90
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! { dg-options "-std=f2008" }
+!
+! PR fortran/48820
+!
+intrinsic :: rank  ! { dg-error "new in TR 29113" }
+end

diff --git a/gcc/testsuite/gfortran.dg/rank_4.f90 b/gcc/testsuite/gfortran.dg/rank_4.f90
new file mode 100644 (file)
index 0000000..40b0209
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/rank_4.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! { dg-options "-std=f2008tr -fdump-tree-original" }
+!
+! PR fortran/48820
+!
+
+program test_rank
+  implicit none
+  intrinsic :: rank
+
+  integer :: a
+  real, allocatable :: b(:,:)
+
+  if (rank(a) /= 0) call not_existing()
+  if (rank (b) /= 2) call not_existing()
+end program test_rank
+
+! { dg-final { scan-tree-dump-times "not_existing" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }