This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[PATCH] Fortran -- clean up KILL
- From: Steve Kargl <sgk at troutmask dot apl dot washington dot edu>
- To: fortran at gcc dot gnu dot org, gcc-patches at gcc dot gnu dot org
- Date: Sun, 11 Mar 2018 09:52:09 -0700
- Subject: [PATCH] Fortran -- clean up KILL
- Authentication-results: sourceware.org; auth=none
- Reply-to: sgk at troutmask dot apl dot washington dot edu
The attach patch cleans up KILL to match its
documentation. In doing so, I have changed
the argument keywords to consistently use
pid and sig. If no one objects, I intend to
commit this tomorrow.
2018-03-11 Steven G. Kargl <kargls@gcc.gnu.org>
* check.c (gfc_check_kill): Check pid and sig are scalar.
(gfc_check_kill_sub): Restrict kind to 4 and 8.
* intrinsic.c (add_function): Sort keyword list. Add pid and sig
keywords for KILL. Remove redundant *back="back" in favor of the
original *bck="back".
(add_subroutines): Sort keyword list. Add pid and sig keywords
for KILL.
* intrinsic.texi: Fix documentation to consistently use pid and sig.
* iresolve.c (gfc_resolve_kill): Kind can only be 4 or 8. Choose the
correct function.
(gfc_resolve_rename_sub): Add comment.
--
Steve
Index: gcc/fortran/check.c
===================================================================
--- gcc/fortran/check.c (revision 258433)
+++ gcc/fortran/check.c (working copy)
@@ -2755,9 +2755,15 @@ gfc_check_kill (gfc_expr *pid, gfc_expr *sig)
if (!type_check (pid, 0, BT_INTEGER))
return false;
+ if (!scalar_check (pid, 0))
+ return false;
+
if (!type_check (sig, 1, BT_INTEGER))
return false;
+ if (!scalar_check (sig, 1))
+ return false;
+
return true;
}
@@ -2785,6 +2791,13 @@ gfc_check_kill_sub (gfc_expr *pid, gfc_expr *sig, gfc_
if (!scalar_check (status, 2))
return false;
+
+ if (status->ts.kind != 4 && status->ts.kind != 8)
+ {
+ gfc_error ("Invalid kind type parameter for STATUS at %L",
+ &status->where);
+ return false;
+ }
return true;
}
Index: gcc/fortran/intrinsic.c
===================================================================
--- gcc/fortran/intrinsic.c (revision 258433)
+++ gcc/fortran/intrinsic.c (working copy)
@@ -1229,25 +1229,26 @@ set_attr_value (int n, ...)
static void
add_functions (void)
{
- /* Argument names as in the standard (to be used as argument keywords). */
+ /* Argument names. These are used as argument keywords and so need to
+ match the documentation. Please keep this list in sorted order. */
const char
- *a = "a", *f = "field", *pt = "pointer", *tg = "target",
- *b = "b", *m = "matrix", *ma = "matrix_a", *mb = "matrix_b",
- *c = "c", *n = "n", *ncopies= "ncopies", *pos = "pos", *bck = "back",
- *i = "i", *v = "vector", *va = "vector_a", *vb = "vector_b",
- *j = "j", *a1 = "a1", *fs = "fsource", *ts = "tsource",
- *l = "l", *a2 = "a2", *mo = "mold", *ord = "order",
- *p = "p", *ar = "array", *shp = "shape", *src = "source",
- *r = "r", *bd = "boundary", *pad = "pad", *set = "set",
- *s = "s", *dm = "dim", *kind = "kind", *msk = "mask",
- *x = "x", *sh = "shift", *stg = "string", *ssg = "substring",
- *y = "y", *sz = "size", *sta = "string_a", *stb = "string_b",
- *z = "z", *ln = "len", *ut = "unit", *han = "handler",
- *num = "number", *tm = "time", *nm = "name", *md = "mode",
- *vl = "values", *p1 = "path1", *p2 = "path2", *com = "command",
- *ca = "coarray", *sub = "sub", *dist = "distance", *failed="failed",
- *c_ptr_1 = "c_ptr_1", *c_ptr_2 = "c_ptr_2", *back = "back",
- *team = "team", *image = "image", *level = "level";
+ *a = "a", *a1 = "a1", *a2 = "a2", *ar = "array", *b = "b",
+ *bck = "back", *bd = "boundary", *c = "c", *c_ptr_1 = "c_ptr_1",
+ *c_ptr_2 = "c_ptr_2", *ca = "coarray", *com = "command",
+ *dist = "distance", *dm = "dim", *f = "field", *failed="failed",
+ *fs = "fsource", *han = "handler", *i = "i",
+ *image = "image", *j = "j", *kind = "kind",
+ *l = "l", *ln = "len", *level = "level", *m = "matrix", *ma = "matrix_a",
+ *mb = "matrix_b", *md = "mode", *mo = "mold", *msk = "mask",
+ *n = "n", *ncopies= "ncopies", *nm = "name", *num = "number",
+ *ord = "order", *p = "p", *p1 = "path1", *p2 = "path2",
+ *pad = "pad", *pid = "pid", *pos = "pos", *pt = "pointer",
+ *r = "r", *s = "s", *set = "set", *sh = "shift", *shp = "shape",
+ *sig = "sig", *src = "source", *ssg = "substring",
+ *sta = "string_a", *stb = "string_b", *stg = "string",
+ *sub = "sub", *sz = "size", *tg = "target", *team = "team", *tm = "time",
+ *ts = "tsource", *ut = "unit", *v = "vector", *va = "vector_a",
+ *vb = "vector_b", *vl = "values", *x = "x", *y = "y", *z = "z";
int di, dr, dd, dl, dc, dz, ii;
@@ -2255,7 +2256,7 @@ add_functions (void)
add_sym_2 ("kill", GFC_ISYM_KILL, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
di, GFC_STD_GNU, gfc_check_kill, NULL, gfc_resolve_kill,
- a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
+ pid, BT_INTEGER, di, REQUIRED, sig, BT_INTEGER, di, REQUIRED);
make_generic ("kill", GFC_ISYM_KILL, GFC_STD_GNU);
@@ -2471,7 +2472,7 @@ add_functions (void)
gfc_check_minloc_maxloc, gfc_simplify_maxloc, gfc_resolve_maxloc,
ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
msk, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL,
- back, BT_LOGICAL, dl, OPTIONAL);
+ bck, BT_LOGICAL, dl, OPTIONAL);
make_generic ("maxloc", GFC_ISYM_MAXLOC, GFC_STD_F95);
@@ -2548,7 +2549,7 @@ add_functions (void)
gfc_check_minloc_maxloc, gfc_simplify_minloc, gfc_resolve_minloc,
ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
msk, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL,
- back, BT_LOGICAL, dl, OPTIONAL);
+ bck, BT_LOGICAL, dl, OPTIONAL);
make_generic ("minloc", GFC_ISYM_MINLOC, GFC_STD_F95);
@@ -3301,20 +3302,21 @@ add_functions (void)
static void
add_subroutines (void)
{
- /* Argument names as in the standard (to be used as argument keywords). */
- const char
- *a = "a", *h = "harvest", *dt = "date", *vl = "values", *pt = "put",
- *c = "count", *tm = "time", *tp = "topos", *gt = "get",
- *t = "to", *zn = "zone", *fp = "frompos", *cm = "count_max",
- *f = "from", *sz = "size", *ln = "len", *cr = "count_rate",
- *com = "command", *length = "length", *st = "status",
- *val = "value", *num = "number", *name = "name",
- *trim_name = "trim_name", *ut = "unit", *han = "handler",
- *sec = "seconds", *res = "result", *of = "offset", *md = "mode",
- *whence = "whence", *pos = "pos", *ptr = "ptr", *p1 = "path1",
- *p2 = "path2", *msk = "mask", *old = "old", *result_image = "result_image",
- *stat = "stat", *errmsg = "errmsg";
-
+ /* Argument names. These are used as argument keywords and so need to
+ match the documentation. Please keep this list in sorted order. */
+ static const char
+ *a = "a", *c = "count", *cm = "count_max", *com = "command",
+ *cr = "count_rate", *dt = "date", *errmsg = "errmsg", *f = "from",
+ *fp = "frompos", *gt = "get", *h = "harvest", *han = "handler",
+ *length = "length", *ln = "len", *md = "mode", *msk = "mask",
+ *name = "name", *num = "number", *of = "offset", *old = "old",
+ *p1 = "path1", *p2 = "path2", *pid = "pid", *pos = "pos",
+ *pt = "put", *ptr = "ptr", *res = "result",
+ *result_image = "result_image", *sec = "seconds", *sig = "sig",
+ *st = "status", *stat = "stat", *sz = "size", *t = "to",
+ *tm = "time", *tp = "topos", *trim_name = "trim_name", *ut = "unit",
+ *val = "value", *vl = "values", *whence = "whence", *zn = "zone";
+
int di, dr, dc, dl, ii;
di = gfc_default_integer_kind;
@@ -3723,8 +3725,8 @@ add_subroutines (void)
add_sym_3s ("kill", GFC_ISYM_KILL, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
gfc_check_kill_sub, NULL, gfc_resolve_kill_sub,
- c, BT_INTEGER, di, REQUIRED, INTENT_IN,
- val, BT_INTEGER, di, REQUIRED, INTENT_IN,
+ pid, BT_INTEGER, di, REQUIRED, INTENT_IN,
+ sig, BT_INTEGER, di, REQUIRED, INTENT_IN,
st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
add_sym_3s ("link", GFC_ISYM_LINK, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
Index: gcc/fortran/intrinsic.texi
===================================================================
--- gcc/fortran/intrinsic.texi (revision 258433)
+++ gcc/fortran/intrinsic.texi (working copy)
@@ -8715,36 +8715,39 @@ end program test_itime
@table @asis
@item @emph{Description}:
@item @emph{Standard}:
-Sends the signal specified by @var{SIGNAL} to the process @var{PID}.
+Sends the signal specified by @var{SIG} to the process @var{PID}.
See @code{kill(2)}.
-This intrinsic is provided in both subroutine and function forms; however,
-only one form can be used in any given program unit.
+This intrinsic is provided in both subroutine and function forms;
+however, only one form can be used in any given program unit.
@item @emph{Class}:
Subroutine, function
@item @emph{Syntax}:
@multitable @columnfractions .80
-@item @code{CALL KILL(C, VALUE [, STATUS])}
-@item @code{STATUS = KILL(C, VALUE)}
+@item @code{CALL KILL(PID, SIG [, STATUS])}
+@item @code{STATUS = KILL(PID, SIG)}
@end multitable
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
-@item @var{C} @tab Shall be a scalar @code{INTEGER}, with
+@item @var{PID} @tab Shall be a scalar @code{INTEGER} with
@code{INTENT(IN)}
-@item @var{VALUE} @tab Shall be a scalar @code{INTEGER}, with
+@item @var{SIG} @tab Shall be a scalar @code{INTEGER} with
@code{INTENT(IN)}
-@item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER(4)} or
-@code{INTEGER(8)}. Returns 0 on success, or a system-specific error code
-otherwise.
+@item @var{STATUS} @tab [Subroutine](Optional) status flag of type
+@code{INTEGER(4)} or @code{INTEGER(8)}.
+Returns 0 on success; otherwise a system-specific error code is returned.
+@item @var{STATUS} @tab [Function] The kind type parameter is that of
+@code{pid} if @code{pid} is of type @code{INTEGER(4)} or @code{INTEGER(8)};
+otherwise, it is default integer kind.
+Returns 0 on success; otherwise a system-specific error code is returned.
@end multitable
@item @emph{See also}:
@ref{ABORT}, @ref{EXIT}
@end table
-
@node KIND
Index: gcc/fortran/iresolve.c
===================================================================
--- gcc/fortran/iresolve.c (revision 258433)
+++ gcc/fortran/iresolve.c (working copy)
@@ -1492,11 +1492,14 @@ gfc_resolve_ishftc (gfc_expr *f, gfc_expr *i, gfc_expr
void
-gfc_resolve_kill (gfc_expr *f, gfc_expr *p ATTRIBUTE_UNUSED,
- gfc_expr *s ATTRIBUTE_UNUSED)
+gfc_resolve_kill (gfc_expr *f, gfc_expr *pid,
+ gfc_expr *sig ATTRIBUTE_UNUSED)
{
f->ts.type = BT_INTEGER;
- f->ts.kind = gfc_default_integer_kind;
+ if (pid->ts.kind == 4 || pid->ts.kind == 8)
+ f->ts.kind = pid->ts.kind;
+ else
+ f->ts.kind = gfc_default_integer_kind;
f->value.function.name = gfc_get_string (PREFIX ("kill_i%d"), f->ts.kind);
}
@@ -3446,6 +3449,7 @@ gfc_resolve_rename_sub (gfc_code *c)
const char *name;
int kind;
+ /* Find the type of status. If not present use default integer kind. */
if (c->ext.actual->next->next->expr != NULL)
kind = c->ext.actual->next->next->expr->ts.kind;
else