From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 94345 invoked by alias); 11 Mar 2018 16:52:14 -0000 Mailing-List: contact fortran-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Subscribe: List-Post: List-Help: , Sender: fortran-owner@gcc.gnu.org Received: (qmail 94324 invoked by uid 89); 11 Mar 2018 16:52:14 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-10.0 required=5.0 tests=AWL,BAYES_00,GIT_PATCH_2,GIT_PATCH_3,KAM_ASCII_DIVIDERS,KAM_LAZY_DOMAIN_SECURITY,RCVD_IN_DNSWL_LOW,T_RP_MATCHES_RCVD autolearn=ham version=3.3.2 spammy=REQUIRED, harvest, *zn, *ut X-Spam-User: qpsmtpd, 2 recipients X-HELO: troutmask.apl.washington.edu Received: from troutmask.apl.washington.edu (HELO troutmask.apl.washington.edu) (128.95.76.21) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Sun, 11 Mar 2018 16:52:11 +0000 Received: from troutmask.apl.washington.edu (localhost [127.0.0.1]) by troutmask.apl.washington.edu (8.15.2/8.15.2) with ESMTPS id w2BGq99d060298 (version=TLSv1.2 cipher=DHE-RSA-AES256-GCM-SHA384 bits=256 verify=NO); Sun, 11 Mar 2018 09:52:09 -0700 (PDT) (envelope-from sgk@troutmask.apl.washington.edu) Received: (from sgk@localhost) by troutmask.apl.washington.edu (8.15.2/8.15.2/Submit) id w2BGq932060297; Sun, 11 Mar 2018 09:52:09 -0700 (PDT) (envelope-from sgk) Date: Sun, 11 Mar 2018 16:52:00 -0000 From: Steve Kargl To: fortran@gcc.gnu.org, gcc-patches@gcc.gnu.org Subject: [PATCH] Fortran -- clean up KILL Message-ID: <20180311165209.GA60279@troutmask.apl.washington.edu> Reply-To: sgk@troutmask.apl.washington.edu MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="RnlQjJ0d97Da+TV1" Content-Disposition: inline User-Agent: Mutt/1.9.2 (2017-12-15) X-IsSubscribed: yes X-SW-Source: 2018-03/txt/msg00030.txt.bz2 --RnlQjJ0d97Da+TV1 Content-Type: text/plain; charset=us-ascii Content-Disposition: inline Content-length: 805 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 * 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 --RnlQjJ0d97Da+TV1 Content-Type: text/x-diff; charset=us-ascii Content-Disposition: attachment; filename="kill.diff" Content-length: 10215 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 --RnlQjJ0d97Da+TV1--