Skip to content

R
riscv-gcc-1
Commit 6970fcc8 by Steven G. Kargl Committed by Steven G. Kargl
Options

re PR fortran/23516 (IMAG is not a generic function when implicit none is declared) 

PR fortran/23516
* intrinsic.c (add_function): Add IMAG, IMAGPART, and REALPART
  intrinsics.
* intrinsic.h: Prototypes for gfc_simplify_realpart and
  gfc_resolve_realpart.
* intrinsic.texi: Document intrinsic procedures.
* simplify.c (gfc_simplify_realpart): New function.
* irseolve.c (gfc_resolve_realpart): New function.

From-SVN: r104537
parent e9931b5b
Showing with 115 additions and 0 deletions
gcc/fortran/ChangeLog
2005-09-22 Steven G. Kargl <kargls@comcast.net>
PR fortran/23516
* intrinsic.c (add_function): Add IMAG, IMAGPART, and REALPART
intrinsics.
* intrinsic.h: Prototypes for gfc_simplify_realpart and
gfc_resolve_realpart.
* intrinsic.texi: Document intrinsic procedures.
* simplify.c (gfc_simplify_realpart): New function.
* irseolve.c (gfc_resolve_realpart): New function.
2005-09-21 Erik Edelmann <erik.edelmann@iki.fi>
PR fortran/19929
......
gcc/fortran/intrinsic.c
......@@ -949,10 +949,14 @@ add_functions (void)
gfc_check_fn_c, gfc_simplify_aimag, gfc_resolve_aimag,
z, BT_COMPLEX, dz, REQUIRED);
make_alias ("imag", GFC_STD_GNU);
make_alias ("imagpart", GFC_STD_GNU);
add_sym_1 ("dimag", 1, 1, BT_REAL, dd, GFC_STD_GNU,
NULL, gfc_simplify_aimag, gfc_resolve_aimag,
z, BT_COMPLEX, dd, REQUIRED);
make_generic ("aimag", GFC_ISYM_AIMAG, GFC_STD_F77);
add_sym_2 ("aint", 1, 1, BT_REAL, dr, GFC_STD_F77,
......@@ -1813,6 +1817,11 @@ add_functions (void)
gfc_check_real, gfc_simplify_real, gfc_resolve_real,
a, BT_UNKNOWN, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
/* This provides compatibility with g77. */
add_sym_1 ("realpart", 1, 0, BT_REAL, dr, GFC_STD_GNU,
gfc_check_fn_c, gfc_simplify_realpart, gfc_resolve_realpart,
a, BT_UNKNOWN, dr, REQUIRED);
add_sym_1 ("float", 1, 0, BT_REAL, dr, GFC_STD_F77,
NULL, gfc_simplify_float, NULL,
a, BT_INTEGER, di, REQUIRED);
......
gcc/fortran/intrinsic.h
......@@ -233,6 +233,7 @@ gfc_expr *gfc_simplify_precision (gfc_expr *);
gfc_expr *gfc_simplify_radix (gfc_expr *);
gfc_expr *gfc_simplify_range (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 *);
gfc_expr *gfc_simplify_reshape (gfc_expr *, gfc_expr *, gfc_expr *,
gfc_expr *);
......@@ -345,6 +346,7 @@ void gfc_resolve_not (gfc_expr *, gfc_expr *);
void gfc_resolve_pack (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_product (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_real (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_realpart (gfc_expr *, gfc_expr *);
void gfc_resolve_rename (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_repeat (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_reshape (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
......
gcc/fortran/intrinsic.texi
......@@ -89,6 +89,7 @@ and editing. All contributions and corrections are strongly encouraged.
* @code{FNUM}: FNUM, File number function
* @code{LOG}: LOG, Logarithm function
* @code{LOG10}: LOG10, Base 10 logarithm function
* @code{REAL}: REAL, Convert to real type
* @code{SQRT}: SQRT, Square-root function
* @code{SIN}: SIN, Sine function
* @code{SINH}: SINH, Hyperbolic sine function
......@@ -402,11 +403,16 @@ end program test_adjustr
@section @code{AIMAG} --- Imaginary part of complex number
@findex @code{AIMAG} intrinsic
@findex @code{DIMAG} intrinsic
@findex @code{IMAG} intrinsic
@findex @code{IMAGPART} intrinsic
@cindex Imaginary part
@table @asis
@item @emph{Description}:
@code{AIMAG(Z)} yields the imaginary part of complex argument @code{Z}.
The @code{IMAG(Z)} and @code{IMAGPART(Z)} intrinsic functions are provided
for compatibility with @command{g77}, and their use in new code is
strongly discouraged.
@item @emph{Option}:
f95, gnu
......@@ -441,6 +447,8 @@ end program test_aimag
@multitable @columnfractions .24 .24 .24 .24
@item Name @tab Argument @tab Return type @tab Option
@item @code{DIMAG(Z)} @tab @code{COMPLEX(8) Z} @tab @code{REAL(8)} @tab f95, gnu
@item @code{IMAG(Z)} @tab @code{COMPLEX(*) Z} @tab @code{REAL(*)} @tab gnu
@item @code{IMAGPART(Z)} @tab @code{COMPLEX(*) Z} @tab @code{REAL(*)} @tab gnu
@end multitable
@end table
......@@ -2821,6 +2829,64 @@ end program test_log10
@end table
@node REAL
@section @code{REAL} --- Convert to real type
@findex @code{REAL} intrinsic
@findex @code{REALPART} intrinsic
@cindex true values
@table @asis
@item @emph{Description}:
@code{REAL(X [, KIND])} converts its argument @var{X} to a real type. The
@code{REALPART(X)} function is provided for compatibility with @command{g77},
and its use is strongly discouraged.
@item @emph{Option}:
f95, gnu
@item @emph{Class}:
transformational function
@item @emph{Syntax}:
@multitable @columnfractions .30 .80
@item @code{X = REAL(X)}
@item @code{X = REAL(X, KIND)}
@item @code{X = REALPART(Z)}
@end multitable
@item @emph{Arguments}:
@multitable @columnfractions .15 .80
@item @var{X} @tab shall be @code{INTEGER(*)}, @code{REAL(*)}, or
@code{COMPLEX(*)}.
@item @var{KIND} @tab (Optional) @var{KIND} shall be a scalar integer.
@end multitable
@item @emph{Return value}:
These functions return the a @code{REAL(*)} variable or array under
the following rules:
@table @asis
@item (A)
@code{REAL(X)} is converted to a default real type if @var{X} is an
integer or real variable.
@item (B)
@code{REAL(X)} is converted to a real type with the kind type parameter
of @var{X} if @var{X} is a complex variable.
@item (C)
@code{REAL(X, KIND)} is converted to a real type with kind type
parameter @var{KIND} if @var{X} is a complex, integer, or real
variable.
@end table
@item @emph{Example}:
@smallexample
program test_real
complex :: x = (1.0, 2.0)
print *, real(x), real(x,8), realpart(x)
end program test_real
@end smallexample
@end table
@node SIN
@section @code{SIN} --- Sine function
......
gcc/fortran/iresolve.c
......@@ -1152,6 +1152,17 @@ gfc_resolve_real (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
void
gfc_resolve_realpart (gfc_expr * f, gfc_expr * a)
{
f->ts.type = BT_REAL;
f->ts.kind = a->ts.kind;
f->value.function.name =
gfc_get_string ("__real_%d_%c%d", f->ts.kind,
gfc_type_letter (a->ts.type), a->ts.kind);
}
void
gfc_resolve_rename (gfc_expr * f, gfc_expr * p1 ATTRIBUTE_UNUSED,
gfc_expr * p2 ATTRIBUTE_UNUSED)
{
......
gcc/fortran/simplify.c
......@@ -372,6 +372,7 @@ gfc_simplify_adjustr (gfc_expr * e)
gfc_expr *
gfc_simplify_aimag (gfc_expr * e)
{
gfc_expr *result;
if (e->expr_type != EXPR_CONSTANT)
......@@ -2591,6 +2592,21 @@ gfc_simplify_real (gfc_expr * e, gfc_expr * k)
return range_check (result, "REAL");
}
gfc_expr *
gfc_simplify_realpart (gfc_expr * e)
{
gfc_expr *result;
if (e->expr_type != EXPR_CONSTANT)
return NULL;
result = gfc_constant_result (BT_REAL, e->ts.kind, &e->where);
mpfr_set (result->value.real, e->value.complex.r, GFC_RND_MODE);
return range_check (result, "REALPART");
}
gfc_expr *
gfc_simplify_repeat (gfc_expr * e, gfc_expr * n)
{
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment