2004-05-13 08:41:07 +02:00
|
|
|
/* Check functions
|
2007-01-07 01:28:29 +01:00
|
|
|
Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007
|
|
|
|
Free Software Foundation, Inc.
|
2004-05-13 08:41:07 +02:00
|
|
|
Contributed by Andy Vaught & Katherine Holcomb
|
|
|
|
|
Make-lang.in, [...]: Update copyright years and boilerplate.
* Make-lang.in, arith.c, arith.h, array.c, bbt.c, check.c,
decl.c, dependency.c, dependency.h, dump-parse-tree.c, error.c,
expr.c, f95-lang.c, gfortran.h, interface.c, intrinsic.c,
intrinsic.h, io.c, iresolve.c, lang-specs.h, match.c, match.h,
matchexp.c, misc.c, module.c, options.c, parse.c, parse.h,
primary.c, resolve.c, scanner.c, simplify.c, st.c, symbol.c,
trans-array.c, trans-array.h, trans-common.c, trans-const.c,
trans-const.h, trans-decl.c, trans-expr.c, trans-intrinsic.c,
trans-io.c, trans-stmt.c, trans-stmt.h, trans-types.c,
trans-types.h, trans.c, trans.h: Update copyright years and
boilerplate.
* data.c: Likewise, also removed two whitespace-only lines.
* gfortranspec.c, lang.opt: Update copyright years.
From-SVN: r81839
2004-05-14 15:00:04 +02:00
|
|
|
This file is part of GCC.
|
2004-05-13 08:41:07 +02:00
|
|
|
|
Make-lang.in, [...]: Update copyright years and boilerplate.
* Make-lang.in, arith.c, arith.h, array.c, bbt.c, check.c,
decl.c, dependency.c, dependency.h, dump-parse-tree.c, error.c,
expr.c, f95-lang.c, gfortran.h, interface.c, intrinsic.c,
intrinsic.h, io.c, iresolve.c, lang-specs.h, match.c, match.h,
matchexp.c, misc.c, module.c, options.c, parse.c, parse.h,
primary.c, resolve.c, scanner.c, simplify.c, st.c, symbol.c,
trans-array.c, trans-array.h, trans-common.c, trans-const.c,
trans-const.h, trans-decl.c, trans-expr.c, trans-intrinsic.c,
trans-io.c, trans-stmt.c, trans-stmt.h, trans-types.c,
trans-types.h, trans.c, trans.h: Update copyright years and
boilerplate.
* data.c: Likewise, also removed two whitespace-only lines.
* gfortranspec.c, lang.opt: Update copyright years.
From-SVN: r81839
2004-05-14 15:00:04 +02:00
|
|
|
GCC is free software; you can redistribute it and/or modify it under
|
|
|
|
the terms of the GNU General Public License as published by the Free
|
arith.c: Change copyright header to refer to version 3 of the GNU General Public...
* arith.c: Change copyright header to refer to version 3 of the GNU General
Public License and to point readers at the COPYING3 file and the FSF's
license web page.
* openmp.c, interface.c, intrinsic.c, trans-array.c, trans-expr.c, symbol.c,
iso-fortran-env.def, intrinsic.h, decl.c, trans-array.h, matchexp.c,
dump-parse-tree.c, trans-common.c, array.c, Make-lang.in, trans-openmp.c,
gfortran.h, error.c, iso-c-binding.def, lang.opt, data.c, trans-const.c,
trans-stmt.c, expr.c, trans-const.h, trans-stmt.h, module.c, trans.c,
scanner.c, trans-types.c, trans.h, gfortranspec.c, trans-types.h,
lang-specs.h, io.c, bbt.c, resolve.c, f95-lang.c, st.c, iresolve.c, match.c,
trans-decl.c, trans-io.c, target-memory.c, match.h, target-memory.h, parse.c,
arith.h, check.c, dependency.c, parse.h, types.def, convert.c, dependency.h,
primary.c, trans-intrinsic.c, options.c, misc.c, simplify.c: Likewise.
From-SVN: r127129
2007-08-01 18:29:36 +02:00
|
|
|
Software Foundation; either version 3, or (at your option) any later
|
Make-lang.in, [...]: Update copyright years and boilerplate.
* Make-lang.in, arith.c, arith.h, array.c, bbt.c, check.c,
decl.c, dependency.c, dependency.h, dump-parse-tree.c, error.c,
expr.c, f95-lang.c, gfortran.h, interface.c, intrinsic.c,
intrinsic.h, io.c, iresolve.c, lang-specs.h, match.c, match.h,
matchexp.c, misc.c, module.c, options.c, parse.c, parse.h,
primary.c, resolve.c, scanner.c, simplify.c, st.c, symbol.c,
trans-array.c, trans-array.h, trans-common.c, trans-const.c,
trans-const.h, trans-decl.c, trans-expr.c, trans-intrinsic.c,
trans-io.c, trans-stmt.c, trans-stmt.h, trans-types.c,
trans-types.h, trans.c, trans.h: Update copyright years and
boilerplate.
* data.c: Likewise, also removed two whitespace-only lines.
* gfortranspec.c, lang.opt: Update copyright years.
From-SVN: r81839
2004-05-14 15:00:04 +02:00
|
|
|
version.
|
2004-05-13 08:41:07 +02:00
|
|
|
|
Make-lang.in, [...]: Update copyright years and boilerplate.
* Make-lang.in, arith.c, arith.h, array.c, bbt.c, check.c,
decl.c, dependency.c, dependency.h, dump-parse-tree.c, error.c,
expr.c, f95-lang.c, gfortran.h, interface.c, intrinsic.c,
intrinsic.h, io.c, iresolve.c, lang-specs.h, match.c, match.h,
matchexp.c, misc.c, module.c, options.c, parse.c, parse.h,
primary.c, resolve.c, scanner.c, simplify.c, st.c, symbol.c,
trans-array.c, trans-array.h, trans-common.c, trans-const.c,
trans-const.h, trans-decl.c, trans-expr.c, trans-intrinsic.c,
trans-io.c, trans-stmt.c, trans-stmt.h, trans-types.c,
trans-types.h, trans.c, trans.h: Update copyright years and
boilerplate.
* data.c: Likewise, also removed two whitespace-only lines.
* gfortranspec.c, lang.opt: Update copyright years.
From-SVN: r81839
2004-05-14 15:00:04 +02:00
|
|
|
GCC is distributed in the hope that it will be useful, but WITHOUT ANY
|
|
|
|
WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
|
|
|
FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
|
|
|
for more details.
|
2004-05-13 08:41:07 +02:00
|
|
|
|
|
|
|
You should have received a copy of the GNU General Public License
|
arith.c: Change copyright header to refer to version 3 of the GNU General Public...
* arith.c: Change copyright header to refer to version 3 of the GNU General
Public License and to point readers at the COPYING3 file and the FSF's
license web page.
* openmp.c, interface.c, intrinsic.c, trans-array.c, trans-expr.c, symbol.c,
iso-fortran-env.def, intrinsic.h, decl.c, trans-array.h, matchexp.c,
dump-parse-tree.c, trans-common.c, array.c, Make-lang.in, trans-openmp.c,
gfortran.h, error.c, iso-c-binding.def, lang.opt, data.c, trans-const.c,
trans-stmt.c, expr.c, trans-const.h, trans-stmt.h, module.c, trans.c,
scanner.c, trans-types.c, trans.h, gfortranspec.c, trans-types.h,
lang-specs.h, io.c, bbt.c, resolve.c, f95-lang.c, st.c, iresolve.c, match.c,
trans-decl.c, trans-io.c, target-memory.c, match.h, target-memory.h, parse.c,
arith.h, check.c, dependency.c, parse.h, types.def, convert.c, dependency.h,
primary.c, trans-intrinsic.c, options.c, misc.c, simplify.c: Likewise.
From-SVN: r127129
2007-08-01 18:29:36 +02:00
|
|
|
along with GCC; see the file COPYING3. If not see
|
|
|
|
<http://www.gnu.org/licenses/>. */
|
2004-05-13 08:41:07 +02:00
|
|
|
|
|
|
|
|
|
|
|
/* These functions check to see if an argument list is compatible with
|
|
|
|
a particular intrinsic function or subroutine. Presence of
|
|
|
|
required arguments has already been established, the argument list
|
|
|
|
has been sorted into the right order and has NULL arguments in the
|
|
|
|
correct places for missing optional arguments. */
|
|
|
|
|
|
|
|
#include "config.h"
|
|
|
|
#include "system.h"
|
|
|
|
#include "flags.h"
|
|
|
|
#include "gfortran.h"
|
|
|
|
#include "intrinsic.h"
|
|
|
|
|
|
|
|
|
|
|
|
/* Check the type of an expression. */
|
|
|
|
|
|
|
|
static try
|
2007-01-07 01:28:29 +01:00
|
|
|
type_check (gfc_expr *e, int n, bt type)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (e->ts.type == type)
|
|
|
|
return SUCCESS;
|
|
|
|
|
re PR fortran/15586 (gfortran should support i18n in its compiler messages)
PR fortran/15586
* arith.c (gfc_arith_error): Change message to include locus.
(check_result, eval_intrinsic, gfc_int2int, gfc_real2real,
gfc_real2complex, gfc_complex2real, gfc_complex2complex): Use
the new gfc_arith_error.
(arith_error): Rewrite full error messages instead of building
them from pieces.
* check.c (must_be): Removed.
(type_check, numeric_check, int_or_real_check, real_or_complex_check,
kind_check, double_check, logical_array_check, array_check,
scalar_check, same_type_check, rank_check, kind_value_check,
variable_check, gfc_check_allocated, gfc_check_associated,
gfc_check_cmplx, gfc_check_dcmplx, gfc_check_dot_product,
gfc_check_index, gfc_check_kind, gfc_check_matmul, gfc_check_null,
gfc_check_pack, gfc_check_precision, gfc_check_present,
gfc_check_spread): Rewrite full error messages instead of
building them from pieces.
* decl.c (gfc_match_entry): Rewrite full error messages instead
of building them from pieces.
* parse.c (gfc_state_name): Remove.
* parse.h: Remove prototype for gfc_state_name.
From-SVN: r105844
2005-10-24 11:11:51 +02:00
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must be %s",
|
|
|
|
gfc_current_intrinsic_arg[n], gfc_current_intrinsic, &e->where,
|
|
|
|
gfc_basic_typename (type));
|
2004-05-13 08:41:07 +02:00
|
|
|
|
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
/* Check that the expression is a numeric type. */
|
|
|
|
|
|
|
|
static try
|
2007-01-07 01:28:29 +01:00
|
|
|
numeric_check (gfc_expr *e, int n)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (gfc_numeric_ts (&e->ts))
|
|
|
|
return SUCCESS;
|
|
|
|
|
2007-04-07 22:20:49 +02:00
|
|
|
/* If the expression has not got a type, check if its namespace can
|
|
|
|
offer a default type. */
|
|
|
|
if ((e->expr_type == EXPR_VARIABLE || e->expr_type == EXPR_VARIABLE)
|
|
|
|
&& e->symtree->n.sym->ts.type == BT_UNKNOWN
|
|
|
|
&& gfc_set_default_type (e->symtree->n.sym, 0,
|
|
|
|
e->symtree->n.sym->ns) == SUCCESS
|
|
|
|
&& gfc_numeric_ts (&e->symtree->n.sym->ts))
|
|
|
|
{
|
|
|
|
e->ts = e->symtree->n.sym->ts;
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
re PR fortran/15586 (gfortran should support i18n in its compiler messages)
PR fortran/15586
* arith.c (gfc_arith_error): Change message to include locus.
(check_result, eval_intrinsic, gfc_int2int, gfc_real2real,
gfc_real2complex, gfc_complex2real, gfc_complex2complex): Use
the new gfc_arith_error.
(arith_error): Rewrite full error messages instead of building
them from pieces.
* check.c (must_be): Removed.
(type_check, numeric_check, int_or_real_check, real_or_complex_check,
kind_check, double_check, logical_array_check, array_check,
scalar_check, same_type_check, rank_check, kind_value_check,
variable_check, gfc_check_allocated, gfc_check_associated,
gfc_check_cmplx, gfc_check_dcmplx, gfc_check_dot_product,
gfc_check_index, gfc_check_kind, gfc_check_matmul, gfc_check_null,
gfc_check_pack, gfc_check_precision, gfc_check_present,
gfc_check_spread): Rewrite full error messages instead of
building them from pieces.
* decl.c (gfc_match_entry): Rewrite full error messages instead
of building them from pieces.
* parse.c (gfc_state_name): Remove.
* parse.h: Remove prototype for gfc_state_name.
From-SVN: r105844
2005-10-24 11:11:51 +02:00
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must be a numeric type",
|
|
|
|
gfc_current_intrinsic_arg[n], gfc_current_intrinsic, &e->where);
|
2004-05-13 08:41:07 +02:00
|
|
|
|
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
/* Check that an expression is integer or real. */
|
|
|
|
|
|
|
|
static try
|
2007-01-07 01:28:29 +01:00
|
|
|
int_or_real_check (gfc_expr *e, int n)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (e->ts.type != BT_INTEGER && e->ts.type != BT_REAL)
|
|
|
|
{
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must be INTEGER "
|
|
|
|
"or REAL", gfc_current_intrinsic_arg[n],
|
|
|
|
gfc_current_intrinsic, &e->where);
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2005-01-29 18:46:34 +01:00
|
|
|
/* Check that an expression is real or complex. */
|
|
|
|
|
|
|
|
static try
|
2007-01-07 01:28:29 +01:00
|
|
|
real_or_complex_check (gfc_expr *e, int n)
|
2005-01-29 18:46:34 +01:00
|
|
|
{
|
|
|
|
if (e->ts.type != BT_REAL && e->ts.type != BT_COMPLEX)
|
|
|
|
{
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must be REAL "
|
|
|
|
"or COMPLEX", gfc_current_intrinsic_arg[n],
|
|
|
|
gfc_current_intrinsic, &e->where);
|
2005-01-29 18:46:34 +01:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
/* Check that the expression is an optional constant integer
|
|
|
|
and that it specifies a valid kind for that type. */
|
|
|
|
|
|
|
|
static try
|
2007-01-07 01:28:29 +01:00
|
|
|
kind_check (gfc_expr *k, int n, bt type)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
int kind;
|
|
|
|
|
|
|
|
if (k == NULL)
|
|
|
|
return SUCCESS;
|
|
|
|
|
|
|
|
if (type_check (k, n, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (k->expr_type != EXPR_CONSTANT)
|
|
|
|
{
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must be a constant",
|
|
|
|
gfc_current_intrinsic_arg[n], gfc_current_intrinsic,
|
|
|
|
&k->where);
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
if (gfc_extract_int (k, &kind) != NULL
|
arith.c (gfc_validate_kind): Add may_fail argument; abort if false and we don't validate the kind.
* arith.c (gfc_validate_kind): Add may_fail argument; abort if
false and we don't validate the kind.
(gfc_check_integer_range, gfc_check_real_range): Update to match.
* check.c (kind_check): Likewise.
* decl.c (gfc_match_old_kind_spec, gfc_match_kind_spec): Likewise.
(match_char_spec, match_logical_spec): Likewise.
* gfortran.h (gfc_validate_kind): Likewise.
* options.c (gfc_handle_option): Likewise.
* primary.c (match_integer_constant, match_real_constant,
match_string_constant, match_logical_constant,
match_const_complex_part): Likewise.
* simplify.c (get_kind, gfc_simplify_bit_size, gfc_simplify_digits,
gfc_simplify_epsilon, gfc_simplify_huge, gfc_simplify_ibclr,
gfc_simplify_ibset, gfc_simplify_ishft, gfc_simplify_ishftc,
gfc_simplify_maxexponent, gfc_simplify_minexponent,
gfc_simplify_nearest, gfc_simplify_not, gfc_simplify_precision,
gfc_simplify_radix, gfc_simplify_range, gfc_simplify_rrspacing,
gfc_simplify_scale, gfc_simplify_spacing, gfc_simplify_tan,
gfc_simplify_tiny): Likewise.
* trans-intrinsic.c (gfc_conv_intrinsic_aint, gfc_conv_intrinsic_mod,
gfc_conv_intrinsic_minmaxloc, gfc_conv_intrinsic_minmaxval,
prepare_arg_info): Likewise.
From-SVN: r86608
2004-08-26 08:07:52 +02:00
|
|
|
|| gfc_validate_kind (type, kind, true) < 0)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
gfc_error ("Invalid kind for %s at %L", gfc_basic_typename (type),
|
|
|
|
&k->where);
|
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
/* Make sure the expression is a double precision real. */
|
|
|
|
|
|
|
|
static try
|
2007-01-07 01:28:29 +01:00
|
|
|
double_check (gfc_expr *d, int n)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (type_check (d, n, BT_REAL) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
gfortran.h (gfc_default_*_kind): Remove prototypes, add extern variable declaration of same name.
* gfortran.h (gfc_default_*_kind): Remove prototypes, add extern
variable declaration of same name.
* arith.c, check.c, decl.c, dump_parse_tree.c, expr.c,
intrinsic.c, io.c, iresolve.c, match.c, options.c, primary.c,
resolve.c, simplify.c, symbol.c, trans-const.c, trans-io.c:
Replace all calls to gfc_default_*_kind with variable accesses.
* trans-types.c: Same as above.
(gfc_default_*_kind_1): Rename to gfc_default_*_kind, remove
static qualifier. Replace all occurences.
(gfc_default_*_kind): Remove functions.
From-SVN: r86662
2004-08-27 16:49:35 +02:00
|
|
|
if (d->ts.kind != gfc_default_double_kind)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must be double "
|
|
|
|
"precision", gfc_current_intrinsic_arg[n],
|
|
|
|
gfc_current_intrinsic, &d->where);
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
/* Make sure the expression is a logical array. */
|
|
|
|
|
|
|
|
static try
|
2007-01-07 01:28:29 +01:00
|
|
|
logical_array_check (gfc_expr *array, int n)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (array->ts.type != BT_LOGICAL || array->rank == 0)
|
|
|
|
{
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must be a logical "
|
|
|
|
"array", gfc_current_intrinsic_arg[n], gfc_current_intrinsic,
|
|
|
|
&array->where);
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
/* Make sure an expression is an array. */
|
|
|
|
|
|
|
|
static try
|
2007-01-07 01:28:29 +01:00
|
|
|
array_check (gfc_expr *e, int n)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (e->rank != 0)
|
|
|
|
return SUCCESS;
|
|
|
|
|
re PR fortran/15586 (gfortran should support i18n in its compiler messages)
PR fortran/15586
* arith.c (gfc_arith_error): Change message to include locus.
(check_result, eval_intrinsic, gfc_int2int, gfc_real2real,
gfc_real2complex, gfc_complex2real, gfc_complex2complex): Use
the new gfc_arith_error.
(arith_error): Rewrite full error messages instead of building
them from pieces.
* check.c (must_be): Removed.
(type_check, numeric_check, int_or_real_check, real_or_complex_check,
kind_check, double_check, logical_array_check, array_check,
scalar_check, same_type_check, rank_check, kind_value_check,
variable_check, gfc_check_allocated, gfc_check_associated,
gfc_check_cmplx, gfc_check_dcmplx, gfc_check_dot_product,
gfc_check_index, gfc_check_kind, gfc_check_matmul, gfc_check_null,
gfc_check_pack, gfc_check_precision, gfc_check_present,
gfc_check_spread): Rewrite full error messages instead of
building them from pieces.
* decl.c (gfc_match_entry): Rewrite full error messages instead
of building them from pieces.
* parse.c (gfc_state_name): Remove.
* parse.h: Remove prototype for gfc_state_name.
From-SVN: r105844
2005-10-24 11:11:51 +02:00
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must be an array",
|
|
|
|
gfc_current_intrinsic_arg[n], gfc_current_intrinsic, &e->where);
|
2004-05-13 08:41:07 +02:00
|
|
|
|
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
/* Make sure an expression is a scalar. */
|
|
|
|
|
|
|
|
static try
|
2007-01-07 01:28:29 +01:00
|
|
|
scalar_check (gfc_expr *e, int n)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (e->rank == 0)
|
|
|
|
return SUCCESS;
|
|
|
|
|
re PR fortran/15586 (gfortran should support i18n in its compiler messages)
PR fortran/15586
* arith.c (gfc_arith_error): Change message to include locus.
(check_result, eval_intrinsic, gfc_int2int, gfc_real2real,
gfc_real2complex, gfc_complex2real, gfc_complex2complex): Use
the new gfc_arith_error.
(arith_error): Rewrite full error messages instead of building
them from pieces.
* check.c (must_be): Removed.
(type_check, numeric_check, int_or_real_check, real_or_complex_check,
kind_check, double_check, logical_array_check, array_check,
scalar_check, same_type_check, rank_check, kind_value_check,
variable_check, gfc_check_allocated, gfc_check_associated,
gfc_check_cmplx, gfc_check_dcmplx, gfc_check_dot_product,
gfc_check_index, gfc_check_kind, gfc_check_matmul, gfc_check_null,
gfc_check_pack, gfc_check_precision, gfc_check_present,
gfc_check_spread): Rewrite full error messages instead of
building them from pieces.
* decl.c (gfc_match_entry): Rewrite full error messages instead
of building them from pieces.
* parse.c (gfc_state_name): Remove.
* parse.h: Remove prototype for gfc_state_name.
From-SVN: r105844
2005-10-24 11:11:51 +02:00
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must be a scalar",
|
|
|
|
gfc_current_intrinsic_arg[n], gfc_current_intrinsic, &e->where);
|
2004-05-13 08:41:07 +02:00
|
|
|
|
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2006-11-10 04:38:43 +01:00
|
|
|
/* Make sure two expressions have the same type. */
|
2004-05-13 08:41:07 +02:00
|
|
|
|
|
|
|
static try
|
2007-01-07 01:28:29 +01:00
|
|
|
same_type_check (gfc_expr *e, int n, gfc_expr *f, int m)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (gfc_compare_types (&e->ts, &f->ts))
|
|
|
|
return SUCCESS;
|
|
|
|
|
re PR fortran/15586 (gfortran should support i18n in its compiler messages)
PR fortran/15586
* arith.c (gfc_arith_error): Change message to include locus.
(check_result, eval_intrinsic, gfc_int2int, gfc_real2real,
gfc_real2complex, gfc_complex2real, gfc_complex2complex): Use
the new gfc_arith_error.
(arith_error): Rewrite full error messages instead of building
them from pieces.
* check.c (must_be): Removed.
(type_check, numeric_check, int_or_real_check, real_or_complex_check,
kind_check, double_check, logical_array_check, array_check,
scalar_check, same_type_check, rank_check, kind_value_check,
variable_check, gfc_check_allocated, gfc_check_associated,
gfc_check_cmplx, gfc_check_dcmplx, gfc_check_dot_product,
gfc_check_index, gfc_check_kind, gfc_check_matmul, gfc_check_null,
gfc_check_pack, gfc_check_precision, gfc_check_present,
gfc_check_spread): Rewrite full error messages instead of
building them from pieces.
* decl.c (gfc_match_entry): Rewrite full error messages instead
of building them from pieces.
* parse.c (gfc_state_name): Remove.
* parse.h: Remove prototype for gfc_state_name.
From-SVN: r105844
2005-10-24 11:11:51 +02:00
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must be the same type "
|
|
|
|
"and kind as '%s'", gfc_current_intrinsic_arg[m],
|
|
|
|
gfc_current_intrinsic, &f->where, gfc_current_intrinsic_arg[n]);
|
2007-01-07 01:28:29 +01:00
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
/* Make sure that an expression has a certain (nonzero) rank. */
|
|
|
|
|
|
|
|
static try
|
2007-01-07 01:28:29 +01:00
|
|
|
rank_check (gfc_expr *e, int n, int rank)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (e->rank == rank)
|
|
|
|
return SUCCESS;
|
|
|
|
|
re PR fortran/15586 (gfortran should support i18n in its compiler messages)
PR fortran/15586
* arith.c (gfc_arith_error): Change message to include locus.
(check_result, eval_intrinsic, gfc_int2int, gfc_real2real,
gfc_real2complex, gfc_complex2real, gfc_complex2complex): Use
the new gfc_arith_error.
(arith_error): Rewrite full error messages instead of building
them from pieces.
* check.c (must_be): Removed.
(type_check, numeric_check, int_or_real_check, real_or_complex_check,
kind_check, double_check, logical_array_check, array_check,
scalar_check, same_type_check, rank_check, kind_value_check,
variable_check, gfc_check_allocated, gfc_check_associated,
gfc_check_cmplx, gfc_check_dcmplx, gfc_check_dot_product,
gfc_check_index, gfc_check_kind, gfc_check_matmul, gfc_check_null,
gfc_check_pack, gfc_check_precision, gfc_check_present,
gfc_check_spread): Rewrite full error messages instead of
building them from pieces.
* decl.c (gfc_match_entry): Rewrite full error messages instead
of building them from pieces.
* parse.c (gfc_state_name): Remove.
* parse.h: Remove prototype for gfc_state_name.
From-SVN: r105844
2005-10-24 11:11:51 +02:00
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must be of rank %d",
|
|
|
|
gfc_current_intrinsic_arg[n], gfc_current_intrinsic,
|
|
|
|
&e->where, rank);
|
2007-01-07 01:28:29 +01:00
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
/* Make sure a variable expression is not an optional dummy argument. */
|
|
|
|
|
|
|
|
static try
|
2007-01-07 01:28:29 +01:00
|
|
|
nonoptional_check (gfc_expr *e, int n)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (e->expr_type == EXPR_VARIABLE && e->symtree->n.sym->attr.optional)
|
|
|
|
{
|
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must not be OPTIONAL",
|
|
|
|
gfc_current_intrinsic_arg[n], gfc_current_intrinsic,
|
|
|
|
&e->where);
|
|
|
|
}
|
|
|
|
|
|
|
|
/* TODO: Recursive check on nonoptional variables? */
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
/* Check that an expression has a particular kind. */
|
|
|
|
|
|
|
|
static try
|
2007-01-07 01:28:29 +01:00
|
|
|
kind_value_check (gfc_expr *e, int n, int k)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (e->ts.kind == k)
|
|
|
|
return SUCCESS;
|
|
|
|
|
re PR fortran/15586 (gfortran should support i18n in its compiler messages)
PR fortran/15586
* arith.c (gfc_arith_error): Change message to include locus.
(check_result, eval_intrinsic, gfc_int2int, gfc_real2real,
gfc_real2complex, gfc_complex2real, gfc_complex2complex): Use
the new gfc_arith_error.
(arith_error): Rewrite full error messages instead of building
them from pieces.
* check.c (must_be): Removed.
(type_check, numeric_check, int_or_real_check, real_or_complex_check,
kind_check, double_check, logical_array_check, array_check,
scalar_check, same_type_check, rank_check, kind_value_check,
variable_check, gfc_check_allocated, gfc_check_associated,
gfc_check_cmplx, gfc_check_dcmplx, gfc_check_dot_product,
gfc_check_index, gfc_check_kind, gfc_check_matmul, gfc_check_null,
gfc_check_pack, gfc_check_precision, gfc_check_present,
gfc_check_spread): Rewrite full error messages instead of
building them from pieces.
* decl.c (gfc_match_entry): Rewrite full error messages instead
of building them from pieces.
* parse.c (gfc_state_name): Remove.
* parse.h: Remove prototype for gfc_state_name.
From-SVN: r105844
2005-10-24 11:11:51 +02:00
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must be of kind %d",
|
|
|
|
gfc_current_intrinsic_arg[n], gfc_current_intrinsic,
|
|
|
|
&e->where, k);
|
2007-01-07 01:28:29 +01:00
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
/* Make sure an expression is a variable. */
|
|
|
|
|
|
|
|
static try
|
2007-01-07 01:28:29 +01:00
|
|
|
variable_check (gfc_expr *e, int n)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if ((e->expr_type == EXPR_VARIABLE
|
|
|
|
&& e->symtree->n.sym->attr.flavor != FL_PARAMETER)
|
|
|
|
|| (e->expr_type == EXPR_FUNCTION
|
|
|
|
&& e->symtree->n.sym->result == e->symtree->n.sym))
|
|
|
|
return SUCCESS;
|
|
|
|
|
|
|
|
if (e->expr_type == EXPR_VARIABLE
|
|
|
|
&& e->symtree->n.sym->attr.intent == INTENT_IN)
|
|
|
|
{
|
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L cannot be INTENT(IN)",
|
|
|
|
gfc_current_intrinsic_arg[n], gfc_current_intrinsic,
|
|
|
|
&e->where);
|
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
re PR fortran/15586 (gfortran should support i18n in its compiler messages)
PR fortran/15586
* arith.c (gfc_arith_error): Change message to include locus.
(check_result, eval_intrinsic, gfc_int2int, gfc_real2real,
gfc_real2complex, gfc_complex2real, gfc_complex2complex): Use
the new gfc_arith_error.
(arith_error): Rewrite full error messages instead of building
them from pieces.
* check.c (must_be): Removed.
(type_check, numeric_check, int_or_real_check, real_or_complex_check,
kind_check, double_check, logical_array_check, array_check,
scalar_check, same_type_check, rank_check, kind_value_check,
variable_check, gfc_check_allocated, gfc_check_associated,
gfc_check_cmplx, gfc_check_dcmplx, gfc_check_dot_product,
gfc_check_index, gfc_check_kind, gfc_check_matmul, gfc_check_null,
gfc_check_pack, gfc_check_precision, gfc_check_present,
gfc_check_spread): Rewrite full error messages instead of
building them from pieces.
* decl.c (gfc_match_entry): Rewrite full error messages instead
of building them from pieces.
* parse.c (gfc_state_name): Remove.
* parse.h: Remove prototype for gfc_state_name.
From-SVN: r105844
2005-10-24 11:11:51 +02:00
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must be a variable",
|
|
|
|
gfc_current_intrinsic_arg[n], gfc_current_intrinsic, &e->where);
|
2004-05-13 08:41:07 +02:00
|
|
|
|
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
/* Check the common DIM parameter for correctness. */
|
|
|
|
|
|
|
|
static try
|
2007-01-07 01:28:29 +01:00
|
|
|
dim_check (gfc_expr *dim, int n, int optional)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
2006-02-14 20:25:36 +01:00
|
|
|
if (optional && dim == NULL)
|
|
|
|
return SUCCESS;
|
2004-05-13 08:41:07 +02:00
|
|
|
|
|
|
|
if (dim == NULL)
|
|
|
|
{
|
|
|
|
gfc_error ("Missing DIM parameter in intrinsic '%s' at %L",
|
|
|
|
gfc_current_intrinsic, gfc_current_intrinsic_where);
|
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
if (type_check (dim, n, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (dim, n) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
2006-02-14 20:25:36 +01:00
|
|
|
if (nonoptional_check (dim, n) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
/* If a DIM parameter is a constant, make sure that it is greater than
|
|
|
|
zero and less than or equal to the rank of the given array. If
|
|
|
|
allow_assumed is zero then dim must be less than the rank of the array
|
|
|
|
for assumed size arrays. */
|
|
|
|
|
|
|
|
static try
|
2007-01-07 01:28:29 +01:00
|
|
|
dim_rank_check (gfc_expr *dim, gfc_expr *array, int allow_assumed)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
gfc_array_ref *ar;
|
|
|
|
int rank;
|
|
|
|
|
|
|
|
if (dim->expr_type != EXPR_CONSTANT || array->expr_type != EXPR_VARIABLE)
|
|
|
|
return SUCCESS;
|
|
|
|
|
|
|
|
ar = gfc_find_array_ref (array);
|
|
|
|
rank = array->rank;
|
2007-03-03 11:43:25 +01:00
|
|
|
if (ar->as->type == AS_ASSUMED_SIZE
|
|
|
|
&& !allow_assumed
|
|
|
|
&& ar->type != AR_ELEMENT
|
|
|
|
&& ar->type != AR_SECTION)
|
2004-05-13 08:41:07 +02:00
|
|
|
rank--;
|
|
|
|
|
|
|
|
if (mpz_cmp_ui (dim->value.integer, 1) < 0
|
|
|
|
|| mpz_cmp_ui (dim->value.integer, rank) > 0)
|
|
|
|
{
|
|
|
|
gfc_error ("'dim' argument of '%s' intrinsic at %L is not a valid "
|
|
|
|
"dimension index", gfc_current_intrinsic, &dim->where);
|
|
|
|
|
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
2007-01-07 01:28:29 +01:00
|
|
|
|
2006-02-04 23:11:57 +01:00
|
|
|
/* Compare the size of a along dimension ai with the size of b along
|
|
|
|
dimension bi, returning 0 if they are known not to be identical,
|
|
|
|
and 1 if they are identical, or if this cannot be determined. */
|
|
|
|
|
|
|
|
static int
|
|
|
|
identical_dimen_shape (gfc_expr *a, int ai, gfc_expr *b, int bi)
|
|
|
|
{
|
|
|
|
mpz_t a_size, b_size;
|
|
|
|
int ret;
|
|
|
|
|
|
|
|
gcc_assert (a->rank > ai);
|
|
|
|
gcc_assert (b->rank > bi);
|
|
|
|
|
|
|
|
ret = 1;
|
|
|
|
|
|
|
|
if (gfc_array_dimen_size (a, ai, &a_size) == SUCCESS)
|
|
|
|
{
|
|
|
|
if (gfc_array_dimen_size (b, bi, &b_size) == SUCCESS)
|
|
|
|
{
|
|
|
|
if (mpz_cmp (a_size, b_size) != 0)
|
|
|
|
ret = 0;
|
|
|
|
|
|
|
|
mpz_clear (b_size);
|
|
|
|
}
|
|
|
|
mpz_clear (a_size);
|
|
|
|
}
|
|
|
|
return ret;
|
|
|
|
}
|
2004-05-13 08:41:07 +02:00
|
|
|
|
2007-01-07 01:28:29 +01:00
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
/***** Check functions *****/
|
|
|
|
|
|
|
|
/* Check subroutine suitable for intrinsics taking a real argument and
|
|
|
|
a kind argument for the result. */
|
|
|
|
|
|
|
|
static try
|
2007-01-07 01:28:29 +01:00
|
|
|
check_a_kind (gfc_expr *a, gfc_expr *kind, bt type)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (type_check (a, 0, BT_REAL) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
if (kind_check (kind, 1, type) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
2007-01-07 01:28:29 +01:00
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
/* Check subroutine suitable for ceiling, floor and nint. */
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_a_ikind (gfc_expr *a, gfc_expr *kind)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
return check_a_kind (a, kind, BT_INTEGER);
|
|
|
|
}
|
|
|
|
|
2007-01-07 01:28:29 +01:00
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
/* Check subroutine suitable for aint, anint. */
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_a_xkind (gfc_expr *a, gfc_expr *kind)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
return check_a_kind (a, kind, BT_REAL);
|
|
|
|
}
|
|
|
|
|
2007-01-07 01:28:29 +01:00
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_abs (gfc_expr *a)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (numeric_check (a, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
2007-01-07 01:28:29 +01:00
|
|
|
|
2005-02-19 20:16:09 +01:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_achar (gfc_expr *a)
|
2005-02-19 20:16:09 +01:00
|
|
|
{
|
|
|
|
if (type_check (a, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
|
intrinsic.c (add_functions): Add ACCESS, CHMOD, RSHIFT, LSHIFT.
* intrinsic.c (add_functions): Add ACCESS, CHMOD, RSHIFT, LSHIFT.
(add_subroutines): Add LTIME, GMTIME and CHMOD.
* intrinsic.h (gfc_check_access_func, gfc_check_chmod,
gfc_check_chmod_sub, gfc_check_ltime_gmtime, gfc_simplify_rshift,
gfc_simplify_lshift, gfc_resolve_access, gfc_resolve_chmod,
gfc_resolve_rshift, gfc_resolve_lshift, gfc_resolve_chmod_sub,
gfc_resolve_gmtime, gfc_resolve_ltime): Add prototypes.
* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_ACCESS,
GFC_ISYM_CHMOD, GFC_ISYM_LSHIFT, GFC_ISYM_RSHIFT.
* iresolve.c (gfc_resolve_access, gfc_resolve_chmod,
gfc_resolve_rshift, gfc_resolve_lshift, gfc_resolve_chmod_sub,
gfc_resolve_gmtime, gfc_resolve_ltime): New functions.
* check.c (gfc_check_access_func, gfc_check_chmod,
gfc_check_chmod_sub, gfc_check_ltime_gmtime): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_rlshift): New function.
(gfc_conv_intrinsic_function): Add cases for the new GFC_ISYM_*.
* intrinsics/date_and_time.c: Add functions for GMTIME and LTIME.
* intrinsics/access.c: New file.
* intrinsics/chmod.c: New file.
* configure.ac: Add checks for <sys/wait.h>, access, fork,execl
and wait.
* Makefile.am: Add new files intrinsics/access.c and
intrinsics/chmod.c.
* configure: Regenerate.
* config.h.in: Regenerate.
* Makefile.in: Regenerate.
* gcc/testsuite/gfortran.dg/chmod_3.f90: New test.
* gcc/testsuite/gfortran.dg/ltime_gmtime_1.f90: New test.
* gcc/testsuite/gfortran.dg/ltime_gmtime_2.f90: New test.
* gcc/testsuite/gfortran.dg/lrshift_1.f90: New test.
* gcc/testsuite/gfortran.dg/chmod_1.f90: New test.
* gcc/testsuite/gfortran.dg/chmod_2.f90: New test.
From-SVN: r115825
2006-07-30 22:48:00 +02:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_access_func (gfc_expr *name, gfc_expr *mode)
|
intrinsic.c (add_functions): Add ACCESS, CHMOD, RSHIFT, LSHIFT.
* intrinsic.c (add_functions): Add ACCESS, CHMOD, RSHIFT, LSHIFT.
(add_subroutines): Add LTIME, GMTIME and CHMOD.
* intrinsic.h (gfc_check_access_func, gfc_check_chmod,
gfc_check_chmod_sub, gfc_check_ltime_gmtime, gfc_simplify_rshift,
gfc_simplify_lshift, gfc_resolve_access, gfc_resolve_chmod,
gfc_resolve_rshift, gfc_resolve_lshift, gfc_resolve_chmod_sub,
gfc_resolve_gmtime, gfc_resolve_ltime): Add prototypes.
* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_ACCESS,
GFC_ISYM_CHMOD, GFC_ISYM_LSHIFT, GFC_ISYM_RSHIFT.
* iresolve.c (gfc_resolve_access, gfc_resolve_chmod,
gfc_resolve_rshift, gfc_resolve_lshift, gfc_resolve_chmod_sub,
gfc_resolve_gmtime, gfc_resolve_ltime): New functions.
* check.c (gfc_check_access_func, gfc_check_chmod,
gfc_check_chmod_sub, gfc_check_ltime_gmtime): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_rlshift): New function.
(gfc_conv_intrinsic_function): Add cases for the new GFC_ISYM_*.
* intrinsics/date_and_time.c: Add functions for GMTIME and LTIME.
* intrinsics/access.c: New file.
* intrinsics/chmod.c: New file.
* configure.ac: Add checks for <sys/wait.h>, access, fork,execl
and wait.
* Makefile.am: Add new files intrinsics/access.c and
intrinsics/chmod.c.
* configure: Regenerate.
* config.h.in: Regenerate.
* Makefile.in: Regenerate.
* gcc/testsuite/gfortran.dg/chmod_3.f90: New test.
* gcc/testsuite/gfortran.dg/ltime_gmtime_1.f90: New test.
* gcc/testsuite/gfortran.dg/ltime_gmtime_2.f90: New test.
* gcc/testsuite/gfortran.dg/lrshift_1.f90: New test.
* gcc/testsuite/gfortran.dg/chmod_1.f90: New test.
* gcc/testsuite/gfortran.dg/chmod_2.f90: New test.
From-SVN: r115825
2006-07-30 22:48:00 +02:00
|
|
|
{
|
|
|
|
if (type_check (name, 0, BT_CHARACTER) == FAILURE
|
|
|
|
|| scalar_check (name, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (mode, 1, BT_CHARACTER) == FAILURE
|
|
|
|
|| scalar_check (mode, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_all_any (gfc_expr *mask, gfc_expr *dim)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (logical_array_check (mask, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (dim_check (dim, 1, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_allocated (gfc_expr *array)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
[multiple changes]
2006-10-05 Erik Edelmann <edelmann@gcc.gnu.org>
Paul Thomas <pault@gcc.gnu.org>
PR fortran/20541
* interface.c (gfc_compare_derived_types): Add comparison of
the allocatable field.
* intrinsic.c (add_subroutines): Add MOVE_ALLOC.
* trans-expr.c (gfc_conv_aliased_arg, gfc_trans_subarray_assign,
gfc_trans_subcomponent_assign, gfc_conv_string_parameter,
gfc_trans_scalar_assign): Add extra arguments l_is_temp
and r_is_var to references to latter function.
(gfc_conv_function_call): Add enum for types of argument and
an associated variable parm_kind. Deallocate components of
INTENT(OUT) and non-variable arrays.
(gfc_trans_subcomponent_assign): Add block to assign arrays
to allocatable components.
(gfc_trans_scalar_assign): Add block to handle assignments of
derived types with allocatable components, using the above new
arguments to control allocation/deallocation of memory and the
copying of allocated arrays.
* trans-array.c (gfc_array_allocate): Remove old identification
of pointer and replace with that of an allocatable array. Add
nullify of structures with allocatable components.
(gfc_conv_array_initializer): Treat EXPR_NULL.
(gfc_conv_array_parameter): Deallocate allocatable components
of non-variable structures.
(gfc_trans_dealloc_allocated): Use second argument of library
deallocate to inhibit, without error, freeing NULL pointers.
(get_full_array_size): New function to return the size of a
full array.
(gfc_duplicate_allocatable): New function to allocate and copy
allocated data.
(structure_alloc_comps): New recursive function to deallocate,
nullify or copy allocatable components.
(gfc_nullify_alloc_comp, gfc_deallocate_alloc_comp,
gfc_copy_alloc_comp): New interface functions to call previous.
(gfc_trans_deferred_array): Add the code to nullify allocatable
components, when entering scope, and to deallocate them on
leaving. Do not call gfc_trans_static_array_pointer and return
for structures with allocatable components and default
initializers.
* symbol.c (gfc_set_component_attr): Set allocatable field.
(gfc_get_component_attr): Set the allocatable attribute.
* intrinsic.h : Prototype for gfc_check_move_alloc.
* decl.c (build_struct): Apply TR15581 constraints for
allocatable components.
(variable_decl): Default initializer is always NULL for
allocatable components.
(match_attr_spec): Allow, or not, allocatable components,
according to the standard in force.
* trans-array.h : Prototypes for gfc_nullify_alloc_comp,
gfc_deallocate_alloc_comp, gfc_copy_alloc_comp and
gfc_duplicate_allocatable.
* gfortran.texi : Add mention of TR15581 extensions.
* gfortran.h : Add attribute alloc_comp, add
gfc_components field allocatable and add the prototype
for gfc_expr_to_initialize.
* trans-stmt.c (generate_loop_for_temp_to_lhs,
generate_loop_for_rhs_to_temp, gfc_trans_where_assign,
gfc_trans_where_3): Add extra arguments to calls to
gfc_trans_scalar_assign and set appropriately.
(gfc_trans_allocate): Nullify allocatable components.
(gfc_trans_deallocate): Deallocate to ultimate allocatable
components but stop at ultimate pointer components.
* module.c (mio_symbol_attribute, mio_symbol_attribute,
mio_component): Add module support for allocatable
components.
* trans-types.c (gfc_get_derived_type): Treat allocatable
components.
* trans.h : Add two boolean arguments to
gfc_trans_scalar_assign.
* resolve.c (resolve_structure_cons): Check conformance of
constructor element and the component.
(resolve_allocate_expr): Add expression to nullify the
constructor expression for allocatable components.
(resolve_transfer): Inhibit I/O of derived types with
allocatable components.
(resolve_fl_derived): Skip check of bounds of allocatable
components.
* trans-decl.c (gfc_get_symbol_decl): Add derived types
with allocatable components to deferred variable.
(gfc_trans_deferred_vars): Make calls for derived types
with allocatable components to gfc_trans_deferred_array.
(gfc_generate_function_code): Nullify allocatable
component function result on entry.
* parse.c (parse_derived): Set symbol attr.allocatable if
allocatable components are present.
* check.c (gfc_check_allocated): Enforce attr.allocatable
for intrinsic arguments.
(gfc_check_move_alloc): Check arguments of move_alloc.
* primary.c (gfc_variable_attr): Set allocatable attribute.
* intrinsic.texi : Add index entry and section for
for move_alloc.
PR fortran/29115
* resolve.c (resolve_structure_cons): It is an error if the
pointer component elements of a derived type constructor are
not pointer or target.
PR fortran/29211
* trans-stmt.c (generate_loop_for_temp_to_lhs,
generate_loop_for_rhs_to_temp): Provide a string length for
the temporary by copying that of the other side of the scalar
assignment.
2006-10-05 Paul Thomas <pault@gcc.gnu.org>
Erik Edelmann <edelmann@gcc.gnu.org>
PR libgfortran/20541
* Makefile.in : Add move_alloc.
* intrinsics/move_alloc.c: New function.
* Makefile.am : Add move_alloc.
2006-10-05 Erik Edelmann <edelmann@gcc.gnu.org>
Paul Thomas <pault@gcc.gnu.org>
PR fortran/20541
* gfortran.dg/alloc_comp_basics_1.f90: New test.
* gfortran.dg/alloc_comp_basics_2.f90: New test.
* gfortran.dg/alloc_comp_assign_1.f90: New test.
* gfortran.dg/alloc_comp_assign_2.f90: New test.
* gfortran.dg/alloc_comp_assign_3.f90: New test.
* gfortran.dg/alloc_comp_assign_4.f90: New test.
* gfortran.dg/alloc_comp_constraint_1.f90: New test.
* gfortran.dg/alloc_comp_constraint_2.f90: New test.
* gfortran.dg/alloc_comp_constraint_3.f90: New test.
* gfortran.dg/alloc_comp_constructor_1.f90: New test.
* gfortran.dg/alloc_comp_constructor_2.f90: New test.
* gfortran.dg/alloc_comp_initializer_1.f90: New test.
* gfortran.dg/alloc_comp_std.f90: New test.
* gfortran.dg/move_alloc.f90: New test.
PR fortran/29115
* gfortran.dg/derived_constructor_comps_2.f90: New test.
PR fortran/29211
* gfortran.dg/forall_char_dependencies_1.f90: New test.
From-SVN: r117558
2006-10-08 18:21:55 +02:00
|
|
|
symbol_attribute attr;
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
if (variable_check (array, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
[multiple changes]
2006-10-05 Erik Edelmann <edelmann@gcc.gnu.org>
Paul Thomas <pault@gcc.gnu.org>
PR fortran/20541
* interface.c (gfc_compare_derived_types): Add comparison of
the allocatable field.
* intrinsic.c (add_subroutines): Add MOVE_ALLOC.
* trans-expr.c (gfc_conv_aliased_arg, gfc_trans_subarray_assign,
gfc_trans_subcomponent_assign, gfc_conv_string_parameter,
gfc_trans_scalar_assign): Add extra arguments l_is_temp
and r_is_var to references to latter function.
(gfc_conv_function_call): Add enum for types of argument and
an associated variable parm_kind. Deallocate components of
INTENT(OUT) and non-variable arrays.
(gfc_trans_subcomponent_assign): Add block to assign arrays
to allocatable components.
(gfc_trans_scalar_assign): Add block to handle assignments of
derived types with allocatable components, using the above new
arguments to control allocation/deallocation of memory and the
copying of allocated arrays.
* trans-array.c (gfc_array_allocate): Remove old identification
of pointer and replace with that of an allocatable array. Add
nullify of structures with allocatable components.
(gfc_conv_array_initializer): Treat EXPR_NULL.
(gfc_conv_array_parameter): Deallocate allocatable components
of non-variable structures.
(gfc_trans_dealloc_allocated): Use second argument of library
deallocate to inhibit, without error, freeing NULL pointers.
(get_full_array_size): New function to return the size of a
full array.
(gfc_duplicate_allocatable): New function to allocate and copy
allocated data.
(structure_alloc_comps): New recursive function to deallocate,
nullify or copy allocatable components.
(gfc_nullify_alloc_comp, gfc_deallocate_alloc_comp,
gfc_copy_alloc_comp): New interface functions to call previous.
(gfc_trans_deferred_array): Add the code to nullify allocatable
components, when entering scope, and to deallocate them on
leaving. Do not call gfc_trans_static_array_pointer and return
for structures with allocatable components and default
initializers.
* symbol.c (gfc_set_component_attr): Set allocatable field.
(gfc_get_component_attr): Set the allocatable attribute.
* intrinsic.h : Prototype for gfc_check_move_alloc.
* decl.c (build_struct): Apply TR15581 constraints for
allocatable components.
(variable_decl): Default initializer is always NULL for
allocatable components.
(match_attr_spec): Allow, or not, allocatable components,
according to the standard in force.
* trans-array.h : Prototypes for gfc_nullify_alloc_comp,
gfc_deallocate_alloc_comp, gfc_copy_alloc_comp and
gfc_duplicate_allocatable.
* gfortran.texi : Add mention of TR15581 extensions.
* gfortran.h : Add attribute alloc_comp, add
gfc_components field allocatable and add the prototype
for gfc_expr_to_initialize.
* trans-stmt.c (generate_loop_for_temp_to_lhs,
generate_loop_for_rhs_to_temp, gfc_trans_where_assign,
gfc_trans_where_3): Add extra arguments to calls to
gfc_trans_scalar_assign and set appropriately.
(gfc_trans_allocate): Nullify allocatable components.
(gfc_trans_deallocate): Deallocate to ultimate allocatable
components but stop at ultimate pointer components.
* module.c (mio_symbol_attribute, mio_symbol_attribute,
mio_component): Add module support for allocatable
components.
* trans-types.c (gfc_get_derived_type): Treat allocatable
components.
* trans.h : Add two boolean arguments to
gfc_trans_scalar_assign.
* resolve.c (resolve_structure_cons): Check conformance of
constructor element and the component.
(resolve_allocate_expr): Add expression to nullify the
constructor expression for allocatable components.
(resolve_transfer): Inhibit I/O of derived types with
allocatable components.
(resolve_fl_derived): Skip check of bounds of allocatable
components.
* trans-decl.c (gfc_get_symbol_decl): Add derived types
with allocatable components to deferred variable.
(gfc_trans_deferred_vars): Make calls for derived types
with allocatable components to gfc_trans_deferred_array.
(gfc_generate_function_code): Nullify allocatable
component function result on entry.
* parse.c (parse_derived): Set symbol attr.allocatable if
allocatable components are present.
* check.c (gfc_check_allocated): Enforce attr.allocatable
for intrinsic arguments.
(gfc_check_move_alloc): Check arguments of move_alloc.
* primary.c (gfc_variable_attr): Set allocatable attribute.
* intrinsic.texi : Add index entry and section for
for move_alloc.
PR fortran/29115
* resolve.c (resolve_structure_cons): It is an error if the
pointer component elements of a derived type constructor are
not pointer or target.
PR fortran/29211
* trans-stmt.c (generate_loop_for_temp_to_lhs,
generate_loop_for_rhs_to_temp): Provide a string length for
the temporary by copying that of the other side of the scalar
assignment.
2006-10-05 Paul Thomas <pault@gcc.gnu.org>
Erik Edelmann <edelmann@gcc.gnu.org>
PR libgfortran/20541
* Makefile.in : Add move_alloc.
* intrinsics/move_alloc.c: New function.
* Makefile.am : Add move_alloc.
2006-10-05 Erik Edelmann <edelmann@gcc.gnu.org>
Paul Thomas <pault@gcc.gnu.org>
PR fortran/20541
* gfortran.dg/alloc_comp_basics_1.f90: New test.
* gfortran.dg/alloc_comp_basics_2.f90: New test.
* gfortran.dg/alloc_comp_assign_1.f90: New test.
* gfortran.dg/alloc_comp_assign_2.f90: New test.
* gfortran.dg/alloc_comp_assign_3.f90: New test.
* gfortran.dg/alloc_comp_assign_4.f90: New test.
* gfortran.dg/alloc_comp_constraint_1.f90: New test.
* gfortran.dg/alloc_comp_constraint_2.f90: New test.
* gfortran.dg/alloc_comp_constraint_3.f90: New test.
* gfortran.dg/alloc_comp_constructor_1.f90: New test.
* gfortran.dg/alloc_comp_constructor_2.f90: New test.
* gfortran.dg/alloc_comp_initializer_1.f90: New test.
* gfortran.dg/alloc_comp_std.f90: New test.
* gfortran.dg/move_alloc.f90: New test.
PR fortran/29115
* gfortran.dg/derived_constructor_comps_2.f90: New test.
PR fortran/29211
* gfortran.dg/forall_char_dependencies_1.f90: New test.
From-SVN: r117558
2006-10-08 18:21:55 +02:00
|
|
|
attr = gfc_variable_attr (array, NULL);
|
|
|
|
if (!attr.allocatable)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
re PR fortran/15586 (gfortran should support i18n in its compiler messages)
PR fortran/15586
* arith.c (gfc_arith_error): Change message to include locus.
(check_result, eval_intrinsic, gfc_int2int, gfc_real2real,
gfc_real2complex, gfc_complex2real, gfc_complex2complex): Use
the new gfc_arith_error.
(arith_error): Rewrite full error messages instead of building
them from pieces.
* check.c (must_be): Removed.
(type_check, numeric_check, int_or_real_check, real_or_complex_check,
kind_check, double_check, logical_array_check, array_check,
scalar_check, same_type_check, rank_check, kind_value_check,
variable_check, gfc_check_allocated, gfc_check_associated,
gfc_check_cmplx, gfc_check_dcmplx, gfc_check_dot_product,
gfc_check_index, gfc_check_kind, gfc_check_matmul, gfc_check_null,
gfc_check_pack, gfc_check_precision, gfc_check_present,
gfc_check_spread): Rewrite full error messages instead of
building them from pieces.
* decl.c (gfc_match_entry): Rewrite full error messages instead
of building them from pieces.
* parse.c (gfc_state_name): Remove.
* parse.h: Remove prototype for gfc_state_name.
From-SVN: r105844
2005-10-24 11:11:51 +02:00
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must be ALLOCATABLE",
|
|
|
|
gfc_current_intrinsic_arg[0], gfc_current_intrinsic,
|
|
|
|
&array->where);
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
2007-08-01 19:55:24 +02:00
|
|
|
if (array_check (array, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
/* Common check function where the first argument must be real or
|
|
|
|
integer and the second argument must be the same as the first. */
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_a_p (gfc_expr *a, gfc_expr *p)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (int_or_real_check (a, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
2005-11-27 15:01:36 +01:00
|
|
|
if (a->ts.type != p->ts.type)
|
|
|
|
{
|
|
|
|
gfc_error ("'%s' and '%s' arguments of '%s' intrinsic at %L must "
|
2007-01-07 01:28:29 +01:00
|
|
|
"have the same type", gfc_current_intrinsic_arg[0],
|
|
|
|
gfc_current_intrinsic_arg[1], gfc_current_intrinsic,
|
|
|
|
&p->where);
|
2005-11-27 15:01:36 +01:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
if (a->ts.kind != p->ts.kind)
|
|
|
|
{
|
|
|
|
if (gfc_notify_std (GFC_STD_GNU, "Extension: Different type kinds at %L",
|
2007-01-07 01:28:29 +01:00
|
|
|
&p->where) == FAILURE)
|
2005-11-27 15:01:36 +01:00
|
|
|
return FAILURE;
|
|
|
|
}
|
2004-05-13 08:41:07 +02:00
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_associated (gfc_expr *pointer, gfc_expr *target)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
symbol_attribute attr;
|
|
|
|
int i;
|
|
|
|
try t;
|
2006-06-05 09:45:03 +02:00
|
|
|
locus *where;
|
|
|
|
|
|
|
|
where = &pointer->where;
|
2004-05-13 08:41:07 +02:00
|
|
|
|
2005-12-08 17:56:10 +01:00
|
|
|
if (pointer->expr_type == EXPR_VARIABLE)
|
|
|
|
attr = gfc_variable_attr (pointer, NULL);
|
|
|
|
else if (pointer->expr_type == EXPR_FUNCTION)
|
|
|
|
attr = pointer->symtree->n.sym->attr;
|
2006-06-05 09:45:03 +02:00
|
|
|
else if (pointer->expr_type == EXPR_NULL)
|
|
|
|
goto null_arg;
|
2005-12-08 17:56:10 +01:00
|
|
|
else
|
|
|
|
gcc_assert (0); /* Pointer must be a variable or a function. */
|
2004-05-13 08:41:07 +02:00
|
|
|
|
|
|
|
if (!attr.pointer)
|
|
|
|
{
|
re PR fortran/15586 (gfortran should support i18n in its compiler messages)
PR fortran/15586
* arith.c (gfc_arith_error): Change message to include locus.
(check_result, eval_intrinsic, gfc_int2int, gfc_real2real,
gfc_real2complex, gfc_complex2real, gfc_complex2complex): Use
the new gfc_arith_error.
(arith_error): Rewrite full error messages instead of building
them from pieces.
* check.c (must_be): Removed.
(type_check, numeric_check, int_or_real_check, real_or_complex_check,
kind_check, double_check, logical_array_check, array_check,
scalar_check, same_type_check, rank_check, kind_value_check,
variable_check, gfc_check_allocated, gfc_check_associated,
gfc_check_cmplx, gfc_check_dcmplx, gfc_check_dot_product,
gfc_check_index, gfc_check_kind, gfc_check_matmul, gfc_check_null,
gfc_check_pack, gfc_check_precision, gfc_check_present,
gfc_check_spread): Rewrite full error messages instead of
building them from pieces.
* decl.c (gfc_match_entry): Rewrite full error messages instead
of building them from pieces.
* parse.c (gfc_state_name): Remove.
* parse.h: Remove prototype for gfc_state_name.
From-SVN: r105844
2005-10-24 11:11:51 +02:00
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must be a POINTER",
|
|
|
|
gfc_current_intrinsic_arg[0], gfc_current_intrinsic,
|
|
|
|
&pointer->where);
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
2005-12-08 17:56:10 +01:00
|
|
|
/* Target argument is optional. */
|
2004-05-13 08:41:07 +02:00
|
|
|
if (target == NULL)
|
|
|
|
return SUCCESS;
|
|
|
|
|
2006-06-05 09:45:03 +02:00
|
|
|
where = &target->where;
|
2004-05-13 08:41:07 +02:00
|
|
|
if (target->expr_type == EXPR_NULL)
|
2006-06-05 09:45:03 +02:00
|
|
|
goto null_arg;
|
2004-05-13 08:41:07 +02:00
|
|
|
|
2005-12-08 17:56:10 +01:00
|
|
|
if (target->expr_type == EXPR_VARIABLE)
|
|
|
|
attr = gfc_variable_attr (target, NULL);
|
|
|
|
else if (target->expr_type == EXPR_FUNCTION)
|
|
|
|
attr = target->symtree->n.sym->attr;
|
|
|
|
else
|
re PR fortran/25746 (Elemental assignment gives wrong result)
2006-05-21 Paul Thomas <pault@gcc.gnu.org>
PR fortran/25746
* interface.c (gfc_extend_assign): Use new code EXEC_ASSIGN_CALL.
* gfortran.h : Put EXEC_ASSIGN_CALL in enum.
* trans-stmt.c (gfc_conv_elemental_dependencies): New function.
(gfc_trans_call): Call it. Add new boolian argument to flag
need for dependency checking. Assert intent OUT and IN for arg1
and arg2.
(gfc_trans_forall_1): Use new code EXEC_ASSIGN_CALL.
trans-stmt.h : Modify prototype of gfc_trans_call.
trans.c (gfc_trans_code): Add call for EXEC_ASSIGN_CALL.
st.c (gfc_free_statement): Free actual for EXEC_ASSIGN_CALL.
* dependency.c (gfc_check_fncall_dependency): Don't check other
against itself.
PR fortran/25090
* resolve.c : Remove resolving_index_expr.
(entry_parameter): Remove.
(gfc_resolve_expr, resolve_charlen, resolve_fl_variable): Remove
calls to entry_parameter and references to resolving_index_expr.
PR fortran/27584
* check.c (gfc_check_associated): Replace NULL assert with an
error message, since it is possible to generate bad code that
has us fall through to here..
PR fortran/19015
* iresolve.c (maxloc, minloc): If DIM is not present, pass the
rank of ARRAY as the shape of the result. Otherwise, pass the
shape of ARRAY, less the dimension DIM.
(maxval, minval): The same, when DIM is present, otherwise no
change.
2006-05-21 Paul Thomas <pault@gcc.gnu.org>
PR fortran/25746
* gfortran.dg/elemental_subroutine_3.f90: New test.
PR fortran/25090
* gfortran.dg/entry_dummy_ref_1.f90: Remove.
PR fortran/27584
* gfortran.dg/associated_target_1.f90: New test.
PR fortran/19015
* gfortran.dg/maxloc_shape_1.f90: New test.
From-SVN: r113949
2006-05-21 09:35:05 +02:00
|
|
|
{
|
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must be a pointer "
|
|
|
|
"or target VARIABLE or FUNCTION", gfc_current_intrinsic_arg[1],
|
|
|
|
gfc_current_intrinsic, &target->where);
|
|
|
|
return FAILURE;
|
|
|
|
}
|
2005-12-08 17:56:10 +01:00
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
if (!attr.pointer && !attr.target)
|
|
|
|
{
|
re PR fortran/15586 (gfortran should support i18n in its compiler messages)
PR fortran/15586
* arith.c (gfc_arith_error): Change message to include locus.
(check_result, eval_intrinsic, gfc_int2int, gfc_real2real,
gfc_real2complex, gfc_complex2real, gfc_complex2complex): Use
the new gfc_arith_error.
(arith_error): Rewrite full error messages instead of building
them from pieces.
* check.c (must_be): Removed.
(type_check, numeric_check, int_or_real_check, real_or_complex_check,
kind_check, double_check, logical_array_check, array_check,
scalar_check, same_type_check, rank_check, kind_value_check,
variable_check, gfc_check_allocated, gfc_check_associated,
gfc_check_cmplx, gfc_check_dcmplx, gfc_check_dot_product,
gfc_check_index, gfc_check_kind, gfc_check_matmul, gfc_check_null,
gfc_check_pack, gfc_check_precision, gfc_check_present,
gfc_check_spread): Rewrite full error messages instead of
building them from pieces.
* decl.c (gfc_match_entry): Rewrite full error messages instead
of building them from pieces.
* parse.c (gfc_state_name): Remove.
* parse.h: Remove prototype for gfc_state_name.
From-SVN: r105844
2005-10-24 11:11:51 +02:00
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must be a POINTER "
|
|
|
|
"or a TARGET", gfc_current_intrinsic_arg[1],
|
|
|
|
gfc_current_intrinsic, &target->where);
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
t = SUCCESS;
|
|
|
|
if (same_type_check (pointer, 0, target, 1) == FAILURE)
|
|
|
|
t = FAILURE;
|
|
|
|
if (rank_check (target, 0, pointer->rank) == FAILURE)
|
|
|
|
t = FAILURE;
|
|
|
|
if (target->rank > 0)
|
|
|
|
{
|
|
|
|
for (i = 0; i < target->rank; i++)
|
2007-01-07 01:28:29 +01:00
|
|
|
if (target->ref->u.ar.dimen_type[i] == DIMEN_VECTOR)
|
|
|
|
{
|
|
|
|
gfc_error ("Array section with a vector subscript at %L shall not "
|
2005-09-17 20:58:01 +02:00
|
|
|
"be the target of a pointer",
|
2007-01-07 01:28:29 +01:00
|
|
|
&target->where);
|
|
|
|
t = FAILURE;
|
|
|
|
break;
|
|
|
|
}
|
2004-05-13 08:41:07 +02:00
|
|
|
}
|
|
|
|
return t;
|
2006-06-05 09:45:03 +02:00
|
|
|
|
|
|
|
null_arg:
|
|
|
|
|
|
|
|
gfc_error ("NULL pointer at %L is not permitted as actual argument "
|
|
|
|
"of '%s' intrinsic function", where, gfc_current_intrinsic);
|
|
|
|
return FAILURE;
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
}
|
|
|
|
|
|
|
|
|
2004-08-26 19:11:27 +02:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_atan2 (gfc_expr *y, gfc_expr *x)
|
2004-08-26 19:11:27 +02:00
|
|
|
{
|
|
|
|
if (type_check (y, 0, BT_REAL) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
if (same_type_check (y, 0, x, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
arith.c (arctangent2, [...]): Fix whitespace issues.
* arith.c (arctangent2, gfc_arith_init_1, gfc_arith_done_1,
gfc_constant_result, gfc_range_check, gfc_arith_power,
eval_type_intrinsic0, eval_intrinsic_f2, gfc_real2real,
gfc_real2complex, gfc_complex2int, gfc_complex2real,
gfc_complex2complex): Fix whitespace issues.
check.c (must_be, type_check, numeric_check, int_or_real_check,
logical_array_check, array_check, scalar_check, nonoptional_check,
variable_check, dim_check, check_a_kind, gfc_check_a_ikind,
gfc_check_a_xkind, gfc_check_abs, gfc_check_all_any,
gfc_check_allocated, gfc_check_a_p, gfc_check_besn,
gfc_check_btest, gfc_check_char, gfc_check_cmplx, gfc_check_count,
gfc_check_cshift, gfc_check_dcmplx, gfc_check_dble,
gfc_check_digits, gfc_check_dot_product, gfc_check_eoshift,
gfc_check_fnum, gfc_check_g77_math1, gfc_check_huge, gfc_check_i,
gfc_check_iand, gfc_check_ibclr, gfc_check_ibits, gfc_check_ibset,
gfc_check_idnint, gfc_check_ieor, gfc_check_index, gfc_check_int,
gfc_check_ior, gfc_check_ishft, gfc_check_ishftc, gfc_check_kind,
gfc_check_lbound, gfc_check_logical, min_max_args,
gfc_check_min_max_integer, gfc_check_min_max_real,
gfc_check_min_max_double, gfc_check_matmul,
gfc_check_minval_maxval, gfc_check_merge, gfc_check_nearest,
gfc_check_pack, gfc_check_precision, gfc_check_radix,
gfc_check_range, gfc_check_real, gfc_check_repeat,
gfc_check_scale, gfc_check_scan, gfc_check_selected_real_kind,
gfc_check_set_exponent): Fix formatting issues.
(gfc_check_size, gfc_check_sign): Alphabetize function order,
remove whitespace-only line.
(gfc_check_fstat, gfc_check_fstat_sub, gfc_check_stat,
gfc_check_stat_sub, gfc_check_transfer, gfc_check_transpose,
gfc_check_ubound, gfc_check_unpack, gfc_check_verify, gfc_check_x,
gfc_check_cpu_time, gfc_check_date_and_time, gfc_check_mvbits,
gfc_check_random_number, gfc_check_random_seed,
gfc_check_second_sub, gfc_check_system_clock,
gfc_check_getcwd_sub, gfc_check_exit, gfc_check_flush,
gfc_check_umask, gfc_check_umask_sub, gfc_check_unlink,
gfc_check_unlink_sub): Fix formatting issues.
From-SVN: r93093
2005-01-08 23:40:47 +01:00
|
|
|
|
check.c (gfc_check_besn, [...]): New functions.
2004-08-29 Steven G. Kargl <kargls@comcast.net>
Paul Brook <paul@codesourcery.com>
* check.c (gfc_check_besn, gfc_check_g77_math1): New functions.
* f95-lang.c (DO_DEFINE_MATH_BUILTIN): Define.
(DEFINE_MATH_BUILTIN, DEFINE_MATH_BUILTIN_C): Use it.
(build_builtin_fntypes): New function.
(gfc_init_builtin_functions): Use it.
* gfortran.h (enum gfc_generic_isym_id): Add GFC_ISYM_{J,Y}{0,1,N}
and GFC_ISYM_ERF{,C}.
(gfc_c_int_kind): Declare.
* intrinsic.c (add_functions): Add [d]bes* and [d]erf*.
* intrinsic.h (gfc_check_besn, gfc_check_g77_math1, gfc_resolve_besn,
gfc_resolve_g77_math1): Add prototypes.
* resolve.c (gfc_resolve_besn, gfc_resolve_g77_math1): New functions.
* mathbuiltins.def: Add comment. Change third argument. Use
DEFINE_MATH_BUILTIN_C. Add bessel and error functions.
* trans-intrinsic.c (BUILT_IN_FUNCTION): Define.
(DEFINE_MATH_BUILTIN, DEFINE_MATH_BUILTIN_C): Use it.
* trans-types.c (gfc_c_int_kind): Declare.
(gfc_init_kinds): Set it.
testsuite/
* gfortran.dg/g77/README: Update.
* gfortran.dg/g77/erfc.f: Copy from g77.f-torture.
* gfortran.dg/g77/intrinsic-unix-bessel.f: Ditto.
* gfortran.dg/g77/intrinsic-unix-erf.f: Ditto.
libgfortran/
* intrinsics/bessel.c: New file.
* intrinsics/erf.c: New file.
* Makefie.am: Add intrinsics/bessel.c and intrinsics/erf.c.
* configure.ac: Test for C99 Bessel and Error functions.
* Makefile.in: Regenerate.
* config.h.in: Regenerate.
* configure: Regenerate.
Co-Authored-By: Paul Brook <paul@codesourcery.com>
From-SVN: r86727
2004-08-29 17:58:16 +02:00
|
|
|
/* BESJN and BESYN functions. */
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_besn (gfc_expr *n, gfc_expr *x)
|
check.c (gfc_check_besn, [...]): New functions.
2004-08-29 Steven G. Kargl <kargls@comcast.net>
Paul Brook <paul@codesourcery.com>
* check.c (gfc_check_besn, gfc_check_g77_math1): New functions.
* f95-lang.c (DO_DEFINE_MATH_BUILTIN): Define.
(DEFINE_MATH_BUILTIN, DEFINE_MATH_BUILTIN_C): Use it.
(build_builtin_fntypes): New function.
(gfc_init_builtin_functions): Use it.
* gfortran.h (enum gfc_generic_isym_id): Add GFC_ISYM_{J,Y}{0,1,N}
and GFC_ISYM_ERF{,C}.
(gfc_c_int_kind): Declare.
* intrinsic.c (add_functions): Add [d]bes* and [d]erf*.
* intrinsic.h (gfc_check_besn, gfc_check_g77_math1, gfc_resolve_besn,
gfc_resolve_g77_math1): Add prototypes.
* resolve.c (gfc_resolve_besn, gfc_resolve_g77_math1): New functions.
* mathbuiltins.def: Add comment. Change third argument. Use
DEFINE_MATH_BUILTIN_C. Add bessel and error functions.
* trans-intrinsic.c (BUILT_IN_FUNCTION): Define.
(DEFINE_MATH_BUILTIN, DEFINE_MATH_BUILTIN_C): Use it.
* trans-types.c (gfc_c_int_kind): Declare.
(gfc_init_kinds): Set it.
testsuite/
* gfortran.dg/g77/README: Update.
* gfortran.dg/g77/erfc.f: Copy from g77.f-torture.
* gfortran.dg/g77/intrinsic-unix-bessel.f: Ditto.
* gfortran.dg/g77/intrinsic-unix-erf.f: Ditto.
libgfortran/
* intrinsics/bessel.c: New file.
* intrinsics/erf.c: New file.
* Makefie.am: Add intrinsics/bessel.c and intrinsics/erf.c.
* configure.ac: Test for C99 Bessel and Error functions.
* Makefile.in: Regenerate.
* config.h.in: Regenerate.
* configure: Regenerate.
Co-Authored-By: Paul Brook <paul@codesourcery.com>
From-SVN: r86727
2004-08-29 17:58:16 +02:00
|
|
|
{
|
|
|
|
if (type_check (n, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (x, 1, BT_REAL) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_btest (gfc_expr *i, gfc_expr *pos)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (type_check (i, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
if (type_check (pos, 1, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_char (gfc_expr *i, gfc_expr *kind)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (type_check (i, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
if (kind_check (kind, 1, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
Makefile.am: Added new files.
* Makefile.am: Added new files.
* Makefile.in: Regenerate.
* aclocal.m4: Regenerate.
* configure.ac: add checks for signal.h headers file, as well as
following functions: chdir, strerror, getlogin, gethostname, kill,
link, symlink, perror, sleep, time.
* configure: Regenerate.
* intrinsics/chdir.c, intrinsics/gerror.c, intrinsics/getlog.c,
intrinsics/hostnm.c, intrinsics/ierrno.c, intrinsics/kill.c,
intrinsics/link.c, intrinsics/perror.c, intrinsics/rename.c,
intrinsics/sleep.c, intrinsics/symlnk.c, intrinsics/time.c: Newly
implementend g77 intrinsics.
* check.c (gfc_check_chdir, gfc_check_chdir_sub, gfc_check_kill,
gfc_check_kill_sub, gfc_check_link, gfc_check_link_sub,
gfc_check_symlnk, gfc_check_symlnk_sub, gfc_check_rename,
gfc_check_rename_sub, gfc_check_sleep_sub, gfc_check_gerror,
gfc_check_getlog, gfc_check_hostnm, gfc_check_hostnm_sub,
gfc_check_perror): new functions to check newly implemented
g77 intrinsics.
* gfortran.h: adding symbols for new intrinsics.
* intrinsic.c (add_functions): adding new intrinsics.
(add_subroutines): adding new intrinsics.
* intrinsic.h: prototype for all checking and resolving
functions.
* iresolve.c (gfc_resolve_chdir, gfc_resolve_chdir_sub,
gfc_resolve_hostnm, gfc_resolve_ierrno, gfc_resolve_kill,
gfc_resolve_link, gfc_resolve_rename, gfc_resolve_symlnk,
gfc_resolve_time, gfc_resolve_time8, gfc_resolve_rename_sub,
gfc_resolve_kill_sub, gfc_resolve_link_sub,
gfc_resolve_symlnk_sub, gfc_resolve_sleep_sub,
gfc_resolve_gerror, gfc_resolve_getlog, gfc_resolve_hostnm_sub,
gfc_resolve_perror): new functions to resolve intrinsics.
* trans-intrinsic.c (gfc_conv_intrinsic_function): add case
for new symbols.
* g77_intrinsics_funcs.f: New test.
* g77_intrinsics_sub.f: New test.
From-SVN: r96893
2005-03-22 23:08:22 +01:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_chdir (gfc_expr *dir)
|
Makefile.am: Added new files.
* Makefile.am: Added new files.
* Makefile.in: Regenerate.
* aclocal.m4: Regenerate.
* configure.ac: add checks for signal.h headers file, as well as
following functions: chdir, strerror, getlogin, gethostname, kill,
link, symlink, perror, sleep, time.
* configure: Regenerate.
* intrinsics/chdir.c, intrinsics/gerror.c, intrinsics/getlog.c,
intrinsics/hostnm.c, intrinsics/ierrno.c, intrinsics/kill.c,
intrinsics/link.c, intrinsics/perror.c, intrinsics/rename.c,
intrinsics/sleep.c, intrinsics/symlnk.c, intrinsics/time.c: Newly
implementend g77 intrinsics.
* check.c (gfc_check_chdir, gfc_check_chdir_sub, gfc_check_kill,
gfc_check_kill_sub, gfc_check_link, gfc_check_link_sub,
gfc_check_symlnk, gfc_check_symlnk_sub, gfc_check_rename,
gfc_check_rename_sub, gfc_check_sleep_sub, gfc_check_gerror,
gfc_check_getlog, gfc_check_hostnm, gfc_check_hostnm_sub,
gfc_check_perror): new functions to check newly implemented
g77 intrinsics.
* gfortran.h: adding symbols for new intrinsics.
* intrinsic.c (add_functions): adding new intrinsics.
(add_subroutines): adding new intrinsics.
* intrinsic.h: prototype for all checking and resolving
functions.
* iresolve.c (gfc_resolve_chdir, gfc_resolve_chdir_sub,
gfc_resolve_hostnm, gfc_resolve_ierrno, gfc_resolve_kill,
gfc_resolve_link, gfc_resolve_rename, gfc_resolve_symlnk,
gfc_resolve_time, gfc_resolve_time8, gfc_resolve_rename_sub,
gfc_resolve_kill_sub, gfc_resolve_link_sub,
gfc_resolve_symlnk_sub, gfc_resolve_sleep_sub,
gfc_resolve_gerror, gfc_resolve_getlog, gfc_resolve_hostnm_sub,
gfc_resolve_perror): new functions to resolve intrinsics.
* trans-intrinsic.c (gfc_conv_intrinsic_function): add case
for new symbols.
* g77_intrinsics_funcs.f: New test.
* g77_intrinsics_sub.f: New test.
From-SVN: r96893
2005-03-22 23:08:22 +01:00
|
|
|
{
|
|
|
|
if (type_check (dir, 0, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_chdir_sub (gfc_expr *dir, gfc_expr *status)
|
Makefile.am: Added new files.
* Makefile.am: Added new files.
* Makefile.in: Regenerate.
* aclocal.m4: Regenerate.
* configure.ac: add checks for signal.h headers file, as well as
following functions: chdir, strerror, getlogin, gethostname, kill,
link, symlink, perror, sleep, time.
* configure: Regenerate.
* intrinsics/chdir.c, intrinsics/gerror.c, intrinsics/getlog.c,
intrinsics/hostnm.c, intrinsics/ierrno.c, intrinsics/kill.c,
intrinsics/link.c, intrinsics/perror.c, intrinsics/rename.c,
intrinsics/sleep.c, intrinsics/symlnk.c, intrinsics/time.c: Newly
implementend g77 intrinsics.
* check.c (gfc_check_chdir, gfc_check_chdir_sub, gfc_check_kill,
gfc_check_kill_sub, gfc_check_link, gfc_check_link_sub,
gfc_check_symlnk, gfc_check_symlnk_sub, gfc_check_rename,
gfc_check_rename_sub, gfc_check_sleep_sub, gfc_check_gerror,
gfc_check_getlog, gfc_check_hostnm, gfc_check_hostnm_sub,
gfc_check_perror): new functions to check newly implemented
g77 intrinsics.
* gfortran.h: adding symbols for new intrinsics.
* intrinsic.c (add_functions): adding new intrinsics.
(add_subroutines): adding new intrinsics.
* intrinsic.h: prototype for all checking and resolving
functions.
* iresolve.c (gfc_resolve_chdir, gfc_resolve_chdir_sub,
gfc_resolve_hostnm, gfc_resolve_ierrno, gfc_resolve_kill,
gfc_resolve_link, gfc_resolve_rename, gfc_resolve_symlnk,
gfc_resolve_time, gfc_resolve_time8, gfc_resolve_rename_sub,
gfc_resolve_kill_sub, gfc_resolve_link_sub,
gfc_resolve_symlnk_sub, gfc_resolve_sleep_sub,
gfc_resolve_gerror, gfc_resolve_getlog, gfc_resolve_hostnm_sub,
gfc_resolve_perror): new functions to resolve intrinsics.
* trans-intrinsic.c (gfc_conv_intrinsic_function): add case
for new symbols.
* g77_intrinsics_funcs.f: New test.
* g77_intrinsics_sub.f: New test.
From-SVN: r96893
2005-03-22 23:08:22 +01:00
|
|
|
{
|
|
|
|
if (type_check (dir, 0, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (status == NULL)
|
|
|
|
return SUCCESS;
|
|
|
|
|
|
|
|
if (type_check (status, 1, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (status, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
intrinsic.c (add_functions): Add ACCESS, CHMOD, RSHIFT, LSHIFT.
* intrinsic.c (add_functions): Add ACCESS, CHMOD, RSHIFT, LSHIFT.
(add_subroutines): Add LTIME, GMTIME and CHMOD.
* intrinsic.h (gfc_check_access_func, gfc_check_chmod,
gfc_check_chmod_sub, gfc_check_ltime_gmtime, gfc_simplify_rshift,
gfc_simplify_lshift, gfc_resolve_access, gfc_resolve_chmod,
gfc_resolve_rshift, gfc_resolve_lshift, gfc_resolve_chmod_sub,
gfc_resolve_gmtime, gfc_resolve_ltime): Add prototypes.
* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_ACCESS,
GFC_ISYM_CHMOD, GFC_ISYM_LSHIFT, GFC_ISYM_RSHIFT.
* iresolve.c (gfc_resolve_access, gfc_resolve_chmod,
gfc_resolve_rshift, gfc_resolve_lshift, gfc_resolve_chmod_sub,
gfc_resolve_gmtime, gfc_resolve_ltime): New functions.
* check.c (gfc_check_access_func, gfc_check_chmod,
gfc_check_chmod_sub, gfc_check_ltime_gmtime): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_rlshift): New function.
(gfc_conv_intrinsic_function): Add cases for the new GFC_ISYM_*.
* intrinsics/date_and_time.c: Add functions for GMTIME and LTIME.
* intrinsics/access.c: New file.
* intrinsics/chmod.c: New file.
* configure.ac: Add checks for <sys/wait.h>, access, fork,execl
and wait.
* Makefile.am: Add new files intrinsics/access.c and
intrinsics/chmod.c.
* configure: Regenerate.
* config.h.in: Regenerate.
* Makefile.in: Regenerate.
* gcc/testsuite/gfortran.dg/chmod_3.f90: New test.
* gcc/testsuite/gfortran.dg/ltime_gmtime_1.f90: New test.
* gcc/testsuite/gfortran.dg/ltime_gmtime_2.f90: New test.
* gcc/testsuite/gfortran.dg/lrshift_1.f90: New test.
* gcc/testsuite/gfortran.dg/chmod_1.f90: New test.
* gcc/testsuite/gfortran.dg/chmod_2.f90: New test.
From-SVN: r115825
2006-07-30 22:48:00 +02:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_chmod (gfc_expr *name, gfc_expr *mode)
|
intrinsic.c (add_functions): Add ACCESS, CHMOD, RSHIFT, LSHIFT.
* intrinsic.c (add_functions): Add ACCESS, CHMOD, RSHIFT, LSHIFT.
(add_subroutines): Add LTIME, GMTIME and CHMOD.
* intrinsic.h (gfc_check_access_func, gfc_check_chmod,
gfc_check_chmod_sub, gfc_check_ltime_gmtime, gfc_simplify_rshift,
gfc_simplify_lshift, gfc_resolve_access, gfc_resolve_chmod,
gfc_resolve_rshift, gfc_resolve_lshift, gfc_resolve_chmod_sub,
gfc_resolve_gmtime, gfc_resolve_ltime): Add prototypes.
* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_ACCESS,
GFC_ISYM_CHMOD, GFC_ISYM_LSHIFT, GFC_ISYM_RSHIFT.
* iresolve.c (gfc_resolve_access, gfc_resolve_chmod,
gfc_resolve_rshift, gfc_resolve_lshift, gfc_resolve_chmod_sub,
gfc_resolve_gmtime, gfc_resolve_ltime): New functions.
* check.c (gfc_check_access_func, gfc_check_chmod,
gfc_check_chmod_sub, gfc_check_ltime_gmtime): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_rlshift): New function.
(gfc_conv_intrinsic_function): Add cases for the new GFC_ISYM_*.
* intrinsics/date_and_time.c: Add functions for GMTIME and LTIME.
* intrinsics/access.c: New file.
* intrinsics/chmod.c: New file.
* configure.ac: Add checks for <sys/wait.h>, access, fork,execl
and wait.
* Makefile.am: Add new files intrinsics/access.c and
intrinsics/chmod.c.
* configure: Regenerate.
* config.h.in: Regenerate.
* Makefile.in: Regenerate.
* gcc/testsuite/gfortran.dg/chmod_3.f90: New test.
* gcc/testsuite/gfortran.dg/ltime_gmtime_1.f90: New test.
* gcc/testsuite/gfortran.dg/ltime_gmtime_2.f90: New test.
* gcc/testsuite/gfortran.dg/lrshift_1.f90: New test.
* gcc/testsuite/gfortran.dg/chmod_1.f90: New test.
* gcc/testsuite/gfortran.dg/chmod_2.f90: New test.
From-SVN: r115825
2006-07-30 22:48:00 +02:00
|
|
|
{
|
|
|
|
if (type_check (name, 0, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (mode, 1, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_chmod_sub (gfc_expr *name, gfc_expr *mode, gfc_expr *status)
|
intrinsic.c (add_functions): Add ACCESS, CHMOD, RSHIFT, LSHIFT.
* intrinsic.c (add_functions): Add ACCESS, CHMOD, RSHIFT, LSHIFT.
(add_subroutines): Add LTIME, GMTIME and CHMOD.
* intrinsic.h (gfc_check_access_func, gfc_check_chmod,
gfc_check_chmod_sub, gfc_check_ltime_gmtime, gfc_simplify_rshift,
gfc_simplify_lshift, gfc_resolve_access, gfc_resolve_chmod,
gfc_resolve_rshift, gfc_resolve_lshift, gfc_resolve_chmod_sub,
gfc_resolve_gmtime, gfc_resolve_ltime): Add prototypes.
* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_ACCESS,
GFC_ISYM_CHMOD, GFC_ISYM_LSHIFT, GFC_ISYM_RSHIFT.
* iresolve.c (gfc_resolve_access, gfc_resolve_chmod,
gfc_resolve_rshift, gfc_resolve_lshift, gfc_resolve_chmod_sub,
gfc_resolve_gmtime, gfc_resolve_ltime): New functions.
* check.c (gfc_check_access_func, gfc_check_chmod,
gfc_check_chmod_sub, gfc_check_ltime_gmtime): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_rlshift): New function.
(gfc_conv_intrinsic_function): Add cases for the new GFC_ISYM_*.
* intrinsics/date_and_time.c: Add functions for GMTIME and LTIME.
* intrinsics/access.c: New file.
* intrinsics/chmod.c: New file.
* configure.ac: Add checks for <sys/wait.h>, access, fork,execl
and wait.
* Makefile.am: Add new files intrinsics/access.c and
intrinsics/chmod.c.
* configure: Regenerate.
* config.h.in: Regenerate.
* Makefile.in: Regenerate.
* gcc/testsuite/gfortran.dg/chmod_3.f90: New test.
* gcc/testsuite/gfortran.dg/ltime_gmtime_1.f90: New test.
* gcc/testsuite/gfortran.dg/ltime_gmtime_2.f90: New test.
* gcc/testsuite/gfortran.dg/lrshift_1.f90: New test.
* gcc/testsuite/gfortran.dg/chmod_1.f90: New test.
* gcc/testsuite/gfortran.dg/chmod_2.f90: New test.
From-SVN: r115825
2006-07-30 22:48:00 +02:00
|
|
|
{
|
|
|
|
if (type_check (name, 0, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (mode, 1, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (status == NULL)
|
|
|
|
return SUCCESS;
|
|
|
|
|
|
|
|
if (type_check (status, 2, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (status, 2) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_cmplx (gfc_expr *x, gfc_expr *y, gfc_expr *kind)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (numeric_check (x, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (y != NULL)
|
|
|
|
{
|
|
|
|
if (numeric_check (y, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (x->ts.type == BT_COMPLEX)
|
|
|
|
{
|
re PR fortran/15586 (gfortran should support i18n in its compiler messages)
PR fortran/15586
* arith.c (gfc_arith_error): Change message to include locus.
(check_result, eval_intrinsic, gfc_int2int, gfc_real2real,
gfc_real2complex, gfc_complex2real, gfc_complex2complex): Use
the new gfc_arith_error.
(arith_error): Rewrite full error messages instead of building
them from pieces.
* check.c (must_be): Removed.
(type_check, numeric_check, int_or_real_check, real_or_complex_check,
kind_check, double_check, logical_array_check, array_check,
scalar_check, same_type_check, rank_check, kind_value_check,
variable_check, gfc_check_allocated, gfc_check_associated,
gfc_check_cmplx, gfc_check_dcmplx, gfc_check_dot_product,
gfc_check_index, gfc_check_kind, gfc_check_matmul, gfc_check_null,
gfc_check_pack, gfc_check_precision, gfc_check_present,
gfc_check_spread): Rewrite full error messages instead of
building them from pieces.
* decl.c (gfc_match_entry): Rewrite full error messages instead
of building them from pieces.
* parse.c (gfc_state_name): Remove.
* parse.h: Remove prototype for gfc_state_name.
From-SVN: r105844
2005-10-24 11:11:51 +02:00
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must not be "
|
|
|
|
"present if 'x' is COMPLEX", gfc_current_intrinsic_arg[1],
|
|
|
|
gfc_current_intrinsic, &y->where);
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
if (kind_check (kind, 2, BT_COMPLEX) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
fget.c: New file.
* intrinsics/fget.c: New file.
* intrinsics/ftell.c: New file.
* io/unix.c (stream_offset): New function.
* io/io.h: Add prototype for stream_offset.
* Makefile.am: Add intrinsics/fget.c and intrinsics/ftell.c.
* Makefile.in: Regenerate.
* intrinsic.c (add_functions): Add COMPLEX, FTELL, FGETC, FGET,
FPUTC, FPUT, AND, XOR and OR intrinsic functions.
(add_subroutines): Add FGETC, FGET, FPUTC, FPUT and FTELL intrinsic
subroutines.
* gfortran.h: Add GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET,
GFC_ISYM_FGETC, GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL,
GFC_ISYM_OR, GFC_ISYM_XOR.
* iresolve.c (gfc_resolve_and, gfc_resolve_complex,
gfc_resolve_or, gfc_resolve_fgetc, gfc_resolve_fget,
gfc_resolve_fputc, gfc_resolve_fput, gfc_resolve_ftell,
gfc_resolve_xor, gfc_resolve_fgetc_sub, gfc_resolve_fget_sub,
gfc_resolve_fputc_sub, gfc_resolve_fput_sub, gfc_resolve_ftell_sub):
New functions.
* check.c (gfc_check_complex, gfc_check_fgetputc_sub,
gfc_check_fgetputc, gfc_check_fgetput_sub, gfc_check_fgetput,
gfc_check_ftell, gfc_check_ftell_sub, gfc_check_and): New functions.
* simplify.c (gfc_simplify_and, gfc_simplify_complex, gfc_simplify_or,
gfc_simplify_xor): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add cases for
GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET, GFC_ISYM_FGETC,
GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL, GFC_ISYM_OR and
GFC_ISYM_XOR.
* intrinsic.h: Add prototypes for all functions added to iresolve.c,
simplify.c and check.c.
* gfortran.dg/complex_intrinsic_1.f90: New test.
* gfortran.dg/complex_intrinsic_2.f90: New test.
* gfortran.dg/fgetc_1.f90: New test.
* gfortran.dg/fgetc_2.f90: New test.
* gfortran.dg/fgetc_3.f90: New test.
* gfortran.dg/ftell_1.f90: New test.
* gfortran.dg/ftell_2.f90: New test.
* gfortran.dg/gnu_logical_1.F: New test.
* gfortran.dg/gnu_logical_2.f90: New test.
From-SVN: r106859
2005-11-13 10:33:19 +01:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_complex (gfc_expr *x, gfc_expr *y)
|
fget.c: New file.
* intrinsics/fget.c: New file.
* intrinsics/ftell.c: New file.
* io/unix.c (stream_offset): New function.
* io/io.h: Add prototype for stream_offset.
* Makefile.am: Add intrinsics/fget.c and intrinsics/ftell.c.
* Makefile.in: Regenerate.
* intrinsic.c (add_functions): Add COMPLEX, FTELL, FGETC, FGET,
FPUTC, FPUT, AND, XOR and OR intrinsic functions.
(add_subroutines): Add FGETC, FGET, FPUTC, FPUT and FTELL intrinsic
subroutines.
* gfortran.h: Add GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET,
GFC_ISYM_FGETC, GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL,
GFC_ISYM_OR, GFC_ISYM_XOR.
* iresolve.c (gfc_resolve_and, gfc_resolve_complex,
gfc_resolve_or, gfc_resolve_fgetc, gfc_resolve_fget,
gfc_resolve_fputc, gfc_resolve_fput, gfc_resolve_ftell,
gfc_resolve_xor, gfc_resolve_fgetc_sub, gfc_resolve_fget_sub,
gfc_resolve_fputc_sub, gfc_resolve_fput_sub, gfc_resolve_ftell_sub):
New functions.
* check.c (gfc_check_complex, gfc_check_fgetputc_sub,
gfc_check_fgetputc, gfc_check_fgetput_sub, gfc_check_fgetput,
gfc_check_ftell, gfc_check_ftell_sub, gfc_check_and): New functions.
* simplify.c (gfc_simplify_and, gfc_simplify_complex, gfc_simplify_or,
gfc_simplify_xor): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add cases for
GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET, GFC_ISYM_FGETC,
GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL, GFC_ISYM_OR and
GFC_ISYM_XOR.
* intrinsic.h: Add prototypes for all functions added to iresolve.c,
simplify.c and check.c.
* gfortran.dg/complex_intrinsic_1.f90: New test.
* gfortran.dg/complex_intrinsic_2.f90: New test.
* gfortran.dg/fgetc_1.f90: New test.
* gfortran.dg/fgetc_2.f90: New test.
* gfortran.dg/fgetc_3.f90: New test.
* gfortran.dg/ftell_1.f90: New test.
* gfortran.dg/ftell_2.f90: New test.
* gfortran.dg/gnu_logical_1.F: New test.
* gfortran.dg/gnu_logical_2.f90: New test.
From-SVN: r106859
2005-11-13 10:33:19 +01:00
|
|
|
{
|
|
|
|
if (x->ts.type != BT_INTEGER && x->ts.type != BT_REAL)
|
|
|
|
{
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must be INTEGER "
|
|
|
|
"or REAL", gfc_current_intrinsic_arg[0],
|
|
|
|
gfc_current_intrinsic, &x->where);
|
fget.c: New file.
* intrinsics/fget.c: New file.
* intrinsics/ftell.c: New file.
* io/unix.c (stream_offset): New function.
* io/io.h: Add prototype for stream_offset.
* Makefile.am: Add intrinsics/fget.c and intrinsics/ftell.c.
* Makefile.in: Regenerate.
* intrinsic.c (add_functions): Add COMPLEX, FTELL, FGETC, FGET,
FPUTC, FPUT, AND, XOR and OR intrinsic functions.
(add_subroutines): Add FGETC, FGET, FPUTC, FPUT and FTELL intrinsic
subroutines.
* gfortran.h: Add GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET,
GFC_ISYM_FGETC, GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL,
GFC_ISYM_OR, GFC_ISYM_XOR.
* iresolve.c (gfc_resolve_and, gfc_resolve_complex,
gfc_resolve_or, gfc_resolve_fgetc, gfc_resolve_fget,
gfc_resolve_fputc, gfc_resolve_fput, gfc_resolve_ftell,
gfc_resolve_xor, gfc_resolve_fgetc_sub, gfc_resolve_fget_sub,
gfc_resolve_fputc_sub, gfc_resolve_fput_sub, gfc_resolve_ftell_sub):
New functions.
* check.c (gfc_check_complex, gfc_check_fgetputc_sub,
gfc_check_fgetputc, gfc_check_fgetput_sub, gfc_check_fgetput,
gfc_check_ftell, gfc_check_ftell_sub, gfc_check_and): New functions.
* simplify.c (gfc_simplify_and, gfc_simplify_complex, gfc_simplify_or,
gfc_simplify_xor): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add cases for
GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET, GFC_ISYM_FGETC,
GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL, GFC_ISYM_OR and
GFC_ISYM_XOR.
* intrinsic.h: Add prototypes for all functions added to iresolve.c,
simplify.c and check.c.
* gfortran.dg/complex_intrinsic_1.f90: New test.
* gfortran.dg/complex_intrinsic_2.f90: New test.
* gfortran.dg/fgetc_1.f90: New test.
* gfortran.dg/fgetc_2.f90: New test.
* gfortran.dg/fgetc_3.f90: New test.
* gfortran.dg/ftell_1.f90: New test.
* gfortran.dg/ftell_2.f90: New test.
* gfortran.dg/gnu_logical_1.F: New test.
* gfortran.dg/gnu_logical_2.f90: New test.
From-SVN: r106859
2005-11-13 10:33:19 +01:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
if (scalar_check (x, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (y->ts.type != BT_INTEGER && y->ts.type != BT_REAL)
|
|
|
|
{
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must be INTEGER "
|
|
|
|
"or REAL", gfc_current_intrinsic_arg[1],
|
|
|
|
gfc_current_intrinsic, &y->where);
|
fget.c: New file.
* intrinsics/fget.c: New file.
* intrinsics/ftell.c: New file.
* io/unix.c (stream_offset): New function.
* io/io.h: Add prototype for stream_offset.
* Makefile.am: Add intrinsics/fget.c and intrinsics/ftell.c.
* Makefile.in: Regenerate.
* intrinsic.c (add_functions): Add COMPLEX, FTELL, FGETC, FGET,
FPUTC, FPUT, AND, XOR and OR intrinsic functions.
(add_subroutines): Add FGETC, FGET, FPUTC, FPUT and FTELL intrinsic
subroutines.
* gfortran.h: Add GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET,
GFC_ISYM_FGETC, GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL,
GFC_ISYM_OR, GFC_ISYM_XOR.
* iresolve.c (gfc_resolve_and, gfc_resolve_complex,
gfc_resolve_or, gfc_resolve_fgetc, gfc_resolve_fget,
gfc_resolve_fputc, gfc_resolve_fput, gfc_resolve_ftell,
gfc_resolve_xor, gfc_resolve_fgetc_sub, gfc_resolve_fget_sub,
gfc_resolve_fputc_sub, gfc_resolve_fput_sub, gfc_resolve_ftell_sub):
New functions.
* check.c (gfc_check_complex, gfc_check_fgetputc_sub,
gfc_check_fgetputc, gfc_check_fgetput_sub, gfc_check_fgetput,
gfc_check_ftell, gfc_check_ftell_sub, gfc_check_and): New functions.
* simplify.c (gfc_simplify_and, gfc_simplify_complex, gfc_simplify_or,
gfc_simplify_xor): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add cases for
GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET, GFC_ISYM_FGETC,
GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL, GFC_ISYM_OR and
GFC_ISYM_XOR.
* intrinsic.h: Add prototypes for all functions added to iresolve.c,
simplify.c and check.c.
* gfortran.dg/complex_intrinsic_1.f90: New test.
* gfortran.dg/complex_intrinsic_2.f90: New test.
* gfortran.dg/fgetc_1.f90: New test.
* gfortran.dg/fgetc_2.f90: New test.
* gfortran.dg/fgetc_3.f90: New test.
* gfortran.dg/ftell_1.f90: New test.
* gfortran.dg/ftell_2.f90: New test.
* gfortran.dg/gnu_logical_1.F: New test.
* gfortran.dg/gnu_logical_2.f90: New test.
From-SVN: r106859
2005-11-13 10:33:19 +01:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
if (scalar_check (y, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
try
|
re PR fortran/29600 ([F03] MINLOC and MAXLOC take an optional KIND argument)
PR fortran/29600
* intrinsic.c (add_functions): Add KIND arguments to COUNT,
IACHAR, ICHAR, INDEX, LBOUND, LEN, LEN_TRIM, SCAN, SIZE, UBOUND
and VERIFY.
* iresolve.c (gfc_resolve_count): Add kind argument.
(gfc_resolve_iachar): New function.
(gfc_resolve_ichar): Add kind argument.
(gfc_resolve_index_func): Likewise.
(gfc_resolve_lbound): Likewise.
(gfc_resolve_len): Likewise.
(gfc_resolve_len_trim): Likewise.
(gfc_resolve_scan): Likewise.
(gfc_resolve_size): New function.
(gfc_resolve_ubound): Add kind argument.
(gfc_resolve_verify): Likewise.
* trans-decl.c (gfc_get_extern_function_decl): Allow specific
intrinsics to have 4 arguments.
* check.c (gfc_check_count): Add kind argument.
(gfc_check_ichar_iachar): Likewise.
(gfc_check_index): Likewise.
(gfc_check_lbound): Likewise.
(gfc_check_len_lentrim): New function.
(gfc_check_scan): Add kind argument.
(gfc_check_size): Likewise.
(gfc_check_ubound): Likewise.
(gfc_check_verify): Likewise.
* intrinsic.texi: Update documentation for COUNT, IACHAR, ICHAR,
INDEX, LBOUND, LEN, LEN_TRIM, SCAN, SIZE, UBOUND and VERIFY.
* simplify.c (get_kind): Whitespace fix.
(int_expr_with_kind): New function.
(gfc_simplify_iachar): Add kind argument.
(gfc_simplify_iachar): Likewise.
(gfc_simplify_ichar): Likewise.
(gfc_simplify_index): Likewise.
(simplify_bound_dim): Likewise.
(simplify_bound): Likewise.
(gfc_simplify_lbound): Likewise.
(gfc_simplify_len): Likewise.
(gfc_simplify_len_trim): Likewise.
(gfc_simplify_scan): Likewise.
(gfc_simplify_shape): Pass NULL as kind argument to gfc_simplify_size.
(gfc_simplify_size): Add kind argument.
(gfc_simplify_ubound): Likewise.
(gfc_simplify_verify): Likewise.
* intrinsic.h: Update prototypes and add new ones.
* trans-intrinsic.c (gfc_conv_intrinsic_index): Rename into
gfc_conv_intrinsic_index_scan_verify.
(gfc_conv_intrinsic_scan, gfc_conv_intrinsic_verify): Remove.
(gfc_conv_intrinsic_function): Call
gfc_conv_intrinsic_index_scan_verify to translate the INDEX,
SCAN and VERIFY intrinsics.
* gfortran.dg/intrinsics_kind_argument_1.f90: New test.
* gfortran.dg/pure_dummy_length_1.f90: Adapt to new error wording.
From-SVN: r127380
2007-08-12 21:57:01 +02:00
|
|
|
gfc_check_count (gfc_expr *mask, gfc_expr *dim, gfc_expr *kind)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (logical_array_check (mask, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
if (dim_check (dim, 1, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
re PR fortran/29600 ([F03] MINLOC and MAXLOC take an optional KIND argument)
PR fortran/29600
* intrinsic.c (add_functions): Add KIND arguments to COUNT,
IACHAR, ICHAR, INDEX, LBOUND, LEN, LEN_TRIM, SCAN, SIZE, UBOUND
and VERIFY.
* iresolve.c (gfc_resolve_count): Add kind argument.
(gfc_resolve_iachar): New function.
(gfc_resolve_ichar): Add kind argument.
(gfc_resolve_index_func): Likewise.
(gfc_resolve_lbound): Likewise.
(gfc_resolve_len): Likewise.
(gfc_resolve_len_trim): Likewise.
(gfc_resolve_scan): Likewise.
(gfc_resolve_size): New function.
(gfc_resolve_ubound): Add kind argument.
(gfc_resolve_verify): Likewise.
* trans-decl.c (gfc_get_extern_function_decl): Allow specific
intrinsics to have 4 arguments.
* check.c (gfc_check_count): Add kind argument.
(gfc_check_ichar_iachar): Likewise.
(gfc_check_index): Likewise.
(gfc_check_lbound): Likewise.
(gfc_check_len_lentrim): New function.
(gfc_check_scan): Add kind argument.
(gfc_check_size): Likewise.
(gfc_check_ubound): Likewise.
(gfc_check_verify): Likewise.
* intrinsic.texi: Update documentation for COUNT, IACHAR, ICHAR,
INDEX, LBOUND, LEN, LEN_TRIM, SCAN, SIZE, UBOUND and VERIFY.
* simplify.c (get_kind): Whitespace fix.
(int_expr_with_kind): New function.
(gfc_simplify_iachar): Add kind argument.
(gfc_simplify_iachar): Likewise.
(gfc_simplify_ichar): Likewise.
(gfc_simplify_index): Likewise.
(simplify_bound_dim): Likewise.
(simplify_bound): Likewise.
(gfc_simplify_lbound): Likewise.
(gfc_simplify_len): Likewise.
(gfc_simplify_len_trim): Likewise.
(gfc_simplify_scan): Likewise.
(gfc_simplify_shape): Pass NULL as kind argument to gfc_simplify_size.
(gfc_simplify_size): Add kind argument.
(gfc_simplify_ubound): Likewise.
(gfc_simplify_verify): Likewise.
* intrinsic.h: Update prototypes and add new ones.
* trans-intrinsic.c (gfc_conv_intrinsic_index): Rename into
gfc_conv_intrinsic_index_scan_verify.
(gfc_conv_intrinsic_scan, gfc_conv_intrinsic_verify): Remove.
(gfc_conv_intrinsic_function): Call
gfc_conv_intrinsic_index_scan_verify to translate the INDEX,
SCAN and VERIFY intrinsics.
* gfortran.dg/intrinsics_kind_argument_1.f90: New test.
* gfortran.dg/pure_dummy_length_1.f90: Adapt to new error wording.
From-SVN: r127380
2007-08-12 21:57:01 +02:00
|
|
|
if (kind_check (kind, 2, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
|
|
|
|
"with KIND argument at %L",
|
|
|
|
gfc_current_intrinsic, &kind->where) == FAILURE)
|
|
|
|
return FAILURE;
|
2004-05-13 08:41:07 +02:00
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_cshift (gfc_expr *array, gfc_expr *shift, gfc_expr *dim)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (array_check (array, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (array->rank == 1)
|
|
|
|
{
|
|
|
|
if (scalar_check (shift, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
else
|
|
|
|
{
|
|
|
|
/* TODO: more requirements on shift parameter. */
|
|
|
|
}
|
|
|
|
|
|
|
|
if (dim_check (dim, 2, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
intrinsic.c (add_functions): Add ctime and fdate intrinsics.
* intrinsic.c (add_functions): Add ctime and fdate intrinsics.
(add_subroutines): Likewise.
* intrinsic.h: Prototypes for gfc_check_ctime,
gfc_check_ctime_sub, gfc_check_fdate_sub, gfc_resolve_ctime,
gfc_resolve_fdate, gfc_resolve_ctime_sub, gfc_resolve_fdate_sub.
* gfortran.h: Add GFC_ISYM_CTIME and GFC_ISYM_FDATE.
* iresolve.c (gfc_resolve_ctime, gfc_resolve_fdate,
gfc_resolve_ctime_sub, gfc_resolve_fdate_sub): New functions.
* trans-decl.c (gfc_build_intrinsic_function_decls): Add
gfor_fndecl_fdate and gfor_fndecl_ctime.
* check.c (gfc_check_ctime, gfc_check_ctime_sub,
gfc_check_fdate_sub): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_ctime,
gfc_conv_intrinsic_fdate): New functions.
(gfc_conv_intrinsic_function): Add cases for GFC_ISYM_CTIME
and GFC_ISYM_FDATE.
* intrinsic.texi: Documentation for the new CTIME and FDATE
intrinsics.
* trans.h: Declarations for gfor_fndecl_ctime and gfor_fndecl_fdate.
* intrinsics/ctime.c: New file.
* configure.ac: Add check for ctime.
* Makefile.am: Add ctime.c
* configure: Regenerate.
* config.h.in: Regenerate.
* Makefile.in: Regenerate.
From-SVN: r106558
2005-11-06 11:17:04 +01:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_ctime (gfc_expr *time)
|
intrinsic.c (add_functions): Add ctime and fdate intrinsics.
* intrinsic.c (add_functions): Add ctime and fdate intrinsics.
(add_subroutines): Likewise.
* intrinsic.h: Prototypes for gfc_check_ctime,
gfc_check_ctime_sub, gfc_check_fdate_sub, gfc_resolve_ctime,
gfc_resolve_fdate, gfc_resolve_ctime_sub, gfc_resolve_fdate_sub.
* gfortran.h: Add GFC_ISYM_CTIME and GFC_ISYM_FDATE.
* iresolve.c (gfc_resolve_ctime, gfc_resolve_fdate,
gfc_resolve_ctime_sub, gfc_resolve_fdate_sub): New functions.
* trans-decl.c (gfc_build_intrinsic_function_decls): Add
gfor_fndecl_fdate and gfor_fndecl_ctime.
* check.c (gfc_check_ctime, gfc_check_ctime_sub,
gfc_check_fdate_sub): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_ctime,
gfc_conv_intrinsic_fdate): New functions.
(gfc_conv_intrinsic_function): Add cases for GFC_ISYM_CTIME
and GFC_ISYM_FDATE.
* intrinsic.texi: Documentation for the new CTIME and FDATE
intrinsics.
* trans.h: Declarations for gfor_fndecl_ctime and gfor_fndecl_fdate.
* intrinsics/ctime.c: New file.
* configure.ac: Add check for ctime.
* Makefile.am: Add ctime.c
* configure: Regenerate.
* config.h.in: Regenerate.
* Makefile.in: Regenerate.
From-SVN: r106558
2005-11-06 11:17:04 +01:00
|
|
|
{
|
|
|
|
if (scalar_check (time, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (time, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_dcmplx (gfc_expr *x, gfc_expr *y)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (numeric_check (x, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (y != NULL)
|
|
|
|
{
|
|
|
|
if (numeric_check (y, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (x->ts.type == BT_COMPLEX)
|
|
|
|
{
|
re PR fortran/15586 (gfortran should support i18n in its compiler messages)
PR fortran/15586
* arith.c (gfc_arith_error): Change message to include locus.
(check_result, eval_intrinsic, gfc_int2int, gfc_real2real,
gfc_real2complex, gfc_complex2real, gfc_complex2complex): Use
the new gfc_arith_error.
(arith_error): Rewrite full error messages instead of building
them from pieces.
* check.c (must_be): Removed.
(type_check, numeric_check, int_or_real_check, real_or_complex_check,
kind_check, double_check, logical_array_check, array_check,
scalar_check, same_type_check, rank_check, kind_value_check,
variable_check, gfc_check_allocated, gfc_check_associated,
gfc_check_cmplx, gfc_check_dcmplx, gfc_check_dot_product,
gfc_check_index, gfc_check_kind, gfc_check_matmul, gfc_check_null,
gfc_check_pack, gfc_check_precision, gfc_check_present,
gfc_check_spread): Rewrite full error messages instead of
building them from pieces.
* decl.c (gfc_match_entry): Rewrite full error messages instead
of building them from pieces.
* parse.c (gfc_state_name): Remove.
* parse.h: Remove prototype for gfc_state_name.
From-SVN: r105844
2005-10-24 11:11:51 +02:00
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must not be "
|
|
|
|
"present if 'x' is COMPLEX", gfc_current_intrinsic_arg[1],
|
|
|
|
gfc_current_intrinsic, &y->where);
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_dble (gfc_expr *x)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (numeric_check (x, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_digits (gfc_expr *x)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (int_or_real_check (x, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_dot_product (gfc_expr *vector_a, gfc_expr *vector_b)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
switch (vector_a->ts.type)
|
|
|
|
{
|
|
|
|
case BT_LOGICAL:
|
|
|
|
if (type_check (vector_b, 1, BT_LOGICAL) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
break;
|
|
|
|
|
|
|
|
case BT_INTEGER:
|
|
|
|
case BT_REAL:
|
|
|
|
case BT_COMPLEX:
|
|
|
|
if (numeric_check (vector_b, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
break;
|
|
|
|
|
|
|
|
default:
|
re PR fortran/15586 (gfortran should support i18n in its compiler messages)
PR fortran/15586
* arith.c (gfc_arith_error): Change message to include locus.
(check_result, eval_intrinsic, gfc_int2int, gfc_real2real,
gfc_real2complex, gfc_complex2real, gfc_complex2complex): Use
the new gfc_arith_error.
(arith_error): Rewrite full error messages instead of building
them from pieces.
* check.c (must_be): Removed.
(type_check, numeric_check, int_or_real_check, real_or_complex_check,
kind_check, double_check, logical_array_check, array_check,
scalar_check, same_type_check, rank_check, kind_value_check,
variable_check, gfc_check_allocated, gfc_check_associated,
gfc_check_cmplx, gfc_check_dcmplx, gfc_check_dot_product,
gfc_check_index, gfc_check_kind, gfc_check_matmul, gfc_check_null,
gfc_check_pack, gfc_check_precision, gfc_check_present,
gfc_check_spread): Rewrite full error messages instead of
building them from pieces.
* decl.c (gfc_match_entry): Rewrite full error messages instead
of building them from pieces.
* parse.c (gfc_state_name): Remove.
* parse.h: Remove prototype for gfc_state_name.
From-SVN: r105844
2005-10-24 11:11:51 +02:00
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must be numeric "
|
|
|
|
"or LOGICAL", gfc_current_intrinsic_arg[0],
|
|
|
|
gfc_current_intrinsic, &vector_a->where);
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
if (rank_check (vector_a, 0, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (rank_check (vector_b, 1, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
2006-02-04 23:11:57 +01:00
|
|
|
if (! identical_dimen_shape (vector_a, 0, vector_b, 0))
|
|
|
|
{
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_error ("different shape for arguments '%s' and '%s' at %L for "
|
|
|
|
"intrinsic 'dot_product'", gfc_current_intrinsic_arg[0],
|
|
|
|
gfc_current_intrinsic_arg[1], &vector_a->where);
|
2006-02-04 23:11:57 +01:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary,
|
|
|
|
gfc_expr *dim)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (array_check (array, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (shift, 1, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (array->rank == 1)
|
|
|
|
{
|
|
|
|
if (scalar_check (shift, 2) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
else
|
|
|
|
{
|
|
|
|
/* TODO: more weird restrictions on shift. */
|
|
|
|
}
|
|
|
|
|
|
|
|
if (boundary != NULL)
|
|
|
|
{
|
|
|
|
if (same_type_check (array, 0, boundary, 2) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
/* TODO: more restrictions on boundary. */
|
|
|
|
}
|
|
|
|
|
|
|
|
if (dim_check (dim, 1, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2005-01-29 18:46:34 +01:00
|
|
|
/* A single complex argument. */
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_fn_c (gfc_expr *a)
|
2005-01-29 18:46:34 +01:00
|
|
|
{
|
|
|
|
if (type_check (a, 0, BT_COMPLEX) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
/* A single real argument. */
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_fn_r (gfc_expr *a)
|
2005-01-29 18:46:34 +01:00
|
|
|
{
|
|
|
|
if (type_check (a, 0, BT_REAL) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
/* A single real or complex argument. */
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_fn_rc (gfc_expr *a)
|
2005-01-29 18:46:34 +01:00
|
|
|
{
|
|
|
|
if (real_or_complex_check (a, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
flush.c: New file.
2004-12-02 Steven G. Kargl <kargls@comcast.net>
Paul Brook <paul@codesourcery.com>
libgfortran/
* intrinsics/flush.c: New file.
* intrinsics/fnum.c: ditto
* intrinsics/stat.c: ditto
* io/io.h (unit_to_fd): Add prototype.
* io/unix.c (unit_to_fd): New function.
* configure.ac: Add test for members of struct stat. Check for
sys/types.h and sys/stat.h
* Makefile.am: Add intrinsics/{flush.c,fnum.c,stat.c}
* configure.in: Regenerate.
* config.h.in: Regenerate.
* Makefile.in: Regenerate.
fortran/
* check.c (gfc_check_flush, gfc_check_fnum): New functions.
(gfc_check_fstat, gfc_check_fstat_sub): New functions.
(gfc_check_stat, gfc_check_stat_sub): New functions.
* gfortran.h (GFC_ISYM_FNUM,GFC_ISYM_FSTAT,GFC_ISYM_STAT): New symbols
* intrinsic.c (add_functions,add_subroutines): Add flush, fnum,
fstat, and stat to intrinsics symbol tables.
* intrinsic.h (gfc_check_flush, gfc_resolve_stat_sub): Add prototypes.
(gfc_resolve_fstat_sub, gfc_resolve_stat): Ditto.
* iresolve.c (gfc_resolve_fnum, gfc_resolve_fstat): New functions.
(gfc_resolve_stat, gfc_resolve_flush): New functions.
(gfc_resolve_stat_sub,gfc_resolve_fstat_sub): New functions
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add new intrinsics.
Co-Authored-By: Paul Brook <paul@codesourcery.com>
From-SVN: r91609
2004-12-02 05:10:26 +01:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_fnum (gfc_expr *unit)
|
flush.c: New file.
2004-12-02 Steven G. Kargl <kargls@comcast.net>
Paul Brook <paul@codesourcery.com>
libgfortran/
* intrinsics/flush.c: New file.
* intrinsics/fnum.c: ditto
* intrinsics/stat.c: ditto
* io/io.h (unit_to_fd): Add prototype.
* io/unix.c (unit_to_fd): New function.
* configure.ac: Add test for members of struct stat. Check for
sys/types.h and sys/stat.h
* Makefile.am: Add intrinsics/{flush.c,fnum.c,stat.c}
* configure.in: Regenerate.
* config.h.in: Regenerate.
* Makefile.in: Regenerate.
fortran/
* check.c (gfc_check_flush, gfc_check_fnum): New functions.
(gfc_check_fstat, gfc_check_fstat_sub): New functions.
(gfc_check_stat, gfc_check_stat_sub): New functions.
* gfortran.h (GFC_ISYM_FNUM,GFC_ISYM_FSTAT,GFC_ISYM_STAT): New symbols
* intrinsic.c (add_functions,add_subroutines): Add flush, fnum,
fstat, and stat to intrinsics symbol tables.
* intrinsic.h (gfc_check_flush, gfc_resolve_stat_sub): Add prototypes.
(gfc_resolve_fstat_sub, gfc_resolve_stat): Ditto.
* iresolve.c (gfc_resolve_fnum, gfc_resolve_fstat): New functions.
(gfc_resolve_stat, gfc_resolve_flush): New functions.
(gfc_resolve_stat_sub,gfc_resolve_fstat_sub): New functions
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add new intrinsics.
Co-Authored-By: Paul Brook <paul@codesourcery.com>
From-SVN: r91609
2004-12-02 05:10:26 +01:00
|
|
|
{
|
|
|
|
if (type_check (unit, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (unit, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_huge (gfc_expr *x)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (int_or_real_check (x, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
/* Check that the single argument is an integer. */
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_i (gfc_expr *i)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (type_check (i, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_iand (gfc_expr *i, gfc_expr *j)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
2004-12-12 22:09:09 +01:00
|
|
|
if (type_check (i, 0, BT_INTEGER) == FAILURE)
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
|
2004-12-12 22:09:09 +01:00
|
|
|
if (type_check (j, 1, BT_INTEGER) == FAILURE)
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
|
2004-12-12 22:09:09 +01:00
|
|
|
if (i->ts.kind != j->ts.kind)
|
|
|
|
{
|
|
|
|
if (gfc_notify_std (GFC_STD_GNU, "Extension: Different type kinds at %L",
|
2007-01-07 01:28:29 +01:00
|
|
|
&i->where) == FAILURE)
|
2004-12-12 22:09:09 +01:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_ibclr (gfc_expr *i, gfc_expr *pos)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
2004-12-12 22:09:09 +01:00
|
|
|
if (type_check (i, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (pos, 1, BT_INTEGER) == FAILURE)
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_ibits (gfc_expr *i, gfc_expr *pos, gfc_expr *len)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
2004-12-12 22:09:09 +01:00
|
|
|
if (type_check (i, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (pos, 1, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (len, 2, BT_INTEGER) == FAILURE)
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_ibset (gfc_expr *i, gfc_expr *pos)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
2004-12-12 22:09:09 +01:00
|
|
|
if (type_check (i, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (pos, 1, BT_INTEGER) == FAILURE)
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2005-04-25 02:09:11 +02:00
|
|
|
try
|
re PR fortran/29600 ([F03] MINLOC and MAXLOC take an optional KIND argument)
PR fortran/29600
* intrinsic.c (add_functions): Add KIND arguments to COUNT,
IACHAR, ICHAR, INDEX, LBOUND, LEN, LEN_TRIM, SCAN, SIZE, UBOUND
and VERIFY.
* iresolve.c (gfc_resolve_count): Add kind argument.
(gfc_resolve_iachar): New function.
(gfc_resolve_ichar): Add kind argument.
(gfc_resolve_index_func): Likewise.
(gfc_resolve_lbound): Likewise.
(gfc_resolve_len): Likewise.
(gfc_resolve_len_trim): Likewise.
(gfc_resolve_scan): Likewise.
(gfc_resolve_size): New function.
(gfc_resolve_ubound): Add kind argument.
(gfc_resolve_verify): Likewise.
* trans-decl.c (gfc_get_extern_function_decl): Allow specific
intrinsics to have 4 arguments.
* check.c (gfc_check_count): Add kind argument.
(gfc_check_ichar_iachar): Likewise.
(gfc_check_index): Likewise.
(gfc_check_lbound): Likewise.
(gfc_check_len_lentrim): New function.
(gfc_check_scan): Add kind argument.
(gfc_check_size): Likewise.
(gfc_check_ubound): Likewise.
(gfc_check_verify): Likewise.
* intrinsic.texi: Update documentation for COUNT, IACHAR, ICHAR,
INDEX, LBOUND, LEN, LEN_TRIM, SCAN, SIZE, UBOUND and VERIFY.
* simplify.c (get_kind): Whitespace fix.
(int_expr_with_kind): New function.
(gfc_simplify_iachar): Add kind argument.
(gfc_simplify_iachar): Likewise.
(gfc_simplify_ichar): Likewise.
(gfc_simplify_index): Likewise.
(simplify_bound_dim): Likewise.
(simplify_bound): Likewise.
(gfc_simplify_lbound): Likewise.
(gfc_simplify_len): Likewise.
(gfc_simplify_len_trim): Likewise.
(gfc_simplify_scan): Likewise.
(gfc_simplify_shape): Pass NULL as kind argument to gfc_simplify_size.
(gfc_simplify_size): Add kind argument.
(gfc_simplify_ubound): Likewise.
(gfc_simplify_verify): Likewise.
* intrinsic.h: Update prototypes and add new ones.
* trans-intrinsic.c (gfc_conv_intrinsic_index): Rename into
gfc_conv_intrinsic_index_scan_verify.
(gfc_conv_intrinsic_scan, gfc_conv_intrinsic_verify): Remove.
(gfc_conv_intrinsic_function): Call
gfc_conv_intrinsic_index_scan_verify to translate the INDEX,
SCAN and VERIFY intrinsics.
* gfortran.dg/intrinsics_kind_argument_1.f90: New test.
* gfortran.dg/pure_dummy_length_1.f90: Adapt to new error wording.
From-SVN: r127380
2007-08-12 21:57:01 +02:00
|
|
|
gfc_check_ichar_iachar (gfc_expr *c, gfc_expr *kind)
|
2005-04-25 02:09:11 +02:00
|
|
|
{
|
|
|
|
int i;
|
|
|
|
|
|
|
|
if (type_check (c, 0, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
re PR fortran/29600 ([F03] MINLOC and MAXLOC take an optional KIND argument)
PR fortran/29600
* intrinsic.c (add_functions): Add KIND arguments to COUNT,
IACHAR, ICHAR, INDEX, LBOUND, LEN, LEN_TRIM, SCAN, SIZE, UBOUND
and VERIFY.
* iresolve.c (gfc_resolve_count): Add kind argument.
(gfc_resolve_iachar): New function.
(gfc_resolve_ichar): Add kind argument.
(gfc_resolve_index_func): Likewise.
(gfc_resolve_lbound): Likewise.
(gfc_resolve_len): Likewise.
(gfc_resolve_len_trim): Likewise.
(gfc_resolve_scan): Likewise.
(gfc_resolve_size): New function.
(gfc_resolve_ubound): Add kind argument.
(gfc_resolve_verify): Likewise.
* trans-decl.c (gfc_get_extern_function_decl): Allow specific
intrinsics to have 4 arguments.
* check.c (gfc_check_count): Add kind argument.
(gfc_check_ichar_iachar): Likewise.
(gfc_check_index): Likewise.
(gfc_check_lbound): Likewise.
(gfc_check_len_lentrim): New function.
(gfc_check_scan): Add kind argument.
(gfc_check_size): Likewise.
(gfc_check_ubound): Likewise.
(gfc_check_verify): Likewise.
* intrinsic.texi: Update documentation for COUNT, IACHAR, ICHAR,
INDEX, LBOUND, LEN, LEN_TRIM, SCAN, SIZE, UBOUND and VERIFY.
* simplify.c (get_kind): Whitespace fix.
(int_expr_with_kind): New function.
(gfc_simplify_iachar): Add kind argument.
(gfc_simplify_iachar): Likewise.
(gfc_simplify_ichar): Likewise.
(gfc_simplify_index): Likewise.
(simplify_bound_dim): Likewise.
(simplify_bound): Likewise.
(gfc_simplify_lbound): Likewise.
(gfc_simplify_len): Likewise.
(gfc_simplify_len_trim): Likewise.
(gfc_simplify_scan): Likewise.
(gfc_simplify_shape): Pass NULL as kind argument to gfc_simplify_size.
(gfc_simplify_size): Add kind argument.
(gfc_simplify_ubound): Likewise.
(gfc_simplify_verify): Likewise.
* intrinsic.h: Update prototypes and add new ones.
* trans-intrinsic.c (gfc_conv_intrinsic_index): Rename into
gfc_conv_intrinsic_index_scan_verify.
(gfc_conv_intrinsic_scan, gfc_conv_intrinsic_verify): Remove.
(gfc_conv_intrinsic_function): Call
gfc_conv_intrinsic_index_scan_verify to translate the INDEX,
SCAN and VERIFY intrinsics.
* gfortran.dg/intrinsics_kind_argument_1.f90: New test.
* gfortran.dg/pure_dummy_length_1.f90: Adapt to new error wording.
From-SVN: r127380
2007-08-12 21:57:01 +02:00
|
|
|
if (kind_check (kind, 1, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
|
|
|
|
"with KIND argument at %L",
|
|
|
|
gfc_current_intrinsic, &kind->where) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
2005-10-24 00:16:38 +02:00
|
|
|
if (c->expr_type == EXPR_VARIABLE || c->expr_type == EXPR_SUBSTRING)
|
2005-04-25 02:09:11 +02:00
|
|
|
{
|
|
|
|
gfc_expr *start;
|
|
|
|
gfc_expr *end;
|
|
|
|
gfc_ref *ref;
|
|
|
|
|
|
|
|
/* Substring references don't have the charlength set. */
|
|
|
|
ref = c->ref;
|
|
|
|
while (ref && ref->type != REF_SUBSTRING)
|
|
|
|
ref = ref->next;
|
|
|
|
|
|
|
|
gcc_assert (ref == NULL || ref->type == REF_SUBSTRING);
|
|
|
|
|
|
|
|
if (!ref)
|
2005-10-24 00:16:38 +02:00
|
|
|
{
|
2007-01-07 01:28:29 +01:00
|
|
|
/* Check that the argument is length one. Non-constant lengths
|
2006-05-28 19:56:58 +02:00
|
|
|
can't be checked here, so assume they are ok. */
|
2005-10-24 00:16:38 +02:00
|
|
|
if (c->ts.cl && c->ts.cl->length)
|
|
|
|
{
|
|
|
|
/* If we already have a length for this expression then use it. */
|
|
|
|
if (c->ts.cl->length->expr_type != EXPR_CONSTANT)
|
|
|
|
return SUCCESS;
|
|
|
|
i = mpz_get_si (c->ts.cl->length->value.integer);
|
|
|
|
}
|
|
|
|
else
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
else
|
|
|
|
{
|
|
|
|
start = ref->u.ss.start;
|
|
|
|
end = ref->u.ss.end;
|
2005-04-25 02:09:11 +02:00
|
|
|
|
2005-10-24 00:16:38 +02:00
|
|
|
gcc_assert (start);
|
|
|
|
if (end == NULL || end->expr_type != EXPR_CONSTANT
|
|
|
|
|| start->expr_type != EXPR_CONSTANT)
|
|
|
|
return SUCCESS;
|
2005-04-25 02:09:11 +02:00
|
|
|
|
2005-10-24 00:16:38 +02:00
|
|
|
i = mpz_get_si (end->value.integer) + 1
|
2007-01-07 01:28:29 +01:00
|
|
|
- mpz_get_si (start->value.integer);
|
2005-10-24 00:16:38 +02:00
|
|
|
}
|
2005-04-25 02:09:11 +02:00
|
|
|
}
|
|
|
|
else
|
|
|
|
return SUCCESS;
|
|
|
|
|
|
|
|
if (i != 1)
|
|
|
|
{
|
|
|
|
gfc_error ("Argument of %s at %L must be of length one",
|
|
|
|
gfc_current_intrinsic, &c->where);
|
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_idnint (gfc_expr *a)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (double_check (a, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_ieor (gfc_expr *i, gfc_expr *j)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
2004-12-12 22:09:09 +01:00
|
|
|
if (type_check (i, 0, BT_INTEGER) == FAILURE)
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
|
2004-12-12 22:09:09 +01:00
|
|
|
if (type_check (j, 1, BT_INTEGER) == FAILURE)
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
|
2004-12-12 22:09:09 +01:00
|
|
|
if (i->ts.kind != j->ts.kind)
|
|
|
|
{
|
|
|
|
if (gfc_notify_std (GFC_STD_GNU, "Extension: Different type kinds at %L",
|
2007-01-07 01:28:29 +01:00
|
|
|
&i->where) == FAILURE)
|
2004-12-12 22:09:09 +01:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
re PR fortran/29600 ([F03] MINLOC and MAXLOC take an optional KIND argument)
PR fortran/29600
* intrinsic.c (add_functions): Add KIND arguments to COUNT,
IACHAR, ICHAR, INDEX, LBOUND, LEN, LEN_TRIM, SCAN, SIZE, UBOUND
and VERIFY.
* iresolve.c (gfc_resolve_count): Add kind argument.
(gfc_resolve_iachar): New function.
(gfc_resolve_ichar): Add kind argument.
(gfc_resolve_index_func): Likewise.
(gfc_resolve_lbound): Likewise.
(gfc_resolve_len): Likewise.
(gfc_resolve_len_trim): Likewise.
(gfc_resolve_scan): Likewise.
(gfc_resolve_size): New function.
(gfc_resolve_ubound): Add kind argument.
(gfc_resolve_verify): Likewise.
* trans-decl.c (gfc_get_extern_function_decl): Allow specific
intrinsics to have 4 arguments.
* check.c (gfc_check_count): Add kind argument.
(gfc_check_ichar_iachar): Likewise.
(gfc_check_index): Likewise.
(gfc_check_lbound): Likewise.
(gfc_check_len_lentrim): New function.
(gfc_check_scan): Add kind argument.
(gfc_check_size): Likewise.
(gfc_check_ubound): Likewise.
(gfc_check_verify): Likewise.
* intrinsic.texi: Update documentation for COUNT, IACHAR, ICHAR,
INDEX, LBOUND, LEN, LEN_TRIM, SCAN, SIZE, UBOUND and VERIFY.
* simplify.c (get_kind): Whitespace fix.
(int_expr_with_kind): New function.
(gfc_simplify_iachar): Add kind argument.
(gfc_simplify_iachar): Likewise.
(gfc_simplify_ichar): Likewise.
(gfc_simplify_index): Likewise.
(simplify_bound_dim): Likewise.
(simplify_bound): Likewise.
(gfc_simplify_lbound): Likewise.
(gfc_simplify_len): Likewise.
(gfc_simplify_len_trim): Likewise.
(gfc_simplify_scan): Likewise.
(gfc_simplify_shape): Pass NULL as kind argument to gfc_simplify_size.
(gfc_simplify_size): Add kind argument.
(gfc_simplify_ubound): Likewise.
(gfc_simplify_verify): Likewise.
* intrinsic.h: Update prototypes and add new ones.
* trans-intrinsic.c (gfc_conv_intrinsic_index): Rename into
gfc_conv_intrinsic_index_scan_verify.
(gfc_conv_intrinsic_scan, gfc_conv_intrinsic_verify): Remove.
(gfc_conv_intrinsic_function): Call
gfc_conv_intrinsic_index_scan_verify to translate the INDEX,
SCAN and VERIFY intrinsics.
* gfortran.dg/intrinsics_kind_argument_1.f90: New test.
* gfortran.dg/pure_dummy_length_1.f90: Adapt to new error wording.
From-SVN: r127380
2007-08-12 21:57:01 +02:00
|
|
|
gfc_check_index (gfc_expr *string, gfc_expr *substring, gfc_expr *back,
|
|
|
|
gfc_expr *kind)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (type_check (string, 0, BT_CHARACTER) == FAILURE
|
|
|
|
|| type_check (substring, 1, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (back != NULL && type_check (back, 2, BT_LOGICAL) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
re PR fortran/29600 ([F03] MINLOC and MAXLOC take an optional KIND argument)
PR fortran/29600
* intrinsic.c (add_functions): Add KIND arguments to COUNT,
IACHAR, ICHAR, INDEX, LBOUND, LEN, LEN_TRIM, SCAN, SIZE, UBOUND
and VERIFY.
* iresolve.c (gfc_resolve_count): Add kind argument.
(gfc_resolve_iachar): New function.
(gfc_resolve_ichar): Add kind argument.
(gfc_resolve_index_func): Likewise.
(gfc_resolve_lbound): Likewise.
(gfc_resolve_len): Likewise.
(gfc_resolve_len_trim): Likewise.
(gfc_resolve_scan): Likewise.
(gfc_resolve_size): New function.
(gfc_resolve_ubound): Add kind argument.
(gfc_resolve_verify): Likewise.
* trans-decl.c (gfc_get_extern_function_decl): Allow specific
intrinsics to have 4 arguments.
* check.c (gfc_check_count): Add kind argument.
(gfc_check_ichar_iachar): Likewise.
(gfc_check_index): Likewise.
(gfc_check_lbound): Likewise.
(gfc_check_len_lentrim): New function.
(gfc_check_scan): Add kind argument.
(gfc_check_size): Likewise.
(gfc_check_ubound): Likewise.
(gfc_check_verify): Likewise.
* intrinsic.texi: Update documentation for COUNT, IACHAR, ICHAR,
INDEX, LBOUND, LEN, LEN_TRIM, SCAN, SIZE, UBOUND and VERIFY.
* simplify.c (get_kind): Whitespace fix.
(int_expr_with_kind): New function.
(gfc_simplify_iachar): Add kind argument.
(gfc_simplify_iachar): Likewise.
(gfc_simplify_ichar): Likewise.
(gfc_simplify_index): Likewise.
(simplify_bound_dim): Likewise.
(simplify_bound): Likewise.
(gfc_simplify_lbound): Likewise.
(gfc_simplify_len): Likewise.
(gfc_simplify_len_trim): Likewise.
(gfc_simplify_scan): Likewise.
(gfc_simplify_shape): Pass NULL as kind argument to gfc_simplify_size.
(gfc_simplify_size): Add kind argument.
(gfc_simplify_ubound): Likewise.
(gfc_simplify_verify): Likewise.
* intrinsic.h: Update prototypes and add new ones.
* trans-intrinsic.c (gfc_conv_intrinsic_index): Rename into
gfc_conv_intrinsic_index_scan_verify.
(gfc_conv_intrinsic_scan, gfc_conv_intrinsic_verify): Remove.
(gfc_conv_intrinsic_function): Call
gfc_conv_intrinsic_index_scan_verify to translate the INDEX,
SCAN and VERIFY intrinsics.
* gfortran.dg/intrinsics_kind_argument_1.f90: New test.
* gfortran.dg/pure_dummy_length_1.f90: Adapt to new error wording.
From-SVN: r127380
2007-08-12 21:57:01 +02:00
|
|
|
if (kind_check (kind, 3, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
|
|
|
|
"with KIND argument at %L",
|
|
|
|
gfc_current_intrinsic, &kind->where) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
if (string->ts.kind != substring->ts.kind)
|
|
|
|
{
|
re PR fortran/15586 (gfortran should support i18n in its compiler messages)
PR fortran/15586
* arith.c (gfc_arith_error): Change message to include locus.
(check_result, eval_intrinsic, gfc_int2int, gfc_real2real,
gfc_real2complex, gfc_complex2real, gfc_complex2complex): Use
the new gfc_arith_error.
(arith_error): Rewrite full error messages instead of building
them from pieces.
* check.c (must_be): Removed.
(type_check, numeric_check, int_or_real_check, real_or_complex_check,
kind_check, double_check, logical_array_check, array_check,
scalar_check, same_type_check, rank_check, kind_value_check,
variable_check, gfc_check_allocated, gfc_check_associated,
gfc_check_cmplx, gfc_check_dcmplx, gfc_check_dot_product,
gfc_check_index, gfc_check_kind, gfc_check_matmul, gfc_check_null,
gfc_check_pack, gfc_check_precision, gfc_check_present,
gfc_check_spread): Rewrite full error messages instead of
building them from pieces.
* decl.c (gfc_match_entry): Rewrite full error messages instead
of building them from pieces.
* parse.c (gfc_state_name): Remove.
* parse.h: Remove prototype for gfc_state_name.
From-SVN: r105844
2005-10-24 11:11:51 +02:00
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must be the same "
|
|
|
|
"kind as '%s'", gfc_current_intrinsic_arg[1],
|
|
|
|
gfc_current_intrinsic, &substring->where,
|
|
|
|
gfc_current_intrinsic_arg[0]);
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_int (gfc_expr *x, gfc_expr *kind)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
2005-02-19 21:07:47 +01:00
|
|
|
if (numeric_check (x, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (kind != NULL)
|
|
|
|
{
|
|
|
|
if (type_check (kind, 1, BT_INTEGER) == FAILURE)
|
2007-01-07 01:28:29 +01:00
|
|
|
return FAILURE;
|
2004-05-13 08:41:07 +02:00
|
|
|
|
2005-02-19 21:07:47 +01:00
|
|
|
if (scalar_check (kind, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
intrinsic.c (add_functions): Add INT2, SHORT, INT8, LONG, LSTAT, MCLOCK and MCLOCK8 intrinsic functions.
* intrinsic.c (add_functions): Add INT2, SHORT, INT8, LONG,
LSTAT, MCLOCK and MCLOCK8 intrinsic functions.
(add_subroutines): Add LSTAT intrinsic subroutine.
* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_INT2,
GFC_ISYM_INT8, GFC_ISYM_LONG, GFC_ISYM_LSTAT, GFC_ISYM_MCLOCK
and GFC_ISYM_MCLOCK8.
* iresolve.c (gfc_resolve_int2, gfc_resolve_int8,
gfc_resolve_long, gfc_resolve_lstat, gfc_resolve_mclock,
gfc_resolve_mclock8, gfc_resolve_lstat_sub): New functions.
* check.c (gfc_check_intconv): New function.
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add cases for
the added GFC_ISYM_*.
* simplify.c (gfc_simplify_intconv, gfc_simplify_int2,
gfc_simplify_int8, gfc_simplify_long): New functions.
* intrinsic.h (gfc_check_intconv, gfc_simplify_int2,
gfc_simplify_int8, gfc_simplify_long, gfc_resolve_int2,
gfc_resolve_int8, gfc_resolve_long, gfc_resolve_lstat,
gfc_resolve_mclock, gfc_resolve_mclock8, gfc_resolve_lstat_sub):
Add prototypes.
* gfortran.dg/mclock.f90: New test.
* gfortran.dg/int_conv_1.f90: New test.
* gfortran.dg/stat_1.f90: New test.
* gfortran.dg/stat_2.f90: New test.
* configure.ac: Check for function clock.
* Makefile.am: Compile new file intrinsics/clock.c.
* intrinsics/clock.c: New file.
* Makefile.in: Regenerate.
* configure: Regenerate.
* config.h.in: Regenerate.
* intrinsics/stat.c: Rename the old stat_i?_sub functions to
helper functions stat_i?_sub_0, and use them for both STAT and
LSTAT.
From-SVN: r115754
2006-07-26 13:58:48 +02:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_intconv (gfc_expr *x)
|
intrinsic.c (add_functions): Add INT2, SHORT, INT8, LONG, LSTAT, MCLOCK and MCLOCK8 intrinsic functions.
* intrinsic.c (add_functions): Add INT2, SHORT, INT8, LONG,
LSTAT, MCLOCK and MCLOCK8 intrinsic functions.
(add_subroutines): Add LSTAT intrinsic subroutine.
* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_INT2,
GFC_ISYM_INT8, GFC_ISYM_LONG, GFC_ISYM_LSTAT, GFC_ISYM_MCLOCK
and GFC_ISYM_MCLOCK8.
* iresolve.c (gfc_resolve_int2, gfc_resolve_int8,
gfc_resolve_long, gfc_resolve_lstat, gfc_resolve_mclock,
gfc_resolve_mclock8, gfc_resolve_lstat_sub): New functions.
* check.c (gfc_check_intconv): New function.
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add cases for
the added GFC_ISYM_*.
* simplify.c (gfc_simplify_intconv, gfc_simplify_int2,
gfc_simplify_int8, gfc_simplify_long): New functions.
* intrinsic.h (gfc_check_intconv, gfc_simplify_int2,
gfc_simplify_int8, gfc_simplify_long, gfc_resolve_int2,
gfc_resolve_int8, gfc_resolve_long, gfc_resolve_lstat,
gfc_resolve_mclock, gfc_resolve_mclock8, gfc_resolve_lstat_sub):
Add prototypes.
* gfortran.dg/mclock.f90: New test.
* gfortran.dg/int_conv_1.f90: New test.
* gfortran.dg/stat_1.f90: New test.
* gfortran.dg/stat_2.f90: New test.
* configure.ac: Check for function clock.
* Makefile.am: Compile new file intrinsics/clock.c.
* intrinsics/clock.c: New file.
* Makefile.in: Regenerate.
* configure: Regenerate.
* config.h.in: Regenerate.
* intrinsics/stat.c: Rename the old stat_i?_sub functions to
helper functions stat_i?_sub_0, and use them for both STAT and
LSTAT.
From-SVN: r115754
2006-07-26 13:58:48 +02:00
|
|
|
{
|
|
|
|
if (numeric_check (x, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_ior (gfc_expr *i, gfc_expr *j)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
2004-12-12 22:09:09 +01:00
|
|
|
if (type_check (i, 0, BT_INTEGER) == FAILURE)
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
|
2004-12-12 22:09:09 +01:00
|
|
|
if (type_check (j, 1, BT_INTEGER) == FAILURE)
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
|
2004-12-12 22:09:09 +01:00
|
|
|
if (i->ts.kind != j->ts.kind)
|
|
|
|
{
|
|
|
|
if (gfc_notify_std (GFC_STD_GNU, "Extension: Different type kinds at %L",
|
2007-01-07 01:28:29 +01:00
|
|
|
&i->where) == FAILURE)
|
|
|
|
return FAILURE;
|
2004-12-12 22:09:09 +01:00
|
|
|
}
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_ishft (gfc_expr *i, gfc_expr *shift)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (type_check (i, 0, BT_INTEGER) == FAILURE
|
|
|
|
|| type_check (shift, 1, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_ishftc (gfc_expr *i, gfc_expr *shift, gfc_expr *size)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (type_check (i, 0, BT_INTEGER) == FAILURE
|
|
|
|
|| type_check (shift, 1, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (size != NULL && type_check (size, 2, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
Makefile.am: Added new files.
* Makefile.am: Added new files.
* Makefile.in: Regenerate.
* aclocal.m4: Regenerate.
* configure.ac: add checks for signal.h headers file, as well as
following functions: chdir, strerror, getlogin, gethostname, kill,
link, symlink, perror, sleep, time.
* configure: Regenerate.
* intrinsics/chdir.c, intrinsics/gerror.c, intrinsics/getlog.c,
intrinsics/hostnm.c, intrinsics/ierrno.c, intrinsics/kill.c,
intrinsics/link.c, intrinsics/perror.c, intrinsics/rename.c,
intrinsics/sleep.c, intrinsics/symlnk.c, intrinsics/time.c: Newly
implementend g77 intrinsics.
* check.c (gfc_check_chdir, gfc_check_chdir_sub, gfc_check_kill,
gfc_check_kill_sub, gfc_check_link, gfc_check_link_sub,
gfc_check_symlnk, gfc_check_symlnk_sub, gfc_check_rename,
gfc_check_rename_sub, gfc_check_sleep_sub, gfc_check_gerror,
gfc_check_getlog, gfc_check_hostnm, gfc_check_hostnm_sub,
gfc_check_perror): new functions to check newly implemented
g77 intrinsics.
* gfortran.h: adding symbols for new intrinsics.
* intrinsic.c (add_functions): adding new intrinsics.
(add_subroutines): adding new intrinsics.
* intrinsic.h: prototype for all checking and resolving
functions.
* iresolve.c (gfc_resolve_chdir, gfc_resolve_chdir_sub,
gfc_resolve_hostnm, gfc_resolve_ierrno, gfc_resolve_kill,
gfc_resolve_link, gfc_resolve_rename, gfc_resolve_symlnk,
gfc_resolve_time, gfc_resolve_time8, gfc_resolve_rename_sub,
gfc_resolve_kill_sub, gfc_resolve_link_sub,
gfc_resolve_symlnk_sub, gfc_resolve_sleep_sub,
gfc_resolve_gerror, gfc_resolve_getlog, gfc_resolve_hostnm_sub,
gfc_resolve_perror): new functions to resolve intrinsics.
* trans-intrinsic.c (gfc_conv_intrinsic_function): add case
for new symbols.
* g77_intrinsics_funcs.f: New test.
* g77_intrinsics_sub.f: New test.
From-SVN: r96893
2005-03-22 23:08:22 +01:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_kill (gfc_expr *pid, gfc_expr *sig)
|
Makefile.am: Added new files.
* Makefile.am: Added new files.
* Makefile.in: Regenerate.
* aclocal.m4: Regenerate.
* configure.ac: add checks for signal.h headers file, as well as
following functions: chdir, strerror, getlogin, gethostname, kill,
link, symlink, perror, sleep, time.
* configure: Regenerate.
* intrinsics/chdir.c, intrinsics/gerror.c, intrinsics/getlog.c,
intrinsics/hostnm.c, intrinsics/ierrno.c, intrinsics/kill.c,
intrinsics/link.c, intrinsics/perror.c, intrinsics/rename.c,
intrinsics/sleep.c, intrinsics/symlnk.c, intrinsics/time.c: Newly
implementend g77 intrinsics.
* check.c (gfc_check_chdir, gfc_check_chdir_sub, gfc_check_kill,
gfc_check_kill_sub, gfc_check_link, gfc_check_link_sub,
gfc_check_symlnk, gfc_check_symlnk_sub, gfc_check_rename,
gfc_check_rename_sub, gfc_check_sleep_sub, gfc_check_gerror,
gfc_check_getlog, gfc_check_hostnm, gfc_check_hostnm_sub,
gfc_check_perror): new functions to check newly implemented
g77 intrinsics.
* gfortran.h: adding symbols for new intrinsics.
* intrinsic.c (add_functions): adding new intrinsics.
(add_subroutines): adding new intrinsics.
* intrinsic.h: prototype for all checking and resolving
functions.
* iresolve.c (gfc_resolve_chdir, gfc_resolve_chdir_sub,
gfc_resolve_hostnm, gfc_resolve_ierrno, gfc_resolve_kill,
gfc_resolve_link, gfc_resolve_rename, gfc_resolve_symlnk,
gfc_resolve_time, gfc_resolve_time8, gfc_resolve_rename_sub,
gfc_resolve_kill_sub, gfc_resolve_link_sub,
gfc_resolve_symlnk_sub, gfc_resolve_sleep_sub,
gfc_resolve_gerror, gfc_resolve_getlog, gfc_resolve_hostnm_sub,
gfc_resolve_perror): new functions to resolve intrinsics.
* trans-intrinsic.c (gfc_conv_intrinsic_function): add case
for new symbols.
* g77_intrinsics_funcs.f: New test.
* g77_intrinsics_sub.f: New test.
From-SVN: r96893
2005-03-22 23:08:22 +01:00
|
|
|
{
|
|
|
|
if (type_check (pid, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (sig, 1, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_kill_sub (gfc_expr *pid, gfc_expr *sig, gfc_expr *status)
|
Makefile.am: Added new files.
* Makefile.am: Added new files.
* Makefile.in: Regenerate.
* aclocal.m4: Regenerate.
* configure.ac: add checks for signal.h headers file, as well as
following functions: chdir, strerror, getlogin, gethostname, kill,
link, symlink, perror, sleep, time.
* configure: Regenerate.
* intrinsics/chdir.c, intrinsics/gerror.c, intrinsics/getlog.c,
intrinsics/hostnm.c, intrinsics/ierrno.c, intrinsics/kill.c,
intrinsics/link.c, intrinsics/perror.c, intrinsics/rename.c,
intrinsics/sleep.c, intrinsics/symlnk.c, intrinsics/time.c: Newly
implementend g77 intrinsics.
* check.c (gfc_check_chdir, gfc_check_chdir_sub, gfc_check_kill,
gfc_check_kill_sub, gfc_check_link, gfc_check_link_sub,
gfc_check_symlnk, gfc_check_symlnk_sub, gfc_check_rename,
gfc_check_rename_sub, gfc_check_sleep_sub, gfc_check_gerror,
gfc_check_getlog, gfc_check_hostnm, gfc_check_hostnm_sub,
gfc_check_perror): new functions to check newly implemented
g77 intrinsics.
* gfortran.h: adding symbols for new intrinsics.
* intrinsic.c (add_functions): adding new intrinsics.
(add_subroutines): adding new intrinsics.
* intrinsic.h: prototype for all checking and resolving
functions.
* iresolve.c (gfc_resolve_chdir, gfc_resolve_chdir_sub,
gfc_resolve_hostnm, gfc_resolve_ierrno, gfc_resolve_kill,
gfc_resolve_link, gfc_resolve_rename, gfc_resolve_symlnk,
gfc_resolve_time, gfc_resolve_time8, gfc_resolve_rename_sub,
gfc_resolve_kill_sub, gfc_resolve_link_sub,
gfc_resolve_symlnk_sub, gfc_resolve_sleep_sub,
gfc_resolve_gerror, gfc_resolve_getlog, gfc_resolve_hostnm_sub,
gfc_resolve_perror): new functions to resolve intrinsics.
* trans-intrinsic.c (gfc_conv_intrinsic_function): add case
for new symbols.
* g77_intrinsics_funcs.f: New test.
* g77_intrinsics_sub.f: New test.
From-SVN: r96893
2005-03-22 23:08:22 +01:00
|
|
|
{
|
|
|
|
if (type_check (pid, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
2007-01-05 02:40:06 +01:00
|
|
|
if (scalar_check (pid, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
Makefile.am: Added new files.
* Makefile.am: Added new files.
* Makefile.in: Regenerate.
* aclocal.m4: Regenerate.
* configure.ac: add checks for signal.h headers file, as well as
following functions: chdir, strerror, getlogin, gethostname, kill,
link, symlink, perror, sleep, time.
* configure: Regenerate.
* intrinsics/chdir.c, intrinsics/gerror.c, intrinsics/getlog.c,
intrinsics/hostnm.c, intrinsics/ierrno.c, intrinsics/kill.c,
intrinsics/link.c, intrinsics/perror.c, intrinsics/rename.c,
intrinsics/sleep.c, intrinsics/symlnk.c, intrinsics/time.c: Newly
implementend g77 intrinsics.
* check.c (gfc_check_chdir, gfc_check_chdir_sub, gfc_check_kill,
gfc_check_kill_sub, gfc_check_link, gfc_check_link_sub,
gfc_check_symlnk, gfc_check_symlnk_sub, gfc_check_rename,
gfc_check_rename_sub, gfc_check_sleep_sub, gfc_check_gerror,
gfc_check_getlog, gfc_check_hostnm, gfc_check_hostnm_sub,
gfc_check_perror): new functions to check newly implemented
g77 intrinsics.
* gfortran.h: adding symbols for new intrinsics.
* intrinsic.c (add_functions): adding new intrinsics.
(add_subroutines): adding new intrinsics.
* intrinsic.h: prototype for all checking and resolving
functions.
* iresolve.c (gfc_resolve_chdir, gfc_resolve_chdir_sub,
gfc_resolve_hostnm, gfc_resolve_ierrno, gfc_resolve_kill,
gfc_resolve_link, gfc_resolve_rename, gfc_resolve_symlnk,
gfc_resolve_time, gfc_resolve_time8, gfc_resolve_rename_sub,
gfc_resolve_kill_sub, gfc_resolve_link_sub,
gfc_resolve_symlnk_sub, gfc_resolve_sleep_sub,
gfc_resolve_gerror, gfc_resolve_getlog, gfc_resolve_hostnm_sub,
gfc_resolve_perror): new functions to resolve intrinsics.
* trans-intrinsic.c (gfc_conv_intrinsic_function): add case
for new symbols.
* g77_intrinsics_funcs.f: New test.
* g77_intrinsics_sub.f: New test.
From-SVN: r96893
2005-03-22 23:08:22 +01:00
|
|
|
if (type_check (sig, 1, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
2007-01-05 02:40:06 +01:00
|
|
|
if (scalar_check (sig, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
Makefile.am: Added new files.
* Makefile.am: Added new files.
* Makefile.in: Regenerate.
* aclocal.m4: Regenerate.
* configure.ac: add checks for signal.h headers file, as well as
following functions: chdir, strerror, getlogin, gethostname, kill,
link, symlink, perror, sleep, time.
* configure: Regenerate.
* intrinsics/chdir.c, intrinsics/gerror.c, intrinsics/getlog.c,
intrinsics/hostnm.c, intrinsics/ierrno.c, intrinsics/kill.c,
intrinsics/link.c, intrinsics/perror.c, intrinsics/rename.c,
intrinsics/sleep.c, intrinsics/symlnk.c, intrinsics/time.c: Newly
implementend g77 intrinsics.
* check.c (gfc_check_chdir, gfc_check_chdir_sub, gfc_check_kill,
gfc_check_kill_sub, gfc_check_link, gfc_check_link_sub,
gfc_check_symlnk, gfc_check_symlnk_sub, gfc_check_rename,
gfc_check_rename_sub, gfc_check_sleep_sub, gfc_check_gerror,
gfc_check_getlog, gfc_check_hostnm, gfc_check_hostnm_sub,
gfc_check_perror): new functions to check newly implemented
g77 intrinsics.
* gfortran.h: adding symbols for new intrinsics.
* intrinsic.c (add_functions): adding new intrinsics.
(add_subroutines): adding new intrinsics.
* intrinsic.h: prototype for all checking and resolving
functions.
* iresolve.c (gfc_resolve_chdir, gfc_resolve_chdir_sub,
gfc_resolve_hostnm, gfc_resolve_ierrno, gfc_resolve_kill,
gfc_resolve_link, gfc_resolve_rename, gfc_resolve_symlnk,
gfc_resolve_time, gfc_resolve_time8, gfc_resolve_rename_sub,
gfc_resolve_kill_sub, gfc_resolve_link_sub,
gfc_resolve_symlnk_sub, gfc_resolve_sleep_sub,
gfc_resolve_gerror, gfc_resolve_getlog, gfc_resolve_hostnm_sub,
gfc_resolve_perror): new functions to resolve intrinsics.
* trans-intrinsic.c (gfc_conv_intrinsic_function): add case
for new symbols.
* g77_intrinsics_funcs.f: New test.
* g77_intrinsics_sub.f: New test.
From-SVN: r96893
2005-03-22 23:08:22 +01:00
|
|
|
if (status == NULL)
|
|
|
|
return SUCCESS;
|
|
|
|
|
|
|
|
if (type_check (status, 2, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (status, 2) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_kind (gfc_expr *x)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (x->ts.type == BT_DERIVED)
|
|
|
|
{
|
re PR fortran/15586 (gfortran should support i18n in its compiler messages)
PR fortran/15586
* arith.c (gfc_arith_error): Change message to include locus.
(check_result, eval_intrinsic, gfc_int2int, gfc_real2real,
gfc_real2complex, gfc_complex2real, gfc_complex2complex): Use
the new gfc_arith_error.
(arith_error): Rewrite full error messages instead of building
them from pieces.
* check.c (must_be): Removed.
(type_check, numeric_check, int_or_real_check, real_or_complex_check,
kind_check, double_check, logical_array_check, array_check,
scalar_check, same_type_check, rank_check, kind_value_check,
variable_check, gfc_check_allocated, gfc_check_associated,
gfc_check_cmplx, gfc_check_dcmplx, gfc_check_dot_product,
gfc_check_index, gfc_check_kind, gfc_check_matmul, gfc_check_null,
gfc_check_pack, gfc_check_precision, gfc_check_present,
gfc_check_spread): Rewrite full error messages instead of
building them from pieces.
* decl.c (gfc_match_entry): Rewrite full error messages instead
of building them from pieces.
* parse.c (gfc_state_name): Remove.
* parse.h: Remove prototype for gfc_state_name.
From-SVN: r105844
2005-10-24 11:11:51 +02:00
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must be a "
|
|
|
|
"non-derived type", gfc_current_intrinsic_arg[0],
|
|
|
|
gfc_current_intrinsic, &x->where);
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
re PR fortran/29600 ([F03] MINLOC and MAXLOC take an optional KIND argument)
PR fortran/29600
* intrinsic.c (add_functions): Add KIND arguments to COUNT,
IACHAR, ICHAR, INDEX, LBOUND, LEN, LEN_TRIM, SCAN, SIZE, UBOUND
and VERIFY.
* iresolve.c (gfc_resolve_count): Add kind argument.
(gfc_resolve_iachar): New function.
(gfc_resolve_ichar): Add kind argument.
(gfc_resolve_index_func): Likewise.
(gfc_resolve_lbound): Likewise.
(gfc_resolve_len): Likewise.
(gfc_resolve_len_trim): Likewise.
(gfc_resolve_scan): Likewise.
(gfc_resolve_size): New function.
(gfc_resolve_ubound): Add kind argument.
(gfc_resolve_verify): Likewise.
* trans-decl.c (gfc_get_extern_function_decl): Allow specific
intrinsics to have 4 arguments.
* check.c (gfc_check_count): Add kind argument.
(gfc_check_ichar_iachar): Likewise.
(gfc_check_index): Likewise.
(gfc_check_lbound): Likewise.
(gfc_check_len_lentrim): New function.
(gfc_check_scan): Add kind argument.
(gfc_check_size): Likewise.
(gfc_check_ubound): Likewise.
(gfc_check_verify): Likewise.
* intrinsic.texi: Update documentation for COUNT, IACHAR, ICHAR,
INDEX, LBOUND, LEN, LEN_TRIM, SCAN, SIZE, UBOUND and VERIFY.
* simplify.c (get_kind): Whitespace fix.
(int_expr_with_kind): New function.
(gfc_simplify_iachar): Add kind argument.
(gfc_simplify_iachar): Likewise.
(gfc_simplify_ichar): Likewise.
(gfc_simplify_index): Likewise.
(simplify_bound_dim): Likewise.
(simplify_bound): Likewise.
(gfc_simplify_lbound): Likewise.
(gfc_simplify_len): Likewise.
(gfc_simplify_len_trim): Likewise.
(gfc_simplify_scan): Likewise.
(gfc_simplify_shape): Pass NULL as kind argument to gfc_simplify_size.
(gfc_simplify_size): Add kind argument.
(gfc_simplify_ubound): Likewise.
(gfc_simplify_verify): Likewise.
* intrinsic.h: Update prototypes and add new ones.
* trans-intrinsic.c (gfc_conv_intrinsic_index): Rename into
gfc_conv_intrinsic_index_scan_verify.
(gfc_conv_intrinsic_scan, gfc_conv_intrinsic_verify): Remove.
(gfc_conv_intrinsic_function): Call
gfc_conv_intrinsic_index_scan_verify to translate the INDEX,
SCAN and VERIFY intrinsics.
* gfortran.dg/intrinsics_kind_argument_1.f90: New test.
* gfortran.dg/pure_dummy_length_1.f90: Adapt to new error wording.
From-SVN: r127380
2007-08-12 21:57:01 +02:00
|
|
|
gfc_check_lbound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (array_check (array, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (dim != NULL)
|
|
|
|
{
|
|
|
|
if (dim_check (dim, 1, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (dim_rank_check (dim, array, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
}
|
re PR fortran/29600 ([F03] MINLOC and MAXLOC take an optional KIND argument)
PR fortran/29600
* intrinsic.c (add_functions): Add KIND arguments to COUNT,
IACHAR, ICHAR, INDEX, LBOUND, LEN, LEN_TRIM, SCAN, SIZE, UBOUND
and VERIFY.
* iresolve.c (gfc_resolve_count): Add kind argument.
(gfc_resolve_iachar): New function.
(gfc_resolve_ichar): Add kind argument.
(gfc_resolve_index_func): Likewise.
(gfc_resolve_lbound): Likewise.
(gfc_resolve_len): Likewise.
(gfc_resolve_len_trim): Likewise.
(gfc_resolve_scan): Likewise.
(gfc_resolve_size): New function.
(gfc_resolve_ubound): Add kind argument.
(gfc_resolve_verify): Likewise.
* trans-decl.c (gfc_get_extern_function_decl): Allow specific
intrinsics to have 4 arguments.
* check.c (gfc_check_count): Add kind argument.
(gfc_check_ichar_iachar): Likewise.
(gfc_check_index): Likewise.
(gfc_check_lbound): Likewise.
(gfc_check_len_lentrim): New function.
(gfc_check_scan): Add kind argument.
(gfc_check_size): Likewise.
(gfc_check_ubound): Likewise.
(gfc_check_verify): Likewise.
* intrinsic.texi: Update documentation for COUNT, IACHAR, ICHAR,
INDEX, LBOUND, LEN, LEN_TRIM, SCAN, SIZE, UBOUND and VERIFY.
* simplify.c (get_kind): Whitespace fix.
(int_expr_with_kind): New function.
(gfc_simplify_iachar): Add kind argument.
(gfc_simplify_iachar): Likewise.
(gfc_simplify_ichar): Likewise.
(gfc_simplify_index): Likewise.
(simplify_bound_dim): Likewise.
(simplify_bound): Likewise.
(gfc_simplify_lbound): Likewise.
(gfc_simplify_len): Likewise.
(gfc_simplify_len_trim): Likewise.
(gfc_simplify_scan): Likewise.
(gfc_simplify_shape): Pass NULL as kind argument to gfc_simplify_size.
(gfc_simplify_size): Add kind argument.
(gfc_simplify_ubound): Likewise.
(gfc_simplify_verify): Likewise.
* intrinsic.h: Update prototypes and add new ones.
* trans-intrinsic.c (gfc_conv_intrinsic_index): Rename into
gfc_conv_intrinsic_index_scan_verify.
(gfc_conv_intrinsic_scan, gfc_conv_intrinsic_verify): Remove.
(gfc_conv_intrinsic_function): Call
gfc_conv_intrinsic_index_scan_verify to translate the INDEX,
SCAN and VERIFY intrinsics.
* gfortran.dg/intrinsics_kind_argument_1.f90: New test.
* gfortran.dg/pure_dummy_length_1.f90: Adapt to new error wording.
From-SVN: r127380
2007-08-12 21:57:01 +02:00
|
|
|
|
|
|
|
if (kind_check (kind, 2, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
|
|
|
|
"with KIND argument at %L",
|
|
|
|
gfc_current_intrinsic, &kind->where) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
|
|
|
gfc_check_len_lentrim (gfc_expr *s, gfc_expr *kind)
|
|
|
|
{
|
|
|
|
if (type_check (s, 0, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (kind_check (kind, 1, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
|
|
|
|
"with KIND argument at %L",
|
|
|
|
gfc_current_intrinsic, &kind->where) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
Makefile.am: Added new files.
* Makefile.am: Added new files.
* Makefile.in: Regenerate.
* aclocal.m4: Regenerate.
* configure.ac: add checks for signal.h headers file, as well as
following functions: chdir, strerror, getlogin, gethostname, kill,
link, symlink, perror, sleep, time.
* configure: Regenerate.
* intrinsics/chdir.c, intrinsics/gerror.c, intrinsics/getlog.c,
intrinsics/hostnm.c, intrinsics/ierrno.c, intrinsics/kill.c,
intrinsics/link.c, intrinsics/perror.c, intrinsics/rename.c,
intrinsics/sleep.c, intrinsics/symlnk.c, intrinsics/time.c: Newly
implementend g77 intrinsics.
* check.c (gfc_check_chdir, gfc_check_chdir_sub, gfc_check_kill,
gfc_check_kill_sub, gfc_check_link, gfc_check_link_sub,
gfc_check_symlnk, gfc_check_symlnk_sub, gfc_check_rename,
gfc_check_rename_sub, gfc_check_sleep_sub, gfc_check_gerror,
gfc_check_getlog, gfc_check_hostnm, gfc_check_hostnm_sub,
gfc_check_perror): new functions to check newly implemented
g77 intrinsics.
* gfortran.h: adding symbols for new intrinsics.
* intrinsic.c (add_functions): adding new intrinsics.
(add_subroutines): adding new intrinsics.
* intrinsic.h: prototype for all checking and resolving
functions.
* iresolve.c (gfc_resolve_chdir, gfc_resolve_chdir_sub,
gfc_resolve_hostnm, gfc_resolve_ierrno, gfc_resolve_kill,
gfc_resolve_link, gfc_resolve_rename, gfc_resolve_symlnk,
gfc_resolve_time, gfc_resolve_time8, gfc_resolve_rename_sub,
gfc_resolve_kill_sub, gfc_resolve_link_sub,
gfc_resolve_symlnk_sub, gfc_resolve_sleep_sub,
gfc_resolve_gerror, gfc_resolve_getlog, gfc_resolve_hostnm_sub,
gfc_resolve_perror): new functions to resolve intrinsics.
* trans-intrinsic.c (gfc_conv_intrinsic_function): add case
for new symbols.
* g77_intrinsics_funcs.f: New test.
* g77_intrinsics_sub.f: New test.
From-SVN: r96893
2005-03-22 23:08:22 +01:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_link (gfc_expr *path1, gfc_expr *path2)
|
Makefile.am: Added new files.
* Makefile.am: Added new files.
* Makefile.in: Regenerate.
* aclocal.m4: Regenerate.
* configure.ac: add checks for signal.h headers file, as well as
following functions: chdir, strerror, getlogin, gethostname, kill,
link, symlink, perror, sleep, time.
* configure: Regenerate.
* intrinsics/chdir.c, intrinsics/gerror.c, intrinsics/getlog.c,
intrinsics/hostnm.c, intrinsics/ierrno.c, intrinsics/kill.c,
intrinsics/link.c, intrinsics/perror.c, intrinsics/rename.c,
intrinsics/sleep.c, intrinsics/symlnk.c, intrinsics/time.c: Newly
implementend g77 intrinsics.
* check.c (gfc_check_chdir, gfc_check_chdir_sub, gfc_check_kill,
gfc_check_kill_sub, gfc_check_link, gfc_check_link_sub,
gfc_check_symlnk, gfc_check_symlnk_sub, gfc_check_rename,
gfc_check_rename_sub, gfc_check_sleep_sub, gfc_check_gerror,
gfc_check_getlog, gfc_check_hostnm, gfc_check_hostnm_sub,
gfc_check_perror): new functions to check newly implemented
g77 intrinsics.
* gfortran.h: adding symbols for new intrinsics.
* intrinsic.c (add_functions): adding new intrinsics.
(add_subroutines): adding new intrinsics.
* intrinsic.h: prototype for all checking and resolving
functions.
* iresolve.c (gfc_resolve_chdir, gfc_resolve_chdir_sub,
gfc_resolve_hostnm, gfc_resolve_ierrno, gfc_resolve_kill,
gfc_resolve_link, gfc_resolve_rename, gfc_resolve_symlnk,
gfc_resolve_time, gfc_resolve_time8, gfc_resolve_rename_sub,
gfc_resolve_kill_sub, gfc_resolve_link_sub,
gfc_resolve_symlnk_sub, gfc_resolve_sleep_sub,
gfc_resolve_gerror, gfc_resolve_getlog, gfc_resolve_hostnm_sub,
gfc_resolve_perror): new functions to resolve intrinsics.
* trans-intrinsic.c (gfc_conv_intrinsic_function): add case
for new symbols.
* g77_intrinsics_funcs.f: New test.
* g77_intrinsics_sub.f: New test.
From-SVN: r96893
2005-03-22 23:08:22 +01:00
|
|
|
{
|
|
|
|
if (type_check (path1, 0, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (path2, 1, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_link_sub (gfc_expr *path1, gfc_expr *path2, gfc_expr *status)
|
Makefile.am: Added new files.
* Makefile.am: Added new files.
* Makefile.in: Regenerate.
* aclocal.m4: Regenerate.
* configure.ac: add checks for signal.h headers file, as well as
following functions: chdir, strerror, getlogin, gethostname, kill,
link, symlink, perror, sleep, time.
* configure: Regenerate.
* intrinsics/chdir.c, intrinsics/gerror.c, intrinsics/getlog.c,
intrinsics/hostnm.c, intrinsics/ierrno.c, intrinsics/kill.c,
intrinsics/link.c, intrinsics/perror.c, intrinsics/rename.c,
intrinsics/sleep.c, intrinsics/symlnk.c, intrinsics/time.c: Newly
implementend g77 intrinsics.
* check.c (gfc_check_chdir, gfc_check_chdir_sub, gfc_check_kill,
gfc_check_kill_sub, gfc_check_link, gfc_check_link_sub,
gfc_check_symlnk, gfc_check_symlnk_sub, gfc_check_rename,
gfc_check_rename_sub, gfc_check_sleep_sub, gfc_check_gerror,
gfc_check_getlog, gfc_check_hostnm, gfc_check_hostnm_sub,
gfc_check_perror): new functions to check newly implemented
g77 intrinsics.
* gfortran.h: adding symbols for new intrinsics.
* intrinsic.c (add_functions): adding new intrinsics.
(add_subroutines): adding new intrinsics.
* intrinsic.h: prototype for all checking and resolving
functions.
* iresolve.c (gfc_resolve_chdir, gfc_resolve_chdir_sub,
gfc_resolve_hostnm, gfc_resolve_ierrno, gfc_resolve_kill,
gfc_resolve_link, gfc_resolve_rename, gfc_resolve_symlnk,
gfc_resolve_time, gfc_resolve_time8, gfc_resolve_rename_sub,
gfc_resolve_kill_sub, gfc_resolve_link_sub,
gfc_resolve_symlnk_sub, gfc_resolve_sleep_sub,
gfc_resolve_gerror, gfc_resolve_getlog, gfc_resolve_hostnm_sub,
gfc_resolve_perror): new functions to resolve intrinsics.
* trans-intrinsic.c (gfc_conv_intrinsic_function): add case
for new symbols.
* g77_intrinsics_funcs.f: New test.
* g77_intrinsics_sub.f: New test.
From-SVN: r96893
2005-03-22 23:08:22 +01:00
|
|
|
{
|
|
|
|
if (type_check (path1, 0, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (path2, 1, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (status == NULL)
|
|
|
|
return SUCCESS;
|
|
|
|
|
|
|
|
if (type_check (status, 2, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (status, 2) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
2007-01-07 01:28:29 +01:00
|
|
|
|
2005-10-24 21:28:18 +02:00
|
|
|
try
|
|
|
|
gfc_check_loc (gfc_expr *expr)
|
|
|
|
{
|
|
|
|
return variable_check (expr, 0);
|
|
|
|
}
|
|
|
|
|
Makefile.am: Added new files.
* Makefile.am: Added new files.
* Makefile.in: Regenerate.
* aclocal.m4: Regenerate.
* configure.ac: add checks for signal.h headers file, as well as
following functions: chdir, strerror, getlogin, gethostname, kill,
link, symlink, perror, sleep, time.
* configure: Regenerate.
* intrinsics/chdir.c, intrinsics/gerror.c, intrinsics/getlog.c,
intrinsics/hostnm.c, intrinsics/ierrno.c, intrinsics/kill.c,
intrinsics/link.c, intrinsics/perror.c, intrinsics/rename.c,
intrinsics/sleep.c, intrinsics/symlnk.c, intrinsics/time.c: Newly
implementend g77 intrinsics.
* check.c (gfc_check_chdir, gfc_check_chdir_sub, gfc_check_kill,
gfc_check_kill_sub, gfc_check_link, gfc_check_link_sub,
gfc_check_symlnk, gfc_check_symlnk_sub, gfc_check_rename,
gfc_check_rename_sub, gfc_check_sleep_sub, gfc_check_gerror,
gfc_check_getlog, gfc_check_hostnm, gfc_check_hostnm_sub,
gfc_check_perror): new functions to check newly implemented
g77 intrinsics.
* gfortran.h: adding symbols for new intrinsics.
* intrinsic.c (add_functions): adding new intrinsics.
(add_subroutines): adding new intrinsics.
* intrinsic.h: prototype for all checking and resolving
functions.
* iresolve.c (gfc_resolve_chdir, gfc_resolve_chdir_sub,
gfc_resolve_hostnm, gfc_resolve_ierrno, gfc_resolve_kill,
gfc_resolve_link, gfc_resolve_rename, gfc_resolve_symlnk,
gfc_resolve_time, gfc_resolve_time8, gfc_resolve_rename_sub,
gfc_resolve_kill_sub, gfc_resolve_link_sub,
gfc_resolve_symlnk_sub, gfc_resolve_sleep_sub,
gfc_resolve_gerror, gfc_resolve_getlog, gfc_resolve_hostnm_sub,
gfc_resolve_perror): new functions to resolve intrinsics.
* trans-intrinsic.c (gfc_conv_intrinsic_function): add case
for new symbols.
* g77_intrinsics_funcs.f: New test.
* g77_intrinsics_sub.f: New test.
From-SVN: r96893
2005-03-22 23:08:22 +01:00
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_symlnk (gfc_expr *path1, gfc_expr *path2)
|
Makefile.am: Added new files.
* Makefile.am: Added new files.
* Makefile.in: Regenerate.
* aclocal.m4: Regenerate.
* configure.ac: add checks for signal.h headers file, as well as
following functions: chdir, strerror, getlogin, gethostname, kill,
link, symlink, perror, sleep, time.
* configure: Regenerate.
* intrinsics/chdir.c, intrinsics/gerror.c, intrinsics/getlog.c,
intrinsics/hostnm.c, intrinsics/ierrno.c, intrinsics/kill.c,
intrinsics/link.c, intrinsics/perror.c, intrinsics/rename.c,
intrinsics/sleep.c, intrinsics/symlnk.c, intrinsics/time.c: Newly
implementend g77 intrinsics.
* check.c (gfc_check_chdir, gfc_check_chdir_sub, gfc_check_kill,
gfc_check_kill_sub, gfc_check_link, gfc_check_link_sub,
gfc_check_symlnk, gfc_check_symlnk_sub, gfc_check_rename,
gfc_check_rename_sub, gfc_check_sleep_sub, gfc_check_gerror,
gfc_check_getlog, gfc_check_hostnm, gfc_check_hostnm_sub,
gfc_check_perror): new functions to check newly implemented
g77 intrinsics.
* gfortran.h: adding symbols for new intrinsics.
* intrinsic.c (add_functions): adding new intrinsics.
(add_subroutines): adding new intrinsics.
* intrinsic.h: prototype for all checking and resolving
functions.
* iresolve.c (gfc_resolve_chdir, gfc_resolve_chdir_sub,
gfc_resolve_hostnm, gfc_resolve_ierrno, gfc_resolve_kill,
gfc_resolve_link, gfc_resolve_rename, gfc_resolve_symlnk,
gfc_resolve_time, gfc_resolve_time8, gfc_resolve_rename_sub,
gfc_resolve_kill_sub, gfc_resolve_link_sub,
gfc_resolve_symlnk_sub, gfc_resolve_sleep_sub,
gfc_resolve_gerror, gfc_resolve_getlog, gfc_resolve_hostnm_sub,
gfc_resolve_perror): new functions to resolve intrinsics.
* trans-intrinsic.c (gfc_conv_intrinsic_function): add case
for new symbols.
* g77_intrinsics_funcs.f: New test.
* g77_intrinsics_sub.f: New test.
From-SVN: r96893
2005-03-22 23:08:22 +01:00
|
|
|
{
|
|
|
|
if (type_check (path1, 0, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (path2, 1, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_symlnk_sub (gfc_expr *path1, gfc_expr *path2, gfc_expr *status)
|
Makefile.am: Added new files.
* Makefile.am: Added new files.
* Makefile.in: Regenerate.
* aclocal.m4: Regenerate.
* configure.ac: add checks for signal.h headers file, as well as
following functions: chdir, strerror, getlogin, gethostname, kill,
link, symlink, perror, sleep, time.
* configure: Regenerate.
* intrinsics/chdir.c, intrinsics/gerror.c, intrinsics/getlog.c,
intrinsics/hostnm.c, intrinsics/ierrno.c, intrinsics/kill.c,
intrinsics/link.c, intrinsics/perror.c, intrinsics/rename.c,
intrinsics/sleep.c, intrinsics/symlnk.c, intrinsics/time.c: Newly
implementend g77 intrinsics.
* check.c (gfc_check_chdir, gfc_check_chdir_sub, gfc_check_kill,
gfc_check_kill_sub, gfc_check_link, gfc_check_link_sub,
gfc_check_symlnk, gfc_check_symlnk_sub, gfc_check_rename,
gfc_check_rename_sub, gfc_check_sleep_sub, gfc_check_gerror,
gfc_check_getlog, gfc_check_hostnm, gfc_check_hostnm_sub,
gfc_check_perror): new functions to check newly implemented
g77 intrinsics.
* gfortran.h: adding symbols for new intrinsics.
* intrinsic.c (add_functions): adding new intrinsics.
(add_subroutines): adding new intrinsics.
* intrinsic.h: prototype for all checking and resolving
functions.
* iresolve.c (gfc_resolve_chdir, gfc_resolve_chdir_sub,
gfc_resolve_hostnm, gfc_resolve_ierrno, gfc_resolve_kill,
gfc_resolve_link, gfc_resolve_rename, gfc_resolve_symlnk,
gfc_resolve_time, gfc_resolve_time8, gfc_resolve_rename_sub,
gfc_resolve_kill_sub, gfc_resolve_link_sub,
gfc_resolve_symlnk_sub, gfc_resolve_sleep_sub,
gfc_resolve_gerror, gfc_resolve_getlog, gfc_resolve_hostnm_sub,
gfc_resolve_perror): new functions to resolve intrinsics.
* trans-intrinsic.c (gfc_conv_intrinsic_function): add case
for new symbols.
* g77_intrinsics_funcs.f: New test.
* g77_intrinsics_sub.f: New test.
From-SVN: r96893
2005-03-22 23:08:22 +01:00
|
|
|
{
|
|
|
|
if (type_check (path1, 0, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (path2, 1, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (status == NULL)
|
|
|
|
return SUCCESS;
|
|
|
|
|
|
|
|
if (type_check (status, 2, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (status, 2) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_logical (gfc_expr *a, gfc_expr *kind)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (type_check (a, 0, BT_LOGICAL) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
if (kind_check (kind, 1, BT_LOGICAL) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
/* Min/max family. */
|
|
|
|
|
|
|
|
static try
|
2007-01-07 01:28:29 +01:00
|
|
|
min_max_args (gfc_actual_arglist *arg)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (arg == NULL || arg->next == NULL)
|
|
|
|
{
|
|
|
|
gfc_error ("Intrinsic '%s' at %L must have at least two arguments",
|
|
|
|
gfc_current_intrinsic, gfc_current_intrinsic_where);
|
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
static try
|
2007-05-20 12:22:15 +02:00
|
|
|
check_rest (bt type, int kind, gfc_actual_arglist *arglist)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
2007-05-20 12:22:15 +02:00
|
|
|
gfc_actual_arglist *arg, *tmp;
|
2004-05-13 08:41:07 +02:00
|
|
|
|
2007-05-20 12:22:15 +02:00
|
|
|
gfc_expr *x;
|
|
|
|
int m, n;
|
2004-05-13 08:41:07 +02:00
|
|
|
|
2007-05-20 12:22:15 +02:00
|
|
|
if (min_max_args (arglist) == FAILURE)
|
|
|
|
return FAILURE;
|
2004-05-13 08:41:07 +02:00
|
|
|
|
2007-05-20 12:22:15 +02:00
|
|
|
for (arg = arglist, n=1; arg; arg = arg->next, n++)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
x = arg->expr;
|
|
|
|
if (x->ts.type != type || x->ts.kind != kind)
|
|
|
|
{
|
2007-01-07 01:28:29 +01:00
|
|
|
if (x->ts.type == type)
|
|
|
|
{
|
|
|
|
if (gfc_notify_std (GFC_STD_GNU, "Extension: Different type "
|
|
|
|
"kinds at %L", &x->where) == FAILURE)
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
2007-01-07 01:28:29 +01:00
|
|
|
}
|
|
|
|
else
|
|
|
|
{
|
|
|
|
gfc_error ("'a%d' argument of '%s' intrinsic at %L must be "
|
|
|
|
"%s(%d)", n, gfc_current_intrinsic, &x->where,
|
|
|
|
gfc_basic_typename (type), kind);
|
|
|
|
return FAILURE;
|
|
|
|
}
|
2004-05-13 08:41:07 +02:00
|
|
|
}
|
2007-05-17 14:37:24 +02:00
|
|
|
|
2007-05-20 12:22:15 +02:00
|
|
|
for (tmp = arglist, m=1; tmp != arg; tmp = tmp->next, m++)
|
|
|
|
{
|
|
|
|
char buffer[80];
|
|
|
|
snprintf (buffer, 80, "arguments 'a%d' and 'a%d' for intrinsic '%s'",
|
|
|
|
m, n, gfc_current_intrinsic);
|
|
|
|
if (gfc_check_conformance (buffer, tmp->expr, x) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
}
|
2004-05-13 08:41:07 +02:00
|
|
|
}
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_min_max (gfc_actual_arglist *arg)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
gfc_expr *x;
|
|
|
|
|
|
|
|
if (min_max_args (arg) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
x = arg->expr;
|
|
|
|
|
2007-08-06 22:47:17 +02:00
|
|
|
if (x->ts.type == BT_CHARACTER)
|
|
|
|
{
|
|
|
|
if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
|
|
|
|
"with CHARACTER argument at %L",
|
|
|
|
gfc_current_intrinsic, &x->where) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
else if (x->ts.type != BT_INTEGER && x->ts.type != BT_REAL)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
2007-08-06 22:47:17 +02:00
|
|
|
gfc_error ("'a1' argument of '%s' intrinsic at %L must be INTEGER, "
|
|
|
|
"REAL or CHARACTER", gfc_current_intrinsic, &x->where);
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
return check_rest (x->ts.type, x->ts.kind, arg);
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_min_max_integer (gfc_actual_arglist *arg)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
gfortran.h (gfc_default_*_kind): Remove prototypes, add extern variable declaration of same name.
* gfortran.h (gfc_default_*_kind): Remove prototypes, add extern
variable declaration of same name.
* arith.c, check.c, decl.c, dump_parse_tree.c, expr.c,
intrinsic.c, io.c, iresolve.c, match.c, options.c, primary.c,
resolve.c, simplify.c, symbol.c, trans-const.c, trans-io.c:
Replace all calls to gfc_default_*_kind with variable accesses.
* trans-types.c: Same as above.
(gfc_default_*_kind_1): Rename to gfc_default_*_kind, remove
static qualifier. Replace all occurences.
(gfc_default_*_kind): Remove functions.
From-SVN: r86662
2004-08-27 16:49:35 +02:00
|
|
|
return check_rest (BT_INTEGER, gfc_default_integer_kind, arg);
|
2004-05-13 08:41:07 +02:00
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_min_max_real (gfc_actual_arglist *arg)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
gfortran.h (gfc_default_*_kind): Remove prototypes, add extern variable declaration of same name.
* gfortran.h (gfc_default_*_kind): Remove prototypes, add extern
variable declaration of same name.
* arith.c, check.c, decl.c, dump_parse_tree.c, expr.c,
intrinsic.c, io.c, iresolve.c, match.c, options.c, primary.c,
resolve.c, simplify.c, symbol.c, trans-const.c, trans-io.c:
Replace all calls to gfc_default_*_kind with variable accesses.
* trans-types.c: Same as above.
(gfc_default_*_kind_1): Rename to gfc_default_*_kind, remove
static qualifier. Replace all occurences.
(gfc_default_*_kind): Remove functions.
From-SVN: r86662
2004-08-27 16:49:35 +02:00
|
|
|
return check_rest (BT_REAL, gfc_default_real_kind, arg);
|
2004-05-13 08:41:07 +02:00
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_min_max_double (gfc_actual_arglist *arg)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
gfortran.h (gfc_default_*_kind): Remove prototypes, add extern variable declaration of same name.
* gfortran.h (gfc_default_*_kind): Remove prototypes, add extern
variable declaration of same name.
* arith.c, check.c, decl.c, dump_parse_tree.c, expr.c,
intrinsic.c, io.c, iresolve.c, match.c, options.c, primary.c,
resolve.c, simplify.c, symbol.c, trans-const.c, trans-io.c:
Replace all calls to gfc_default_*_kind with variable accesses.
* trans-types.c: Same as above.
(gfc_default_*_kind_1): Rename to gfc_default_*_kind, remove
static qualifier. Replace all occurences.
(gfc_default_*_kind): Remove functions.
From-SVN: r86662
2004-08-27 16:49:35 +02:00
|
|
|
return check_rest (BT_REAL, gfc_default_double_kind, arg);
|
2004-05-13 08:41:07 +02:00
|
|
|
}
|
|
|
|
|
2007-01-07 01:28:29 +01:00
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
/* End of min/max family. */
|
|
|
|
|
2005-10-30 13:17:48 +01:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_malloc (gfc_expr *size)
|
2005-10-30 13:17:48 +01:00
|
|
|
{
|
|
|
|
if (type_check (size, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (size, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_matmul (gfc_expr *matrix_a, gfc_expr *matrix_b)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if ((matrix_a->ts.type != BT_LOGICAL) && !gfc_numeric_ts (&matrix_b->ts))
|
|
|
|
{
|
re PR fortran/15586 (gfortran should support i18n in its compiler messages)
PR fortran/15586
* arith.c (gfc_arith_error): Change message to include locus.
(check_result, eval_intrinsic, gfc_int2int, gfc_real2real,
gfc_real2complex, gfc_complex2real, gfc_complex2complex): Use
the new gfc_arith_error.
(arith_error): Rewrite full error messages instead of building
them from pieces.
* check.c (must_be): Removed.
(type_check, numeric_check, int_or_real_check, real_or_complex_check,
kind_check, double_check, logical_array_check, array_check,
scalar_check, same_type_check, rank_check, kind_value_check,
variable_check, gfc_check_allocated, gfc_check_associated,
gfc_check_cmplx, gfc_check_dcmplx, gfc_check_dot_product,
gfc_check_index, gfc_check_kind, gfc_check_matmul, gfc_check_null,
gfc_check_pack, gfc_check_precision, gfc_check_present,
gfc_check_spread): Rewrite full error messages instead of
building them from pieces.
* decl.c (gfc_match_entry): Rewrite full error messages instead
of building them from pieces.
* parse.c (gfc_state_name): Remove.
* parse.h: Remove prototype for gfc_state_name.
From-SVN: r105844
2005-10-24 11:11:51 +02:00
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must be numeric "
|
|
|
|
"or LOGICAL", gfc_current_intrinsic_arg[0],
|
|
|
|
gfc_current_intrinsic, &matrix_a->where);
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
if ((matrix_b->ts.type != BT_LOGICAL) && !gfc_numeric_ts (&matrix_a->ts))
|
|
|
|
{
|
re PR fortran/15586 (gfortran should support i18n in its compiler messages)
PR fortran/15586
* arith.c (gfc_arith_error): Change message to include locus.
(check_result, eval_intrinsic, gfc_int2int, gfc_real2real,
gfc_real2complex, gfc_complex2real, gfc_complex2complex): Use
the new gfc_arith_error.
(arith_error): Rewrite full error messages instead of building
them from pieces.
* check.c (must_be): Removed.
(type_check, numeric_check, int_or_real_check, real_or_complex_check,
kind_check, double_check, logical_array_check, array_check,
scalar_check, same_type_check, rank_check, kind_value_check,
variable_check, gfc_check_allocated, gfc_check_associated,
gfc_check_cmplx, gfc_check_dcmplx, gfc_check_dot_product,
gfc_check_index, gfc_check_kind, gfc_check_matmul, gfc_check_null,
gfc_check_pack, gfc_check_precision, gfc_check_present,
gfc_check_spread): Rewrite full error messages instead of
building them from pieces.
* decl.c (gfc_match_entry): Rewrite full error messages instead
of building them from pieces.
* parse.c (gfc_state_name): Remove.
* parse.h: Remove prototype for gfc_state_name.
From-SVN: r105844
2005-10-24 11:11:51 +02:00
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must be numeric "
|
|
|
|
"or LOGICAL", gfc_current_intrinsic_arg[1],
|
|
|
|
gfc_current_intrinsic, &matrix_b->where);
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
switch (matrix_a->rank)
|
|
|
|
{
|
|
|
|
case 1:
|
|
|
|
if (rank_check (matrix_b, 1, 2) == FAILURE)
|
|
|
|
return FAILURE;
|
2006-02-04 23:11:57 +01:00
|
|
|
/* Check for case matrix_a has shape(m), matrix_b has shape (m, k). */
|
2007-01-07 01:28:29 +01:00
|
|
|
if (!identical_dimen_shape (matrix_a, 0, matrix_b, 0))
|
2006-02-04 23:11:57 +01:00
|
|
|
{
|
|
|
|
gfc_error ("different shape on dimension 1 for arguments '%s' "
|
|
|
|
"and '%s' at %L for intrinsic matmul",
|
|
|
|
gfc_current_intrinsic_arg[0],
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_current_intrinsic_arg[1], &matrix_a->where);
|
2006-02-04 23:11:57 +01:00
|
|
|
return FAILURE;
|
|
|
|
}
|
2004-05-13 08:41:07 +02:00
|
|
|
break;
|
|
|
|
|
|
|
|
case 2:
|
2006-02-04 23:11:57 +01:00
|
|
|
if (matrix_b->rank != 2)
|
|
|
|
{
|
|
|
|
if (rank_check (matrix_b, 1, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
/* matrix_b has rank 1 or 2 here. Common check for the cases
|
|
|
|
- matrix_a has shape (n,m) and matrix_b has shape (m, k)
|
|
|
|
- matrix_a has shape (n,m) and matrix_b has shape (m). */
|
2007-01-07 01:28:29 +01:00
|
|
|
if (!identical_dimen_shape (matrix_a, 1, matrix_b, 0))
|
2006-02-04 23:11:57 +01:00
|
|
|
{
|
|
|
|
gfc_error ("different shape on dimension 2 for argument '%s' and "
|
|
|
|
"dimension 1 for argument '%s' at %L for intrinsic "
|
|
|
|
"matmul", gfc_current_intrinsic_arg[0],
|
|
|
|
gfc_current_intrinsic_arg[1], &matrix_a->where);
|
|
|
|
return FAILURE;
|
|
|
|
}
|
2004-05-13 08:41:07 +02:00
|
|
|
break;
|
|
|
|
|
|
|
|
default:
|
re PR fortran/15586 (gfortran should support i18n in its compiler messages)
PR fortran/15586
* arith.c (gfc_arith_error): Change message to include locus.
(check_result, eval_intrinsic, gfc_int2int, gfc_real2real,
gfc_real2complex, gfc_complex2real, gfc_complex2complex): Use
the new gfc_arith_error.
(arith_error): Rewrite full error messages instead of building
them from pieces.
* check.c (must_be): Removed.
(type_check, numeric_check, int_or_real_check, real_or_complex_check,
kind_check, double_check, logical_array_check, array_check,
scalar_check, same_type_check, rank_check, kind_value_check,
variable_check, gfc_check_allocated, gfc_check_associated,
gfc_check_cmplx, gfc_check_dcmplx, gfc_check_dot_product,
gfc_check_index, gfc_check_kind, gfc_check_matmul, gfc_check_null,
gfc_check_pack, gfc_check_precision, gfc_check_present,
gfc_check_spread): Rewrite full error messages instead of
building them from pieces.
* decl.c (gfc_match_entry): Rewrite full error messages instead
of building them from pieces.
* parse.c (gfc_state_name): Remove.
* parse.h: Remove prototype for gfc_state_name.
From-SVN: r105844
2005-10-24 11:11:51 +02:00
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must be of rank "
|
|
|
|
"1 or 2", gfc_current_intrinsic_arg[0],
|
|
|
|
gfc_current_intrinsic, &matrix_a->where);
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
/* Whoever came up with this interface was probably on something.
|
|
|
|
The possibilities for the occupation of the second and third
|
|
|
|
parameters are:
|
|
|
|
|
2007-01-07 01:28:29 +01:00
|
|
|
Arg #2 Arg #3
|
|
|
|
NULL NULL
|
|
|
|
DIM NULL
|
|
|
|
MASK NULL
|
|
|
|
NULL MASK minloc(array, mask=m)
|
|
|
|
DIM MASK
|
2004-06-14 17:56:50 +02:00
|
|
|
|
|
|
|
I.e. in the case of minloc(array,mask), mask will be in the second
|
|
|
|
position of the argument list and we'll have to fix that up. */
|
2004-05-13 08:41:07 +02:00
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_minloc_maxloc (gfc_actual_arglist *ap)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
2004-06-14 17:56:50 +02:00
|
|
|
gfc_expr *a, *m, *d;
|
2004-05-13 08:41:07 +02:00
|
|
|
|
2004-06-14 17:56:50 +02:00
|
|
|
a = ap->expr;
|
2007-01-07 01:28:29 +01:00
|
|
|
if (int_or_real_check (a, 0) == FAILURE || array_check (a, 0) == FAILURE)
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
|
2004-06-14 17:56:50 +02:00
|
|
|
d = ap->next->expr;
|
|
|
|
m = ap->next->next->expr;
|
2004-05-13 08:41:07 +02:00
|
|
|
|
2004-06-14 17:56:50 +02:00
|
|
|
if (m == NULL && d != NULL && d->ts.type == BT_LOGICAL
|
2005-02-24 19:26:27 +01:00
|
|
|
&& ap->next->name == NULL)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
2004-06-14 17:56:50 +02:00
|
|
|
m = d;
|
|
|
|
d = NULL;
|
|
|
|
ap->next->expr = NULL;
|
|
|
|
ap->next->next->expr = m;
|
2004-05-13 08:41:07 +02:00
|
|
|
}
|
|
|
|
|
2006-02-14 20:25:36 +01:00
|
|
|
if (dim_check (d, 1, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
2006-02-15 12:02:21 +01:00
|
|
|
if (d && dim_rank_check (d, a, 0) == FAILURE)
|
2004-06-14 17:56:50 +02:00
|
|
|
return FAILURE;
|
2004-05-13 08:41:07 +02:00
|
|
|
|
2004-06-14 17:56:50 +02:00
|
|
|
if (m != NULL && type_check (m, 2, BT_LOGICAL) == FAILURE)
|
|
|
|
return FAILURE;
|
2004-05-13 08:41:07 +02:00
|
|
|
|
2006-01-31 23:52:49 +01:00
|
|
|
if (m != NULL)
|
|
|
|
{
|
|
|
|
char buffer[80];
|
2007-01-07 01:28:29 +01:00
|
|
|
snprintf (buffer, 80, "arguments '%s' and '%s' for intrinsic %s",
|
|
|
|
gfc_current_intrinsic_arg[0], gfc_current_intrinsic_arg[2],
|
|
|
|
gfc_current_intrinsic);
|
2006-01-31 23:52:49 +01:00
|
|
|
if (gfc_check_conformance (buffer, a, m) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2004-08-19 17:31:37 +02:00
|
|
|
/* Similar to minloc/maxloc, the argument list might need to be
|
|
|
|
reordered for the MINVAL, MAXVAL, PRODUCT, and SUM intrinsics. The
|
|
|
|
difference is that MINLOC/MAXLOC take an additional KIND argument.
|
|
|
|
The possibilities are:
|
|
|
|
|
2007-01-07 01:28:29 +01:00
|
|
|
Arg #2 Arg #3
|
|
|
|
NULL NULL
|
|
|
|
DIM NULL
|
|
|
|
MASK NULL
|
|
|
|
NULL MASK minval(array, mask=m)
|
|
|
|
DIM MASK
|
2004-08-19 17:31:37 +02:00
|
|
|
|
|
|
|
I.e. in the case of minval(array,mask), mask will be in the second
|
|
|
|
position of the argument list and we'll have to fix that up. */
|
|
|
|
|
2004-08-22 14:09:26 +02:00
|
|
|
static try
|
2007-01-07 01:28:29 +01:00
|
|
|
check_reduction (gfc_actual_arglist *ap)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
2006-01-31 23:52:49 +01:00
|
|
|
gfc_expr *a, *m, *d;
|
2004-05-13 08:41:07 +02:00
|
|
|
|
2006-01-31 23:52:49 +01:00
|
|
|
a = ap->expr;
|
2004-08-19 17:31:37 +02:00
|
|
|
d = ap->next->expr;
|
|
|
|
m = ap->next->next->expr;
|
2004-05-13 08:41:07 +02:00
|
|
|
|
2004-08-19 17:31:37 +02:00
|
|
|
if (m == NULL && d != NULL && d->ts.type == BT_LOGICAL
|
2005-02-24 19:26:27 +01:00
|
|
|
&& ap->next->name == NULL)
|
2004-08-19 17:31:37 +02:00
|
|
|
{
|
|
|
|
m = d;
|
|
|
|
d = NULL;
|
|
|
|
ap->next->expr = NULL;
|
|
|
|
ap->next->next->expr = m;
|
|
|
|
}
|
|
|
|
|
2006-02-14 20:25:36 +01:00
|
|
|
if (dim_check (d, 1, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
2006-02-15 12:02:21 +01:00
|
|
|
if (d && dim_rank_check (d, a, 0) == FAILURE)
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
|
2004-08-19 17:31:37 +02:00
|
|
|
if (m != NULL && type_check (m, 2, BT_LOGICAL) == FAILURE)
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
|
2006-01-31 23:52:49 +01:00
|
|
|
if (m != NULL)
|
|
|
|
{
|
|
|
|
char buffer[80];
|
2007-01-07 01:28:29 +01:00
|
|
|
snprintf (buffer, 80, "arguments '%s' and '%s' for intrinsic %s",
|
|
|
|
gfc_current_intrinsic_arg[0], gfc_current_intrinsic_arg[2],
|
|
|
|
gfc_current_intrinsic);
|
2006-01-31 23:52:49 +01:00
|
|
|
if (gfc_check_conformance (buffer, a, m) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2004-08-22 14:09:26 +02:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_minval_maxval (gfc_actual_arglist *ap)
|
2004-08-22 14:09:26 +02:00
|
|
|
{
|
|
|
|
if (int_or_real_check (ap->expr, 0) == FAILURE
|
|
|
|
|| array_check (ap->expr, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
arith.c (arctangent2, [...]): Fix whitespace issues.
* arith.c (arctangent2, gfc_arith_init_1, gfc_arith_done_1,
gfc_constant_result, gfc_range_check, gfc_arith_power,
eval_type_intrinsic0, eval_intrinsic_f2, gfc_real2real,
gfc_real2complex, gfc_complex2int, gfc_complex2real,
gfc_complex2complex): Fix whitespace issues.
check.c (must_be, type_check, numeric_check, int_or_real_check,
logical_array_check, array_check, scalar_check, nonoptional_check,
variable_check, dim_check, check_a_kind, gfc_check_a_ikind,
gfc_check_a_xkind, gfc_check_abs, gfc_check_all_any,
gfc_check_allocated, gfc_check_a_p, gfc_check_besn,
gfc_check_btest, gfc_check_char, gfc_check_cmplx, gfc_check_count,
gfc_check_cshift, gfc_check_dcmplx, gfc_check_dble,
gfc_check_digits, gfc_check_dot_product, gfc_check_eoshift,
gfc_check_fnum, gfc_check_g77_math1, gfc_check_huge, gfc_check_i,
gfc_check_iand, gfc_check_ibclr, gfc_check_ibits, gfc_check_ibset,
gfc_check_idnint, gfc_check_ieor, gfc_check_index, gfc_check_int,
gfc_check_ior, gfc_check_ishft, gfc_check_ishftc, gfc_check_kind,
gfc_check_lbound, gfc_check_logical, min_max_args,
gfc_check_min_max_integer, gfc_check_min_max_real,
gfc_check_min_max_double, gfc_check_matmul,
gfc_check_minval_maxval, gfc_check_merge, gfc_check_nearest,
gfc_check_pack, gfc_check_precision, gfc_check_radix,
gfc_check_range, gfc_check_real, gfc_check_repeat,
gfc_check_scale, gfc_check_scan, gfc_check_selected_real_kind,
gfc_check_set_exponent): Fix formatting issues.
(gfc_check_size, gfc_check_sign): Alphabetize function order,
remove whitespace-only line.
(gfc_check_fstat, gfc_check_fstat_sub, gfc_check_stat,
gfc_check_stat_sub, gfc_check_transfer, gfc_check_transpose,
gfc_check_ubound, gfc_check_unpack, gfc_check_verify, gfc_check_x,
gfc_check_cpu_time, gfc_check_date_and_time, gfc_check_mvbits,
gfc_check_random_number, gfc_check_random_seed,
gfc_check_second_sub, gfc_check_system_clock,
gfc_check_getcwd_sub, gfc_check_exit, gfc_check_flush,
gfc_check_umask, gfc_check_umask_sub, gfc_check_unlink,
gfc_check_unlink_sub): Fix formatting issues.
From-SVN: r93093
2005-01-08 23:40:47 +01:00
|
|
|
|
2004-08-22 14:09:26 +02:00
|
|
|
return check_reduction (ap);
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_product_sum (gfc_actual_arglist *ap)
|
2004-08-22 14:09:26 +02:00
|
|
|
{
|
|
|
|
if (numeric_check (ap->expr, 0) == FAILURE
|
|
|
|
|| array_check (ap->expr, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
arith.c (arctangent2, [...]): Fix whitespace issues.
* arith.c (arctangent2, gfc_arith_init_1, gfc_arith_done_1,
gfc_constant_result, gfc_range_check, gfc_arith_power,
eval_type_intrinsic0, eval_intrinsic_f2, gfc_real2real,
gfc_real2complex, gfc_complex2int, gfc_complex2real,
gfc_complex2complex): Fix whitespace issues.
check.c (must_be, type_check, numeric_check, int_or_real_check,
logical_array_check, array_check, scalar_check, nonoptional_check,
variable_check, dim_check, check_a_kind, gfc_check_a_ikind,
gfc_check_a_xkind, gfc_check_abs, gfc_check_all_any,
gfc_check_allocated, gfc_check_a_p, gfc_check_besn,
gfc_check_btest, gfc_check_char, gfc_check_cmplx, gfc_check_count,
gfc_check_cshift, gfc_check_dcmplx, gfc_check_dble,
gfc_check_digits, gfc_check_dot_product, gfc_check_eoshift,
gfc_check_fnum, gfc_check_g77_math1, gfc_check_huge, gfc_check_i,
gfc_check_iand, gfc_check_ibclr, gfc_check_ibits, gfc_check_ibset,
gfc_check_idnint, gfc_check_ieor, gfc_check_index, gfc_check_int,
gfc_check_ior, gfc_check_ishft, gfc_check_ishftc, gfc_check_kind,
gfc_check_lbound, gfc_check_logical, min_max_args,
gfc_check_min_max_integer, gfc_check_min_max_real,
gfc_check_min_max_double, gfc_check_matmul,
gfc_check_minval_maxval, gfc_check_merge, gfc_check_nearest,
gfc_check_pack, gfc_check_precision, gfc_check_radix,
gfc_check_range, gfc_check_real, gfc_check_repeat,
gfc_check_scale, gfc_check_scan, gfc_check_selected_real_kind,
gfc_check_set_exponent): Fix formatting issues.
(gfc_check_size, gfc_check_sign): Alphabetize function order,
remove whitespace-only line.
(gfc_check_fstat, gfc_check_fstat_sub, gfc_check_stat,
gfc_check_stat_sub, gfc_check_transfer, gfc_check_transpose,
gfc_check_ubound, gfc_check_unpack, gfc_check_verify, gfc_check_x,
gfc_check_cpu_time, gfc_check_date_and_time, gfc_check_mvbits,
gfc_check_random_number, gfc_check_random_seed,
gfc_check_second_sub, gfc_check_system_clock,
gfc_check_getcwd_sub, gfc_check_exit, gfc_check_flush,
gfc_check_umask, gfc_check_umask_sub, gfc_check_unlink,
gfc_check_unlink_sub): Fix formatting issues.
From-SVN: r93093
2005-01-08 23:40:47 +01:00
|
|
|
|
2004-08-22 14:09:26 +02:00
|
|
|
return check_reduction (ap);
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_merge (gfc_expr *tsource, gfc_expr *fsource, gfc_expr *mask)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (same_type_check (tsource, 0, fsource, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (mask, 2, BT_LOGICAL) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
[multiple changes]
2006-10-05 Erik Edelmann <edelmann@gcc.gnu.org>
Paul Thomas <pault@gcc.gnu.org>
PR fortran/20541
* interface.c (gfc_compare_derived_types): Add comparison of
the allocatable field.
* intrinsic.c (add_subroutines): Add MOVE_ALLOC.
* trans-expr.c (gfc_conv_aliased_arg, gfc_trans_subarray_assign,
gfc_trans_subcomponent_assign, gfc_conv_string_parameter,
gfc_trans_scalar_assign): Add extra arguments l_is_temp
and r_is_var to references to latter function.
(gfc_conv_function_call): Add enum for types of argument and
an associated variable parm_kind. Deallocate components of
INTENT(OUT) and non-variable arrays.
(gfc_trans_subcomponent_assign): Add block to assign arrays
to allocatable components.
(gfc_trans_scalar_assign): Add block to handle assignments of
derived types with allocatable components, using the above new
arguments to control allocation/deallocation of memory and the
copying of allocated arrays.
* trans-array.c (gfc_array_allocate): Remove old identification
of pointer and replace with that of an allocatable array. Add
nullify of structures with allocatable components.
(gfc_conv_array_initializer): Treat EXPR_NULL.
(gfc_conv_array_parameter): Deallocate allocatable components
of non-variable structures.
(gfc_trans_dealloc_allocated): Use second argument of library
deallocate to inhibit, without error, freeing NULL pointers.
(get_full_array_size): New function to return the size of a
full array.
(gfc_duplicate_allocatable): New function to allocate and copy
allocated data.
(structure_alloc_comps): New recursive function to deallocate,
nullify or copy allocatable components.
(gfc_nullify_alloc_comp, gfc_deallocate_alloc_comp,
gfc_copy_alloc_comp): New interface functions to call previous.
(gfc_trans_deferred_array): Add the code to nullify allocatable
components, when entering scope, and to deallocate them on
leaving. Do not call gfc_trans_static_array_pointer and return
for structures with allocatable components and default
initializers.
* symbol.c (gfc_set_component_attr): Set allocatable field.
(gfc_get_component_attr): Set the allocatable attribute.
* intrinsic.h : Prototype for gfc_check_move_alloc.
* decl.c (build_struct): Apply TR15581 constraints for
allocatable components.
(variable_decl): Default initializer is always NULL for
allocatable components.
(match_attr_spec): Allow, or not, allocatable components,
according to the standard in force.
* trans-array.h : Prototypes for gfc_nullify_alloc_comp,
gfc_deallocate_alloc_comp, gfc_copy_alloc_comp and
gfc_duplicate_allocatable.
* gfortran.texi : Add mention of TR15581 extensions.
* gfortran.h : Add attribute alloc_comp, add
gfc_components field allocatable and add the prototype
for gfc_expr_to_initialize.
* trans-stmt.c (generate_loop_for_temp_to_lhs,
generate_loop_for_rhs_to_temp, gfc_trans_where_assign,
gfc_trans_where_3): Add extra arguments to calls to
gfc_trans_scalar_assign and set appropriately.
(gfc_trans_allocate): Nullify allocatable components.
(gfc_trans_deallocate): Deallocate to ultimate allocatable
components but stop at ultimate pointer components.
* module.c (mio_symbol_attribute, mio_symbol_attribute,
mio_component): Add module support for allocatable
components.
* trans-types.c (gfc_get_derived_type): Treat allocatable
components.
* trans.h : Add two boolean arguments to
gfc_trans_scalar_assign.
* resolve.c (resolve_structure_cons): Check conformance of
constructor element and the component.
(resolve_allocate_expr): Add expression to nullify the
constructor expression for allocatable components.
(resolve_transfer): Inhibit I/O of derived types with
allocatable components.
(resolve_fl_derived): Skip check of bounds of allocatable
components.
* trans-decl.c (gfc_get_symbol_decl): Add derived types
with allocatable components to deferred variable.
(gfc_trans_deferred_vars): Make calls for derived types
with allocatable components to gfc_trans_deferred_array.
(gfc_generate_function_code): Nullify allocatable
component function result on entry.
* parse.c (parse_derived): Set symbol attr.allocatable if
allocatable components are present.
* check.c (gfc_check_allocated): Enforce attr.allocatable
for intrinsic arguments.
(gfc_check_move_alloc): Check arguments of move_alloc.
* primary.c (gfc_variable_attr): Set allocatable attribute.
* intrinsic.texi : Add index entry and section for
for move_alloc.
PR fortran/29115
* resolve.c (resolve_structure_cons): It is an error if the
pointer component elements of a derived type constructor are
not pointer or target.
PR fortran/29211
* trans-stmt.c (generate_loop_for_temp_to_lhs,
generate_loop_for_rhs_to_temp): Provide a string length for
the temporary by copying that of the other side of the scalar
assignment.
2006-10-05 Paul Thomas <pault@gcc.gnu.org>
Erik Edelmann <edelmann@gcc.gnu.org>
PR libgfortran/20541
* Makefile.in : Add move_alloc.
* intrinsics/move_alloc.c: New function.
* Makefile.am : Add move_alloc.
2006-10-05 Erik Edelmann <edelmann@gcc.gnu.org>
Paul Thomas <pault@gcc.gnu.org>
PR fortran/20541
* gfortran.dg/alloc_comp_basics_1.f90: New test.
* gfortran.dg/alloc_comp_basics_2.f90: New test.
* gfortran.dg/alloc_comp_assign_1.f90: New test.
* gfortran.dg/alloc_comp_assign_2.f90: New test.
* gfortran.dg/alloc_comp_assign_3.f90: New test.
* gfortran.dg/alloc_comp_assign_4.f90: New test.
* gfortran.dg/alloc_comp_constraint_1.f90: New test.
* gfortran.dg/alloc_comp_constraint_2.f90: New test.
* gfortran.dg/alloc_comp_constraint_3.f90: New test.
* gfortran.dg/alloc_comp_constructor_1.f90: New test.
* gfortran.dg/alloc_comp_constructor_2.f90: New test.
* gfortran.dg/alloc_comp_initializer_1.f90: New test.
* gfortran.dg/alloc_comp_std.f90: New test.
* gfortran.dg/move_alloc.f90: New test.
PR fortran/29115
* gfortran.dg/derived_constructor_comps_2.f90: New test.
PR fortran/29211
* gfortran.dg/forall_char_dependencies_1.f90: New test.
From-SVN: r117558
2006-10-08 18:21:55 +02:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_move_alloc (gfc_expr *from, gfc_expr *to)
|
[multiple changes]
2006-10-05 Erik Edelmann <edelmann@gcc.gnu.org>
Paul Thomas <pault@gcc.gnu.org>
PR fortran/20541
* interface.c (gfc_compare_derived_types): Add comparison of
the allocatable field.
* intrinsic.c (add_subroutines): Add MOVE_ALLOC.
* trans-expr.c (gfc_conv_aliased_arg, gfc_trans_subarray_assign,
gfc_trans_subcomponent_assign, gfc_conv_string_parameter,
gfc_trans_scalar_assign): Add extra arguments l_is_temp
and r_is_var to references to latter function.
(gfc_conv_function_call): Add enum for types of argument and
an associated variable parm_kind. Deallocate components of
INTENT(OUT) and non-variable arrays.
(gfc_trans_subcomponent_assign): Add block to assign arrays
to allocatable components.
(gfc_trans_scalar_assign): Add block to handle assignments of
derived types with allocatable components, using the above new
arguments to control allocation/deallocation of memory and the
copying of allocated arrays.
* trans-array.c (gfc_array_allocate): Remove old identification
of pointer and replace with that of an allocatable array. Add
nullify of structures with allocatable components.
(gfc_conv_array_initializer): Treat EXPR_NULL.
(gfc_conv_array_parameter): Deallocate allocatable components
of non-variable structures.
(gfc_trans_dealloc_allocated): Use second argument of library
deallocate to inhibit, without error, freeing NULL pointers.
(get_full_array_size): New function to return the size of a
full array.
(gfc_duplicate_allocatable): New function to allocate and copy
allocated data.
(structure_alloc_comps): New recursive function to deallocate,
nullify or copy allocatable components.
(gfc_nullify_alloc_comp, gfc_deallocate_alloc_comp,
gfc_copy_alloc_comp): New interface functions to call previous.
(gfc_trans_deferred_array): Add the code to nullify allocatable
components, when entering scope, and to deallocate them on
leaving. Do not call gfc_trans_static_array_pointer and return
for structures with allocatable components and default
initializers.
* symbol.c (gfc_set_component_attr): Set allocatable field.
(gfc_get_component_attr): Set the allocatable attribute.
* intrinsic.h : Prototype for gfc_check_move_alloc.
* decl.c (build_struct): Apply TR15581 constraints for
allocatable components.
(variable_decl): Default initializer is always NULL for
allocatable components.
(match_attr_spec): Allow, or not, allocatable components,
according to the standard in force.
* trans-array.h : Prototypes for gfc_nullify_alloc_comp,
gfc_deallocate_alloc_comp, gfc_copy_alloc_comp and
gfc_duplicate_allocatable.
* gfortran.texi : Add mention of TR15581 extensions.
* gfortran.h : Add attribute alloc_comp, add
gfc_components field allocatable and add the prototype
for gfc_expr_to_initialize.
* trans-stmt.c (generate_loop_for_temp_to_lhs,
generate_loop_for_rhs_to_temp, gfc_trans_where_assign,
gfc_trans_where_3): Add extra arguments to calls to
gfc_trans_scalar_assign and set appropriately.
(gfc_trans_allocate): Nullify allocatable components.
(gfc_trans_deallocate): Deallocate to ultimate allocatable
components but stop at ultimate pointer components.
* module.c (mio_symbol_attribute, mio_symbol_attribute,
mio_component): Add module support for allocatable
components.
* trans-types.c (gfc_get_derived_type): Treat allocatable
components.
* trans.h : Add two boolean arguments to
gfc_trans_scalar_assign.
* resolve.c (resolve_structure_cons): Check conformance of
constructor element and the component.
(resolve_allocate_expr): Add expression to nullify the
constructor expression for allocatable components.
(resolve_transfer): Inhibit I/O of derived types with
allocatable components.
(resolve_fl_derived): Skip check of bounds of allocatable
components.
* trans-decl.c (gfc_get_symbol_decl): Add derived types
with allocatable components to deferred variable.
(gfc_trans_deferred_vars): Make calls for derived types
with allocatable components to gfc_trans_deferred_array.
(gfc_generate_function_code): Nullify allocatable
component function result on entry.
* parse.c (parse_derived): Set symbol attr.allocatable if
allocatable components are present.
* check.c (gfc_check_allocated): Enforce attr.allocatable
for intrinsic arguments.
(gfc_check_move_alloc): Check arguments of move_alloc.
* primary.c (gfc_variable_attr): Set allocatable attribute.
* intrinsic.texi : Add index entry and section for
for move_alloc.
PR fortran/29115
* resolve.c (resolve_structure_cons): It is an error if the
pointer component elements of a derived type constructor are
not pointer or target.
PR fortran/29211
* trans-stmt.c (generate_loop_for_temp_to_lhs,
generate_loop_for_rhs_to_temp): Provide a string length for
the temporary by copying that of the other side of the scalar
assignment.
2006-10-05 Paul Thomas <pault@gcc.gnu.org>
Erik Edelmann <edelmann@gcc.gnu.org>
PR libgfortran/20541
* Makefile.in : Add move_alloc.
* intrinsics/move_alloc.c: New function.
* Makefile.am : Add move_alloc.
2006-10-05 Erik Edelmann <edelmann@gcc.gnu.org>
Paul Thomas <pault@gcc.gnu.org>
PR fortran/20541
* gfortran.dg/alloc_comp_basics_1.f90: New test.
* gfortran.dg/alloc_comp_basics_2.f90: New test.
* gfortran.dg/alloc_comp_assign_1.f90: New test.
* gfortran.dg/alloc_comp_assign_2.f90: New test.
* gfortran.dg/alloc_comp_assign_3.f90: New test.
* gfortran.dg/alloc_comp_assign_4.f90: New test.
* gfortran.dg/alloc_comp_constraint_1.f90: New test.
* gfortran.dg/alloc_comp_constraint_2.f90: New test.
* gfortran.dg/alloc_comp_constraint_3.f90: New test.
* gfortran.dg/alloc_comp_constructor_1.f90: New test.
* gfortran.dg/alloc_comp_constructor_2.f90: New test.
* gfortran.dg/alloc_comp_initializer_1.f90: New test.
* gfortran.dg/alloc_comp_std.f90: New test.
* gfortran.dg/move_alloc.f90: New test.
PR fortran/29115
* gfortran.dg/derived_constructor_comps_2.f90: New test.
PR fortran/29211
* gfortran.dg/forall_char_dependencies_1.f90: New test.
From-SVN: r117558
2006-10-08 18:21:55 +02:00
|
|
|
{
|
|
|
|
symbol_attribute attr;
|
|
|
|
|
|
|
|
if (variable_check (from, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (array_check (from, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
attr = gfc_variable_attr (from, NULL);
|
|
|
|
if (!attr.allocatable)
|
|
|
|
{
|
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must be ALLOCATABLE",
|
|
|
|
gfc_current_intrinsic_arg[0], gfc_current_intrinsic,
|
|
|
|
&from->where);
|
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
if (variable_check (to, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (array_check (to, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
attr = gfc_variable_attr (to, NULL);
|
|
|
|
if (!attr.allocatable)
|
|
|
|
{
|
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must be ALLOCATABLE",
|
|
|
|
gfc_current_intrinsic_arg[0], gfc_current_intrinsic,
|
|
|
|
&to->where);
|
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
if (same_type_check (from, 0, to, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (to->rank != from->rank)
|
|
|
|
{
|
|
|
|
gfc_error ("the '%s' and '%s' arguments of '%s' intrinsic at %L must "
|
|
|
|
"have the same rank %d/%d", gfc_current_intrinsic_arg[0],
|
|
|
|
gfc_current_intrinsic_arg[1], gfc_current_intrinsic,
|
|
|
|
&to->where, from->rank, to->rank);
|
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
if (to->ts.kind != from->ts.kind)
|
|
|
|
{
|
|
|
|
gfc_error ("the '%s' and '%s' arguments of '%s' intrinsic at %L must "
|
|
|
|
"be of the same kind %d/%d", gfc_current_intrinsic_arg[0],
|
|
|
|
gfc_current_intrinsic_arg[1], gfc_current_intrinsic,
|
|
|
|
&to->where, from->ts.kind, to->ts.kind);
|
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
2004-05-13 08:41:07 +02:00
|
|
|
|
2007-01-07 01:28:29 +01:00
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_nearest (gfc_expr *x, gfc_expr *s)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (type_check (x, 0, BT_REAL) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (s, 1, BT_REAL) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
2007-01-07 01:28:29 +01:00
|
|
|
|
2006-10-08 15:21:42 +02:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_new_line (gfc_expr *a)
|
2006-10-08 15:21:42 +02:00
|
|
|
{
|
|
|
|
if (type_check (a, 0, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
2004-05-13 08:41:07 +02:00
|
|
|
|
2007-01-07 01:28:29 +01:00
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_null (gfc_expr *mold)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
symbol_attribute attr;
|
|
|
|
|
|
|
|
if (mold == NULL)
|
|
|
|
return SUCCESS;
|
|
|
|
|
|
|
|
if (variable_check (mold, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
attr = gfc_variable_attr (mold, NULL);
|
|
|
|
|
|
|
|
if (!attr.pointer)
|
|
|
|
{
|
re PR fortran/15586 (gfortran should support i18n in its compiler messages)
PR fortran/15586
* arith.c (gfc_arith_error): Change message to include locus.
(check_result, eval_intrinsic, gfc_int2int, gfc_real2real,
gfc_real2complex, gfc_complex2real, gfc_complex2complex): Use
the new gfc_arith_error.
(arith_error): Rewrite full error messages instead of building
them from pieces.
* check.c (must_be): Removed.
(type_check, numeric_check, int_or_real_check, real_or_complex_check,
kind_check, double_check, logical_array_check, array_check,
scalar_check, same_type_check, rank_check, kind_value_check,
variable_check, gfc_check_allocated, gfc_check_associated,
gfc_check_cmplx, gfc_check_dcmplx, gfc_check_dot_product,
gfc_check_index, gfc_check_kind, gfc_check_matmul, gfc_check_null,
gfc_check_pack, gfc_check_precision, gfc_check_present,
gfc_check_spread): Rewrite full error messages instead of
building them from pieces.
* decl.c (gfc_match_entry): Rewrite full error messages instead
of building them from pieces.
* parse.c (gfc_state_name): Remove.
* parse.h: Remove prototype for gfc_state_name.
From-SVN: r105844
2005-10-24 11:11:51 +02:00
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must be a POINTER",
|
|
|
|
gfc_current_intrinsic_arg[0],
|
|
|
|
gfc_current_intrinsic, &mold->where);
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_pack (gfc_expr *array, gfc_expr *mask, gfc_expr *vector)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
2006-02-04 23:11:57 +01:00
|
|
|
char buffer[80];
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
if (array_check (array, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (mask, 1, BT_LOGICAL) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
2007-01-07 01:28:29 +01:00
|
|
|
snprintf (buffer, 80, "arguments '%s' and '%s' for intrinsic '%s'",
|
|
|
|
gfc_current_intrinsic_arg[0], gfc_current_intrinsic_arg[1],
|
|
|
|
gfc_current_intrinsic);
|
2006-02-04 23:11:57 +01:00
|
|
|
if (gfc_check_conformance (buffer, array, mask) == FAILURE)
|
|
|
|
return FAILURE;
|
2004-05-13 08:41:07 +02:00
|
|
|
|
|
|
|
if (vector != NULL)
|
|
|
|
{
|
|
|
|
if (same_type_check (array, 0, vector, 2) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (rank_check (vector, 2, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
/* TODO: More constraints here. */
|
|
|
|
}
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_precision (gfc_expr *x)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (x->ts.type != BT_REAL && x->ts.type != BT_COMPLEX)
|
|
|
|
{
|
re PR fortran/15586 (gfortran should support i18n in its compiler messages)
PR fortran/15586
* arith.c (gfc_arith_error): Change message to include locus.
(check_result, eval_intrinsic, gfc_int2int, gfc_real2real,
gfc_real2complex, gfc_complex2real, gfc_complex2complex): Use
the new gfc_arith_error.
(arith_error): Rewrite full error messages instead of building
them from pieces.
* check.c (must_be): Removed.
(type_check, numeric_check, int_or_real_check, real_or_complex_check,
kind_check, double_check, logical_array_check, array_check,
scalar_check, same_type_check, rank_check, kind_value_check,
variable_check, gfc_check_allocated, gfc_check_associated,
gfc_check_cmplx, gfc_check_dcmplx, gfc_check_dot_product,
gfc_check_index, gfc_check_kind, gfc_check_matmul, gfc_check_null,
gfc_check_pack, gfc_check_precision, gfc_check_present,
gfc_check_spread): Rewrite full error messages instead of
building them from pieces.
* decl.c (gfc_match_entry): Rewrite full error messages instead
of building them from pieces.
* parse.c (gfc_state_name): Remove.
* parse.h: Remove prototype for gfc_state_name.
From-SVN: r105844
2005-10-24 11:11:51 +02:00
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must be of type "
|
|
|
|
"REAL or COMPLEX", gfc_current_intrinsic_arg[0],
|
|
|
|
gfc_current_intrinsic, &x->where);
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_present (gfc_expr *a)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
gfc_symbol *sym;
|
|
|
|
|
|
|
|
if (variable_check (a, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
sym = a->symtree->n.sym;
|
|
|
|
if (!sym->attr.dummy)
|
|
|
|
{
|
re PR fortran/15586 (gfortran should support i18n in its compiler messages)
PR fortran/15586
* arith.c (gfc_arith_error): Change message to include locus.
(check_result, eval_intrinsic, gfc_int2int, gfc_real2real,
gfc_real2complex, gfc_complex2real, gfc_complex2complex): Use
the new gfc_arith_error.
(arith_error): Rewrite full error messages instead of building
them from pieces.
* check.c (must_be): Removed.
(type_check, numeric_check, int_or_real_check, real_or_complex_check,
kind_check, double_check, logical_array_check, array_check,
scalar_check, same_type_check, rank_check, kind_value_check,
variable_check, gfc_check_allocated, gfc_check_associated,
gfc_check_cmplx, gfc_check_dcmplx, gfc_check_dot_product,
gfc_check_index, gfc_check_kind, gfc_check_matmul, gfc_check_null,
gfc_check_pack, gfc_check_precision, gfc_check_present,
gfc_check_spread): Rewrite full error messages instead of
building them from pieces.
* decl.c (gfc_match_entry): Rewrite full error messages instead
of building them from pieces.
* parse.c (gfc_state_name): Remove.
* parse.h: Remove prototype for gfc_state_name.
From-SVN: r105844
2005-10-24 11:11:51 +02:00
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must be of a "
|
|
|
|
"dummy variable", gfc_current_intrinsic_arg[0],
|
|
|
|
gfc_current_intrinsic, &a->where);
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
if (!sym->attr.optional)
|
|
|
|
{
|
re PR fortran/15586 (gfortran should support i18n in its compiler messages)
PR fortran/15586
* arith.c (gfc_arith_error): Change message to include locus.
(check_result, eval_intrinsic, gfc_int2int, gfc_real2real,
gfc_real2complex, gfc_complex2real, gfc_complex2complex): Use
the new gfc_arith_error.
(arith_error): Rewrite full error messages instead of building
them from pieces.
* check.c (must_be): Removed.
(type_check, numeric_check, int_or_real_check, real_or_complex_check,
kind_check, double_check, logical_array_check, array_check,
scalar_check, same_type_check, rank_check, kind_value_check,
variable_check, gfc_check_allocated, gfc_check_associated,
gfc_check_cmplx, gfc_check_dcmplx, gfc_check_dot_product,
gfc_check_index, gfc_check_kind, gfc_check_matmul, gfc_check_null,
gfc_check_pack, gfc_check_precision, gfc_check_present,
gfc_check_spread): Rewrite full error messages instead of
building them from pieces.
* decl.c (gfc_match_entry): Rewrite full error messages instead
of building them from pieces.
* parse.c (gfc_state_name): Remove.
* parse.h: Remove prototype for gfc_state_name.
From-SVN: r105844
2005-10-24 11:11:51 +02:00
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must be of "
|
|
|
|
"an OPTIONAL dummy variable", gfc_current_intrinsic_arg[0],
|
|
|
|
gfc_current_intrinsic, &a->where);
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
2007-01-07 01:28:29 +01:00
|
|
|
/* 13.14.82 PRESENT(A)
|
|
|
|
......
|
|
|
|
Argument. A shall be the name of an optional dummy argument that is
|
|
|
|
accessible in the subprogram in which the PRESENT function reference
|
|
|
|
appears... */
|
2006-07-13 07:07:35 +02:00
|
|
|
|
|
|
|
if (a->ref != NULL
|
2007-01-07 01:28:29 +01:00
|
|
|
&& !(a->ref->next == NULL && a->ref->type == REF_ARRAY
|
|
|
|
&& a->ref->u.ar.type == AR_FULL))
|
2006-07-13 07:07:35 +02:00
|
|
|
{
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must not be a "
|
|
|
|
"subobject of '%s'", gfc_current_intrinsic_arg[0],
|
2006-07-13 07:07:35 +02:00
|
|
|
gfc_current_intrinsic, &a->where, sym->name);
|
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_radix (gfc_expr *x)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (int_or_real_check (x, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_range (gfc_expr *x)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (numeric_check (x, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
/* real, float, sngl. */
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_real (gfc_expr *a, gfc_expr *kind)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (numeric_check (a, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (kind_check (kind, 1, BT_REAL) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
Makefile.am: Added new files.
* Makefile.am: Added new files.
* Makefile.in: Regenerate.
* aclocal.m4: Regenerate.
* configure.ac: add checks for signal.h headers file, as well as
following functions: chdir, strerror, getlogin, gethostname, kill,
link, symlink, perror, sleep, time.
* configure: Regenerate.
* intrinsics/chdir.c, intrinsics/gerror.c, intrinsics/getlog.c,
intrinsics/hostnm.c, intrinsics/ierrno.c, intrinsics/kill.c,
intrinsics/link.c, intrinsics/perror.c, intrinsics/rename.c,
intrinsics/sleep.c, intrinsics/symlnk.c, intrinsics/time.c: Newly
implementend g77 intrinsics.
* check.c (gfc_check_chdir, gfc_check_chdir_sub, gfc_check_kill,
gfc_check_kill_sub, gfc_check_link, gfc_check_link_sub,
gfc_check_symlnk, gfc_check_symlnk_sub, gfc_check_rename,
gfc_check_rename_sub, gfc_check_sleep_sub, gfc_check_gerror,
gfc_check_getlog, gfc_check_hostnm, gfc_check_hostnm_sub,
gfc_check_perror): new functions to check newly implemented
g77 intrinsics.
* gfortran.h: adding symbols for new intrinsics.
* intrinsic.c (add_functions): adding new intrinsics.
(add_subroutines): adding new intrinsics.
* intrinsic.h: prototype for all checking and resolving
functions.
* iresolve.c (gfc_resolve_chdir, gfc_resolve_chdir_sub,
gfc_resolve_hostnm, gfc_resolve_ierrno, gfc_resolve_kill,
gfc_resolve_link, gfc_resolve_rename, gfc_resolve_symlnk,
gfc_resolve_time, gfc_resolve_time8, gfc_resolve_rename_sub,
gfc_resolve_kill_sub, gfc_resolve_link_sub,
gfc_resolve_symlnk_sub, gfc_resolve_sleep_sub,
gfc_resolve_gerror, gfc_resolve_getlog, gfc_resolve_hostnm_sub,
gfc_resolve_perror): new functions to resolve intrinsics.
* trans-intrinsic.c (gfc_conv_intrinsic_function): add case
for new symbols.
* g77_intrinsics_funcs.f: New test.
* g77_intrinsics_sub.f: New test.
From-SVN: r96893
2005-03-22 23:08:22 +01:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_rename (gfc_expr *path1, gfc_expr *path2)
|
Makefile.am: Added new files.
* Makefile.am: Added new files.
* Makefile.in: Regenerate.
* aclocal.m4: Regenerate.
* configure.ac: add checks for signal.h headers file, as well as
following functions: chdir, strerror, getlogin, gethostname, kill,
link, symlink, perror, sleep, time.
* configure: Regenerate.
* intrinsics/chdir.c, intrinsics/gerror.c, intrinsics/getlog.c,
intrinsics/hostnm.c, intrinsics/ierrno.c, intrinsics/kill.c,
intrinsics/link.c, intrinsics/perror.c, intrinsics/rename.c,
intrinsics/sleep.c, intrinsics/symlnk.c, intrinsics/time.c: Newly
implementend g77 intrinsics.
* check.c (gfc_check_chdir, gfc_check_chdir_sub, gfc_check_kill,
gfc_check_kill_sub, gfc_check_link, gfc_check_link_sub,
gfc_check_symlnk, gfc_check_symlnk_sub, gfc_check_rename,
gfc_check_rename_sub, gfc_check_sleep_sub, gfc_check_gerror,
gfc_check_getlog, gfc_check_hostnm, gfc_check_hostnm_sub,
gfc_check_perror): new functions to check newly implemented
g77 intrinsics.
* gfortran.h: adding symbols for new intrinsics.
* intrinsic.c (add_functions): adding new intrinsics.
(add_subroutines): adding new intrinsics.
* intrinsic.h: prototype for all checking and resolving
functions.
* iresolve.c (gfc_resolve_chdir, gfc_resolve_chdir_sub,
gfc_resolve_hostnm, gfc_resolve_ierrno, gfc_resolve_kill,
gfc_resolve_link, gfc_resolve_rename, gfc_resolve_symlnk,
gfc_resolve_time, gfc_resolve_time8, gfc_resolve_rename_sub,
gfc_resolve_kill_sub, gfc_resolve_link_sub,
gfc_resolve_symlnk_sub, gfc_resolve_sleep_sub,
gfc_resolve_gerror, gfc_resolve_getlog, gfc_resolve_hostnm_sub,
gfc_resolve_perror): new functions to resolve intrinsics.
* trans-intrinsic.c (gfc_conv_intrinsic_function): add case
for new symbols.
* g77_intrinsics_funcs.f: New test.
* g77_intrinsics_sub.f: New test.
From-SVN: r96893
2005-03-22 23:08:22 +01:00
|
|
|
{
|
|
|
|
if (type_check (path1, 0, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (path2, 1, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_rename_sub (gfc_expr *path1, gfc_expr *path2, gfc_expr *status)
|
Makefile.am: Added new files.
* Makefile.am: Added new files.
* Makefile.in: Regenerate.
* aclocal.m4: Regenerate.
* configure.ac: add checks for signal.h headers file, as well as
following functions: chdir, strerror, getlogin, gethostname, kill,
link, symlink, perror, sleep, time.
* configure: Regenerate.
* intrinsics/chdir.c, intrinsics/gerror.c, intrinsics/getlog.c,
intrinsics/hostnm.c, intrinsics/ierrno.c, intrinsics/kill.c,
intrinsics/link.c, intrinsics/perror.c, intrinsics/rename.c,
intrinsics/sleep.c, intrinsics/symlnk.c, intrinsics/time.c: Newly
implementend g77 intrinsics.
* check.c (gfc_check_chdir, gfc_check_chdir_sub, gfc_check_kill,
gfc_check_kill_sub, gfc_check_link, gfc_check_link_sub,
gfc_check_symlnk, gfc_check_symlnk_sub, gfc_check_rename,
gfc_check_rename_sub, gfc_check_sleep_sub, gfc_check_gerror,
gfc_check_getlog, gfc_check_hostnm, gfc_check_hostnm_sub,
gfc_check_perror): new functions to check newly implemented
g77 intrinsics.
* gfortran.h: adding symbols for new intrinsics.
* intrinsic.c (add_functions): adding new intrinsics.
(add_subroutines): adding new intrinsics.
* intrinsic.h: prototype for all checking and resolving
functions.
* iresolve.c (gfc_resolve_chdir, gfc_resolve_chdir_sub,
gfc_resolve_hostnm, gfc_resolve_ierrno, gfc_resolve_kill,
gfc_resolve_link, gfc_resolve_rename, gfc_resolve_symlnk,
gfc_resolve_time, gfc_resolve_time8, gfc_resolve_rename_sub,
gfc_resolve_kill_sub, gfc_resolve_link_sub,
gfc_resolve_symlnk_sub, gfc_resolve_sleep_sub,
gfc_resolve_gerror, gfc_resolve_getlog, gfc_resolve_hostnm_sub,
gfc_resolve_perror): new functions to resolve intrinsics.
* trans-intrinsic.c (gfc_conv_intrinsic_function): add case
for new symbols.
* g77_intrinsics_funcs.f: New test.
* g77_intrinsics_sub.f: New test.
From-SVN: r96893
2005-03-22 23:08:22 +01:00
|
|
|
{
|
|
|
|
if (type_check (path1, 0, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (path2, 1, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (status == NULL)
|
|
|
|
return SUCCESS;
|
|
|
|
|
|
|
|
if (type_check (status, 2, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (status, 2) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_repeat (gfc_expr *x, gfc_expr *y)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (type_check (x, 0, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (x, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (y, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (y, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_reshape (gfc_expr *source, gfc_expr *shape,
|
|
|
|
gfc_expr *pad, gfc_expr *order)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
mpz_t size;
|
2006-11-10 22:06:42 +01:00
|
|
|
mpz_t nelems;
|
2004-05-13 08:41:07 +02:00
|
|
|
int m;
|
|
|
|
|
|
|
|
if (array_check (source, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (rank_check (shape, 1, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (shape, 1, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (gfc_array_size (shape, &size) != SUCCESS)
|
|
|
|
{
|
|
|
|
gfc_error ("'shape' argument of 'reshape' intrinsic at %L must be an "
|
|
|
|
"array of constant size", &shape->where);
|
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
m = mpz_cmp_ui (size, GFC_MAX_DIMENSIONS);
|
|
|
|
mpz_clear (size);
|
|
|
|
|
|
|
|
if (m > 0)
|
|
|
|
{
|
2005-09-17 20:58:01 +02:00
|
|
|
gfc_error ("'shape' argument of 'reshape' intrinsic at %L has more "
|
|
|
|
"than %d elements", &shape->where, GFC_MAX_DIMENSIONS);
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
if (pad != NULL)
|
|
|
|
{
|
|
|
|
if (same_type_check (source, 0, pad, 2) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
if (array_check (pad, 2) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
if (order != NULL && array_check (order, 3) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
2007-01-07 01:28:29 +01:00
|
|
|
if (pad == NULL && shape->expr_type == EXPR_ARRAY
|
|
|
|
&& gfc_is_constant_expr (shape)
|
|
|
|
&& !(source->expr_type == EXPR_VARIABLE && source->symtree->n.sym->as
|
|
|
|
&& source->symtree->n.sym->as->type == AS_ASSUMED_SIZE))
|
2006-11-10 22:06:42 +01:00
|
|
|
{
|
|
|
|
/* Check the match in size between source and destination. */
|
|
|
|
if (gfc_array_size (source, &nelems) == SUCCESS)
|
|
|
|
{
|
|
|
|
gfc_constructor *c;
|
|
|
|
bool test;
|
|
|
|
|
|
|
|
c = shape->value.constructor;
|
|
|
|
mpz_init_set_ui (size, 1);
|
|
|
|
for (; c; c = c->next)
|
|
|
|
mpz_mul (size, size, c->expr->value.integer);
|
|
|
|
|
|
|
|
test = mpz_cmp (nelems, size) < 0 && mpz_cmp_ui (size, 0) > 0;
|
|
|
|
mpz_clear (nelems);
|
|
|
|
mpz_clear (size);
|
|
|
|
|
|
|
|
if (test)
|
|
|
|
{
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_error ("Without padding, there are not enough elements "
|
|
|
|
"in the intrinsic RESHAPE source at %L to match "
|
|
|
|
"the shape", &source->where);
|
2006-11-10 22:06:42 +01:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_scale (gfc_expr *x, gfc_expr *i)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (type_check (x, 0, BT_REAL) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (i, 1, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
re PR fortran/29600 ([F03] MINLOC and MAXLOC take an optional KIND argument)
PR fortran/29600
* intrinsic.c (add_functions): Add KIND arguments to COUNT,
IACHAR, ICHAR, INDEX, LBOUND, LEN, LEN_TRIM, SCAN, SIZE, UBOUND
and VERIFY.
* iresolve.c (gfc_resolve_count): Add kind argument.
(gfc_resolve_iachar): New function.
(gfc_resolve_ichar): Add kind argument.
(gfc_resolve_index_func): Likewise.
(gfc_resolve_lbound): Likewise.
(gfc_resolve_len): Likewise.
(gfc_resolve_len_trim): Likewise.
(gfc_resolve_scan): Likewise.
(gfc_resolve_size): New function.
(gfc_resolve_ubound): Add kind argument.
(gfc_resolve_verify): Likewise.
* trans-decl.c (gfc_get_extern_function_decl): Allow specific
intrinsics to have 4 arguments.
* check.c (gfc_check_count): Add kind argument.
(gfc_check_ichar_iachar): Likewise.
(gfc_check_index): Likewise.
(gfc_check_lbound): Likewise.
(gfc_check_len_lentrim): New function.
(gfc_check_scan): Add kind argument.
(gfc_check_size): Likewise.
(gfc_check_ubound): Likewise.
(gfc_check_verify): Likewise.
* intrinsic.texi: Update documentation for COUNT, IACHAR, ICHAR,
INDEX, LBOUND, LEN, LEN_TRIM, SCAN, SIZE, UBOUND and VERIFY.
* simplify.c (get_kind): Whitespace fix.
(int_expr_with_kind): New function.
(gfc_simplify_iachar): Add kind argument.
(gfc_simplify_iachar): Likewise.
(gfc_simplify_ichar): Likewise.
(gfc_simplify_index): Likewise.
(simplify_bound_dim): Likewise.
(simplify_bound): Likewise.
(gfc_simplify_lbound): Likewise.
(gfc_simplify_len): Likewise.
(gfc_simplify_len_trim): Likewise.
(gfc_simplify_scan): Likewise.
(gfc_simplify_shape): Pass NULL as kind argument to gfc_simplify_size.
(gfc_simplify_size): Add kind argument.
(gfc_simplify_ubound): Likewise.
(gfc_simplify_verify): Likewise.
* intrinsic.h: Update prototypes and add new ones.
* trans-intrinsic.c (gfc_conv_intrinsic_index): Rename into
gfc_conv_intrinsic_index_scan_verify.
(gfc_conv_intrinsic_scan, gfc_conv_intrinsic_verify): Remove.
(gfc_conv_intrinsic_function): Call
gfc_conv_intrinsic_index_scan_verify to translate the INDEX,
SCAN and VERIFY intrinsics.
* gfortran.dg/intrinsics_kind_argument_1.f90: New test.
* gfortran.dg/pure_dummy_length_1.f90: Adapt to new error wording.
From-SVN: r127380
2007-08-12 21:57:01 +02:00
|
|
|
gfc_check_scan (gfc_expr *x, gfc_expr *y, gfc_expr *z, gfc_expr *kind)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (type_check (x, 0, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (y, 1, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (z != NULL && type_check (z, 2, BT_LOGICAL) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
re PR fortran/29600 ([F03] MINLOC and MAXLOC take an optional KIND argument)
PR fortran/29600
* intrinsic.c (add_functions): Add KIND arguments to COUNT,
IACHAR, ICHAR, INDEX, LBOUND, LEN, LEN_TRIM, SCAN, SIZE, UBOUND
and VERIFY.
* iresolve.c (gfc_resolve_count): Add kind argument.
(gfc_resolve_iachar): New function.
(gfc_resolve_ichar): Add kind argument.
(gfc_resolve_index_func): Likewise.
(gfc_resolve_lbound): Likewise.
(gfc_resolve_len): Likewise.
(gfc_resolve_len_trim): Likewise.
(gfc_resolve_scan): Likewise.
(gfc_resolve_size): New function.
(gfc_resolve_ubound): Add kind argument.
(gfc_resolve_verify): Likewise.
* trans-decl.c (gfc_get_extern_function_decl): Allow specific
intrinsics to have 4 arguments.
* check.c (gfc_check_count): Add kind argument.
(gfc_check_ichar_iachar): Likewise.
(gfc_check_index): Likewise.
(gfc_check_lbound): Likewise.
(gfc_check_len_lentrim): New function.
(gfc_check_scan): Add kind argument.
(gfc_check_size): Likewise.
(gfc_check_ubound): Likewise.
(gfc_check_verify): Likewise.
* intrinsic.texi: Update documentation for COUNT, IACHAR, ICHAR,
INDEX, LBOUND, LEN, LEN_TRIM, SCAN, SIZE, UBOUND and VERIFY.
* simplify.c (get_kind): Whitespace fix.
(int_expr_with_kind): New function.
(gfc_simplify_iachar): Add kind argument.
(gfc_simplify_iachar): Likewise.
(gfc_simplify_ichar): Likewise.
(gfc_simplify_index): Likewise.
(simplify_bound_dim): Likewise.
(simplify_bound): Likewise.
(gfc_simplify_lbound): Likewise.
(gfc_simplify_len): Likewise.
(gfc_simplify_len_trim): Likewise.
(gfc_simplify_scan): Likewise.
(gfc_simplify_shape): Pass NULL as kind argument to gfc_simplify_size.
(gfc_simplify_size): Add kind argument.
(gfc_simplify_ubound): Likewise.
(gfc_simplify_verify): Likewise.
* intrinsic.h: Update prototypes and add new ones.
* trans-intrinsic.c (gfc_conv_intrinsic_index): Rename into
gfc_conv_intrinsic_index_scan_verify.
(gfc_conv_intrinsic_scan, gfc_conv_intrinsic_verify): Remove.
(gfc_conv_intrinsic_function): Call
gfc_conv_intrinsic_index_scan_verify to translate the INDEX,
SCAN and VERIFY intrinsics.
* gfortran.dg/intrinsics_kind_argument_1.f90: New test.
* gfortran.dg/pure_dummy_length_1.f90: Adapt to new error wording.
From-SVN: r127380
2007-08-12 21:57:01 +02:00
|
|
|
if (kind_check (kind, 3, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
|
|
|
|
"with KIND argument at %L",
|
|
|
|
gfc_current_intrinsic, &kind->where) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
if (same_type_check (x, 0, y, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2005-11-01 06:53:29 +01:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_secnds (gfc_expr *r)
|
2005-11-01 06:53:29 +01:00
|
|
|
{
|
|
|
|
if (type_check (r, 0, BT_REAL) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (kind_value_check (r, 0, 4) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (r, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2005-02-19 21:29:05 +01:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_selected_int_kind (gfc_expr *r)
|
2005-02-19 21:29:05 +01:00
|
|
|
{
|
|
|
|
if (type_check (r, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (r, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_selected_real_kind (gfc_expr *p, gfc_expr *r)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (p == NULL && r == NULL)
|
|
|
|
{
|
|
|
|
gfc_error ("Missing arguments to %s intrinsic at %L",
|
|
|
|
gfc_current_intrinsic, gfc_current_intrinsic_where);
|
|
|
|
|
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
if (p != NULL && type_check (p, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (r != NULL && type_check (r, 1, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_set_exponent (gfc_expr *x, gfc_expr *i)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (type_check (x, 0, BT_REAL) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (i, 1, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_shape (gfc_expr *source)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
gfc_array_ref *ar;
|
|
|
|
|
|
|
|
if (source->rank == 0 || source->expr_type != EXPR_VARIABLE)
|
|
|
|
return SUCCESS;
|
|
|
|
|
|
|
|
ar = gfc_find_array_ref (source);
|
|
|
|
|
|
|
|
if (ar->as && ar->as->type == AS_ASSUMED_SIZE)
|
|
|
|
{
|
|
|
|
gfc_error ("'source' argument of 'shape' intrinsic at %L must not be "
|
|
|
|
"an assumed size array", &source->where);
|
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_sign (gfc_expr *a, gfc_expr *b)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
arith.c (arctangent2, [...]): Fix whitespace issues.
* arith.c (arctangent2, gfc_arith_init_1, gfc_arith_done_1,
gfc_constant_result, gfc_range_check, gfc_arith_power,
eval_type_intrinsic0, eval_intrinsic_f2, gfc_real2real,
gfc_real2complex, gfc_complex2int, gfc_complex2real,
gfc_complex2complex): Fix whitespace issues.
check.c (must_be, type_check, numeric_check, int_or_real_check,
logical_array_check, array_check, scalar_check, nonoptional_check,
variable_check, dim_check, check_a_kind, gfc_check_a_ikind,
gfc_check_a_xkind, gfc_check_abs, gfc_check_all_any,
gfc_check_allocated, gfc_check_a_p, gfc_check_besn,
gfc_check_btest, gfc_check_char, gfc_check_cmplx, gfc_check_count,
gfc_check_cshift, gfc_check_dcmplx, gfc_check_dble,
gfc_check_digits, gfc_check_dot_product, gfc_check_eoshift,
gfc_check_fnum, gfc_check_g77_math1, gfc_check_huge, gfc_check_i,
gfc_check_iand, gfc_check_ibclr, gfc_check_ibits, gfc_check_ibset,
gfc_check_idnint, gfc_check_ieor, gfc_check_index, gfc_check_int,
gfc_check_ior, gfc_check_ishft, gfc_check_ishftc, gfc_check_kind,
gfc_check_lbound, gfc_check_logical, min_max_args,
gfc_check_min_max_integer, gfc_check_min_max_real,
gfc_check_min_max_double, gfc_check_matmul,
gfc_check_minval_maxval, gfc_check_merge, gfc_check_nearest,
gfc_check_pack, gfc_check_precision, gfc_check_radix,
gfc_check_range, gfc_check_real, gfc_check_repeat,
gfc_check_scale, gfc_check_scan, gfc_check_selected_real_kind,
gfc_check_set_exponent): Fix formatting issues.
(gfc_check_size, gfc_check_sign): Alphabetize function order,
remove whitespace-only line.
(gfc_check_fstat, gfc_check_fstat_sub, gfc_check_stat,
gfc_check_stat_sub, gfc_check_transfer, gfc_check_transpose,
gfc_check_ubound, gfc_check_unpack, gfc_check_verify, gfc_check_x,
gfc_check_cpu_time, gfc_check_date_and_time, gfc_check_mvbits,
gfc_check_random_number, gfc_check_random_seed,
gfc_check_second_sub, gfc_check_system_clock,
gfc_check_getcwd_sub, gfc_check_exit, gfc_check_flush,
gfc_check_umask, gfc_check_umask_sub, gfc_check_unlink,
gfc_check_unlink_sub): Fix formatting issues.
From-SVN: r93093
2005-01-08 23:40:47 +01:00
|
|
|
if (int_or_real_check (a, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
2004-05-13 08:41:07 +02:00
|
|
|
|
arith.c (arctangent2, [...]): Fix whitespace issues.
* arith.c (arctangent2, gfc_arith_init_1, gfc_arith_done_1,
gfc_constant_result, gfc_range_check, gfc_arith_power,
eval_type_intrinsic0, eval_intrinsic_f2, gfc_real2real,
gfc_real2complex, gfc_complex2int, gfc_complex2real,
gfc_complex2complex): Fix whitespace issues.
check.c (must_be, type_check, numeric_check, int_or_real_check,
logical_array_check, array_check, scalar_check, nonoptional_check,
variable_check, dim_check, check_a_kind, gfc_check_a_ikind,
gfc_check_a_xkind, gfc_check_abs, gfc_check_all_any,
gfc_check_allocated, gfc_check_a_p, gfc_check_besn,
gfc_check_btest, gfc_check_char, gfc_check_cmplx, gfc_check_count,
gfc_check_cshift, gfc_check_dcmplx, gfc_check_dble,
gfc_check_digits, gfc_check_dot_product, gfc_check_eoshift,
gfc_check_fnum, gfc_check_g77_math1, gfc_check_huge, gfc_check_i,
gfc_check_iand, gfc_check_ibclr, gfc_check_ibits, gfc_check_ibset,
gfc_check_idnint, gfc_check_ieor, gfc_check_index, gfc_check_int,
gfc_check_ior, gfc_check_ishft, gfc_check_ishftc, gfc_check_kind,
gfc_check_lbound, gfc_check_logical, min_max_args,
gfc_check_min_max_integer, gfc_check_min_max_real,
gfc_check_min_max_double, gfc_check_matmul,
gfc_check_minval_maxval, gfc_check_merge, gfc_check_nearest,
gfc_check_pack, gfc_check_precision, gfc_check_radix,
gfc_check_range, gfc_check_real, gfc_check_repeat,
gfc_check_scale, gfc_check_scan, gfc_check_selected_real_kind,
gfc_check_set_exponent): Fix formatting issues.
(gfc_check_size, gfc_check_sign): Alphabetize function order,
remove whitespace-only line.
(gfc_check_fstat, gfc_check_fstat_sub, gfc_check_stat,
gfc_check_stat_sub, gfc_check_transfer, gfc_check_transpose,
gfc_check_ubound, gfc_check_unpack, gfc_check_verify, gfc_check_x,
gfc_check_cpu_time, gfc_check_date_and_time, gfc_check_mvbits,
gfc_check_random_number, gfc_check_random_seed,
gfc_check_second_sub, gfc_check_system_clock,
gfc_check_getcwd_sub, gfc_check_exit, gfc_check_flush,
gfc_check_umask, gfc_check_umask_sub, gfc_check_unlink,
gfc_check_unlink_sub): Fix formatting issues.
From-SVN: r93093
2005-01-08 23:40:47 +01:00
|
|
|
if (same_type_check (a, 0, b, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
re PR fortran/29600 ([F03] MINLOC and MAXLOC take an optional KIND argument)
PR fortran/29600
* intrinsic.c (add_functions): Add KIND arguments to COUNT,
IACHAR, ICHAR, INDEX, LBOUND, LEN, LEN_TRIM, SCAN, SIZE, UBOUND
and VERIFY.
* iresolve.c (gfc_resolve_count): Add kind argument.
(gfc_resolve_iachar): New function.
(gfc_resolve_ichar): Add kind argument.
(gfc_resolve_index_func): Likewise.
(gfc_resolve_lbound): Likewise.
(gfc_resolve_len): Likewise.
(gfc_resolve_len_trim): Likewise.
(gfc_resolve_scan): Likewise.
(gfc_resolve_size): New function.
(gfc_resolve_ubound): Add kind argument.
(gfc_resolve_verify): Likewise.
* trans-decl.c (gfc_get_extern_function_decl): Allow specific
intrinsics to have 4 arguments.
* check.c (gfc_check_count): Add kind argument.
(gfc_check_ichar_iachar): Likewise.
(gfc_check_index): Likewise.
(gfc_check_lbound): Likewise.
(gfc_check_len_lentrim): New function.
(gfc_check_scan): Add kind argument.
(gfc_check_size): Likewise.
(gfc_check_ubound): Likewise.
(gfc_check_verify): Likewise.
* intrinsic.texi: Update documentation for COUNT, IACHAR, ICHAR,
INDEX, LBOUND, LEN, LEN_TRIM, SCAN, SIZE, UBOUND and VERIFY.
* simplify.c (get_kind): Whitespace fix.
(int_expr_with_kind): New function.
(gfc_simplify_iachar): Add kind argument.
(gfc_simplify_iachar): Likewise.
(gfc_simplify_ichar): Likewise.
(gfc_simplify_index): Likewise.
(simplify_bound_dim): Likewise.
(simplify_bound): Likewise.
(gfc_simplify_lbound): Likewise.
(gfc_simplify_len): Likewise.
(gfc_simplify_len_trim): Likewise.
(gfc_simplify_scan): Likewise.
(gfc_simplify_shape): Pass NULL as kind argument to gfc_simplify_size.
(gfc_simplify_size): Add kind argument.
(gfc_simplify_ubound): Likewise.
(gfc_simplify_verify): Likewise.
* intrinsic.h: Update prototypes and add new ones.
* trans-intrinsic.c (gfc_conv_intrinsic_index): Rename into
gfc_conv_intrinsic_index_scan_verify.
(gfc_conv_intrinsic_scan, gfc_conv_intrinsic_verify): Remove.
(gfc_conv_intrinsic_function): Call
gfc_conv_intrinsic_index_scan_verify to translate the INDEX,
SCAN and VERIFY intrinsics.
* gfortran.dg/intrinsics_kind_argument_1.f90: New test.
* gfortran.dg/pure_dummy_length_1.f90: Adapt to new error wording.
From-SVN: r127380
2007-08-12 21:57:01 +02:00
|
|
|
gfc_check_size (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
|
arith.c (arctangent2, [...]): Fix whitespace issues.
* arith.c (arctangent2, gfc_arith_init_1, gfc_arith_done_1,
gfc_constant_result, gfc_range_check, gfc_arith_power,
eval_type_intrinsic0, eval_intrinsic_f2, gfc_real2real,
gfc_real2complex, gfc_complex2int, gfc_complex2real,
gfc_complex2complex): Fix whitespace issues.
check.c (must_be, type_check, numeric_check, int_or_real_check,
logical_array_check, array_check, scalar_check, nonoptional_check,
variable_check, dim_check, check_a_kind, gfc_check_a_ikind,
gfc_check_a_xkind, gfc_check_abs, gfc_check_all_any,
gfc_check_allocated, gfc_check_a_p, gfc_check_besn,
gfc_check_btest, gfc_check_char, gfc_check_cmplx, gfc_check_count,
gfc_check_cshift, gfc_check_dcmplx, gfc_check_dble,
gfc_check_digits, gfc_check_dot_product, gfc_check_eoshift,
gfc_check_fnum, gfc_check_g77_math1, gfc_check_huge, gfc_check_i,
gfc_check_iand, gfc_check_ibclr, gfc_check_ibits, gfc_check_ibset,
gfc_check_idnint, gfc_check_ieor, gfc_check_index, gfc_check_int,
gfc_check_ior, gfc_check_ishft, gfc_check_ishftc, gfc_check_kind,
gfc_check_lbound, gfc_check_logical, min_max_args,
gfc_check_min_max_integer, gfc_check_min_max_real,
gfc_check_min_max_double, gfc_check_matmul,
gfc_check_minval_maxval, gfc_check_merge, gfc_check_nearest,
gfc_check_pack, gfc_check_precision, gfc_check_radix,
gfc_check_range, gfc_check_real, gfc_check_repeat,
gfc_check_scale, gfc_check_scan, gfc_check_selected_real_kind,
gfc_check_set_exponent): Fix formatting issues.
(gfc_check_size, gfc_check_sign): Alphabetize function order,
remove whitespace-only line.
(gfc_check_fstat, gfc_check_fstat_sub, gfc_check_stat,
gfc_check_stat_sub, gfc_check_transfer, gfc_check_transpose,
gfc_check_ubound, gfc_check_unpack, gfc_check_verify, gfc_check_x,
gfc_check_cpu_time, gfc_check_date_and_time, gfc_check_mvbits,
gfc_check_random_number, gfc_check_random_seed,
gfc_check_second_sub, gfc_check_system_clock,
gfc_check_getcwd_sub, gfc_check_exit, gfc_check_flush,
gfc_check_umask, gfc_check_umask_sub, gfc_check_unlink,
gfc_check_unlink_sub): Fix formatting issues.
From-SVN: r93093
2005-01-08 23:40:47 +01:00
|
|
|
{
|
2004-05-13 08:41:07 +02:00
|
|
|
if (array_check (array, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (dim != NULL)
|
|
|
|
{
|
|
|
|
if (type_check (dim, 1, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
gfortran.h (gfc_default_*_kind): Remove prototypes, add extern variable declaration of same name.
* gfortran.h (gfc_default_*_kind): Remove prototypes, add extern
variable declaration of same name.
* arith.c, check.c, decl.c, dump_parse_tree.c, expr.c,
intrinsic.c, io.c, iresolve.c, match.c, options.c, primary.c,
resolve.c, simplify.c, symbol.c, trans-const.c, trans-io.c:
Replace all calls to gfc_default_*_kind with variable accesses.
* trans-types.c: Same as above.
(gfc_default_*_kind_1): Rename to gfc_default_*_kind, remove
static qualifier. Replace all occurences.
(gfc_default_*_kind): Remove functions.
From-SVN: r86662
2004-08-27 16:49:35 +02:00
|
|
|
if (kind_value_check (dim, 1, gfc_default_integer_kind) == FAILURE)
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (dim_rank_check (dim, array, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
re PR fortran/29600 ([F03] MINLOC and MAXLOC take an optional KIND argument)
PR fortran/29600
* intrinsic.c (add_functions): Add KIND arguments to COUNT,
IACHAR, ICHAR, INDEX, LBOUND, LEN, LEN_TRIM, SCAN, SIZE, UBOUND
and VERIFY.
* iresolve.c (gfc_resolve_count): Add kind argument.
(gfc_resolve_iachar): New function.
(gfc_resolve_ichar): Add kind argument.
(gfc_resolve_index_func): Likewise.
(gfc_resolve_lbound): Likewise.
(gfc_resolve_len): Likewise.
(gfc_resolve_len_trim): Likewise.
(gfc_resolve_scan): Likewise.
(gfc_resolve_size): New function.
(gfc_resolve_ubound): Add kind argument.
(gfc_resolve_verify): Likewise.
* trans-decl.c (gfc_get_extern_function_decl): Allow specific
intrinsics to have 4 arguments.
* check.c (gfc_check_count): Add kind argument.
(gfc_check_ichar_iachar): Likewise.
(gfc_check_index): Likewise.
(gfc_check_lbound): Likewise.
(gfc_check_len_lentrim): New function.
(gfc_check_scan): Add kind argument.
(gfc_check_size): Likewise.
(gfc_check_ubound): Likewise.
(gfc_check_verify): Likewise.
* intrinsic.texi: Update documentation for COUNT, IACHAR, ICHAR,
INDEX, LBOUND, LEN, LEN_TRIM, SCAN, SIZE, UBOUND and VERIFY.
* simplify.c (get_kind): Whitespace fix.
(int_expr_with_kind): New function.
(gfc_simplify_iachar): Add kind argument.
(gfc_simplify_iachar): Likewise.
(gfc_simplify_ichar): Likewise.
(gfc_simplify_index): Likewise.
(simplify_bound_dim): Likewise.
(simplify_bound): Likewise.
(gfc_simplify_lbound): Likewise.
(gfc_simplify_len): Likewise.
(gfc_simplify_len_trim): Likewise.
(gfc_simplify_scan): Likewise.
(gfc_simplify_shape): Pass NULL as kind argument to gfc_simplify_size.
(gfc_simplify_size): Add kind argument.
(gfc_simplify_ubound): Likewise.
(gfc_simplify_verify): Likewise.
* intrinsic.h: Update prototypes and add new ones.
* trans-intrinsic.c (gfc_conv_intrinsic_index): Rename into
gfc_conv_intrinsic_index_scan_verify.
(gfc_conv_intrinsic_scan, gfc_conv_intrinsic_verify): Remove.
(gfc_conv_intrinsic_function): Call
gfc_conv_intrinsic_index_scan_verify to translate the INDEX,
SCAN and VERIFY intrinsics.
* gfortran.dg/intrinsics_kind_argument_1.f90: New test.
* gfortran.dg/pure_dummy_length_1.f90: Adapt to new error wording.
From-SVN: r127380
2007-08-12 21:57:01 +02:00
|
|
|
if (kind_check (kind, 2, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
|
|
|
|
"with KIND argument at %L",
|
|
|
|
gfc_current_intrinsic, &kind->where) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2007-05-29 11:03:03 +02:00
|
|
|
try
|
|
|
|
gfc_check_sizeof (gfc_expr *arg __attribute__((unused)))
|
|
|
|
{
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
Makefile.am: Added new files.
* Makefile.am: Added new files.
* Makefile.in: Regenerate.
* aclocal.m4: Regenerate.
* configure.ac: add checks for signal.h headers file, as well as
following functions: chdir, strerror, getlogin, gethostname, kill,
link, symlink, perror, sleep, time.
* configure: Regenerate.
* intrinsics/chdir.c, intrinsics/gerror.c, intrinsics/getlog.c,
intrinsics/hostnm.c, intrinsics/ierrno.c, intrinsics/kill.c,
intrinsics/link.c, intrinsics/perror.c, intrinsics/rename.c,
intrinsics/sleep.c, intrinsics/symlnk.c, intrinsics/time.c: Newly
implementend g77 intrinsics.
* check.c (gfc_check_chdir, gfc_check_chdir_sub, gfc_check_kill,
gfc_check_kill_sub, gfc_check_link, gfc_check_link_sub,
gfc_check_symlnk, gfc_check_symlnk_sub, gfc_check_rename,
gfc_check_rename_sub, gfc_check_sleep_sub, gfc_check_gerror,
gfc_check_getlog, gfc_check_hostnm, gfc_check_hostnm_sub,
gfc_check_perror): new functions to check newly implemented
g77 intrinsics.
* gfortran.h: adding symbols for new intrinsics.
* intrinsic.c (add_functions): adding new intrinsics.
(add_subroutines): adding new intrinsics.
* intrinsic.h: prototype for all checking and resolving
functions.
* iresolve.c (gfc_resolve_chdir, gfc_resolve_chdir_sub,
gfc_resolve_hostnm, gfc_resolve_ierrno, gfc_resolve_kill,
gfc_resolve_link, gfc_resolve_rename, gfc_resolve_symlnk,
gfc_resolve_time, gfc_resolve_time8, gfc_resolve_rename_sub,
gfc_resolve_kill_sub, gfc_resolve_link_sub,
gfc_resolve_symlnk_sub, gfc_resolve_sleep_sub,
gfc_resolve_gerror, gfc_resolve_getlog, gfc_resolve_hostnm_sub,
gfc_resolve_perror): new functions to resolve intrinsics.
* trans-intrinsic.c (gfc_conv_intrinsic_function): add case
for new symbols.
* g77_intrinsics_funcs.f: New test.
* g77_intrinsics_sub.f: New test.
From-SVN: r96893
2005-03-22 23:08:22 +01:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_sleep_sub (gfc_expr *seconds)
|
Makefile.am: Added new files.
* Makefile.am: Added new files.
* Makefile.in: Regenerate.
* aclocal.m4: Regenerate.
* configure.ac: add checks for signal.h headers file, as well as
following functions: chdir, strerror, getlogin, gethostname, kill,
link, symlink, perror, sleep, time.
* configure: Regenerate.
* intrinsics/chdir.c, intrinsics/gerror.c, intrinsics/getlog.c,
intrinsics/hostnm.c, intrinsics/ierrno.c, intrinsics/kill.c,
intrinsics/link.c, intrinsics/perror.c, intrinsics/rename.c,
intrinsics/sleep.c, intrinsics/symlnk.c, intrinsics/time.c: Newly
implementend g77 intrinsics.
* check.c (gfc_check_chdir, gfc_check_chdir_sub, gfc_check_kill,
gfc_check_kill_sub, gfc_check_link, gfc_check_link_sub,
gfc_check_symlnk, gfc_check_symlnk_sub, gfc_check_rename,
gfc_check_rename_sub, gfc_check_sleep_sub, gfc_check_gerror,
gfc_check_getlog, gfc_check_hostnm, gfc_check_hostnm_sub,
gfc_check_perror): new functions to check newly implemented
g77 intrinsics.
* gfortran.h: adding symbols for new intrinsics.
* intrinsic.c (add_functions): adding new intrinsics.
(add_subroutines): adding new intrinsics.
* intrinsic.h: prototype for all checking and resolving
functions.
* iresolve.c (gfc_resolve_chdir, gfc_resolve_chdir_sub,
gfc_resolve_hostnm, gfc_resolve_ierrno, gfc_resolve_kill,
gfc_resolve_link, gfc_resolve_rename, gfc_resolve_symlnk,
gfc_resolve_time, gfc_resolve_time8, gfc_resolve_rename_sub,
gfc_resolve_kill_sub, gfc_resolve_link_sub,
gfc_resolve_symlnk_sub, gfc_resolve_sleep_sub,
gfc_resolve_gerror, gfc_resolve_getlog, gfc_resolve_hostnm_sub,
gfc_resolve_perror): new functions to resolve intrinsics.
* trans-intrinsic.c (gfc_conv_intrinsic_function): add case
for new symbols.
* g77_intrinsics_funcs.f: New test.
* g77_intrinsics_sub.f: New test.
From-SVN: r96893
2005-03-22 23:08:22 +01:00
|
|
|
{
|
|
|
|
if (type_check (seconds, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (seconds, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_spread (gfc_expr *source, gfc_expr *dim, gfc_expr *ncopies)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (source->rank >= GFC_MAX_DIMENSIONS)
|
|
|
|
{
|
re PR fortran/15586 (gfortran should support i18n in its compiler messages)
PR fortran/15586
* arith.c (gfc_arith_error): Change message to include locus.
(check_result, eval_intrinsic, gfc_int2int, gfc_real2real,
gfc_real2complex, gfc_complex2real, gfc_complex2complex): Use
the new gfc_arith_error.
(arith_error): Rewrite full error messages instead of building
them from pieces.
* check.c (must_be): Removed.
(type_check, numeric_check, int_or_real_check, real_or_complex_check,
kind_check, double_check, logical_array_check, array_check,
scalar_check, same_type_check, rank_check, kind_value_check,
variable_check, gfc_check_allocated, gfc_check_associated,
gfc_check_cmplx, gfc_check_dcmplx, gfc_check_dot_product,
gfc_check_index, gfc_check_kind, gfc_check_matmul, gfc_check_null,
gfc_check_pack, gfc_check_precision, gfc_check_present,
gfc_check_spread): Rewrite full error messages instead of
building them from pieces.
* decl.c (gfc_match_entry): Rewrite full error messages instead
of building them from pieces.
* parse.c (gfc_state_name): Remove.
* parse.h: Remove prototype for gfc_state_name.
From-SVN: r105844
2005-10-24 11:11:51 +02:00
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must be less "
|
|
|
|
"than rank %d", gfc_current_intrinsic_arg[0],
|
|
|
|
gfc_current_intrinsic, &source->where, GFC_MAX_DIMENSIONS);
|
2005-09-17 20:58:01 +02:00
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
if (dim_check (dim, 1, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (ncopies, 2, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
flush.c: New file.
2004-12-02 Steven G. Kargl <kargls@comcast.net>
Paul Brook <paul@codesourcery.com>
libgfortran/
* intrinsics/flush.c: New file.
* intrinsics/fnum.c: ditto
* intrinsics/stat.c: ditto
* io/io.h (unit_to_fd): Add prototype.
* io/unix.c (unit_to_fd): New function.
* configure.ac: Add test for members of struct stat. Check for
sys/types.h and sys/stat.h
* Makefile.am: Add intrinsics/{flush.c,fnum.c,stat.c}
* configure.in: Regenerate.
* config.h.in: Regenerate.
* Makefile.in: Regenerate.
fortran/
* check.c (gfc_check_flush, gfc_check_fnum): New functions.
(gfc_check_fstat, gfc_check_fstat_sub): New functions.
(gfc_check_stat, gfc_check_stat_sub): New functions.
* gfortran.h (GFC_ISYM_FNUM,GFC_ISYM_FSTAT,GFC_ISYM_STAT): New symbols
* intrinsic.c (add_functions,add_subroutines): Add flush, fnum,
fstat, and stat to intrinsics symbol tables.
* intrinsic.h (gfc_check_flush, gfc_resolve_stat_sub): Add prototypes.
(gfc_resolve_fstat_sub, gfc_resolve_stat): Ditto.
* iresolve.c (gfc_resolve_fnum, gfc_resolve_fstat): New functions.
(gfc_resolve_stat, gfc_resolve_flush): New functions.
(gfc_resolve_stat_sub,gfc_resolve_fstat_sub): New functions
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add new intrinsics.
Co-Authored-By: Paul Brook <paul@codesourcery.com>
From-SVN: r91609
2004-12-02 05:10:26 +01:00
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
if (scalar_check (ncopies, 2) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
fget.c: New file.
* intrinsics/fget.c: New file.
* intrinsics/ftell.c: New file.
* io/unix.c (stream_offset): New function.
* io/io.h: Add prototype for stream_offset.
* Makefile.am: Add intrinsics/fget.c and intrinsics/ftell.c.
* Makefile.in: Regenerate.
* intrinsic.c (add_functions): Add COMPLEX, FTELL, FGETC, FGET,
FPUTC, FPUT, AND, XOR and OR intrinsic functions.
(add_subroutines): Add FGETC, FGET, FPUTC, FPUT and FTELL intrinsic
subroutines.
* gfortran.h: Add GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET,
GFC_ISYM_FGETC, GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL,
GFC_ISYM_OR, GFC_ISYM_XOR.
* iresolve.c (gfc_resolve_and, gfc_resolve_complex,
gfc_resolve_or, gfc_resolve_fgetc, gfc_resolve_fget,
gfc_resolve_fputc, gfc_resolve_fput, gfc_resolve_ftell,
gfc_resolve_xor, gfc_resolve_fgetc_sub, gfc_resolve_fget_sub,
gfc_resolve_fputc_sub, gfc_resolve_fput_sub, gfc_resolve_ftell_sub):
New functions.
* check.c (gfc_check_complex, gfc_check_fgetputc_sub,
gfc_check_fgetputc, gfc_check_fgetput_sub, gfc_check_fgetput,
gfc_check_ftell, gfc_check_ftell_sub, gfc_check_and): New functions.
* simplify.c (gfc_simplify_and, gfc_simplify_complex, gfc_simplify_or,
gfc_simplify_xor): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add cases for
GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET, GFC_ISYM_FGETC,
GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL, GFC_ISYM_OR and
GFC_ISYM_XOR.
* intrinsic.h: Add prototypes for all functions added to iresolve.c,
simplify.c and check.c.
* gfortran.dg/complex_intrinsic_1.f90: New test.
* gfortran.dg/complex_intrinsic_2.f90: New test.
* gfortran.dg/fgetc_1.f90: New test.
* gfortran.dg/fgetc_2.f90: New test.
* gfortran.dg/fgetc_3.f90: New test.
* gfortran.dg/ftell_1.f90: New test.
* gfortran.dg/ftell_2.f90: New test.
* gfortran.dg/gnu_logical_1.F: New test.
* gfortran.dg/gnu_logical_2.f90: New test.
From-SVN: r106859
2005-11-13 10:33:19 +01:00
|
|
|
/* Functions for checking FGETC, FPUTC, FGET and FPUT (subroutines and
|
|
|
|
functions). */
|
2007-01-07 01:28:29 +01:00
|
|
|
|
fget.c: New file.
* intrinsics/fget.c: New file.
* intrinsics/ftell.c: New file.
* io/unix.c (stream_offset): New function.
* io/io.h: Add prototype for stream_offset.
* Makefile.am: Add intrinsics/fget.c and intrinsics/ftell.c.
* Makefile.in: Regenerate.
* intrinsic.c (add_functions): Add COMPLEX, FTELL, FGETC, FGET,
FPUTC, FPUT, AND, XOR and OR intrinsic functions.
(add_subroutines): Add FGETC, FGET, FPUTC, FPUT and FTELL intrinsic
subroutines.
* gfortran.h: Add GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET,
GFC_ISYM_FGETC, GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL,
GFC_ISYM_OR, GFC_ISYM_XOR.
* iresolve.c (gfc_resolve_and, gfc_resolve_complex,
gfc_resolve_or, gfc_resolve_fgetc, gfc_resolve_fget,
gfc_resolve_fputc, gfc_resolve_fput, gfc_resolve_ftell,
gfc_resolve_xor, gfc_resolve_fgetc_sub, gfc_resolve_fget_sub,
gfc_resolve_fputc_sub, gfc_resolve_fput_sub, gfc_resolve_ftell_sub):
New functions.
* check.c (gfc_check_complex, gfc_check_fgetputc_sub,
gfc_check_fgetputc, gfc_check_fgetput_sub, gfc_check_fgetput,
gfc_check_ftell, gfc_check_ftell_sub, gfc_check_and): New functions.
* simplify.c (gfc_simplify_and, gfc_simplify_complex, gfc_simplify_or,
gfc_simplify_xor): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add cases for
GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET, GFC_ISYM_FGETC,
GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL, GFC_ISYM_OR and
GFC_ISYM_XOR.
* intrinsic.h: Add prototypes for all functions added to iresolve.c,
simplify.c and check.c.
* gfortran.dg/complex_intrinsic_1.f90: New test.
* gfortran.dg/complex_intrinsic_2.f90: New test.
* gfortran.dg/fgetc_1.f90: New test.
* gfortran.dg/fgetc_2.f90: New test.
* gfortran.dg/fgetc_3.f90: New test.
* gfortran.dg/ftell_1.f90: New test.
* gfortran.dg/ftell_2.f90: New test.
* gfortran.dg/gnu_logical_1.F: New test.
* gfortran.dg/gnu_logical_2.f90: New test.
From-SVN: r106859
2005-11-13 10:33:19 +01:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_fgetputc_sub (gfc_expr *unit, gfc_expr *c, gfc_expr *status)
|
fget.c: New file.
* intrinsics/fget.c: New file.
* intrinsics/ftell.c: New file.
* io/unix.c (stream_offset): New function.
* io/io.h: Add prototype for stream_offset.
* Makefile.am: Add intrinsics/fget.c and intrinsics/ftell.c.
* Makefile.in: Regenerate.
* intrinsic.c (add_functions): Add COMPLEX, FTELL, FGETC, FGET,
FPUTC, FPUT, AND, XOR and OR intrinsic functions.
(add_subroutines): Add FGETC, FGET, FPUTC, FPUT and FTELL intrinsic
subroutines.
* gfortran.h: Add GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET,
GFC_ISYM_FGETC, GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL,
GFC_ISYM_OR, GFC_ISYM_XOR.
* iresolve.c (gfc_resolve_and, gfc_resolve_complex,
gfc_resolve_or, gfc_resolve_fgetc, gfc_resolve_fget,
gfc_resolve_fputc, gfc_resolve_fput, gfc_resolve_ftell,
gfc_resolve_xor, gfc_resolve_fgetc_sub, gfc_resolve_fget_sub,
gfc_resolve_fputc_sub, gfc_resolve_fput_sub, gfc_resolve_ftell_sub):
New functions.
* check.c (gfc_check_complex, gfc_check_fgetputc_sub,
gfc_check_fgetputc, gfc_check_fgetput_sub, gfc_check_fgetput,
gfc_check_ftell, gfc_check_ftell_sub, gfc_check_and): New functions.
* simplify.c (gfc_simplify_and, gfc_simplify_complex, gfc_simplify_or,
gfc_simplify_xor): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add cases for
GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET, GFC_ISYM_FGETC,
GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL, GFC_ISYM_OR and
GFC_ISYM_XOR.
* intrinsic.h: Add prototypes for all functions added to iresolve.c,
simplify.c and check.c.
* gfortran.dg/complex_intrinsic_1.f90: New test.
* gfortran.dg/complex_intrinsic_2.f90: New test.
* gfortran.dg/fgetc_1.f90: New test.
* gfortran.dg/fgetc_2.f90: New test.
* gfortran.dg/fgetc_3.f90: New test.
* gfortran.dg/ftell_1.f90: New test.
* gfortran.dg/ftell_2.f90: New test.
* gfortran.dg/gnu_logical_1.F: New test.
* gfortran.dg/gnu_logical_2.f90: New test.
From-SVN: r106859
2005-11-13 10:33:19 +01:00
|
|
|
{
|
|
|
|
if (type_check (unit, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (unit, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (c, 1, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (status == NULL)
|
|
|
|
return SUCCESS;
|
|
|
|
|
|
|
|
if (type_check (status, 2, BT_INTEGER) == FAILURE
|
|
|
|
|| kind_value_check (status, 2, gfc_default_integer_kind) == FAILURE
|
|
|
|
|| scalar_check (status, 2) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_fgetputc (gfc_expr *unit, gfc_expr *c)
|
fget.c: New file.
* intrinsics/fget.c: New file.
* intrinsics/ftell.c: New file.
* io/unix.c (stream_offset): New function.
* io/io.h: Add prototype for stream_offset.
* Makefile.am: Add intrinsics/fget.c and intrinsics/ftell.c.
* Makefile.in: Regenerate.
* intrinsic.c (add_functions): Add COMPLEX, FTELL, FGETC, FGET,
FPUTC, FPUT, AND, XOR and OR intrinsic functions.
(add_subroutines): Add FGETC, FGET, FPUTC, FPUT and FTELL intrinsic
subroutines.
* gfortran.h: Add GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET,
GFC_ISYM_FGETC, GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL,
GFC_ISYM_OR, GFC_ISYM_XOR.
* iresolve.c (gfc_resolve_and, gfc_resolve_complex,
gfc_resolve_or, gfc_resolve_fgetc, gfc_resolve_fget,
gfc_resolve_fputc, gfc_resolve_fput, gfc_resolve_ftell,
gfc_resolve_xor, gfc_resolve_fgetc_sub, gfc_resolve_fget_sub,
gfc_resolve_fputc_sub, gfc_resolve_fput_sub, gfc_resolve_ftell_sub):
New functions.
* check.c (gfc_check_complex, gfc_check_fgetputc_sub,
gfc_check_fgetputc, gfc_check_fgetput_sub, gfc_check_fgetput,
gfc_check_ftell, gfc_check_ftell_sub, gfc_check_and): New functions.
* simplify.c (gfc_simplify_and, gfc_simplify_complex, gfc_simplify_or,
gfc_simplify_xor): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add cases for
GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET, GFC_ISYM_FGETC,
GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL, GFC_ISYM_OR and
GFC_ISYM_XOR.
* intrinsic.h: Add prototypes for all functions added to iresolve.c,
simplify.c and check.c.
* gfortran.dg/complex_intrinsic_1.f90: New test.
* gfortran.dg/complex_intrinsic_2.f90: New test.
* gfortran.dg/fgetc_1.f90: New test.
* gfortran.dg/fgetc_2.f90: New test.
* gfortran.dg/fgetc_3.f90: New test.
* gfortran.dg/ftell_1.f90: New test.
* gfortran.dg/ftell_2.f90: New test.
* gfortran.dg/gnu_logical_1.F: New test.
* gfortran.dg/gnu_logical_2.f90: New test.
From-SVN: r106859
2005-11-13 10:33:19 +01:00
|
|
|
{
|
|
|
|
return gfc_check_fgetputc_sub (unit, c, NULL);
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_fgetput_sub (gfc_expr *c, gfc_expr *status)
|
fget.c: New file.
* intrinsics/fget.c: New file.
* intrinsics/ftell.c: New file.
* io/unix.c (stream_offset): New function.
* io/io.h: Add prototype for stream_offset.
* Makefile.am: Add intrinsics/fget.c and intrinsics/ftell.c.
* Makefile.in: Regenerate.
* intrinsic.c (add_functions): Add COMPLEX, FTELL, FGETC, FGET,
FPUTC, FPUT, AND, XOR and OR intrinsic functions.
(add_subroutines): Add FGETC, FGET, FPUTC, FPUT and FTELL intrinsic
subroutines.
* gfortran.h: Add GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET,
GFC_ISYM_FGETC, GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL,
GFC_ISYM_OR, GFC_ISYM_XOR.
* iresolve.c (gfc_resolve_and, gfc_resolve_complex,
gfc_resolve_or, gfc_resolve_fgetc, gfc_resolve_fget,
gfc_resolve_fputc, gfc_resolve_fput, gfc_resolve_ftell,
gfc_resolve_xor, gfc_resolve_fgetc_sub, gfc_resolve_fget_sub,
gfc_resolve_fputc_sub, gfc_resolve_fput_sub, gfc_resolve_ftell_sub):
New functions.
* check.c (gfc_check_complex, gfc_check_fgetputc_sub,
gfc_check_fgetputc, gfc_check_fgetput_sub, gfc_check_fgetput,
gfc_check_ftell, gfc_check_ftell_sub, gfc_check_and): New functions.
* simplify.c (gfc_simplify_and, gfc_simplify_complex, gfc_simplify_or,
gfc_simplify_xor): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add cases for
GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET, GFC_ISYM_FGETC,
GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL, GFC_ISYM_OR and
GFC_ISYM_XOR.
* intrinsic.h: Add prototypes for all functions added to iresolve.c,
simplify.c and check.c.
* gfortran.dg/complex_intrinsic_1.f90: New test.
* gfortran.dg/complex_intrinsic_2.f90: New test.
* gfortran.dg/fgetc_1.f90: New test.
* gfortran.dg/fgetc_2.f90: New test.
* gfortran.dg/fgetc_3.f90: New test.
* gfortran.dg/ftell_1.f90: New test.
* gfortran.dg/ftell_2.f90: New test.
* gfortran.dg/gnu_logical_1.F: New test.
* gfortran.dg/gnu_logical_2.f90: New test.
From-SVN: r106859
2005-11-13 10:33:19 +01:00
|
|
|
{
|
|
|
|
if (type_check (c, 0, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (status == NULL)
|
|
|
|
return SUCCESS;
|
|
|
|
|
|
|
|
if (type_check (status, 1, BT_INTEGER) == FAILURE
|
|
|
|
|| kind_value_check (status, 1, gfc_default_integer_kind) == FAILURE
|
|
|
|
|| scalar_check (status, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_fgetput (gfc_expr *c)
|
fget.c: New file.
* intrinsics/fget.c: New file.
* intrinsics/ftell.c: New file.
* io/unix.c (stream_offset): New function.
* io/io.h: Add prototype for stream_offset.
* Makefile.am: Add intrinsics/fget.c and intrinsics/ftell.c.
* Makefile.in: Regenerate.
* intrinsic.c (add_functions): Add COMPLEX, FTELL, FGETC, FGET,
FPUTC, FPUT, AND, XOR and OR intrinsic functions.
(add_subroutines): Add FGETC, FGET, FPUTC, FPUT and FTELL intrinsic
subroutines.
* gfortran.h: Add GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET,
GFC_ISYM_FGETC, GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL,
GFC_ISYM_OR, GFC_ISYM_XOR.
* iresolve.c (gfc_resolve_and, gfc_resolve_complex,
gfc_resolve_or, gfc_resolve_fgetc, gfc_resolve_fget,
gfc_resolve_fputc, gfc_resolve_fput, gfc_resolve_ftell,
gfc_resolve_xor, gfc_resolve_fgetc_sub, gfc_resolve_fget_sub,
gfc_resolve_fputc_sub, gfc_resolve_fput_sub, gfc_resolve_ftell_sub):
New functions.
* check.c (gfc_check_complex, gfc_check_fgetputc_sub,
gfc_check_fgetputc, gfc_check_fgetput_sub, gfc_check_fgetput,
gfc_check_ftell, gfc_check_ftell_sub, gfc_check_and): New functions.
* simplify.c (gfc_simplify_and, gfc_simplify_complex, gfc_simplify_or,
gfc_simplify_xor): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add cases for
GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET, GFC_ISYM_FGETC,
GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL, GFC_ISYM_OR and
GFC_ISYM_XOR.
* intrinsic.h: Add prototypes for all functions added to iresolve.c,
simplify.c and check.c.
* gfortran.dg/complex_intrinsic_1.f90: New test.
* gfortran.dg/complex_intrinsic_2.f90: New test.
* gfortran.dg/fgetc_1.f90: New test.
* gfortran.dg/fgetc_2.f90: New test.
* gfortran.dg/fgetc_3.f90: New test.
* gfortran.dg/ftell_1.f90: New test.
* gfortran.dg/ftell_2.f90: New test.
* gfortran.dg/gnu_logical_1.F: New test.
* gfortran.dg/gnu_logical_2.f90: New test.
From-SVN: r106859
2005-11-13 10:33:19 +01:00
|
|
|
{
|
|
|
|
return gfc_check_fgetput_sub (c, NULL);
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2007-05-04 20:02:18 +02:00
|
|
|
try
|
|
|
|
gfc_check_fseek_sub (gfc_expr *unit, gfc_expr *offset, gfc_expr *whence, gfc_expr *status)
|
|
|
|
{
|
|
|
|
if (type_check (unit, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (unit, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (offset, 1, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (offset, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (whence, 2, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (whence, 2) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (status == NULL)
|
|
|
|
return SUCCESS;
|
|
|
|
|
|
|
|
if (type_check (status, 3, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (kind_value_check (status, 3, 4) == FAILURE)
|
2007-05-04 20:08:42 +02:00
|
|
|
return FAILURE;
|
2007-05-04 20:02:18 +02:00
|
|
|
|
|
|
|
if (scalar_check (status, 3) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
flush.c: New file.
2004-12-02 Steven G. Kargl <kargls@comcast.net>
Paul Brook <paul@codesourcery.com>
libgfortran/
* intrinsics/flush.c: New file.
* intrinsics/fnum.c: ditto
* intrinsics/stat.c: ditto
* io/io.h (unit_to_fd): Add prototype.
* io/unix.c (unit_to_fd): New function.
* configure.ac: Add test for members of struct stat. Check for
sys/types.h and sys/stat.h
* Makefile.am: Add intrinsics/{flush.c,fnum.c,stat.c}
* configure.in: Regenerate.
* config.h.in: Regenerate.
* Makefile.in: Regenerate.
fortran/
* check.c (gfc_check_flush, gfc_check_fnum): New functions.
(gfc_check_fstat, gfc_check_fstat_sub): New functions.
(gfc_check_stat, gfc_check_stat_sub): New functions.
* gfortran.h (GFC_ISYM_FNUM,GFC_ISYM_FSTAT,GFC_ISYM_STAT): New symbols
* intrinsic.c (add_functions,add_subroutines): Add flush, fnum,
fstat, and stat to intrinsics symbol tables.
* intrinsic.h (gfc_check_flush, gfc_resolve_stat_sub): Add prototypes.
(gfc_resolve_fstat_sub, gfc_resolve_stat): Ditto.
* iresolve.c (gfc_resolve_fnum, gfc_resolve_fstat): New functions.
(gfc_resolve_stat, gfc_resolve_flush): New functions.
(gfc_resolve_stat_sub,gfc_resolve_fstat_sub): New functions
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add new intrinsics.
Co-Authored-By: Paul Brook <paul@codesourcery.com>
From-SVN: r91609
2004-12-02 05:10:26 +01:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_fstat (gfc_expr *unit, gfc_expr *array)
|
flush.c: New file.
2004-12-02 Steven G. Kargl <kargls@comcast.net>
Paul Brook <paul@codesourcery.com>
libgfortran/
* intrinsics/flush.c: New file.
* intrinsics/fnum.c: ditto
* intrinsics/stat.c: ditto
* io/io.h (unit_to_fd): Add prototype.
* io/unix.c (unit_to_fd): New function.
* configure.ac: Add test for members of struct stat. Check for
sys/types.h and sys/stat.h
* Makefile.am: Add intrinsics/{flush.c,fnum.c,stat.c}
* configure.in: Regenerate.
* config.h.in: Regenerate.
* Makefile.in: Regenerate.
fortran/
* check.c (gfc_check_flush, gfc_check_fnum): New functions.
(gfc_check_fstat, gfc_check_fstat_sub): New functions.
(gfc_check_stat, gfc_check_stat_sub): New functions.
* gfortran.h (GFC_ISYM_FNUM,GFC_ISYM_FSTAT,GFC_ISYM_STAT): New symbols
* intrinsic.c (add_functions,add_subroutines): Add flush, fnum,
fstat, and stat to intrinsics symbol tables.
* intrinsic.h (gfc_check_flush, gfc_resolve_stat_sub): Add prototypes.
(gfc_resolve_fstat_sub, gfc_resolve_stat): Ditto.
* iresolve.c (gfc_resolve_fnum, gfc_resolve_fstat): New functions.
(gfc_resolve_stat, gfc_resolve_flush): New functions.
(gfc_resolve_stat_sub,gfc_resolve_fstat_sub): New functions
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add new intrinsics.
Co-Authored-By: Paul Brook <paul@codesourcery.com>
From-SVN: r91609
2004-12-02 05:10:26 +01:00
|
|
|
{
|
|
|
|
if (type_check (unit, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (unit, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (array, 1, BT_INTEGER) == FAILURE
|
|
|
|
|| kind_value_check (unit, 0, gfc_default_integer_kind) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (array_check (array, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_fstat_sub (gfc_expr *unit, gfc_expr *array, gfc_expr *status)
|
flush.c: New file.
2004-12-02 Steven G. Kargl <kargls@comcast.net>
Paul Brook <paul@codesourcery.com>
libgfortran/
* intrinsics/flush.c: New file.
* intrinsics/fnum.c: ditto
* intrinsics/stat.c: ditto
* io/io.h (unit_to_fd): Add prototype.
* io/unix.c (unit_to_fd): New function.
* configure.ac: Add test for members of struct stat. Check for
sys/types.h and sys/stat.h
* Makefile.am: Add intrinsics/{flush.c,fnum.c,stat.c}
* configure.in: Regenerate.
* config.h.in: Regenerate.
* Makefile.in: Regenerate.
fortran/
* check.c (gfc_check_flush, gfc_check_fnum): New functions.
(gfc_check_fstat, gfc_check_fstat_sub): New functions.
(gfc_check_stat, gfc_check_stat_sub): New functions.
* gfortran.h (GFC_ISYM_FNUM,GFC_ISYM_FSTAT,GFC_ISYM_STAT): New symbols
* intrinsic.c (add_functions,add_subroutines): Add flush, fnum,
fstat, and stat to intrinsics symbol tables.
* intrinsic.h (gfc_check_flush, gfc_resolve_stat_sub): Add prototypes.
(gfc_resolve_fstat_sub, gfc_resolve_stat): Ditto.
* iresolve.c (gfc_resolve_fnum, gfc_resolve_fstat): New functions.
(gfc_resolve_stat, gfc_resolve_flush): New functions.
(gfc_resolve_stat_sub,gfc_resolve_fstat_sub): New functions
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add new intrinsics.
Co-Authored-By: Paul Brook <paul@codesourcery.com>
From-SVN: r91609
2004-12-02 05:10:26 +01:00
|
|
|
{
|
|
|
|
if (type_check (unit, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (unit, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (array, 1, BT_INTEGER) == FAILURE
|
|
|
|
|| kind_value_check (array, 1, gfc_default_integer_kind) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (array_check (array, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (status == NULL)
|
|
|
|
return SUCCESS;
|
|
|
|
|
|
|
|
if (type_check (status, 2, BT_INTEGER) == FAILURE
|
|
|
|
|| kind_value_check (status, 2, gfc_default_integer_kind) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (status, 2) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
fget.c: New file.
* intrinsics/fget.c: New file.
* intrinsics/ftell.c: New file.
* io/unix.c (stream_offset): New function.
* io/io.h: Add prototype for stream_offset.
* Makefile.am: Add intrinsics/fget.c and intrinsics/ftell.c.
* Makefile.in: Regenerate.
* intrinsic.c (add_functions): Add COMPLEX, FTELL, FGETC, FGET,
FPUTC, FPUT, AND, XOR and OR intrinsic functions.
(add_subroutines): Add FGETC, FGET, FPUTC, FPUT and FTELL intrinsic
subroutines.
* gfortran.h: Add GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET,
GFC_ISYM_FGETC, GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL,
GFC_ISYM_OR, GFC_ISYM_XOR.
* iresolve.c (gfc_resolve_and, gfc_resolve_complex,
gfc_resolve_or, gfc_resolve_fgetc, gfc_resolve_fget,
gfc_resolve_fputc, gfc_resolve_fput, gfc_resolve_ftell,
gfc_resolve_xor, gfc_resolve_fgetc_sub, gfc_resolve_fget_sub,
gfc_resolve_fputc_sub, gfc_resolve_fput_sub, gfc_resolve_ftell_sub):
New functions.
* check.c (gfc_check_complex, gfc_check_fgetputc_sub,
gfc_check_fgetputc, gfc_check_fgetput_sub, gfc_check_fgetput,
gfc_check_ftell, gfc_check_ftell_sub, gfc_check_and): New functions.
* simplify.c (gfc_simplify_and, gfc_simplify_complex, gfc_simplify_or,
gfc_simplify_xor): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add cases for
GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET, GFC_ISYM_FGETC,
GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL, GFC_ISYM_OR and
GFC_ISYM_XOR.
* intrinsic.h: Add prototypes for all functions added to iresolve.c,
simplify.c and check.c.
* gfortran.dg/complex_intrinsic_1.f90: New test.
* gfortran.dg/complex_intrinsic_2.f90: New test.
* gfortran.dg/fgetc_1.f90: New test.
* gfortran.dg/fgetc_2.f90: New test.
* gfortran.dg/fgetc_3.f90: New test.
* gfortran.dg/ftell_1.f90: New test.
* gfortran.dg/ftell_2.f90: New test.
* gfortran.dg/gnu_logical_1.F: New test.
* gfortran.dg/gnu_logical_2.f90: New test.
From-SVN: r106859
2005-11-13 10:33:19 +01:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_ftell (gfc_expr *unit)
|
fget.c: New file.
* intrinsics/fget.c: New file.
* intrinsics/ftell.c: New file.
* io/unix.c (stream_offset): New function.
* io/io.h: Add prototype for stream_offset.
* Makefile.am: Add intrinsics/fget.c and intrinsics/ftell.c.
* Makefile.in: Regenerate.
* intrinsic.c (add_functions): Add COMPLEX, FTELL, FGETC, FGET,
FPUTC, FPUT, AND, XOR and OR intrinsic functions.
(add_subroutines): Add FGETC, FGET, FPUTC, FPUT and FTELL intrinsic
subroutines.
* gfortran.h: Add GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET,
GFC_ISYM_FGETC, GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL,
GFC_ISYM_OR, GFC_ISYM_XOR.
* iresolve.c (gfc_resolve_and, gfc_resolve_complex,
gfc_resolve_or, gfc_resolve_fgetc, gfc_resolve_fget,
gfc_resolve_fputc, gfc_resolve_fput, gfc_resolve_ftell,
gfc_resolve_xor, gfc_resolve_fgetc_sub, gfc_resolve_fget_sub,
gfc_resolve_fputc_sub, gfc_resolve_fput_sub, gfc_resolve_ftell_sub):
New functions.
* check.c (gfc_check_complex, gfc_check_fgetputc_sub,
gfc_check_fgetputc, gfc_check_fgetput_sub, gfc_check_fgetput,
gfc_check_ftell, gfc_check_ftell_sub, gfc_check_and): New functions.
* simplify.c (gfc_simplify_and, gfc_simplify_complex, gfc_simplify_or,
gfc_simplify_xor): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add cases for
GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET, GFC_ISYM_FGETC,
GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL, GFC_ISYM_OR and
GFC_ISYM_XOR.
* intrinsic.h: Add prototypes for all functions added to iresolve.c,
simplify.c and check.c.
* gfortran.dg/complex_intrinsic_1.f90: New test.
* gfortran.dg/complex_intrinsic_2.f90: New test.
* gfortran.dg/fgetc_1.f90: New test.
* gfortran.dg/fgetc_2.f90: New test.
* gfortran.dg/fgetc_3.f90: New test.
* gfortran.dg/ftell_1.f90: New test.
* gfortran.dg/ftell_2.f90: New test.
* gfortran.dg/gnu_logical_1.F: New test.
* gfortran.dg/gnu_logical_2.f90: New test.
From-SVN: r106859
2005-11-13 10:33:19 +01:00
|
|
|
{
|
|
|
|
if (type_check (unit, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (unit, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_ftell_sub (gfc_expr *unit, gfc_expr *offset)
|
fget.c: New file.
* intrinsics/fget.c: New file.
* intrinsics/ftell.c: New file.
* io/unix.c (stream_offset): New function.
* io/io.h: Add prototype for stream_offset.
* Makefile.am: Add intrinsics/fget.c and intrinsics/ftell.c.
* Makefile.in: Regenerate.
* intrinsic.c (add_functions): Add COMPLEX, FTELL, FGETC, FGET,
FPUTC, FPUT, AND, XOR and OR intrinsic functions.
(add_subroutines): Add FGETC, FGET, FPUTC, FPUT and FTELL intrinsic
subroutines.
* gfortran.h: Add GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET,
GFC_ISYM_FGETC, GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL,
GFC_ISYM_OR, GFC_ISYM_XOR.
* iresolve.c (gfc_resolve_and, gfc_resolve_complex,
gfc_resolve_or, gfc_resolve_fgetc, gfc_resolve_fget,
gfc_resolve_fputc, gfc_resolve_fput, gfc_resolve_ftell,
gfc_resolve_xor, gfc_resolve_fgetc_sub, gfc_resolve_fget_sub,
gfc_resolve_fputc_sub, gfc_resolve_fput_sub, gfc_resolve_ftell_sub):
New functions.
* check.c (gfc_check_complex, gfc_check_fgetputc_sub,
gfc_check_fgetputc, gfc_check_fgetput_sub, gfc_check_fgetput,
gfc_check_ftell, gfc_check_ftell_sub, gfc_check_and): New functions.
* simplify.c (gfc_simplify_and, gfc_simplify_complex, gfc_simplify_or,
gfc_simplify_xor): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add cases for
GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET, GFC_ISYM_FGETC,
GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL, GFC_ISYM_OR and
GFC_ISYM_XOR.
* intrinsic.h: Add prototypes for all functions added to iresolve.c,
simplify.c and check.c.
* gfortran.dg/complex_intrinsic_1.f90: New test.
* gfortran.dg/complex_intrinsic_2.f90: New test.
* gfortran.dg/fgetc_1.f90: New test.
* gfortran.dg/fgetc_2.f90: New test.
* gfortran.dg/fgetc_3.f90: New test.
* gfortran.dg/ftell_1.f90: New test.
* gfortran.dg/ftell_2.f90: New test.
* gfortran.dg/gnu_logical_1.F: New test.
* gfortran.dg/gnu_logical_2.f90: New test.
From-SVN: r106859
2005-11-13 10:33:19 +01:00
|
|
|
{
|
|
|
|
if (type_check (unit, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (unit, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (offset, 1, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (offset, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
flush.c: New file.
2004-12-02 Steven G. Kargl <kargls@comcast.net>
Paul Brook <paul@codesourcery.com>
libgfortran/
* intrinsics/flush.c: New file.
* intrinsics/fnum.c: ditto
* intrinsics/stat.c: ditto
* io/io.h (unit_to_fd): Add prototype.
* io/unix.c (unit_to_fd): New function.
* configure.ac: Add test for members of struct stat. Check for
sys/types.h and sys/stat.h
* Makefile.am: Add intrinsics/{flush.c,fnum.c,stat.c}
* configure.in: Regenerate.
* config.h.in: Regenerate.
* Makefile.in: Regenerate.
fortran/
* check.c (gfc_check_flush, gfc_check_fnum): New functions.
(gfc_check_fstat, gfc_check_fstat_sub): New functions.
(gfc_check_stat, gfc_check_stat_sub): New functions.
* gfortran.h (GFC_ISYM_FNUM,GFC_ISYM_FSTAT,GFC_ISYM_STAT): New symbols
* intrinsic.c (add_functions,add_subroutines): Add flush, fnum,
fstat, and stat to intrinsics symbol tables.
* intrinsic.h (gfc_check_flush, gfc_resolve_stat_sub): Add prototypes.
(gfc_resolve_fstat_sub, gfc_resolve_stat): Ditto.
* iresolve.c (gfc_resolve_fnum, gfc_resolve_fstat): New functions.
(gfc_resolve_stat, gfc_resolve_flush): New functions.
(gfc_resolve_stat_sub,gfc_resolve_fstat_sub): New functions
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add new intrinsics.
Co-Authored-By: Paul Brook <paul@codesourcery.com>
From-SVN: r91609
2004-12-02 05:10:26 +01:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_stat (gfc_expr *name, gfc_expr *array)
|
flush.c: New file.
2004-12-02 Steven G. Kargl <kargls@comcast.net>
Paul Brook <paul@codesourcery.com>
libgfortran/
* intrinsics/flush.c: New file.
* intrinsics/fnum.c: ditto
* intrinsics/stat.c: ditto
* io/io.h (unit_to_fd): Add prototype.
* io/unix.c (unit_to_fd): New function.
* configure.ac: Add test for members of struct stat. Check for
sys/types.h and sys/stat.h
* Makefile.am: Add intrinsics/{flush.c,fnum.c,stat.c}
* configure.in: Regenerate.
* config.h.in: Regenerate.
* Makefile.in: Regenerate.
fortran/
* check.c (gfc_check_flush, gfc_check_fnum): New functions.
(gfc_check_fstat, gfc_check_fstat_sub): New functions.
(gfc_check_stat, gfc_check_stat_sub): New functions.
* gfortran.h (GFC_ISYM_FNUM,GFC_ISYM_FSTAT,GFC_ISYM_STAT): New symbols
* intrinsic.c (add_functions,add_subroutines): Add flush, fnum,
fstat, and stat to intrinsics symbol tables.
* intrinsic.h (gfc_check_flush, gfc_resolve_stat_sub): Add prototypes.
(gfc_resolve_fstat_sub, gfc_resolve_stat): Ditto.
* iresolve.c (gfc_resolve_fnum, gfc_resolve_fstat): New functions.
(gfc_resolve_stat, gfc_resolve_flush): New functions.
(gfc_resolve_stat_sub,gfc_resolve_fstat_sub): New functions
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add new intrinsics.
Co-Authored-By: Paul Brook <paul@codesourcery.com>
From-SVN: r91609
2004-12-02 05:10:26 +01:00
|
|
|
{
|
|
|
|
if (type_check (name, 0, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (array, 1, BT_INTEGER) == FAILURE
|
|
|
|
|| kind_value_check (array, 1, gfc_default_integer_kind) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (array_check (array, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_stat_sub (gfc_expr *name, gfc_expr *array, gfc_expr *status)
|
flush.c: New file.
2004-12-02 Steven G. Kargl <kargls@comcast.net>
Paul Brook <paul@codesourcery.com>
libgfortran/
* intrinsics/flush.c: New file.
* intrinsics/fnum.c: ditto
* intrinsics/stat.c: ditto
* io/io.h (unit_to_fd): Add prototype.
* io/unix.c (unit_to_fd): New function.
* configure.ac: Add test for members of struct stat. Check for
sys/types.h and sys/stat.h
* Makefile.am: Add intrinsics/{flush.c,fnum.c,stat.c}
* configure.in: Regenerate.
* config.h.in: Regenerate.
* Makefile.in: Regenerate.
fortran/
* check.c (gfc_check_flush, gfc_check_fnum): New functions.
(gfc_check_fstat, gfc_check_fstat_sub): New functions.
(gfc_check_stat, gfc_check_stat_sub): New functions.
* gfortran.h (GFC_ISYM_FNUM,GFC_ISYM_FSTAT,GFC_ISYM_STAT): New symbols
* intrinsic.c (add_functions,add_subroutines): Add flush, fnum,
fstat, and stat to intrinsics symbol tables.
* intrinsic.h (gfc_check_flush, gfc_resolve_stat_sub): Add prototypes.
(gfc_resolve_fstat_sub, gfc_resolve_stat): Ditto.
* iresolve.c (gfc_resolve_fnum, gfc_resolve_fstat): New functions.
(gfc_resolve_stat, gfc_resolve_flush): New functions.
(gfc_resolve_stat_sub,gfc_resolve_fstat_sub): New functions
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add new intrinsics.
Co-Authored-By: Paul Brook <paul@codesourcery.com>
From-SVN: r91609
2004-12-02 05:10:26 +01:00
|
|
|
{
|
|
|
|
if (type_check (name, 0, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (array, 1, BT_INTEGER) == FAILURE
|
|
|
|
|| kind_value_check (array, 1, gfc_default_integer_kind) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (array_check (array, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (status == NULL)
|
|
|
|
return SUCCESS;
|
|
|
|
|
|
|
|
if (type_check (status, 2, BT_INTEGER) == FAILURE
|
|
|
|
|| kind_value_check (array, 1, gfc_default_integer_kind) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (status, 2) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_transfer (gfc_expr *source ATTRIBUTE_UNUSED,
|
|
|
|
gfc_expr *mold ATTRIBUTE_UNUSED, gfc_expr *size)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
2007-05-28 22:53:09 +02:00
|
|
|
if (mold->ts.type == BT_HOLLERITH)
|
|
|
|
{
|
|
|
|
gfc_error ("'MOLD' argument of 'TRANSFER' intrinsic at %L must not be %s",
|
|
|
|
&mold->where, gfc_basic_typename (BT_HOLLERITH));
|
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
if (size != NULL)
|
|
|
|
{
|
|
|
|
if (type_check (size, 2, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (size, 2) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (nonoptional_check (size, 2) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_transpose (gfc_expr *matrix)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (rank_check (matrix, 0, 2) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
re PR fortran/29600 ([F03] MINLOC and MAXLOC take an optional KIND argument)
PR fortran/29600
* intrinsic.c (add_functions): Add KIND arguments to COUNT,
IACHAR, ICHAR, INDEX, LBOUND, LEN, LEN_TRIM, SCAN, SIZE, UBOUND
and VERIFY.
* iresolve.c (gfc_resolve_count): Add kind argument.
(gfc_resolve_iachar): New function.
(gfc_resolve_ichar): Add kind argument.
(gfc_resolve_index_func): Likewise.
(gfc_resolve_lbound): Likewise.
(gfc_resolve_len): Likewise.
(gfc_resolve_len_trim): Likewise.
(gfc_resolve_scan): Likewise.
(gfc_resolve_size): New function.
(gfc_resolve_ubound): Add kind argument.
(gfc_resolve_verify): Likewise.
* trans-decl.c (gfc_get_extern_function_decl): Allow specific
intrinsics to have 4 arguments.
* check.c (gfc_check_count): Add kind argument.
(gfc_check_ichar_iachar): Likewise.
(gfc_check_index): Likewise.
(gfc_check_lbound): Likewise.
(gfc_check_len_lentrim): New function.
(gfc_check_scan): Add kind argument.
(gfc_check_size): Likewise.
(gfc_check_ubound): Likewise.
(gfc_check_verify): Likewise.
* intrinsic.texi: Update documentation for COUNT, IACHAR, ICHAR,
INDEX, LBOUND, LEN, LEN_TRIM, SCAN, SIZE, UBOUND and VERIFY.
* simplify.c (get_kind): Whitespace fix.
(int_expr_with_kind): New function.
(gfc_simplify_iachar): Add kind argument.
(gfc_simplify_iachar): Likewise.
(gfc_simplify_ichar): Likewise.
(gfc_simplify_index): Likewise.
(simplify_bound_dim): Likewise.
(simplify_bound): Likewise.
(gfc_simplify_lbound): Likewise.
(gfc_simplify_len): Likewise.
(gfc_simplify_len_trim): Likewise.
(gfc_simplify_scan): Likewise.
(gfc_simplify_shape): Pass NULL as kind argument to gfc_simplify_size.
(gfc_simplify_size): Add kind argument.
(gfc_simplify_ubound): Likewise.
(gfc_simplify_verify): Likewise.
* intrinsic.h: Update prototypes and add new ones.
* trans-intrinsic.c (gfc_conv_intrinsic_index): Rename into
gfc_conv_intrinsic_index_scan_verify.
(gfc_conv_intrinsic_scan, gfc_conv_intrinsic_verify): Remove.
(gfc_conv_intrinsic_function): Call
gfc_conv_intrinsic_index_scan_verify to translate the INDEX,
SCAN and VERIFY intrinsics.
* gfortran.dg/intrinsics_kind_argument_1.f90: New test.
* gfortran.dg/pure_dummy_length_1.f90: Adapt to new error wording.
From-SVN: r127380
2007-08-12 21:57:01 +02:00
|
|
|
gfc_check_ubound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (array_check (array, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (dim != NULL)
|
|
|
|
{
|
|
|
|
if (dim_check (dim, 1, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (dim_rank_check (dim, array, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
}
|
arith.c (arctangent2, [...]): Fix whitespace issues.
* arith.c (arctangent2, gfc_arith_init_1, gfc_arith_done_1,
gfc_constant_result, gfc_range_check, gfc_arith_power,
eval_type_intrinsic0, eval_intrinsic_f2, gfc_real2real,
gfc_real2complex, gfc_complex2int, gfc_complex2real,
gfc_complex2complex): Fix whitespace issues.
check.c (must_be, type_check, numeric_check, int_or_real_check,
logical_array_check, array_check, scalar_check, nonoptional_check,
variable_check, dim_check, check_a_kind, gfc_check_a_ikind,
gfc_check_a_xkind, gfc_check_abs, gfc_check_all_any,
gfc_check_allocated, gfc_check_a_p, gfc_check_besn,
gfc_check_btest, gfc_check_char, gfc_check_cmplx, gfc_check_count,
gfc_check_cshift, gfc_check_dcmplx, gfc_check_dble,
gfc_check_digits, gfc_check_dot_product, gfc_check_eoshift,
gfc_check_fnum, gfc_check_g77_math1, gfc_check_huge, gfc_check_i,
gfc_check_iand, gfc_check_ibclr, gfc_check_ibits, gfc_check_ibset,
gfc_check_idnint, gfc_check_ieor, gfc_check_index, gfc_check_int,
gfc_check_ior, gfc_check_ishft, gfc_check_ishftc, gfc_check_kind,
gfc_check_lbound, gfc_check_logical, min_max_args,
gfc_check_min_max_integer, gfc_check_min_max_real,
gfc_check_min_max_double, gfc_check_matmul,
gfc_check_minval_maxval, gfc_check_merge, gfc_check_nearest,
gfc_check_pack, gfc_check_precision, gfc_check_radix,
gfc_check_range, gfc_check_real, gfc_check_repeat,
gfc_check_scale, gfc_check_scan, gfc_check_selected_real_kind,
gfc_check_set_exponent): Fix formatting issues.
(gfc_check_size, gfc_check_sign): Alphabetize function order,
remove whitespace-only line.
(gfc_check_fstat, gfc_check_fstat_sub, gfc_check_stat,
gfc_check_stat_sub, gfc_check_transfer, gfc_check_transpose,
gfc_check_ubound, gfc_check_unpack, gfc_check_verify, gfc_check_x,
gfc_check_cpu_time, gfc_check_date_and_time, gfc_check_mvbits,
gfc_check_random_number, gfc_check_random_seed,
gfc_check_second_sub, gfc_check_system_clock,
gfc_check_getcwd_sub, gfc_check_exit, gfc_check_flush,
gfc_check_umask, gfc_check_umask_sub, gfc_check_unlink,
gfc_check_unlink_sub): Fix formatting issues.
From-SVN: r93093
2005-01-08 23:40:47 +01:00
|
|
|
|
re PR fortran/29600 ([F03] MINLOC and MAXLOC take an optional KIND argument)
PR fortran/29600
* intrinsic.c (add_functions): Add KIND arguments to COUNT,
IACHAR, ICHAR, INDEX, LBOUND, LEN, LEN_TRIM, SCAN, SIZE, UBOUND
and VERIFY.
* iresolve.c (gfc_resolve_count): Add kind argument.
(gfc_resolve_iachar): New function.
(gfc_resolve_ichar): Add kind argument.
(gfc_resolve_index_func): Likewise.
(gfc_resolve_lbound): Likewise.
(gfc_resolve_len): Likewise.
(gfc_resolve_len_trim): Likewise.
(gfc_resolve_scan): Likewise.
(gfc_resolve_size): New function.
(gfc_resolve_ubound): Add kind argument.
(gfc_resolve_verify): Likewise.
* trans-decl.c (gfc_get_extern_function_decl): Allow specific
intrinsics to have 4 arguments.
* check.c (gfc_check_count): Add kind argument.
(gfc_check_ichar_iachar): Likewise.
(gfc_check_index): Likewise.
(gfc_check_lbound): Likewise.
(gfc_check_len_lentrim): New function.
(gfc_check_scan): Add kind argument.
(gfc_check_size): Likewise.
(gfc_check_ubound): Likewise.
(gfc_check_verify): Likewise.
* intrinsic.texi: Update documentation for COUNT, IACHAR, ICHAR,
INDEX, LBOUND, LEN, LEN_TRIM, SCAN, SIZE, UBOUND and VERIFY.
* simplify.c (get_kind): Whitespace fix.
(int_expr_with_kind): New function.
(gfc_simplify_iachar): Add kind argument.
(gfc_simplify_iachar): Likewise.
(gfc_simplify_ichar): Likewise.
(gfc_simplify_index): Likewise.
(simplify_bound_dim): Likewise.
(simplify_bound): Likewise.
(gfc_simplify_lbound): Likewise.
(gfc_simplify_len): Likewise.
(gfc_simplify_len_trim): Likewise.
(gfc_simplify_scan): Likewise.
(gfc_simplify_shape): Pass NULL as kind argument to gfc_simplify_size.
(gfc_simplify_size): Add kind argument.
(gfc_simplify_ubound): Likewise.
(gfc_simplify_verify): Likewise.
* intrinsic.h: Update prototypes and add new ones.
* trans-intrinsic.c (gfc_conv_intrinsic_index): Rename into
gfc_conv_intrinsic_index_scan_verify.
(gfc_conv_intrinsic_scan, gfc_conv_intrinsic_verify): Remove.
(gfc_conv_intrinsic_function): Call
gfc_conv_intrinsic_index_scan_verify to translate the INDEX,
SCAN and VERIFY intrinsics.
* gfortran.dg/intrinsics_kind_argument_1.f90: New test.
* gfortran.dg/pure_dummy_length_1.f90: Adapt to new error wording.
From-SVN: r127380
2007-08-12 21:57:01 +02:00
|
|
|
if (kind_check (kind, 2, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
|
|
|
|
"with KIND argument at %L",
|
|
|
|
gfc_current_intrinsic, &kind->where) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_unpack (gfc_expr *vector, gfc_expr *mask, gfc_expr *field)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (rank_check (vector, 0, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (array_check (mask, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (mask, 1, BT_LOGICAL) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (same_type_check (vector, 0, field, 2) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
re PR fortran/29600 ([F03] MINLOC and MAXLOC take an optional KIND argument)
PR fortran/29600
* intrinsic.c (add_functions): Add KIND arguments to COUNT,
IACHAR, ICHAR, INDEX, LBOUND, LEN, LEN_TRIM, SCAN, SIZE, UBOUND
and VERIFY.
* iresolve.c (gfc_resolve_count): Add kind argument.
(gfc_resolve_iachar): New function.
(gfc_resolve_ichar): Add kind argument.
(gfc_resolve_index_func): Likewise.
(gfc_resolve_lbound): Likewise.
(gfc_resolve_len): Likewise.
(gfc_resolve_len_trim): Likewise.
(gfc_resolve_scan): Likewise.
(gfc_resolve_size): New function.
(gfc_resolve_ubound): Add kind argument.
(gfc_resolve_verify): Likewise.
* trans-decl.c (gfc_get_extern_function_decl): Allow specific
intrinsics to have 4 arguments.
* check.c (gfc_check_count): Add kind argument.
(gfc_check_ichar_iachar): Likewise.
(gfc_check_index): Likewise.
(gfc_check_lbound): Likewise.
(gfc_check_len_lentrim): New function.
(gfc_check_scan): Add kind argument.
(gfc_check_size): Likewise.
(gfc_check_ubound): Likewise.
(gfc_check_verify): Likewise.
* intrinsic.texi: Update documentation for COUNT, IACHAR, ICHAR,
INDEX, LBOUND, LEN, LEN_TRIM, SCAN, SIZE, UBOUND and VERIFY.
* simplify.c (get_kind): Whitespace fix.
(int_expr_with_kind): New function.
(gfc_simplify_iachar): Add kind argument.
(gfc_simplify_iachar): Likewise.
(gfc_simplify_ichar): Likewise.
(gfc_simplify_index): Likewise.
(simplify_bound_dim): Likewise.
(simplify_bound): Likewise.
(gfc_simplify_lbound): Likewise.
(gfc_simplify_len): Likewise.
(gfc_simplify_len_trim): Likewise.
(gfc_simplify_scan): Likewise.
(gfc_simplify_shape): Pass NULL as kind argument to gfc_simplify_size.
(gfc_simplify_size): Add kind argument.
(gfc_simplify_ubound): Likewise.
(gfc_simplify_verify): Likewise.
* intrinsic.h: Update prototypes and add new ones.
* trans-intrinsic.c (gfc_conv_intrinsic_index): Rename into
gfc_conv_intrinsic_index_scan_verify.
(gfc_conv_intrinsic_scan, gfc_conv_intrinsic_verify): Remove.
(gfc_conv_intrinsic_function): Call
gfc_conv_intrinsic_index_scan_verify to translate the INDEX,
SCAN and VERIFY intrinsics.
* gfortran.dg/intrinsics_kind_argument_1.f90: New test.
* gfortran.dg/pure_dummy_length_1.f90: Adapt to new error wording.
From-SVN: r127380
2007-08-12 21:57:01 +02:00
|
|
|
gfc_check_verify (gfc_expr *x, gfc_expr *y, gfc_expr *z, gfc_expr *kind)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (type_check (x, 0, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (same_type_check (x, 0, y, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (z != NULL && type_check (z, 2, BT_LOGICAL) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
re PR fortran/29600 ([F03] MINLOC and MAXLOC take an optional KIND argument)
PR fortran/29600
* intrinsic.c (add_functions): Add KIND arguments to COUNT,
IACHAR, ICHAR, INDEX, LBOUND, LEN, LEN_TRIM, SCAN, SIZE, UBOUND
and VERIFY.
* iresolve.c (gfc_resolve_count): Add kind argument.
(gfc_resolve_iachar): New function.
(gfc_resolve_ichar): Add kind argument.
(gfc_resolve_index_func): Likewise.
(gfc_resolve_lbound): Likewise.
(gfc_resolve_len): Likewise.
(gfc_resolve_len_trim): Likewise.
(gfc_resolve_scan): Likewise.
(gfc_resolve_size): New function.
(gfc_resolve_ubound): Add kind argument.
(gfc_resolve_verify): Likewise.
* trans-decl.c (gfc_get_extern_function_decl): Allow specific
intrinsics to have 4 arguments.
* check.c (gfc_check_count): Add kind argument.
(gfc_check_ichar_iachar): Likewise.
(gfc_check_index): Likewise.
(gfc_check_lbound): Likewise.
(gfc_check_len_lentrim): New function.
(gfc_check_scan): Add kind argument.
(gfc_check_size): Likewise.
(gfc_check_ubound): Likewise.
(gfc_check_verify): Likewise.
* intrinsic.texi: Update documentation for COUNT, IACHAR, ICHAR,
INDEX, LBOUND, LEN, LEN_TRIM, SCAN, SIZE, UBOUND and VERIFY.
* simplify.c (get_kind): Whitespace fix.
(int_expr_with_kind): New function.
(gfc_simplify_iachar): Add kind argument.
(gfc_simplify_iachar): Likewise.
(gfc_simplify_ichar): Likewise.
(gfc_simplify_index): Likewise.
(simplify_bound_dim): Likewise.
(simplify_bound): Likewise.
(gfc_simplify_lbound): Likewise.
(gfc_simplify_len): Likewise.
(gfc_simplify_len_trim): Likewise.
(gfc_simplify_scan): Likewise.
(gfc_simplify_shape): Pass NULL as kind argument to gfc_simplify_size.
(gfc_simplify_size): Add kind argument.
(gfc_simplify_ubound): Likewise.
(gfc_simplify_verify): Likewise.
* intrinsic.h: Update prototypes and add new ones.
* trans-intrinsic.c (gfc_conv_intrinsic_index): Rename into
gfc_conv_intrinsic_index_scan_verify.
(gfc_conv_intrinsic_scan, gfc_conv_intrinsic_verify): Remove.
(gfc_conv_intrinsic_function): Call
gfc_conv_intrinsic_index_scan_verify to translate the INDEX,
SCAN and VERIFY intrinsics.
* gfortran.dg/intrinsics_kind_argument_1.f90: New test.
* gfortran.dg/pure_dummy_length_1.f90: Adapt to new error wording.
From-SVN: r127380
2007-08-12 21:57:01 +02:00
|
|
|
if (kind_check (kind, 3, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
|
|
|
|
"with KIND argument at %L",
|
|
|
|
gfc_current_intrinsic, &kind->where) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_trim (gfc_expr *x)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (type_check (x, 0, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (x, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2005-11-05 09:34:07 +01:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_ttynam (gfc_expr *unit)
|
2005-11-05 09:34:07 +01:00
|
|
|
{
|
|
|
|
if (scalar_check (unit, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (unit, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
/* Common check function for the half a dozen intrinsics that have a
|
|
|
|
single real argument. */
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_x (gfc_expr *x)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (type_check (x, 0, BT_REAL) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
/************* Check functions for intrinsic subroutines *************/
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_cpu_time (gfc_expr *time)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (scalar_check (time, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (time, 0, BT_REAL) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (variable_check (time, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_date_and_time (gfc_expr *date, gfc_expr *time,
|
|
|
|
gfc_expr *zone, gfc_expr *values)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (date != NULL)
|
|
|
|
{
|
|
|
|
if (type_check (date, 0, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
if (scalar_check (date, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
if (variable_check (date, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
if (time != NULL)
|
|
|
|
{
|
|
|
|
if (type_check (time, 1, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
if (scalar_check (time, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
if (variable_check (time, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
if (zone != NULL)
|
|
|
|
{
|
|
|
|
if (type_check (zone, 2, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
if (scalar_check (zone, 2) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
if (variable_check (zone, 2) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
if (values != NULL)
|
|
|
|
{
|
|
|
|
if (type_check (values, 3, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
if (array_check (values, 3) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
if (rank_check (values, 3, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
if (variable_check (values, 3) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_mvbits (gfc_expr *from, gfc_expr *frompos, gfc_expr *len,
|
|
|
|
gfc_expr *to, gfc_expr *topos)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (type_check (from, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (frompos, 1, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (len, 2, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (same_type_check (from, 0, to, 3) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (variable_check (to, 3) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (topos, 4, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_random_number (gfc_expr *harvest)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
|
|
|
if (type_check (harvest, 0, BT_REAL) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (variable_check (harvest, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_random_seed (gfc_expr *size, gfc_expr *put, gfc_expr *get)
|
2004-05-13 08:41:07 +02:00
|
|
|
{
|
2007-08-12 22:45:29 +02:00
|
|
|
unsigned int nargs = 0;
|
|
|
|
locus *where = NULL;
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
if (size != NULL)
|
|
|
|
{
|
2007-08-12 22:45:29 +02:00
|
|
|
if (size->expr_type != EXPR_VARIABLE
|
|
|
|
|| !size->symtree->n.sym->attr.optional)
|
|
|
|
nargs++;
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
if (scalar_check (size, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (size, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (variable_check (size, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
gfortran.h (gfc_default_*_kind): Remove prototypes, add extern variable declaration of same name.
* gfortran.h (gfc_default_*_kind): Remove prototypes, add extern
variable declaration of same name.
* arith.c, check.c, decl.c, dump_parse_tree.c, expr.c,
intrinsic.c, io.c, iresolve.c, match.c, options.c, primary.c,
resolve.c, simplify.c, symbol.c, trans-const.c, trans-io.c:
Replace all calls to gfc_default_*_kind with variable accesses.
* trans-types.c: Same as above.
(gfc_default_*_kind_1): Rename to gfc_default_*_kind, remove
static qualifier. Replace all occurences.
(gfc_default_*_kind): Remove functions.
From-SVN: r86662
2004-08-27 16:49:35 +02:00
|
|
|
if (kind_value_check (size, 0, gfc_default_integer_kind) == FAILURE)
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
if (put != NULL)
|
|
|
|
{
|
2007-08-12 22:45:29 +02:00
|
|
|
if (put->expr_type != EXPR_VARIABLE
|
|
|
|
|| !put->symtree->n.sym->attr.optional)
|
|
|
|
{
|
|
|
|
nargs++;
|
|
|
|
where = &put->where;
|
|
|
|
}
|
2004-05-23 13:06:09 +02:00
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
if (array_check (put, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
2004-05-23 13:06:09 +02:00
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
if (rank_check (put, 1, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (put, 1, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
gfortran.h (gfc_default_*_kind): Remove prototypes, add extern variable declaration of same name.
* gfortran.h (gfc_default_*_kind): Remove prototypes, add extern
variable declaration of same name.
* arith.c, check.c, decl.c, dump_parse_tree.c, expr.c,
intrinsic.c, io.c, iresolve.c, match.c, options.c, primary.c,
resolve.c, simplify.c, symbol.c, trans-const.c, trans-io.c:
Replace all calls to gfc_default_*_kind with variable accesses.
* trans-types.c: Same as above.
(gfc_default_*_kind_1): Rename to gfc_default_*_kind, remove
static qualifier. Replace all occurences.
(gfc_default_*_kind): Remove functions.
From-SVN: r86662
2004-08-27 16:49:35 +02:00
|
|
|
if (kind_value_check (put, 1, gfc_default_integer_kind) == FAILURE)
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
if (get != NULL)
|
|
|
|
{
|
2007-08-12 22:45:29 +02:00
|
|
|
if (get->expr_type != EXPR_VARIABLE
|
|
|
|
|| !get->symtree->n.sym->attr.optional)
|
|
|
|
{
|
|
|
|
nargs++;
|
|
|
|
where = &get->where;
|
|
|
|
}
|
2004-05-23 13:06:09 +02:00
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
if (array_check (get, 2) == FAILURE)
|
|
|
|
return FAILURE;
|
2004-05-23 13:06:09 +02:00
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
if (rank_check (get, 2, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (get, 2, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (variable_check (get, 2) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
gfortran.h (gfc_default_*_kind): Remove prototypes, add extern variable declaration of same name.
* gfortran.h (gfc_default_*_kind): Remove prototypes, add extern
variable declaration of same name.
* arith.c, check.c, decl.c, dump_parse_tree.c, expr.c,
intrinsic.c, io.c, iresolve.c, match.c, options.c, primary.c,
resolve.c, simplify.c, symbol.c, trans-const.c, trans-io.c:
Replace all calls to gfc_default_*_kind with variable accesses.
* trans-types.c: Same as above.
(gfc_default_*_kind_1): Rename to gfc_default_*_kind, remove
static qualifier. Replace all occurences.
(gfc_default_*_kind): Remove functions.
From-SVN: r86662
2004-08-27 16:49:35 +02:00
|
|
|
if (kind_value_check (get, 2, gfc_default_integer_kind) == FAILURE)
|
2004-05-13 08:41:07 +02:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
2007-08-12 22:45:29 +02:00
|
|
|
/* RANDOM_SEED may not have more than one non-optional argument. */
|
|
|
|
if (nargs > 1)
|
|
|
|
gfc_error ("Too many arguments to %s at %L", gfc_current_intrinsic, where);
|
|
|
|
|
2004-05-13 08:41:07 +02:00
|
|
|
return SUCCESS;
|
|
|
|
}
|
2004-05-22 14:47:42 +02:00
|
|
|
|
2007-01-07 01:28:29 +01:00
|
|
|
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_second_sub (gfc_expr *time)
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
{
|
|
|
|
if (scalar_check (time, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (time, 0, BT_REAL) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (kind_value_check(time, 0, 4) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2004-05-22 14:47:42 +02:00
|
|
|
/* The arguments of SYSTEM_CLOCK are scalar, integer variables. Note,
|
|
|
|
count, count_rate, and count_max are all optional arguments */
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_system_clock (gfc_expr *count, gfc_expr *count_rate,
|
|
|
|
gfc_expr *count_max)
|
2004-05-22 14:47:42 +02:00
|
|
|
{
|
|
|
|
if (count != NULL)
|
|
|
|
{
|
|
|
|
if (scalar_check (count, 0) == FAILURE)
|
2007-01-07 01:28:29 +01:00
|
|
|
return FAILURE;
|
2004-05-22 14:47:42 +02:00
|
|
|
|
|
|
|
if (type_check (count, 0, BT_INTEGER) == FAILURE)
|
2007-01-07 01:28:29 +01:00
|
|
|
return FAILURE;
|
2004-05-22 14:47:42 +02:00
|
|
|
|
|
|
|
if (variable_check (count, 0) == FAILURE)
|
2007-01-07 01:28:29 +01:00
|
|
|
return FAILURE;
|
2004-05-22 14:47:42 +02:00
|
|
|
}
|
|
|
|
|
|
|
|
if (count_rate != NULL)
|
|
|
|
{
|
|
|
|
if (scalar_check (count_rate, 1) == FAILURE)
|
2007-01-07 01:28:29 +01:00
|
|
|
return FAILURE;
|
2004-05-22 14:47:42 +02:00
|
|
|
|
|
|
|
if (type_check (count_rate, 1, BT_INTEGER) == FAILURE)
|
2007-01-07 01:28:29 +01:00
|
|
|
return FAILURE;
|
2004-05-22 14:47:42 +02:00
|
|
|
|
|
|
|
if (variable_check (count_rate, 1) == FAILURE)
|
2007-01-07 01:28:29 +01:00
|
|
|
return FAILURE;
|
2004-05-22 14:47:42 +02:00
|
|
|
|
arith.c (arctangent2, [...]): Fix whitespace issues.
* arith.c (arctangent2, gfc_arith_init_1, gfc_arith_done_1,
gfc_constant_result, gfc_range_check, gfc_arith_power,
eval_type_intrinsic0, eval_intrinsic_f2, gfc_real2real,
gfc_real2complex, gfc_complex2int, gfc_complex2real,
gfc_complex2complex): Fix whitespace issues.
check.c (must_be, type_check, numeric_check, int_or_real_check,
logical_array_check, array_check, scalar_check, nonoptional_check,
variable_check, dim_check, check_a_kind, gfc_check_a_ikind,
gfc_check_a_xkind, gfc_check_abs, gfc_check_all_any,
gfc_check_allocated, gfc_check_a_p, gfc_check_besn,
gfc_check_btest, gfc_check_char, gfc_check_cmplx, gfc_check_count,
gfc_check_cshift, gfc_check_dcmplx, gfc_check_dble,
gfc_check_digits, gfc_check_dot_product, gfc_check_eoshift,
gfc_check_fnum, gfc_check_g77_math1, gfc_check_huge, gfc_check_i,
gfc_check_iand, gfc_check_ibclr, gfc_check_ibits, gfc_check_ibset,
gfc_check_idnint, gfc_check_ieor, gfc_check_index, gfc_check_int,
gfc_check_ior, gfc_check_ishft, gfc_check_ishftc, gfc_check_kind,
gfc_check_lbound, gfc_check_logical, min_max_args,
gfc_check_min_max_integer, gfc_check_min_max_real,
gfc_check_min_max_double, gfc_check_matmul,
gfc_check_minval_maxval, gfc_check_merge, gfc_check_nearest,
gfc_check_pack, gfc_check_precision, gfc_check_radix,
gfc_check_range, gfc_check_real, gfc_check_repeat,
gfc_check_scale, gfc_check_scan, gfc_check_selected_real_kind,
gfc_check_set_exponent): Fix formatting issues.
(gfc_check_size, gfc_check_sign): Alphabetize function order,
remove whitespace-only line.
(gfc_check_fstat, gfc_check_fstat_sub, gfc_check_stat,
gfc_check_stat_sub, gfc_check_transfer, gfc_check_transpose,
gfc_check_ubound, gfc_check_unpack, gfc_check_verify, gfc_check_x,
gfc_check_cpu_time, gfc_check_date_and_time, gfc_check_mvbits,
gfc_check_random_number, gfc_check_random_seed,
gfc_check_second_sub, gfc_check_system_clock,
gfc_check_getcwd_sub, gfc_check_exit, gfc_check_flush,
gfc_check_umask, gfc_check_umask_sub, gfc_check_unlink,
gfc_check_unlink_sub): Fix formatting issues.
From-SVN: r93093
2005-01-08 23:40:47 +01:00
|
|
|
if (count != NULL
|
|
|
|
&& same_type_check (count, 0, count_rate, 1) == FAILURE)
|
2007-01-07 01:28:29 +01:00
|
|
|
return FAILURE;
|
2004-05-22 14:47:42 +02:00
|
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
if (count_max != NULL)
|
|
|
|
{
|
|
|
|
if (scalar_check (count_max, 2) == FAILURE)
|
2007-01-07 01:28:29 +01:00
|
|
|
return FAILURE;
|
2004-05-22 14:47:42 +02:00
|
|
|
|
|
|
|
if (type_check (count_max, 2, BT_INTEGER) == FAILURE)
|
2007-01-07 01:28:29 +01:00
|
|
|
return FAILURE;
|
2004-05-22 14:47:42 +02:00
|
|
|
|
|
|
|
if (variable_check (count_max, 2) == FAILURE)
|
2007-01-07 01:28:29 +01:00
|
|
|
return FAILURE;
|
2004-05-22 14:47:42 +02:00
|
|
|
|
arith.c (arctangent2, [...]): Fix whitespace issues.
* arith.c (arctangent2, gfc_arith_init_1, gfc_arith_done_1,
gfc_constant_result, gfc_range_check, gfc_arith_power,
eval_type_intrinsic0, eval_intrinsic_f2, gfc_real2real,
gfc_real2complex, gfc_complex2int, gfc_complex2real,
gfc_complex2complex): Fix whitespace issues.
check.c (must_be, type_check, numeric_check, int_or_real_check,
logical_array_check, array_check, scalar_check, nonoptional_check,
variable_check, dim_check, check_a_kind, gfc_check_a_ikind,
gfc_check_a_xkind, gfc_check_abs, gfc_check_all_any,
gfc_check_allocated, gfc_check_a_p, gfc_check_besn,
gfc_check_btest, gfc_check_char, gfc_check_cmplx, gfc_check_count,
gfc_check_cshift, gfc_check_dcmplx, gfc_check_dble,
gfc_check_digits, gfc_check_dot_product, gfc_check_eoshift,
gfc_check_fnum, gfc_check_g77_math1, gfc_check_huge, gfc_check_i,
gfc_check_iand, gfc_check_ibclr, gfc_check_ibits, gfc_check_ibset,
gfc_check_idnint, gfc_check_ieor, gfc_check_index, gfc_check_int,
gfc_check_ior, gfc_check_ishft, gfc_check_ishftc, gfc_check_kind,
gfc_check_lbound, gfc_check_logical, min_max_args,
gfc_check_min_max_integer, gfc_check_min_max_real,
gfc_check_min_max_double, gfc_check_matmul,
gfc_check_minval_maxval, gfc_check_merge, gfc_check_nearest,
gfc_check_pack, gfc_check_precision, gfc_check_radix,
gfc_check_range, gfc_check_real, gfc_check_repeat,
gfc_check_scale, gfc_check_scan, gfc_check_selected_real_kind,
gfc_check_set_exponent): Fix formatting issues.
(gfc_check_size, gfc_check_sign): Alphabetize function order,
remove whitespace-only line.
(gfc_check_fstat, gfc_check_fstat_sub, gfc_check_stat,
gfc_check_stat_sub, gfc_check_transfer, gfc_check_transpose,
gfc_check_ubound, gfc_check_unpack, gfc_check_verify, gfc_check_x,
gfc_check_cpu_time, gfc_check_date_and_time, gfc_check_mvbits,
gfc_check_random_number, gfc_check_random_seed,
gfc_check_second_sub, gfc_check_system_clock,
gfc_check_getcwd_sub, gfc_check_exit, gfc_check_flush,
gfc_check_umask, gfc_check_umask_sub, gfc_check_unlink,
gfc_check_unlink_sub): Fix formatting issues.
From-SVN: r93093
2005-01-08 23:40:47 +01:00
|
|
|
if (count != NULL
|
|
|
|
&& same_type_check (count, 0, count_max, 2) == FAILURE)
|
2007-01-07 01:28:29 +01:00
|
|
|
return FAILURE;
|
2004-05-22 14:47:42 +02:00
|
|
|
|
|
|
|
if (count_rate != NULL
|
2007-01-07 01:28:29 +01:00
|
|
|
&& same_type_check (count_rate, 1, count_max, 2) == FAILURE)
|
|
|
|
return FAILURE;
|
arith.c (arctangent2, [...]): Fix whitespace issues.
* arith.c (arctangent2, gfc_arith_init_1, gfc_arith_done_1,
gfc_constant_result, gfc_range_check, gfc_arith_power,
eval_type_intrinsic0, eval_intrinsic_f2, gfc_real2real,
gfc_real2complex, gfc_complex2int, gfc_complex2real,
gfc_complex2complex): Fix whitespace issues.
check.c (must_be, type_check, numeric_check, int_or_real_check,
logical_array_check, array_check, scalar_check, nonoptional_check,
variable_check, dim_check, check_a_kind, gfc_check_a_ikind,
gfc_check_a_xkind, gfc_check_abs, gfc_check_all_any,
gfc_check_allocated, gfc_check_a_p, gfc_check_besn,
gfc_check_btest, gfc_check_char, gfc_check_cmplx, gfc_check_count,
gfc_check_cshift, gfc_check_dcmplx, gfc_check_dble,
gfc_check_digits, gfc_check_dot_product, gfc_check_eoshift,
gfc_check_fnum, gfc_check_g77_math1, gfc_check_huge, gfc_check_i,
gfc_check_iand, gfc_check_ibclr, gfc_check_ibits, gfc_check_ibset,
gfc_check_idnint, gfc_check_ieor, gfc_check_index, gfc_check_int,
gfc_check_ior, gfc_check_ishft, gfc_check_ishftc, gfc_check_kind,
gfc_check_lbound, gfc_check_logical, min_max_args,
gfc_check_min_max_integer, gfc_check_min_max_real,
gfc_check_min_max_double, gfc_check_matmul,
gfc_check_minval_maxval, gfc_check_merge, gfc_check_nearest,
gfc_check_pack, gfc_check_precision, gfc_check_radix,
gfc_check_range, gfc_check_real, gfc_check_repeat,
gfc_check_scale, gfc_check_scan, gfc_check_selected_real_kind,
gfc_check_set_exponent): Fix formatting issues.
(gfc_check_size, gfc_check_sign): Alphabetize function order,
remove whitespace-only line.
(gfc_check_fstat, gfc_check_fstat_sub, gfc_check_stat,
gfc_check_stat_sub, gfc_check_transfer, gfc_check_transpose,
gfc_check_ubound, gfc_check_unpack, gfc_check_verify, gfc_check_x,
gfc_check_cpu_time, gfc_check_date_and_time, gfc_check_mvbits,
gfc_check_random_number, gfc_check_random_seed,
gfc_check_second_sub, gfc_check_system_clock,
gfc_check_getcwd_sub, gfc_check_exit, gfc_check_flush,
gfc_check_umask, gfc_check_umask_sub, gfc_check_unlink,
gfc_check_unlink_sub): Fix formatting issues.
From-SVN: r93093
2005-01-08 23:40:47 +01:00
|
|
|
}
|
2004-05-22 14:47:42 +02:00
|
|
|
|
arith.c (arctangent2, [...]): Fix whitespace issues.
* arith.c (arctangent2, gfc_arith_init_1, gfc_arith_done_1,
gfc_constant_result, gfc_range_check, gfc_arith_power,
eval_type_intrinsic0, eval_intrinsic_f2, gfc_real2real,
gfc_real2complex, gfc_complex2int, gfc_complex2real,
gfc_complex2complex): Fix whitespace issues.
check.c (must_be, type_check, numeric_check, int_or_real_check,
logical_array_check, array_check, scalar_check, nonoptional_check,
variable_check, dim_check, check_a_kind, gfc_check_a_ikind,
gfc_check_a_xkind, gfc_check_abs, gfc_check_all_any,
gfc_check_allocated, gfc_check_a_p, gfc_check_besn,
gfc_check_btest, gfc_check_char, gfc_check_cmplx, gfc_check_count,
gfc_check_cshift, gfc_check_dcmplx, gfc_check_dble,
gfc_check_digits, gfc_check_dot_product, gfc_check_eoshift,
gfc_check_fnum, gfc_check_g77_math1, gfc_check_huge, gfc_check_i,
gfc_check_iand, gfc_check_ibclr, gfc_check_ibits, gfc_check_ibset,
gfc_check_idnint, gfc_check_ieor, gfc_check_index, gfc_check_int,
gfc_check_ior, gfc_check_ishft, gfc_check_ishftc, gfc_check_kind,
gfc_check_lbound, gfc_check_logical, min_max_args,
gfc_check_min_max_integer, gfc_check_min_max_real,
gfc_check_min_max_double, gfc_check_matmul,
gfc_check_minval_maxval, gfc_check_merge, gfc_check_nearest,
gfc_check_pack, gfc_check_precision, gfc_check_radix,
gfc_check_range, gfc_check_real, gfc_check_repeat,
gfc_check_scale, gfc_check_scan, gfc_check_selected_real_kind,
gfc_check_set_exponent): Fix formatting issues.
(gfc_check_size, gfc_check_sign): Alphabetize function order,
remove whitespace-only line.
(gfc_check_fstat, gfc_check_fstat_sub, gfc_check_stat,
gfc_check_stat_sub, gfc_check_transfer, gfc_check_transpose,
gfc_check_ubound, gfc_check_unpack, gfc_check_verify, gfc_check_x,
gfc_check_cpu_time, gfc_check_date_and_time, gfc_check_mvbits,
gfc_check_random_number, gfc_check_random_seed,
gfc_check_second_sub, gfc_check_system_clock,
gfc_check_getcwd_sub, gfc_check_exit, gfc_check_flush,
gfc_check_umask, gfc_check_umask_sub, gfc_check_unlink,
gfc_check_unlink_sub): Fix formatting issues.
From-SVN: r93093
2005-01-08 23:40:47 +01:00
|
|
|
return SUCCESS;
|
2004-05-22 14:47:42 +02:00
|
|
|
}
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
|
2007-01-07 01:28:29 +01:00
|
|
|
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_irand (gfc_expr *x)
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
{
|
2004-10-30 16:18:34 +02:00
|
|
|
if (x == NULL)
|
|
|
|
return SUCCESS;
|
|
|
|
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
if (scalar_check (x, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (x, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (kind_value_check(x, 0, 4) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
check.c (gfc_check_alarm_sub, [...]): New functions.
* check.c (gfc_check_alarm_sub, gfc_check_signal,
gfc_check_signal_sub): New functions.
* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_SIGNAL.
* intrinsic.c (add_functions): Add signal intrinsic.
(add_subroutines): Add signal and alarm intrinsics.
* intrinsic.texi: Document the new intrinsics.
* iresolve.c (gfc_resolve_signal, gfc_resolve_alarm_sub,
gfc_resolve_signal_sub): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add case
for GFC_ISYM_SIGNAL.
* intrinsic.h: Add prototypes for gfc_check_alarm_sub,
gfc_check_signal, gfc_check_signal_sub, gfc_resolve_signal,
gfc_resolve_alarm_sub, gfc_resolve_signal_sub.
* Makefile.am (intrinsics): Add signal.c.
* Makefile.in: Regenerate.
* configure.ac: Checks for signal and alarm.
* config.h.in: Regenerate.
* configure: Regenerate.
* intrinsics/signal.c: New file for SIGNAL and ALARM intrinsics.
From-SVN: r105967
2005-10-28 23:16:17 +02:00
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_alarm_sub (gfc_expr *seconds, gfc_expr *handler, gfc_expr *status)
|
check.c (gfc_check_alarm_sub, [...]): New functions.
* check.c (gfc_check_alarm_sub, gfc_check_signal,
gfc_check_signal_sub): New functions.
* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_SIGNAL.
* intrinsic.c (add_functions): Add signal intrinsic.
(add_subroutines): Add signal and alarm intrinsics.
* intrinsic.texi: Document the new intrinsics.
* iresolve.c (gfc_resolve_signal, gfc_resolve_alarm_sub,
gfc_resolve_signal_sub): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add case
for GFC_ISYM_SIGNAL.
* intrinsic.h: Add prototypes for gfc_check_alarm_sub,
gfc_check_signal, gfc_check_signal_sub, gfc_resolve_signal,
gfc_resolve_alarm_sub, gfc_resolve_signal_sub.
* Makefile.am (intrinsics): Add signal.c.
* Makefile.in: Regenerate.
* configure.ac: Checks for signal and alarm.
* config.h.in: Regenerate.
* configure: Regenerate.
* intrinsics/signal.c: New file for SIGNAL and ALARM intrinsics.
From-SVN: r105967
2005-10-28 23:16:17 +02:00
|
|
|
{
|
|
|
|
if (scalar_check (seconds, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (seconds, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (handler->ts.type != BT_INTEGER && handler->ts.type != BT_PROCEDURE)
|
|
|
|
{
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must be INTEGER "
|
|
|
|
"or PROCEDURE", gfc_current_intrinsic_arg[1],
|
|
|
|
gfc_current_intrinsic, &handler->where);
|
check.c (gfc_check_alarm_sub, [...]): New functions.
* check.c (gfc_check_alarm_sub, gfc_check_signal,
gfc_check_signal_sub): New functions.
* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_SIGNAL.
* intrinsic.c (add_functions): Add signal intrinsic.
(add_subroutines): Add signal and alarm intrinsics.
* intrinsic.texi: Document the new intrinsics.
* iresolve.c (gfc_resolve_signal, gfc_resolve_alarm_sub,
gfc_resolve_signal_sub): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add case
for GFC_ISYM_SIGNAL.
* intrinsic.h: Add prototypes for gfc_check_alarm_sub,
gfc_check_signal, gfc_check_signal_sub, gfc_resolve_signal,
gfc_resolve_alarm_sub, gfc_resolve_signal_sub.
* Makefile.am (intrinsics): Add signal.c.
* Makefile.in: Regenerate.
* configure.ac: Checks for signal and alarm.
* config.h.in: Regenerate.
* configure: Regenerate.
* intrinsics/signal.c: New file for SIGNAL and ALARM intrinsics.
From-SVN: r105967
2005-10-28 23:16:17 +02:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
if (handler->ts.type == BT_INTEGER && scalar_check (handler, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (status == NULL)
|
|
|
|
return SUCCESS;
|
|
|
|
|
|
|
|
if (scalar_check (status, 2) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (status, 2, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
2007-03-08 22:45:22 +01:00
|
|
|
if (kind_value_check (status, 2, gfc_default_integer_kind) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
check.c (gfc_check_alarm_sub, [...]): New functions.
* check.c (gfc_check_alarm_sub, gfc_check_signal,
gfc_check_signal_sub): New functions.
* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_SIGNAL.
* intrinsic.c (add_functions): Add signal intrinsic.
(add_subroutines): Add signal and alarm intrinsics.
* intrinsic.texi: Document the new intrinsics.
* iresolve.c (gfc_resolve_signal, gfc_resolve_alarm_sub,
gfc_resolve_signal_sub): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add case
for GFC_ISYM_SIGNAL.
* intrinsic.h: Add prototypes for gfc_check_alarm_sub,
gfc_check_signal, gfc_check_signal_sub, gfc_resolve_signal,
gfc_resolve_alarm_sub, gfc_resolve_signal_sub.
* Makefile.am (intrinsics): Add signal.c.
* Makefile.in: Regenerate.
* configure.ac: Checks for signal and alarm.
* config.h.in: Regenerate.
* configure: Regenerate.
* intrinsics/signal.c: New file for SIGNAL and ALARM intrinsics.
From-SVN: r105967
2005-10-28 23:16:17 +02:00
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_rand (gfc_expr *x)
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
{
|
2004-10-30 16:18:34 +02:00
|
|
|
if (x == NULL)
|
|
|
|
return SUCCESS;
|
|
|
|
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
if (scalar_check (x, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (x, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (kind_value_check(x, 0, 4) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
2007-01-07 01:28:29 +01:00
|
|
|
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_srand (gfc_expr *x)
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
{
|
|
|
|
if (scalar_check (x, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (x, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (kind_value_check(x, 0, 4) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
2007-01-07 01:28:29 +01:00
|
|
|
|
intrinsic.c (add_functions): Add ctime and fdate intrinsics.
* intrinsic.c (add_functions): Add ctime and fdate intrinsics.
(add_subroutines): Likewise.
* intrinsic.h: Prototypes for gfc_check_ctime,
gfc_check_ctime_sub, gfc_check_fdate_sub, gfc_resolve_ctime,
gfc_resolve_fdate, gfc_resolve_ctime_sub, gfc_resolve_fdate_sub.
* gfortran.h: Add GFC_ISYM_CTIME and GFC_ISYM_FDATE.
* iresolve.c (gfc_resolve_ctime, gfc_resolve_fdate,
gfc_resolve_ctime_sub, gfc_resolve_fdate_sub): New functions.
* trans-decl.c (gfc_build_intrinsic_function_decls): Add
gfor_fndecl_fdate and gfor_fndecl_ctime.
* check.c (gfc_check_ctime, gfc_check_ctime_sub,
gfc_check_fdate_sub): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_ctime,
gfc_conv_intrinsic_fdate): New functions.
(gfc_conv_intrinsic_function): Add cases for GFC_ISYM_CTIME
and GFC_ISYM_FDATE.
* intrinsic.texi: Documentation for the new CTIME and FDATE
intrinsics.
* trans.h: Declarations for gfor_fndecl_ctime and gfor_fndecl_fdate.
* intrinsics/ctime.c: New file.
* configure.ac: Add check for ctime.
* Makefile.am: Add ctime.c
* configure: Regenerate.
* config.h.in: Regenerate.
* Makefile.in: Regenerate.
From-SVN: r106558
2005-11-06 11:17:04 +01:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_ctime_sub (gfc_expr *time, gfc_expr *result)
|
intrinsic.c (add_functions): Add ctime and fdate intrinsics.
* intrinsic.c (add_functions): Add ctime and fdate intrinsics.
(add_subroutines): Likewise.
* intrinsic.h: Prototypes for gfc_check_ctime,
gfc_check_ctime_sub, gfc_check_fdate_sub, gfc_resolve_ctime,
gfc_resolve_fdate, gfc_resolve_ctime_sub, gfc_resolve_fdate_sub.
* gfortran.h: Add GFC_ISYM_CTIME and GFC_ISYM_FDATE.
* iresolve.c (gfc_resolve_ctime, gfc_resolve_fdate,
gfc_resolve_ctime_sub, gfc_resolve_fdate_sub): New functions.
* trans-decl.c (gfc_build_intrinsic_function_decls): Add
gfor_fndecl_fdate and gfor_fndecl_ctime.
* check.c (gfc_check_ctime, gfc_check_ctime_sub,
gfc_check_fdate_sub): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_ctime,
gfc_conv_intrinsic_fdate): New functions.
(gfc_conv_intrinsic_function): Add cases for GFC_ISYM_CTIME
and GFC_ISYM_FDATE.
* intrinsic.texi: Documentation for the new CTIME and FDATE
intrinsics.
* trans.h: Declarations for gfor_fndecl_ctime and gfor_fndecl_fdate.
* intrinsics/ctime.c: New file.
* configure.ac: Add check for ctime.
* Makefile.am: Add ctime.c
* configure: Regenerate.
* config.h.in: Regenerate.
* Makefile.in: Regenerate.
From-SVN: r106558
2005-11-06 11:17:04 +01:00
|
|
|
{
|
|
|
|
if (scalar_check (time, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (time, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (result, 1, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
2007-01-07 01:28:29 +01:00
|
|
|
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_etime (gfc_expr *x)
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
{
|
|
|
|
if (array_check (x, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (rank_check (x, 0, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (variable_check (x, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (x, 0, BT_REAL) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (kind_value_check(x, 0, 4) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
2007-01-07 01:28:29 +01:00
|
|
|
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_etime_sub (gfc_expr *values, gfc_expr *time)
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
{
|
|
|
|
if (array_check (values, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (rank_check (values, 0, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (variable_check (values, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (values, 0, BT_REAL) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (kind_value_check(values, 0, 4) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (time, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (time, 1, BT_REAL) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (kind_value_check(time, 1, 4) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
2004-09-15 16:09:17 +02:00
|
|
|
|
|
|
|
|
intrinsic.c (add_functions): Add ctime and fdate intrinsics.
* intrinsic.c (add_functions): Add ctime and fdate intrinsics.
(add_subroutines): Likewise.
* intrinsic.h: Prototypes for gfc_check_ctime,
gfc_check_ctime_sub, gfc_check_fdate_sub, gfc_resolve_ctime,
gfc_resolve_fdate, gfc_resolve_ctime_sub, gfc_resolve_fdate_sub.
* gfortran.h: Add GFC_ISYM_CTIME and GFC_ISYM_FDATE.
* iresolve.c (gfc_resolve_ctime, gfc_resolve_fdate,
gfc_resolve_ctime_sub, gfc_resolve_fdate_sub): New functions.
* trans-decl.c (gfc_build_intrinsic_function_decls): Add
gfor_fndecl_fdate and gfor_fndecl_ctime.
* check.c (gfc_check_ctime, gfc_check_ctime_sub,
gfc_check_fdate_sub): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_ctime,
gfc_conv_intrinsic_fdate): New functions.
(gfc_conv_intrinsic_function): Add cases for GFC_ISYM_CTIME
and GFC_ISYM_FDATE.
* intrinsic.texi: Documentation for the new CTIME and FDATE
intrinsics.
* trans.h: Declarations for gfor_fndecl_ctime and gfor_fndecl_fdate.
* intrinsics/ctime.c: New file.
* configure.ac: Add check for ctime.
* Makefile.am: Add ctime.c
* configure: Regenerate.
* config.h.in: Regenerate.
* Makefile.in: Regenerate.
From-SVN: r106558
2005-11-06 11:17:04 +01:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_fdate_sub (gfc_expr *date)
|
intrinsic.c (add_functions): Add ctime and fdate intrinsics.
* intrinsic.c (add_functions): Add ctime and fdate intrinsics.
(add_subroutines): Likewise.
* intrinsic.h: Prototypes for gfc_check_ctime,
gfc_check_ctime_sub, gfc_check_fdate_sub, gfc_resolve_ctime,
gfc_resolve_fdate, gfc_resolve_ctime_sub, gfc_resolve_fdate_sub.
* gfortran.h: Add GFC_ISYM_CTIME and GFC_ISYM_FDATE.
* iresolve.c (gfc_resolve_ctime, gfc_resolve_fdate,
gfc_resolve_ctime_sub, gfc_resolve_fdate_sub): New functions.
* trans-decl.c (gfc_build_intrinsic_function_decls): Add
gfor_fndecl_fdate and gfor_fndecl_ctime.
* check.c (gfc_check_ctime, gfc_check_ctime_sub,
gfc_check_fdate_sub): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_ctime,
gfc_conv_intrinsic_fdate): New functions.
(gfc_conv_intrinsic_function): Add cases for GFC_ISYM_CTIME
and GFC_ISYM_FDATE.
* intrinsic.texi: Documentation for the new CTIME and FDATE
intrinsics.
* trans.h: Declarations for gfor_fndecl_ctime and gfor_fndecl_fdate.
* intrinsics/ctime.c: New file.
* configure.ac: Add check for ctime.
* Makefile.am: Add ctime.c
* configure: Regenerate.
* config.h.in: Regenerate.
* Makefile.in: Regenerate.
From-SVN: r106558
2005-11-06 11:17:04 +01:00
|
|
|
{
|
|
|
|
if (type_check (date, 0, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
Makefile.am: Added new files.
* Makefile.am: Added new files.
* Makefile.in: Regenerate.
* aclocal.m4: Regenerate.
* configure.ac: add checks for signal.h headers file, as well as
following functions: chdir, strerror, getlogin, gethostname, kill,
link, symlink, perror, sleep, time.
* configure: Regenerate.
* intrinsics/chdir.c, intrinsics/gerror.c, intrinsics/getlog.c,
intrinsics/hostnm.c, intrinsics/ierrno.c, intrinsics/kill.c,
intrinsics/link.c, intrinsics/perror.c, intrinsics/rename.c,
intrinsics/sleep.c, intrinsics/symlnk.c, intrinsics/time.c: Newly
implementend g77 intrinsics.
* check.c (gfc_check_chdir, gfc_check_chdir_sub, gfc_check_kill,
gfc_check_kill_sub, gfc_check_link, gfc_check_link_sub,
gfc_check_symlnk, gfc_check_symlnk_sub, gfc_check_rename,
gfc_check_rename_sub, gfc_check_sleep_sub, gfc_check_gerror,
gfc_check_getlog, gfc_check_hostnm, gfc_check_hostnm_sub,
gfc_check_perror): new functions to check newly implemented
g77 intrinsics.
* gfortran.h: adding symbols for new intrinsics.
* intrinsic.c (add_functions): adding new intrinsics.
(add_subroutines): adding new intrinsics.
* intrinsic.h: prototype for all checking and resolving
functions.
* iresolve.c (gfc_resolve_chdir, gfc_resolve_chdir_sub,
gfc_resolve_hostnm, gfc_resolve_ierrno, gfc_resolve_kill,
gfc_resolve_link, gfc_resolve_rename, gfc_resolve_symlnk,
gfc_resolve_time, gfc_resolve_time8, gfc_resolve_rename_sub,
gfc_resolve_kill_sub, gfc_resolve_link_sub,
gfc_resolve_symlnk_sub, gfc_resolve_sleep_sub,
gfc_resolve_gerror, gfc_resolve_getlog, gfc_resolve_hostnm_sub,
gfc_resolve_perror): new functions to resolve intrinsics.
* trans-intrinsic.c (gfc_conv_intrinsic_function): add case
for new symbols.
* g77_intrinsics_funcs.f: New test.
* g77_intrinsics_sub.f: New test.
From-SVN: r96893
2005-03-22 23:08:22 +01:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_gerror (gfc_expr *msg)
|
Makefile.am: Added new files.
* Makefile.am: Added new files.
* Makefile.in: Regenerate.
* aclocal.m4: Regenerate.
* configure.ac: add checks for signal.h headers file, as well as
following functions: chdir, strerror, getlogin, gethostname, kill,
link, symlink, perror, sleep, time.
* configure: Regenerate.
* intrinsics/chdir.c, intrinsics/gerror.c, intrinsics/getlog.c,
intrinsics/hostnm.c, intrinsics/ierrno.c, intrinsics/kill.c,
intrinsics/link.c, intrinsics/perror.c, intrinsics/rename.c,
intrinsics/sleep.c, intrinsics/symlnk.c, intrinsics/time.c: Newly
implementend g77 intrinsics.
* check.c (gfc_check_chdir, gfc_check_chdir_sub, gfc_check_kill,
gfc_check_kill_sub, gfc_check_link, gfc_check_link_sub,
gfc_check_symlnk, gfc_check_symlnk_sub, gfc_check_rename,
gfc_check_rename_sub, gfc_check_sleep_sub, gfc_check_gerror,
gfc_check_getlog, gfc_check_hostnm, gfc_check_hostnm_sub,
gfc_check_perror): new functions to check newly implemented
g77 intrinsics.
* gfortran.h: adding symbols for new intrinsics.
* intrinsic.c (add_functions): adding new intrinsics.
(add_subroutines): adding new intrinsics.
* intrinsic.h: prototype for all checking and resolving
functions.
* iresolve.c (gfc_resolve_chdir, gfc_resolve_chdir_sub,
gfc_resolve_hostnm, gfc_resolve_ierrno, gfc_resolve_kill,
gfc_resolve_link, gfc_resolve_rename, gfc_resolve_symlnk,
gfc_resolve_time, gfc_resolve_time8, gfc_resolve_rename_sub,
gfc_resolve_kill_sub, gfc_resolve_link_sub,
gfc_resolve_symlnk_sub, gfc_resolve_sleep_sub,
gfc_resolve_gerror, gfc_resolve_getlog, gfc_resolve_hostnm_sub,
gfc_resolve_perror): new functions to resolve intrinsics.
* trans-intrinsic.c (gfc_conv_intrinsic_function): add case
for new symbols.
* g77_intrinsics_funcs.f: New test.
* g77_intrinsics_sub.f: New test.
From-SVN: r96893
2005-03-22 23:08:22 +01:00
|
|
|
{
|
|
|
|
if (type_check (msg, 0, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2004-09-15 16:09:17 +02:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_getcwd_sub (gfc_expr *cwd, gfc_expr *status)
|
2004-09-15 16:09:17 +02:00
|
|
|
{
|
|
|
|
if (type_check (cwd, 0, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
check.c (gfc_check_getcwd_sub): Fix seg fault.
* check.c (gfc_check_getcwd_sub): Fix seg fault.
* check.c (gfc_check_exit,gfc_check_umask,gfc_check_umask_sub,
gfc_check_unlink,gfc_check_unlink_sub): New functions
* gfortran.h (GFC_ISYM_UMASK,GFC_ISYM_UNLINK): New symbols
* intrinsic.c (add_functions,add_subroutines): Add umask, unlink,
exit to intrinsics symbol tables.
* intrinsic.h (gfc_check_umask,gfc_check_unlink,gfc_check_exit,
gfc_check_umask_sub,gfc_check_unlink_sub,gfc_resolve_umask,
gfc_resolve_unlink,gfc_resolve_exit,gfc_resolve_umask_sub,
gfc_resolve_unlink_sub): Add and sort prototypes.
* iresolve.c (gfc_resolve_umask,gfc_resolve_unlink,gfc_resolve_exit,
gfc_resolve_umask_sub,gfc_resolve_unlink_sub): New functions
* trans-intrinsic.c (gfc_conv_intrinsic_function): Use symbols
libgfortran/
* Makefile.am: Add intrinsics/{umask.c,unlink.c,exit.c}
* Makefile.in: Regenerated
* intrinsics/umask.c: New file
* intrinsics/unlink.c: ditto
* intrinsics/exit.c: ditto
From-SVN: r90949
2004-11-20 02:44:49 +01:00
|
|
|
if (status == NULL)
|
|
|
|
return SUCCESS;
|
|
|
|
|
|
|
|
if (scalar_check (status, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (status, 1, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
Makefile.am: Added new files.
* Makefile.am: Added new files.
* Makefile.in: Regenerate.
* aclocal.m4: Regenerate.
* configure.ac: add checks for signal.h headers file, as well as
following functions: chdir, strerror, getlogin, gethostname, kill,
link, symlink, perror, sleep, time.
* configure: Regenerate.
* intrinsics/chdir.c, intrinsics/gerror.c, intrinsics/getlog.c,
intrinsics/hostnm.c, intrinsics/ierrno.c, intrinsics/kill.c,
intrinsics/link.c, intrinsics/perror.c, intrinsics/rename.c,
intrinsics/sleep.c, intrinsics/symlnk.c, intrinsics/time.c: Newly
implementend g77 intrinsics.
* check.c (gfc_check_chdir, gfc_check_chdir_sub, gfc_check_kill,
gfc_check_kill_sub, gfc_check_link, gfc_check_link_sub,
gfc_check_symlnk, gfc_check_symlnk_sub, gfc_check_rename,
gfc_check_rename_sub, gfc_check_sleep_sub, gfc_check_gerror,
gfc_check_getlog, gfc_check_hostnm, gfc_check_hostnm_sub,
gfc_check_perror): new functions to check newly implemented
g77 intrinsics.
* gfortran.h: adding symbols for new intrinsics.
* intrinsic.c (add_functions): adding new intrinsics.
(add_subroutines): adding new intrinsics.
* intrinsic.h: prototype for all checking and resolving
functions.
* iresolve.c (gfc_resolve_chdir, gfc_resolve_chdir_sub,
gfc_resolve_hostnm, gfc_resolve_ierrno, gfc_resolve_kill,
gfc_resolve_link, gfc_resolve_rename, gfc_resolve_symlnk,
gfc_resolve_time, gfc_resolve_time8, gfc_resolve_rename_sub,
gfc_resolve_kill_sub, gfc_resolve_link_sub,
gfc_resolve_symlnk_sub, gfc_resolve_sleep_sub,
gfc_resolve_gerror, gfc_resolve_getlog, gfc_resolve_hostnm_sub,
gfc_resolve_perror): new functions to resolve intrinsics.
* trans-intrinsic.c (gfc_conv_intrinsic_function): add case
for new symbols.
* g77_intrinsics_funcs.f: New test.
* g77_intrinsics_sub.f: New test.
From-SVN: r96893
2005-03-22 23:08:22 +01:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_getlog (gfc_expr *msg)
|
Makefile.am: Added new files.
* Makefile.am: Added new files.
* Makefile.in: Regenerate.
* aclocal.m4: Regenerate.
* configure.ac: add checks for signal.h headers file, as well as
following functions: chdir, strerror, getlogin, gethostname, kill,
link, symlink, perror, sleep, time.
* configure: Regenerate.
* intrinsics/chdir.c, intrinsics/gerror.c, intrinsics/getlog.c,
intrinsics/hostnm.c, intrinsics/ierrno.c, intrinsics/kill.c,
intrinsics/link.c, intrinsics/perror.c, intrinsics/rename.c,
intrinsics/sleep.c, intrinsics/symlnk.c, intrinsics/time.c: Newly
implementend g77 intrinsics.
* check.c (gfc_check_chdir, gfc_check_chdir_sub, gfc_check_kill,
gfc_check_kill_sub, gfc_check_link, gfc_check_link_sub,
gfc_check_symlnk, gfc_check_symlnk_sub, gfc_check_rename,
gfc_check_rename_sub, gfc_check_sleep_sub, gfc_check_gerror,
gfc_check_getlog, gfc_check_hostnm, gfc_check_hostnm_sub,
gfc_check_perror): new functions to check newly implemented
g77 intrinsics.
* gfortran.h: adding symbols for new intrinsics.
* intrinsic.c (add_functions): adding new intrinsics.
(add_subroutines): adding new intrinsics.
* intrinsic.h: prototype for all checking and resolving
functions.
* iresolve.c (gfc_resolve_chdir, gfc_resolve_chdir_sub,
gfc_resolve_hostnm, gfc_resolve_ierrno, gfc_resolve_kill,
gfc_resolve_link, gfc_resolve_rename, gfc_resolve_symlnk,
gfc_resolve_time, gfc_resolve_time8, gfc_resolve_rename_sub,
gfc_resolve_kill_sub, gfc_resolve_link_sub,
gfc_resolve_symlnk_sub, gfc_resolve_sleep_sub,
gfc_resolve_gerror, gfc_resolve_getlog, gfc_resolve_hostnm_sub,
gfc_resolve_perror): new functions to resolve intrinsics.
* trans-intrinsic.c (gfc_conv_intrinsic_function): add case
for new symbols.
* g77_intrinsics_funcs.f: New test.
* g77_intrinsics_sub.f: New test.
From-SVN: r96893
2005-03-22 23:08:22 +01:00
|
|
|
{
|
|
|
|
if (type_check (msg, 0, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
check.c (gfc_check_getcwd_sub): Fix seg fault.
* check.c (gfc_check_getcwd_sub): Fix seg fault.
* check.c (gfc_check_exit,gfc_check_umask,gfc_check_umask_sub,
gfc_check_unlink,gfc_check_unlink_sub): New functions
* gfortran.h (GFC_ISYM_UMASK,GFC_ISYM_UNLINK): New symbols
* intrinsic.c (add_functions,add_subroutines): Add umask, unlink,
exit to intrinsics symbol tables.
* intrinsic.h (gfc_check_umask,gfc_check_unlink,gfc_check_exit,
gfc_check_umask_sub,gfc_check_unlink_sub,gfc_resolve_umask,
gfc_resolve_unlink,gfc_resolve_exit,gfc_resolve_umask_sub,
gfc_resolve_unlink_sub): Add and sort prototypes.
* iresolve.c (gfc_resolve_umask,gfc_resolve_unlink,gfc_resolve_exit,
gfc_resolve_umask_sub,gfc_resolve_unlink_sub): New functions
* trans-intrinsic.c (gfc_conv_intrinsic_function): Use symbols
libgfortran/
* Makefile.am: Add intrinsics/{umask.c,unlink.c,exit.c}
* Makefile.in: Regenerated
* intrinsics/umask.c: New file
* intrinsics/unlink.c: ditto
* intrinsics/exit.c: ditto
From-SVN: r90949
2004-11-20 02:44:49 +01:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_exit (gfc_expr *status)
|
check.c (gfc_check_getcwd_sub): Fix seg fault.
* check.c (gfc_check_getcwd_sub): Fix seg fault.
* check.c (gfc_check_exit,gfc_check_umask,gfc_check_umask_sub,
gfc_check_unlink,gfc_check_unlink_sub): New functions
* gfortran.h (GFC_ISYM_UMASK,GFC_ISYM_UNLINK): New symbols
* intrinsic.c (add_functions,add_subroutines): Add umask, unlink,
exit to intrinsics symbol tables.
* intrinsic.h (gfc_check_umask,gfc_check_unlink,gfc_check_exit,
gfc_check_umask_sub,gfc_check_unlink_sub,gfc_resolve_umask,
gfc_resolve_unlink,gfc_resolve_exit,gfc_resolve_umask_sub,
gfc_resolve_unlink_sub): Add and sort prototypes.
* iresolve.c (gfc_resolve_umask,gfc_resolve_unlink,gfc_resolve_exit,
gfc_resolve_umask_sub,gfc_resolve_unlink_sub): New functions
* trans-intrinsic.c (gfc_conv_intrinsic_function): Use symbols
libgfortran/
* Makefile.am: Add intrinsics/{umask.c,unlink.c,exit.c}
* Makefile.in: Regenerated
* intrinsics/umask.c: New file
* intrinsics/unlink.c: ditto
* intrinsics/exit.c: ditto
From-SVN: r90949
2004-11-20 02:44:49 +01:00
|
|
|
{
|
|
|
|
if (status == NULL)
|
arith.c (arctangent2, [...]): Fix whitespace issues.
* arith.c (arctangent2, gfc_arith_init_1, gfc_arith_done_1,
gfc_constant_result, gfc_range_check, gfc_arith_power,
eval_type_intrinsic0, eval_intrinsic_f2, gfc_real2real,
gfc_real2complex, gfc_complex2int, gfc_complex2real,
gfc_complex2complex): Fix whitespace issues.
check.c (must_be, type_check, numeric_check, int_or_real_check,
logical_array_check, array_check, scalar_check, nonoptional_check,
variable_check, dim_check, check_a_kind, gfc_check_a_ikind,
gfc_check_a_xkind, gfc_check_abs, gfc_check_all_any,
gfc_check_allocated, gfc_check_a_p, gfc_check_besn,
gfc_check_btest, gfc_check_char, gfc_check_cmplx, gfc_check_count,
gfc_check_cshift, gfc_check_dcmplx, gfc_check_dble,
gfc_check_digits, gfc_check_dot_product, gfc_check_eoshift,
gfc_check_fnum, gfc_check_g77_math1, gfc_check_huge, gfc_check_i,
gfc_check_iand, gfc_check_ibclr, gfc_check_ibits, gfc_check_ibset,
gfc_check_idnint, gfc_check_ieor, gfc_check_index, gfc_check_int,
gfc_check_ior, gfc_check_ishft, gfc_check_ishftc, gfc_check_kind,
gfc_check_lbound, gfc_check_logical, min_max_args,
gfc_check_min_max_integer, gfc_check_min_max_real,
gfc_check_min_max_double, gfc_check_matmul,
gfc_check_minval_maxval, gfc_check_merge, gfc_check_nearest,
gfc_check_pack, gfc_check_precision, gfc_check_radix,
gfc_check_range, gfc_check_real, gfc_check_repeat,
gfc_check_scale, gfc_check_scan, gfc_check_selected_real_kind,
gfc_check_set_exponent): Fix formatting issues.
(gfc_check_size, gfc_check_sign): Alphabetize function order,
remove whitespace-only line.
(gfc_check_fstat, gfc_check_fstat_sub, gfc_check_stat,
gfc_check_stat_sub, gfc_check_transfer, gfc_check_transpose,
gfc_check_ubound, gfc_check_unpack, gfc_check_verify, gfc_check_x,
gfc_check_cpu_time, gfc_check_date_and_time, gfc_check_mvbits,
gfc_check_random_number, gfc_check_random_seed,
gfc_check_second_sub, gfc_check_system_clock,
gfc_check_getcwd_sub, gfc_check_exit, gfc_check_flush,
gfc_check_umask, gfc_check_umask_sub, gfc_check_unlink,
gfc_check_unlink_sub): Fix formatting issues.
From-SVN: r93093
2005-01-08 23:40:47 +01:00
|
|
|
return SUCCESS;
|
check.c (gfc_check_getcwd_sub): Fix seg fault.
* check.c (gfc_check_getcwd_sub): Fix seg fault.
* check.c (gfc_check_exit,gfc_check_umask,gfc_check_umask_sub,
gfc_check_unlink,gfc_check_unlink_sub): New functions
* gfortran.h (GFC_ISYM_UMASK,GFC_ISYM_UNLINK): New symbols
* intrinsic.c (add_functions,add_subroutines): Add umask, unlink,
exit to intrinsics symbol tables.
* intrinsic.h (gfc_check_umask,gfc_check_unlink,gfc_check_exit,
gfc_check_umask_sub,gfc_check_unlink_sub,gfc_resolve_umask,
gfc_resolve_unlink,gfc_resolve_exit,gfc_resolve_umask_sub,
gfc_resolve_unlink_sub): Add and sort prototypes.
* iresolve.c (gfc_resolve_umask,gfc_resolve_unlink,gfc_resolve_exit,
gfc_resolve_umask_sub,gfc_resolve_unlink_sub): New functions
* trans-intrinsic.c (gfc_conv_intrinsic_function): Use symbols
libgfortran/
* Makefile.am: Add intrinsics/{umask.c,unlink.c,exit.c}
* Makefile.in: Regenerated
* intrinsics/umask.c: New file
* intrinsics/unlink.c: ditto
* intrinsics/exit.c: ditto
From-SVN: r90949
2004-11-20 02:44:49 +01:00
|
|
|
|
|
|
|
if (type_check (status, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (status, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
flush.c: New file.
2004-12-02 Steven G. Kargl <kargls@comcast.net>
Paul Brook <paul@codesourcery.com>
libgfortran/
* intrinsics/flush.c: New file.
* intrinsics/fnum.c: ditto
* intrinsics/stat.c: ditto
* io/io.h (unit_to_fd): Add prototype.
* io/unix.c (unit_to_fd): New function.
* configure.ac: Add test for members of struct stat. Check for
sys/types.h and sys/stat.h
* Makefile.am: Add intrinsics/{flush.c,fnum.c,stat.c}
* configure.in: Regenerate.
* config.h.in: Regenerate.
* Makefile.in: Regenerate.
fortran/
* check.c (gfc_check_flush, gfc_check_fnum): New functions.
(gfc_check_fstat, gfc_check_fstat_sub): New functions.
(gfc_check_stat, gfc_check_stat_sub): New functions.
* gfortran.h (GFC_ISYM_FNUM,GFC_ISYM_FSTAT,GFC_ISYM_STAT): New symbols
* intrinsic.c (add_functions,add_subroutines): Add flush, fnum,
fstat, and stat to intrinsics symbol tables.
* intrinsic.h (gfc_check_flush, gfc_resolve_stat_sub): Add prototypes.
(gfc_resolve_fstat_sub, gfc_resolve_stat): Ditto.
* iresolve.c (gfc_resolve_fnum, gfc_resolve_fstat): New functions.
(gfc_resolve_stat, gfc_resolve_flush): New functions.
(gfc_resolve_stat_sub,gfc_resolve_fstat_sub): New functions
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add new intrinsics.
Co-Authored-By: Paul Brook <paul@codesourcery.com>
From-SVN: r91609
2004-12-02 05:10:26 +01:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_flush (gfc_expr *unit)
|
flush.c: New file.
2004-12-02 Steven G. Kargl <kargls@comcast.net>
Paul Brook <paul@codesourcery.com>
libgfortran/
* intrinsics/flush.c: New file.
* intrinsics/fnum.c: ditto
* intrinsics/stat.c: ditto
* io/io.h (unit_to_fd): Add prototype.
* io/unix.c (unit_to_fd): New function.
* configure.ac: Add test for members of struct stat. Check for
sys/types.h and sys/stat.h
* Makefile.am: Add intrinsics/{flush.c,fnum.c,stat.c}
* configure.in: Regenerate.
* config.h.in: Regenerate.
* Makefile.in: Regenerate.
fortran/
* check.c (gfc_check_flush, gfc_check_fnum): New functions.
(gfc_check_fstat, gfc_check_fstat_sub): New functions.
(gfc_check_stat, gfc_check_stat_sub): New functions.
* gfortran.h (GFC_ISYM_FNUM,GFC_ISYM_FSTAT,GFC_ISYM_STAT): New symbols
* intrinsic.c (add_functions,add_subroutines): Add flush, fnum,
fstat, and stat to intrinsics symbol tables.
* intrinsic.h (gfc_check_flush, gfc_resolve_stat_sub): Add prototypes.
(gfc_resolve_fstat_sub, gfc_resolve_stat): Ditto.
* iresolve.c (gfc_resolve_fnum, gfc_resolve_fstat): New functions.
(gfc_resolve_stat, gfc_resolve_flush): New functions.
(gfc_resolve_stat_sub,gfc_resolve_fstat_sub): New functions
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add new intrinsics.
Co-Authored-By: Paul Brook <paul@codesourcery.com>
From-SVN: r91609
2004-12-02 05:10:26 +01:00
|
|
|
{
|
|
|
|
if (unit == NULL)
|
|
|
|
return SUCCESS;
|
|
|
|
|
|
|
|
if (type_check (unit, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (unit, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2005-10-30 13:17:48 +01:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_free (gfc_expr *i)
|
2005-10-30 13:17:48 +01:00
|
|
|
{
|
|
|
|
if (type_check (i, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (i, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
Makefile.am: Added new files.
* Makefile.am: Added new files.
* Makefile.in: Regenerate.
* aclocal.m4: Regenerate.
* configure.ac: add checks for signal.h headers file, as well as
following functions: chdir, strerror, getlogin, gethostname, kill,
link, symlink, perror, sleep, time.
* configure: Regenerate.
* intrinsics/chdir.c, intrinsics/gerror.c, intrinsics/getlog.c,
intrinsics/hostnm.c, intrinsics/ierrno.c, intrinsics/kill.c,
intrinsics/link.c, intrinsics/perror.c, intrinsics/rename.c,
intrinsics/sleep.c, intrinsics/symlnk.c, intrinsics/time.c: Newly
implementend g77 intrinsics.
* check.c (gfc_check_chdir, gfc_check_chdir_sub, gfc_check_kill,
gfc_check_kill_sub, gfc_check_link, gfc_check_link_sub,
gfc_check_symlnk, gfc_check_symlnk_sub, gfc_check_rename,
gfc_check_rename_sub, gfc_check_sleep_sub, gfc_check_gerror,
gfc_check_getlog, gfc_check_hostnm, gfc_check_hostnm_sub,
gfc_check_perror): new functions to check newly implemented
g77 intrinsics.
* gfortran.h: adding symbols for new intrinsics.
* intrinsic.c (add_functions): adding new intrinsics.
(add_subroutines): adding new intrinsics.
* intrinsic.h: prototype for all checking and resolving
functions.
* iresolve.c (gfc_resolve_chdir, gfc_resolve_chdir_sub,
gfc_resolve_hostnm, gfc_resolve_ierrno, gfc_resolve_kill,
gfc_resolve_link, gfc_resolve_rename, gfc_resolve_symlnk,
gfc_resolve_time, gfc_resolve_time8, gfc_resolve_rename_sub,
gfc_resolve_kill_sub, gfc_resolve_link_sub,
gfc_resolve_symlnk_sub, gfc_resolve_sleep_sub,
gfc_resolve_gerror, gfc_resolve_getlog, gfc_resolve_hostnm_sub,
gfc_resolve_perror): new functions to resolve intrinsics.
* trans-intrinsic.c (gfc_conv_intrinsic_function): add case
for new symbols.
* g77_intrinsics_funcs.f: New test.
* g77_intrinsics_sub.f: New test.
From-SVN: r96893
2005-03-22 23:08:22 +01:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_hostnm (gfc_expr *name)
|
Makefile.am: Added new files.
* Makefile.am: Added new files.
* Makefile.in: Regenerate.
* aclocal.m4: Regenerate.
* configure.ac: add checks for signal.h headers file, as well as
following functions: chdir, strerror, getlogin, gethostname, kill,
link, symlink, perror, sleep, time.
* configure: Regenerate.
* intrinsics/chdir.c, intrinsics/gerror.c, intrinsics/getlog.c,
intrinsics/hostnm.c, intrinsics/ierrno.c, intrinsics/kill.c,
intrinsics/link.c, intrinsics/perror.c, intrinsics/rename.c,
intrinsics/sleep.c, intrinsics/symlnk.c, intrinsics/time.c: Newly
implementend g77 intrinsics.
* check.c (gfc_check_chdir, gfc_check_chdir_sub, gfc_check_kill,
gfc_check_kill_sub, gfc_check_link, gfc_check_link_sub,
gfc_check_symlnk, gfc_check_symlnk_sub, gfc_check_rename,
gfc_check_rename_sub, gfc_check_sleep_sub, gfc_check_gerror,
gfc_check_getlog, gfc_check_hostnm, gfc_check_hostnm_sub,
gfc_check_perror): new functions to check newly implemented
g77 intrinsics.
* gfortran.h: adding symbols for new intrinsics.
* intrinsic.c (add_functions): adding new intrinsics.
(add_subroutines): adding new intrinsics.
* intrinsic.h: prototype for all checking and resolving
functions.
* iresolve.c (gfc_resolve_chdir, gfc_resolve_chdir_sub,
gfc_resolve_hostnm, gfc_resolve_ierrno, gfc_resolve_kill,
gfc_resolve_link, gfc_resolve_rename, gfc_resolve_symlnk,
gfc_resolve_time, gfc_resolve_time8, gfc_resolve_rename_sub,
gfc_resolve_kill_sub, gfc_resolve_link_sub,
gfc_resolve_symlnk_sub, gfc_resolve_sleep_sub,
gfc_resolve_gerror, gfc_resolve_getlog, gfc_resolve_hostnm_sub,
gfc_resolve_perror): new functions to resolve intrinsics.
* trans-intrinsic.c (gfc_conv_intrinsic_function): add case
for new symbols.
* g77_intrinsics_funcs.f: New test.
* g77_intrinsics_sub.f: New test.
From-SVN: r96893
2005-03-22 23:08:22 +01:00
|
|
|
{
|
|
|
|
if (type_check (name, 0, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_hostnm_sub (gfc_expr *name, gfc_expr *status)
|
Makefile.am: Added new files.
* Makefile.am: Added new files.
* Makefile.in: Regenerate.
* aclocal.m4: Regenerate.
* configure.ac: add checks for signal.h headers file, as well as
following functions: chdir, strerror, getlogin, gethostname, kill,
link, symlink, perror, sleep, time.
* configure: Regenerate.
* intrinsics/chdir.c, intrinsics/gerror.c, intrinsics/getlog.c,
intrinsics/hostnm.c, intrinsics/ierrno.c, intrinsics/kill.c,
intrinsics/link.c, intrinsics/perror.c, intrinsics/rename.c,
intrinsics/sleep.c, intrinsics/symlnk.c, intrinsics/time.c: Newly
implementend g77 intrinsics.
* check.c (gfc_check_chdir, gfc_check_chdir_sub, gfc_check_kill,
gfc_check_kill_sub, gfc_check_link, gfc_check_link_sub,
gfc_check_symlnk, gfc_check_symlnk_sub, gfc_check_rename,
gfc_check_rename_sub, gfc_check_sleep_sub, gfc_check_gerror,
gfc_check_getlog, gfc_check_hostnm, gfc_check_hostnm_sub,
gfc_check_perror): new functions to check newly implemented
g77 intrinsics.
* gfortran.h: adding symbols for new intrinsics.
* intrinsic.c (add_functions): adding new intrinsics.
(add_subroutines): adding new intrinsics.
* intrinsic.h: prototype for all checking and resolving
functions.
* iresolve.c (gfc_resolve_chdir, gfc_resolve_chdir_sub,
gfc_resolve_hostnm, gfc_resolve_ierrno, gfc_resolve_kill,
gfc_resolve_link, gfc_resolve_rename, gfc_resolve_symlnk,
gfc_resolve_time, gfc_resolve_time8, gfc_resolve_rename_sub,
gfc_resolve_kill_sub, gfc_resolve_link_sub,
gfc_resolve_symlnk_sub, gfc_resolve_sleep_sub,
gfc_resolve_gerror, gfc_resolve_getlog, gfc_resolve_hostnm_sub,
gfc_resolve_perror): new functions to resolve intrinsics.
* trans-intrinsic.c (gfc_conv_intrinsic_function): add case
for new symbols.
* g77_intrinsics_funcs.f: New test.
* g77_intrinsics_sub.f: New test.
From-SVN: r96893
2005-03-22 23:08:22 +01:00
|
|
|
{
|
|
|
|
if (type_check (name, 0, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (status == NULL)
|
|
|
|
return SUCCESS;
|
|
|
|
|
|
|
|
if (scalar_check (status, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (status, 1, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2006-07-04 13:39:46 +02:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_itime_idate (gfc_expr *values)
|
2006-07-04 13:39:46 +02:00
|
|
|
{
|
|
|
|
if (array_check (values, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (rank_check (values, 0, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (variable_check (values, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (values, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (kind_value_check(values, 0, gfc_default_integer_kind) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
intrinsic.c (add_functions): Add ACCESS, CHMOD, RSHIFT, LSHIFT.
* intrinsic.c (add_functions): Add ACCESS, CHMOD, RSHIFT, LSHIFT.
(add_subroutines): Add LTIME, GMTIME and CHMOD.
* intrinsic.h (gfc_check_access_func, gfc_check_chmod,
gfc_check_chmod_sub, gfc_check_ltime_gmtime, gfc_simplify_rshift,
gfc_simplify_lshift, gfc_resolve_access, gfc_resolve_chmod,
gfc_resolve_rshift, gfc_resolve_lshift, gfc_resolve_chmod_sub,
gfc_resolve_gmtime, gfc_resolve_ltime): Add prototypes.
* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_ACCESS,
GFC_ISYM_CHMOD, GFC_ISYM_LSHIFT, GFC_ISYM_RSHIFT.
* iresolve.c (gfc_resolve_access, gfc_resolve_chmod,
gfc_resolve_rshift, gfc_resolve_lshift, gfc_resolve_chmod_sub,
gfc_resolve_gmtime, gfc_resolve_ltime): New functions.
* check.c (gfc_check_access_func, gfc_check_chmod,
gfc_check_chmod_sub, gfc_check_ltime_gmtime): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_rlshift): New function.
(gfc_conv_intrinsic_function): Add cases for the new GFC_ISYM_*.
* intrinsics/date_and_time.c: Add functions for GMTIME and LTIME.
* intrinsics/access.c: New file.
* intrinsics/chmod.c: New file.
* configure.ac: Add checks for <sys/wait.h>, access, fork,execl
and wait.
* Makefile.am: Add new files intrinsics/access.c and
intrinsics/chmod.c.
* configure: Regenerate.
* config.h.in: Regenerate.
* Makefile.in: Regenerate.
* gcc/testsuite/gfortran.dg/chmod_3.f90: New test.
* gcc/testsuite/gfortran.dg/ltime_gmtime_1.f90: New test.
* gcc/testsuite/gfortran.dg/ltime_gmtime_2.f90: New test.
* gcc/testsuite/gfortran.dg/lrshift_1.f90: New test.
* gcc/testsuite/gfortran.dg/chmod_1.f90: New test.
* gcc/testsuite/gfortran.dg/chmod_2.f90: New test.
From-SVN: r115825
2006-07-30 22:48:00 +02:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_ltime_gmtime (gfc_expr *time, gfc_expr *values)
|
intrinsic.c (add_functions): Add ACCESS, CHMOD, RSHIFT, LSHIFT.
* intrinsic.c (add_functions): Add ACCESS, CHMOD, RSHIFT, LSHIFT.
(add_subroutines): Add LTIME, GMTIME and CHMOD.
* intrinsic.h (gfc_check_access_func, gfc_check_chmod,
gfc_check_chmod_sub, gfc_check_ltime_gmtime, gfc_simplify_rshift,
gfc_simplify_lshift, gfc_resolve_access, gfc_resolve_chmod,
gfc_resolve_rshift, gfc_resolve_lshift, gfc_resolve_chmod_sub,
gfc_resolve_gmtime, gfc_resolve_ltime): Add prototypes.
* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_ACCESS,
GFC_ISYM_CHMOD, GFC_ISYM_LSHIFT, GFC_ISYM_RSHIFT.
* iresolve.c (gfc_resolve_access, gfc_resolve_chmod,
gfc_resolve_rshift, gfc_resolve_lshift, gfc_resolve_chmod_sub,
gfc_resolve_gmtime, gfc_resolve_ltime): New functions.
* check.c (gfc_check_access_func, gfc_check_chmod,
gfc_check_chmod_sub, gfc_check_ltime_gmtime): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_rlshift): New function.
(gfc_conv_intrinsic_function): Add cases for the new GFC_ISYM_*.
* intrinsics/date_and_time.c: Add functions for GMTIME and LTIME.
* intrinsics/access.c: New file.
* intrinsics/chmod.c: New file.
* configure.ac: Add checks for <sys/wait.h>, access, fork,execl
and wait.
* Makefile.am: Add new files intrinsics/access.c and
intrinsics/chmod.c.
* configure: Regenerate.
* config.h.in: Regenerate.
* Makefile.in: Regenerate.
* gcc/testsuite/gfortran.dg/chmod_3.f90: New test.
* gcc/testsuite/gfortran.dg/ltime_gmtime_1.f90: New test.
* gcc/testsuite/gfortran.dg/ltime_gmtime_2.f90: New test.
* gcc/testsuite/gfortran.dg/lrshift_1.f90: New test.
* gcc/testsuite/gfortran.dg/chmod_1.f90: New test.
* gcc/testsuite/gfortran.dg/chmod_2.f90: New test.
From-SVN: r115825
2006-07-30 22:48:00 +02:00
|
|
|
{
|
|
|
|
if (type_check (time, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (kind_value_check(time, 0, gfc_default_integer_kind) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (time, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (array_check (values, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (rank_check (values, 1, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (variable_check (values, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (values, 1, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (kind_value_check(values, 1, gfc_default_integer_kind) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2005-08-09 19:33:17 +02:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_ttynam_sub (gfc_expr *unit, gfc_expr *name)
|
2005-08-09 19:33:17 +02:00
|
|
|
{
|
|
|
|
if (scalar_check (unit, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (unit, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (name, 1, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_isatty (gfc_expr *unit)
|
2005-08-09 19:33:17 +02:00
|
|
|
{
|
|
|
|
if (unit == NULL)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (unit, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (unit, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2007-08-05 12:18:38 +02:00
|
|
|
try
|
|
|
|
gfc_check_isnan (gfc_expr *x)
|
|
|
|
{
|
|
|
|
if (type_check (x, 0, BT_REAL) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
Makefile.am: Added new files.
* Makefile.am: Added new files.
* Makefile.in: Regenerate.
* aclocal.m4: Regenerate.
* configure.ac: add checks for signal.h headers file, as well as
following functions: chdir, strerror, getlogin, gethostname, kill,
link, symlink, perror, sleep, time.
* configure: Regenerate.
* intrinsics/chdir.c, intrinsics/gerror.c, intrinsics/getlog.c,
intrinsics/hostnm.c, intrinsics/ierrno.c, intrinsics/kill.c,
intrinsics/link.c, intrinsics/perror.c, intrinsics/rename.c,
intrinsics/sleep.c, intrinsics/symlnk.c, intrinsics/time.c: Newly
implementend g77 intrinsics.
* check.c (gfc_check_chdir, gfc_check_chdir_sub, gfc_check_kill,
gfc_check_kill_sub, gfc_check_link, gfc_check_link_sub,
gfc_check_symlnk, gfc_check_symlnk_sub, gfc_check_rename,
gfc_check_rename_sub, gfc_check_sleep_sub, gfc_check_gerror,
gfc_check_getlog, gfc_check_hostnm, gfc_check_hostnm_sub,
gfc_check_perror): new functions to check newly implemented
g77 intrinsics.
* gfortran.h: adding symbols for new intrinsics.
* intrinsic.c (add_functions): adding new intrinsics.
(add_subroutines): adding new intrinsics.
* intrinsic.h: prototype for all checking and resolving
functions.
* iresolve.c (gfc_resolve_chdir, gfc_resolve_chdir_sub,
gfc_resolve_hostnm, gfc_resolve_ierrno, gfc_resolve_kill,
gfc_resolve_link, gfc_resolve_rename, gfc_resolve_symlnk,
gfc_resolve_time, gfc_resolve_time8, gfc_resolve_rename_sub,
gfc_resolve_kill_sub, gfc_resolve_link_sub,
gfc_resolve_symlnk_sub, gfc_resolve_sleep_sub,
gfc_resolve_gerror, gfc_resolve_getlog, gfc_resolve_hostnm_sub,
gfc_resolve_perror): new functions to resolve intrinsics.
* trans-intrinsic.c (gfc_conv_intrinsic_function): add case
for new symbols.
* g77_intrinsics_funcs.f: New test.
* g77_intrinsics_sub.f: New test.
From-SVN: r96893
2005-03-22 23:08:22 +01:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_perror (gfc_expr *string)
|
Makefile.am: Added new files.
* Makefile.am: Added new files.
* Makefile.in: Regenerate.
* aclocal.m4: Regenerate.
* configure.ac: add checks for signal.h headers file, as well as
following functions: chdir, strerror, getlogin, gethostname, kill,
link, symlink, perror, sleep, time.
* configure: Regenerate.
* intrinsics/chdir.c, intrinsics/gerror.c, intrinsics/getlog.c,
intrinsics/hostnm.c, intrinsics/ierrno.c, intrinsics/kill.c,
intrinsics/link.c, intrinsics/perror.c, intrinsics/rename.c,
intrinsics/sleep.c, intrinsics/symlnk.c, intrinsics/time.c: Newly
implementend g77 intrinsics.
* check.c (gfc_check_chdir, gfc_check_chdir_sub, gfc_check_kill,
gfc_check_kill_sub, gfc_check_link, gfc_check_link_sub,
gfc_check_symlnk, gfc_check_symlnk_sub, gfc_check_rename,
gfc_check_rename_sub, gfc_check_sleep_sub, gfc_check_gerror,
gfc_check_getlog, gfc_check_hostnm, gfc_check_hostnm_sub,
gfc_check_perror): new functions to check newly implemented
g77 intrinsics.
* gfortran.h: adding symbols for new intrinsics.
* intrinsic.c (add_functions): adding new intrinsics.
(add_subroutines): adding new intrinsics.
* intrinsic.h: prototype for all checking and resolving
functions.
* iresolve.c (gfc_resolve_chdir, gfc_resolve_chdir_sub,
gfc_resolve_hostnm, gfc_resolve_ierrno, gfc_resolve_kill,
gfc_resolve_link, gfc_resolve_rename, gfc_resolve_symlnk,
gfc_resolve_time, gfc_resolve_time8, gfc_resolve_rename_sub,
gfc_resolve_kill_sub, gfc_resolve_link_sub,
gfc_resolve_symlnk_sub, gfc_resolve_sleep_sub,
gfc_resolve_gerror, gfc_resolve_getlog, gfc_resolve_hostnm_sub,
gfc_resolve_perror): new functions to resolve intrinsics.
* trans-intrinsic.c (gfc_conv_intrinsic_function): add case
for new symbols.
* g77_intrinsics_funcs.f: New test.
* g77_intrinsics_sub.f: New test.
From-SVN: r96893
2005-03-22 23:08:22 +01:00
|
|
|
{
|
|
|
|
if (type_check (string, 0, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
check.c (gfc_check_getcwd_sub): Fix seg fault.
* check.c (gfc_check_getcwd_sub): Fix seg fault.
* check.c (gfc_check_exit,gfc_check_umask,gfc_check_umask_sub,
gfc_check_unlink,gfc_check_unlink_sub): New functions
* gfortran.h (GFC_ISYM_UMASK,GFC_ISYM_UNLINK): New symbols
* intrinsic.c (add_functions,add_subroutines): Add umask, unlink,
exit to intrinsics symbol tables.
* intrinsic.h (gfc_check_umask,gfc_check_unlink,gfc_check_exit,
gfc_check_umask_sub,gfc_check_unlink_sub,gfc_resolve_umask,
gfc_resolve_unlink,gfc_resolve_exit,gfc_resolve_umask_sub,
gfc_resolve_unlink_sub): Add and sort prototypes.
* iresolve.c (gfc_resolve_umask,gfc_resolve_unlink,gfc_resolve_exit,
gfc_resolve_umask_sub,gfc_resolve_unlink_sub): New functions
* trans-intrinsic.c (gfc_conv_intrinsic_function): Use symbols
libgfortran/
* Makefile.am: Add intrinsics/{umask.c,unlink.c,exit.c}
* Makefile.in: Regenerated
* intrinsics/umask.c: New file
* intrinsics/unlink.c: ditto
* intrinsics/exit.c: ditto
From-SVN: r90949
2004-11-20 02:44:49 +01:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_umask (gfc_expr *mask)
|
check.c (gfc_check_getcwd_sub): Fix seg fault.
* check.c (gfc_check_getcwd_sub): Fix seg fault.
* check.c (gfc_check_exit,gfc_check_umask,gfc_check_umask_sub,
gfc_check_unlink,gfc_check_unlink_sub): New functions
* gfortran.h (GFC_ISYM_UMASK,GFC_ISYM_UNLINK): New symbols
* intrinsic.c (add_functions,add_subroutines): Add umask, unlink,
exit to intrinsics symbol tables.
* intrinsic.h (gfc_check_umask,gfc_check_unlink,gfc_check_exit,
gfc_check_umask_sub,gfc_check_unlink_sub,gfc_resolve_umask,
gfc_resolve_unlink,gfc_resolve_exit,gfc_resolve_umask_sub,
gfc_resolve_unlink_sub): Add and sort prototypes.
* iresolve.c (gfc_resolve_umask,gfc_resolve_unlink,gfc_resolve_exit,
gfc_resolve_umask_sub,gfc_resolve_unlink_sub): New functions
* trans-intrinsic.c (gfc_conv_intrinsic_function): Use symbols
libgfortran/
* Makefile.am: Add intrinsics/{umask.c,unlink.c,exit.c}
* Makefile.in: Regenerated
* intrinsics/umask.c: New file
* intrinsics/unlink.c: ditto
* intrinsics/exit.c: ditto
From-SVN: r90949
2004-11-20 02:44:49 +01:00
|
|
|
{
|
|
|
|
if (type_check (mask, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (mask, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_umask_sub (gfc_expr *mask, gfc_expr *old)
|
check.c (gfc_check_getcwd_sub): Fix seg fault.
* check.c (gfc_check_getcwd_sub): Fix seg fault.
* check.c (gfc_check_exit,gfc_check_umask,gfc_check_umask_sub,
gfc_check_unlink,gfc_check_unlink_sub): New functions
* gfortran.h (GFC_ISYM_UMASK,GFC_ISYM_UNLINK): New symbols
* intrinsic.c (add_functions,add_subroutines): Add umask, unlink,
exit to intrinsics symbol tables.
* intrinsic.h (gfc_check_umask,gfc_check_unlink,gfc_check_exit,
gfc_check_umask_sub,gfc_check_unlink_sub,gfc_resolve_umask,
gfc_resolve_unlink,gfc_resolve_exit,gfc_resolve_umask_sub,
gfc_resolve_unlink_sub): Add and sort prototypes.
* iresolve.c (gfc_resolve_umask,gfc_resolve_unlink,gfc_resolve_exit,
gfc_resolve_umask_sub,gfc_resolve_unlink_sub): New functions
* trans-intrinsic.c (gfc_conv_intrinsic_function): Use symbols
libgfortran/
* Makefile.am: Add intrinsics/{umask.c,unlink.c,exit.c}
* Makefile.in: Regenerated
* intrinsics/umask.c: New file
* intrinsics/unlink.c: ditto
* intrinsics/exit.c: ditto
From-SVN: r90949
2004-11-20 02:44:49 +01:00
|
|
|
{
|
|
|
|
if (type_check (mask, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (mask, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (old == NULL)
|
|
|
|
return SUCCESS;
|
|
|
|
|
|
|
|
if (scalar_check (old, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (old, 1, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_unlink (gfc_expr *name)
|
check.c (gfc_check_getcwd_sub): Fix seg fault.
* check.c (gfc_check_getcwd_sub): Fix seg fault.
* check.c (gfc_check_exit,gfc_check_umask,gfc_check_umask_sub,
gfc_check_unlink,gfc_check_unlink_sub): New functions
* gfortran.h (GFC_ISYM_UMASK,GFC_ISYM_UNLINK): New symbols
* intrinsic.c (add_functions,add_subroutines): Add umask, unlink,
exit to intrinsics symbol tables.
* intrinsic.h (gfc_check_umask,gfc_check_unlink,gfc_check_exit,
gfc_check_umask_sub,gfc_check_unlink_sub,gfc_resolve_umask,
gfc_resolve_unlink,gfc_resolve_exit,gfc_resolve_umask_sub,
gfc_resolve_unlink_sub): Add and sort prototypes.
* iresolve.c (gfc_resolve_umask,gfc_resolve_unlink,gfc_resolve_exit,
gfc_resolve_umask_sub,gfc_resolve_unlink_sub): New functions
* trans-intrinsic.c (gfc_conv_intrinsic_function): Use symbols
libgfortran/
* Makefile.am: Add intrinsics/{umask.c,unlink.c,exit.c}
* Makefile.in: Regenerated
* intrinsics/umask.c: New file
* intrinsics/unlink.c: ditto
* intrinsics/exit.c: ditto
From-SVN: r90949
2004-11-20 02:44:49 +01:00
|
|
|
{
|
|
|
|
if (type_check (name, 0, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_unlink_sub (gfc_expr *name, gfc_expr *status)
|
check.c (gfc_check_getcwd_sub): Fix seg fault.
* check.c (gfc_check_getcwd_sub): Fix seg fault.
* check.c (gfc_check_exit,gfc_check_umask,gfc_check_umask_sub,
gfc_check_unlink,gfc_check_unlink_sub): New functions
* gfortran.h (GFC_ISYM_UMASK,GFC_ISYM_UNLINK): New symbols
* intrinsic.c (add_functions,add_subroutines): Add umask, unlink,
exit to intrinsics symbol tables.
* intrinsic.h (gfc_check_umask,gfc_check_unlink,gfc_check_exit,
gfc_check_umask_sub,gfc_check_unlink_sub,gfc_resolve_umask,
gfc_resolve_unlink,gfc_resolve_exit,gfc_resolve_umask_sub,
gfc_resolve_unlink_sub): Add and sort prototypes.
* iresolve.c (gfc_resolve_umask,gfc_resolve_unlink,gfc_resolve_exit,
gfc_resolve_umask_sub,gfc_resolve_unlink_sub): New functions
* trans-intrinsic.c (gfc_conv_intrinsic_function): Use symbols
libgfortran/
* Makefile.am: Add intrinsics/{umask.c,unlink.c,exit.c}
* Makefile.in: Regenerated
* intrinsics/umask.c: New file
* intrinsics/unlink.c: ditto
* intrinsics/exit.c: ditto
From-SVN: r90949
2004-11-20 02:44:49 +01:00
|
|
|
{
|
|
|
|
if (type_check (name, 0, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (status == NULL)
|
|
|
|
return SUCCESS;
|
|
|
|
|
2004-09-15 16:09:17 +02:00
|
|
|
if (scalar_check (status, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (status, 1, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
2004-10-04 23:30:32 +02:00
|
|
|
|
|
|
|
|
check.c (gfc_check_alarm_sub, [...]): New functions.
* check.c (gfc_check_alarm_sub, gfc_check_signal,
gfc_check_signal_sub): New functions.
* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_SIGNAL.
* intrinsic.c (add_functions): Add signal intrinsic.
(add_subroutines): Add signal and alarm intrinsics.
* intrinsic.texi: Document the new intrinsics.
* iresolve.c (gfc_resolve_signal, gfc_resolve_alarm_sub,
gfc_resolve_signal_sub): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add case
for GFC_ISYM_SIGNAL.
* intrinsic.h: Add prototypes for gfc_check_alarm_sub,
gfc_check_signal, gfc_check_signal_sub, gfc_resolve_signal,
gfc_resolve_alarm_sub, gfc_resolve_signal_sub.
* Makefile.am (intrinsics): Add signal.c.
* Makefile.in: Regenerate.
* configure.ac: Checks for signal and alarm.
* config.h.in: Regenerate.
* configure: Regenerate.
* intrinsics/signal.c: New file for SIGNAL and ALARM intrinsics.
From-SVN: r105967
2005-10-28 23:16:17 +02:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_signal (gfc_expr *number, gfc_expr *handler)
|
check.c (gfc_check_alarm_sub, [...]): New functions.
* check.c (gfc_check_alarm_sub, gfc_check_signal,
gfc_check_signal_sub): New functions.
* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_SIGNAL.
* intrinsic.c (add_functions): Add signal intrinsic.
(add_subroutines): Add signal and alarm intrinsics.
* intrinsic.texi: Document the new intrinsics.
* iresolve.c (gfc_resolve_signal, gfc_resolve_alarm_sub,
gfc_resolve_signal_sub): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add case
for GFC_ISYM_SIGNAL.
* intrinsic.h: Add prototypes for gfc_check_alarm_sub,
gfc_check_signal, gfc_check_signal_sub, gfc_resolve_signal,
gfc_resolve_alarm_sub, gfc_resolve_signal_sub.
* Makefile.am (intrinsics): Add signal.c.
* Makefile.in: Regenerate.
* configure.ac: Checks for signal and alarm.
* config.h.in: Regenerate.
* configure: Regenerate.
* intrinsics/signal.c: New file for SIGNAL and ALARM intrinsics.
From-SVN: r105967
2005-10-28 23:16:17 +02:00
|
|
|
{
|
|
|
|
if (scalar_check (number, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (number, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (handler->ts.type != BT_INTEGER && handler->ts.type != BT_PROCEDURE)
|
|
|
|
{
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must be INTEGER "
|
|
|
|
"or PROCEDURE", gfc_current_intrinsic_arg[1],
|
|
|
|
gfc_current_intrinsic, &handler->where);
|
check.c (gfc_check_alarm_sub, [...]): New functions.
* check.c (gfc_check_alarm_sub, gfc_check_signal,
gfc_check_signal_sub): New functions.
* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_SIGNAL.
* intrinsic.c (add_functions): Add signal intrinsic.
(add_subroutines): Add signal and alarm intrinsics.
* intrinsic.texi: Document the new intrinsics.
* iresolve.c (gfc_resolve_signal, gfc_resolve_alarm_sub,
gfc_resolve_signal_sub): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add case
for GFC_ISYM_SIGNAL.
* intrinsic.h: Add prototypes for gfc_check_alarm_sub,
gfc_check_signal, gfc_check_signal_sub, gfc_resolve_signal,
gfc_resolve_alarm_sub, gfc_resolve_signal_sub.
* Makefile.am (intrinsics): Add signal.c.
* Makefile.in: Regenerate.
* configure.ac: Checks for signal and alarm.
* config.h.in: Regenerate.
* configure: Regenerate.
* intrinsics/signal.c: New file for SIGNAL and ALARM intrinsics.
From-SVN: r105967
2005-10-28 23:16:17 +02:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
if (handler->ts.type == BT_INTEGER && scalar_check (handler, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_signal_sub (gfc_expr *number, gfc_expr *handler, gfc_expr *status)
|
check.c (gfc_check_alarm_sub, [...]): New functions.
* check.c (gfc_check_alarm_sub, gfc_check_signal,
gfc_check_signal_sub): New functions.
* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_SIGNAL.
* intrinsic.c (add_functions): Add signal intrinsic.
(add_subroutines): Add signal and alarm intrinsics.
* intrinsic.texi: Document the new intrinsics.
* iresolve.c (gfc_resolve_signal, gfc_resolve_alarm_sub,
gfc_resolve_signal_sub): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add case
for GFC_ISYM_SIGNAL.
* intrinsic.h: Add prototypes for gfc_check_alarm_sub,
gfc_check_signal, gfc_check_signal_sub, gfc_resolve_signal,
gfc_resolve_alarm_sub, gfc_resolve_signal_sub.
* Makefile.am (intrinsics): Add signal.c.
* Makefile.in: Regenerate.
* configure.ac: Checks for signal and alarm.
* config.h.in: Regenerate.
* configure: Regenerate.
* intrinsics/signal.c: New file for SIGNAL and ALARM intrinsics.
From-SVN: r105967
2005-10-28 23:16:17 +02:00
|
|
|
{
|
|
|
|
if (scalar_check (number, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (number, 0, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (handler->ts.type != BT_INTEGER && handler->ts.type != BT_PROCEDURE)
|
|
|
|
{
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must be INTEGER "
|
|
|
|
"or PROCEDURE", gfc_current_intrinsic_arg[1],
|
|
|
|
gfc_current_intrinsic, &handler->where);
|
check.c (gfc_check_alarm_sub, [...]): New functions.
* check.c (gfc_check_alarm_sub, gfc_check_signal,
gfc_check_signal_sub): New functions.
* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_SIGNAL.
* intrinsic.c (add_functions): Add signal intrinsic.
(add_subroutines): Add signal and alarm intrinsics.
* intrinsic.texi: Document the new intrinsics.
* iresolve.c (gfc_resolve_signal, gfc_resolve_alarm_sub,
gfc_resolve_signal_sub): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add case
for GFC_ISYM_SIGNAL.
* intrinsic.h: Add prototypes for gfc_check_alarm_sub,
gfc_check_signal, gfc_check_signal_sub, gfc_resolve_signal,
gfc_resolve_alarm_sub, gfc_resolve_signal_sub.
* Makefile.am (intrinsics): Add signal.c.
* Makefile.in: Regenerate.
* configure.ac: Checks for signal and alarm.
* config.h.in: Regenerate.
* configure: Regenerate.
* intrinsics/signal.c: New file for SIGNAL and ALARM intrinsics.
From-SVN: r105967
2005-10-28 23:16:17 +02:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
if (handler->ts.type == BT_INTEGER && scalar_check (handler, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (status == NULL)
|
|
|
|
return SUCCESS;
|
|
|
|
|
|
|
|
if (type_check (status, 2, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (status, 2) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2004-10-04 23:30:32 +02:00
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_system_sub (gfc_expr *cmd, gfc_expr *status)
|
2004-10-04 23:30:32 +02:00
|
|
|
{
|
|
|
|
if (type_check (cmd, 0, BT_CHARACTER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (status, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (type_check (status, 1, BT_INTEGER) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (kind_value_check (status, 1, gfc_default_integer_kind) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|
fget.c: New file.
* intrinsics/fget.c: New file.
* intrinsics/ftell.c: New file.
* io/unix.c (stream_offset): New function.
* io/io.h: Add prototype for stream_offset.
* Makefile.am: Add intrinsics/fget.c and intrinsics/ftell.c.
* Makefile.in: Regenerate.
* intrinsic.c (add_functions): Add COMPLEX, FTELL, FGETC, FGET,
FPUTC, FPUT, AND, XOR and OR intrinsic functions.
(add_subroutines): Add FGETC, FGET, FPUTC, FPUT and FTELL intrinsic
subroutines.
* gfortran.h: Add GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET,
GFC_ISYM_FGETC, GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL,
GFC_ISYM_OR, GFC_ISYM_XOR.
* iresolve.c (gfc_resolve_and, gfc_resolve_complex,
gfc_resolve_or, gfc_resolve_fgetc, gfc_resolve_fget,
gfc_resolve_fputc, gfc_resolve_fput, gfc_resolve_ftell,
gfc_resolve_xor, gfc_resolve_fgetc_sub, gfc_resolve_fget_sub,
gfc_resolve_fputc_sub, gfc_resolve_fput_sub, gfc_resolve_ftell_sub):
New functions.
* check.c (gfc_check_complex, gfc_check_fgetputc_sub,
gfc_check_fgetputc, gfc_check_fgetput_sub, gfc_check_fgetput,
gfc_check_ftell, gfc_check_ftell_sub, gfc_check_and): New functions.
* simplify.c (gfc_simplify_and, gfc_simplify_complex, gfc_simplify_or,
gfc_simplify_xor): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add cases for
GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET, GFC_ISYM_FGETC,
GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL, GFC_ISYM_OR and
GFC_ISYM_XOR.
* intrinsic.h: Add prototypes for all functions added to iresolve.c,
simplify.c and check.c.
* gfortran.dg/complex_intrinsic_1.f90: New test.
* gfortran.dg/complex_intrinsic_2.f90: New test.
* gfortran.dg/fgetc_1.f90: New test.
* gfortran.dg/fgetc_2.f90: New test.
* gfortran.dg/fgetc_3.f90: New test.
* gfortran.dg/ftell_1.f90: New test.
* gfortran.dg/ftell_2.f90: New test.
* gfortran.dg/gnu_logical_1.F: New test.
* gfortran.dg/gnu_logical_2.f90: New test.
From-SVN: r106859
2005-11-13 10:33:19 +01:00
|
|
|
|
|
|
|
|
|
|
|
/* This is used for the GNU intrinsics AND, OR and XOR. */
|
|
|
|
try
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_check_and (gfc_expr *i, gfc_expr *j)
|
fget.c: New file.
* intrinsics/fget.c: New file.
* intrinsics/ftell.c: New file.
* io/unix.c (stream_offset): New function.
* io/io.h: Add prototype for stream_offset.
* Makefile.am: Add intrinsics/fget.c and intrinsics/ftell.c.
* Makefile.in: Regenerate.
* intrinsic.c (add_functions): Add COMPLEX, FTELL, FGETC, FGET,
FPUTC, FPUT, AND, XOR and OR intrinsic functions.
(add_subroutines): Add FGETC, FGET, FPUTC, FPUT and FTELL intrinsic
subroutines.
* gfortran.h: Add GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET,
GFC_ISYM_FGETC, GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL,
GFC_ISYM_OR, GFC_ISYM_XOR.
* iresolve.c (gfc_resolve_and, gfc_resolve_complex,
gfc_resolve_or, gfc_resolve_fgetc, gfc_resolve_fget,
gfc_resolve_fputc, gfc_resolve_fput, gfc_resolve_ftell,
gfc_resolve_xor, gfc_resolve_fgetc_sub, gfc_resolve_fget_sub,
gfc_resolve_fputc_sub, gfc_resolve_fput_sub, gfc_resolve_ftell_sub):
New functions.
* check.c (gfc_check_complex, gfc_check_fgetputc_sub,
gfc_check_fgetputc, gfc_check_fgetput_sub, gfc_check_fgetput,
gfc_check_ftell, gfc_check_ftell_sub, gfc_check_and): New functions.
* simplify.c (gfc_simplify_and, gfc_simplify_complex, gfc_simplify_or,
gfc_simplify_xor): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add cases for
GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET, GFC_ISYM_FGETC,
GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL, GFC_ISYM_OR and
GFC_ISYM_XOR.
* intrinsic.h: Add prototypes for all functions added to iresolve.c,
simplify.c and check.c.
* gfortran.dg/complex_intrinsic_1.f90: New test.
* gfortran.dg/complex_intrinsic_2.f90: New test.
* gfortran.dg/fgetc_1.f90: New test.
* gfortran.dg/fgetc_2.f90: New test.
* gfortran.dg/fgetc_3.f90: New test.
* gfortran.dg/ftell_1.f90: New test.
* gfortran.dg/ftell_2.f90: New test.
* gfortran.dg/gnu_logical_1.F: New test.
* gfortran.dg/gnu_logical_2.f90: New test.
From-SVN: r106859
2005-11-13 10:33:19 +01:00
|
|
|
{
|
|
|
|
if (i->ts.type != BT_INTEGER && i->ts.type != BT_LOGICAL)
|
|
|
|
{
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must be INTEGER "
|
|
|
|
"or LOGICAL", gfc_current_intrinsic_arg[0],
|
|
|
|
gfc_current_intrinsic, &i->where);
|
fget.c: New file.
* intrinsics/fget.c: New file.
* intrinsics/ftell.c: New file.
* io/unix.c (stream_offset): New function.
* io/io.h: Add prototype for stream_offset.
* Makefile.am: Add intrinsics/fget.c and intrinsics/ftell.c.
* Makefile.in: Regenerate.
* intrinsic.c (add_functions): Add COMPLEX, FTELL, FGETC, FGET,
FPUTC, FPUT, AND, XOR and OR intrinsic functions.
(add_subroutines): Add FGETC, FGET, FPUTC, FPUT and FTELL intrinsic
subroutines.
* gfortran.h: Add GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET,
GFC_ISYM_FGETC, GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL,
GFC_ISYM_OR, GFC_ISYM_XOR.
* iresolve.c (gfc_resolve_and, gfc_resolve_complex,
gfc_resolve_or, gfc_resolve_fgetc, gfc_resolve_fget,
gfc_resolve_fputc, gfc_resolve_fput, gfc_resolve_ftell,
gfc_resolve_xor, gfc_resolve_fgetc_sub, gfc_resolve_fget_sub,
gfc_resolve_fputc_sub, gfc_resolve_fput_sub, gfc_resolve_ftell_sub):
New functions.
* check.c (gfc_check_complex, gfc_check_fgetputc_sub,
gfc_check_fgetputc, gfc_check_fgetput_sub, gfc_check_fgetput,
gfc_check_ftell, gfc_check_ftell_sub, gfc_check_and): New functions.
* simplify.c (gfc_simplify_and, gfc_simplify_complex, gfc_simplify_or,
gfc_simplify_xor): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add cases for
GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET, GFC_ISYM_FGETC,
GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL, GFC_ISYM_OR and
GFC_ISYM_XOR.
* intrinsic.h: Add prototypes for all functions added to iresolve.c,
simplify.c and check.c.
* gfortran.dg/complex_intrinsic_1.f90: New test.
* gfortran.dg/complex_intrinsic_2.f90: New test.
* gfortran.dg/fgetc_1.f90: New test.
* gfortran.dg/fgetc_2.f90: New test.
* gfortran.dg/fgetc_3.f90: New test.
* gfortran.dg/ftell_1.f90: New test.
* gfortran.dg/ftell_2.f90: New test.
* gfortran.dg/gnu_logical_1.F: New test.
* gfortran.dg/gnu_logical_2.f90: New test.
From-SVN: r106859
2005-11-13 10:33:19 +01:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
if (j->ts.type != BT_INTEGER && j->ts.type != BT_LOGICAL)
|
|
|
|
{
|
2007-01-07 01:28:29 +01:00
|
|
|
gfc_error ("'%s' argument of '%s' intrinsic at %L must be INTEGER "
|
|
|
|
"or LOGICAL", gfc_current_intrinsic_arg[1],
|
|
|
|
gfc_current_intrinsic, &j->where);
|
fget.c: New file.
* intrinsics/fget.c: New file.
* intrinsics/ftell.c: New file.
* io/unix.c (stream_offset): New function.
* io/io.h: Add prototype for stream_offset.
* Makefile.am: Add intrinsics/fget.c and intrinsics/ftell.c.
* Makefile.in: Regenerate.
* intrinsic.c (add_functions): Add COMPLEX, FTELL, FGETC, FGET,
FPUTC, FPUT, AND, XOR and OR intrinsic functions.
(add_subroutines): Add FGETC, FGET, FPUTC, FPUT and FTELL intrinsic
subroutines.
* gfortran.h: Add GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET,
GFC_ISYM_FGETC, GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL,
GFC_ISYM_OR, GFC_ISYM_XOR.
* iresolve.c (gfc_resolve_and, gfc_resolve_complex,
gfc_resolve_or, gfc_resolve_fgetc, gfc_resolve_fget,
gfc_resolve_fputc, gfc_resolve_fput, gfc_resolve_ftell,
gfc_resolve_xor, gfc_resolve_fgetc_sub, gfc_resolve_fget_sub,
gfc_resolve_fputc_sub, gfc_resolve_fput_sub, gfc_resolve_ftell_sub):
New functions.
* check.c (gfc_check_complex, gfc_check_fgetputc_sub,
gfc_check_fgetputc, gfc_check_fgetput_sub, gfc_check_fgetput,
gfc_check_ftell, gfc_check_ftell_sub, gfc_check_and): New functions.
* simplify.c (gfc_simplify_and, gfc_simplify_complex, gfc_simplify_or,
gfc_simplify_xor): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add cases for
GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET, GFC_ISYM_FGETC,
GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL, GFC_ISYM_OR and
GFC_ISYM_XOR.
* intrinsic.h: Add prototypes for all functions added to iresolve.c,
simplify.c and check.c.
* gfortran.dg/complex_intrinsic_1.f90: New test.
* gfortran.dg/complex_intrinsic_2.f90: New test.
* gfortran.dg/fgetc_1.f90: New test.
* gfortran.dg/fgetc_2.f90: New test.
* gfortran.dg/fgetc_3.f90: New test.
* gfortran.dg/ftell_1.f90: New test.
* gfortran.dg/ftell_2.f90: New test.
* gfortran.dg/gnu_logical_1.F: New test.
* gfortran.dg/gnu_logical_2.f90: New test.
From-SVN: r106859
2005-11-13 10:33:19 +01:00
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
if (i->ts.type != j->ts.type)
|
|
|
|
{
|
|
|
|
gfc_error ("'%s' and '%s' arguments of '%s' intrinsic at %L must "
|
|
|
|
"have the same type", gfc_current_intrinsic_arg[0],
|
|
|
|
gfc_current_intrinsic_arg[1], gfc_current_intrinsic,
|
|
|
|
&j->where);
|
|
|
|
return FAILURE;
|
|
|
|
}
|
|
|
|
|
|
|
|
if (scalar_check (i, 0) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
if (scalar_check (j, 1) == FAILURE)
|
|
|
|
return FAILURE;
|
|
|
|
|
|
|
|
return SUCCESS;
|
|
|
|
}
|