mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-06 04:00:25 +08:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
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
This commit is contained in:
Tobias Burnus 2011-05-27 20:51:31 +02:00 committed by Tobias Burnus
parent f97b516f9a
commit 2514987fa9
10 changed files with 131 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
gcc/fortran/ChangeLog
View File

@ -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>

27
gcc/fortran/check.c
View File

@ -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)

1
gcc/fortran/gfortran.h
View File

@ -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,

9
gcc/fortran/intrinsic.c
View File

@ -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;

2
gcc/fortran/intrinsic.h
View File

@ -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 *);

42
gcc/fortran/intrinsic.texi
View File

@ -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

7
gcc/fortran/simplify.c
View File

@ -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)
{

6
gcc/testsuite/ChangeLog
View File

@ -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

7
gcc/testsuite/gfortran.dg/rank_3.f90 Normal file
View File

@ -0,0 +1,7 @@
! { dg-do compile }
! { dg-options "-std=f2008" }
!
! PR fortran/48820
!
intrinsic :: rank ! { dg-error "new in TR 29113" }
end

19
gcc/testsuite/gfortran.dg/rank_4.f90 Normal file
View File

@ -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" } }