Fortran -- clean up KILL

Message ID	20180311165209.GA60279@troutmask.apl.washington.edu
State	New
Headers	show Return-Path: <gcc-patches-return-474559-incoming=patchwork.ozlabs.org@gcc.gnu.org> DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:subject:message-id:reply-to:mime-version:content-type; q=dns; s=default; b=oRxYL+rBFK5ooRr1K/v2fLl4hBbXJkvCUBL0JCiExIy p0ECF+DzKKEBVX5+be8fAhu2sKmr3Ng4VGWUj3dENufLPQOeBGQ2uRka3Sv0dJFV jQueNvtAt+vBXUxYbDV+yE9uBQzxzMVrJZ7FDlGC1C82P377TDmeaYKDuqE3pO/8 = Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk Sender: gcc-patches-owner@gcc.gnu.org Date: Sun, 11 Mar 2018 09:52:09 -0700 From: Steve Kargl <sgk@troutmask.apl.washington.edu> 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)
Series	Fortran -- clean up KILL \| expand Fortran -- clean up KILL

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

Fortran -- clean up KILL

Commit Message

Comments

Patch