aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/fortran/ChangeLog11
-rw-r--r--gcc/fortran/intrinsic.c9
-rw-r--r--gcc/fortran/intrinsic.h2
-rw-r--r--gcc/fortran/intrinsic.texi66
-rw-r--r--gcc/fortran/iresolve.c11
-rw-r--r--gcc/fortran/simplify.c16
6 files changed, 115 insertions, 0 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 0095d4d..e6c8da1 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,14 @@
+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
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 180e7ae..be23556 100644
--- a/gcc/fortran/intrinsic.c
+++ b/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);
diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index a10e844..c405cce 100644
--- a/gcc/fortran/intrinsic.h
+++ b/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 *,
diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index 0ac6a54..2043c28 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/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
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index ed043a6..dda6acb 100644
--- a/gcc/fortran/iresolve.c
+++ b/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)
{
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 44dfe1a..7c9a6dc 100644
--- a/gcc/fortran/simplify.c
+++ b/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)
{
generated by cgit v1.1 at 2024-10-03 22:28:41 +0000