&& specific->id != GFC_ISYM_RANK
&& specific->id != GFC_ISYM_SHAPE
&& specific->id != GFC_ISYM_SIZE
+ && specific->id != GFC_ISYM_SIZEOF
&& specific->id != GFC_ISYM_UBOUND
&& specific->id != GFC_ISYM_C_LOC)
{
if (!gfc_check_intrinsic_standard (isym, &symstd, false, loc)
&& !sym->attr.artificial)
{
- if (sym->attr.proc == PROC_UNKNOWN
- && gfc_option.warn_intrinsics_std)
- gfc_warning_now ("The intrinsic '%s' at %L is not included in the"
- " selected standard but %s and '%s' will be"
- " treated as if declared EXTERNAL. Use an"
+ if (sym->attr.proc == PROC_UNKNOWN && warn_intrinsics_std)
+ gfc_warning_now (OPT_Wintrinsics_std, "The intrinsic %qs at %L is not "
+ "included in the selected standard but %s and %qs will"
+ " be treated as if declared EXTERNAL. Use an"
" appropriate -std=* option or define"
" -fall-intrinsics to allow this intrinsic.",
sym->name, &loc, symstd, sym->name);
g = gfc_find_function (name);
if (g == NULL)
- gfc_internal_error ("make_generic(): Can't find generic symbol '%s'",
+ gfc_internal_error ("make_generic(): Can't find generic symbol %qs",
name);
gcc_assert (g->id == id);
*z = "z", *ln = "len", *ut = "unit", *han = "handler",
*num = "number", *tm = "time", *nm = "name", *md = "mode",
*vl = "values", *p1 = "path1", *p2 = "path2", *com = "command",
- *ca = "coarray", *sub = "sub";
+ *ca = "coarray", *sub = "sub", *dist = "distance", *failed="failed";
int di, dr, dd, dl, dc, dz, ii;
make_generic ("null", GFC_ISYM_NULL, GFC_STD_F95);
- add_sym_0 ("num_images", GFC_ISYM_NUM_IMAGES, CLASS_INQUIRY, ACTUAL_NO,
+ add_sym_2 ("num_images", GFC_ISYM_NUM_IMAGES, CLASS_INQUIRY, ACTUAL_NO,
BT_INTEGER, di, GFC_STD_F2008,
- NULL, gfc_simplify_num_images, NULL);
+ gfc_check_num_images, gfc_simplify_num_images, NULL,
+ dist, BT_INTEGER, di, OPTIONAL,
+ failed, BT_LOGICAL, dl, OPTIONAL);
add_sym_3 ("pack", GFC_ISYM_PACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
gfc_check_pack, gfc_simplify_pack, gfc_resolve_pack,
ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
make_from_module();
- add_sym_1 ("sizeof", GFC_ISYM_SIZEOF, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, ii,
- GFC_STD_GNU, gfc_check_sizeof, gfc_simplify_sizeof, NULL,
+ add_sym_1 ("sizeof", GFC_ISYM_SIZEOF, CLASS_INQUIRY, ACTUAL_NO,
+ BT_INTEGER, ii, GFC_STD_GNU,
+ gfc_check_sizeof, gfc_simplify_sizeof, NULL,
x, BT_UNKNOWN, 0, REQUIRED);
make_generic ("sizeof", GFC_ISYM_SIZEOF, GFC_STD_GNU);
make_generic ("tanh", GFC_ISYM_TANH, GFC_STD_F77);
- add_sym_2 ("this_image", GFC_ISYM_THIS_IMAGE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
+ add_sym_3 ("this_image", GFC_ISYM_THIS_IMAGE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
gfc_check_this_image, gfc_simplify_this_image, gfc_resolve_this_image,
- ca, BT_REAL, dr, OPTIONAL, dm, BT_INTEGER, ii, OPTIONAL);
+ ca, BT_REAL, dr, OPTIONAL, dm, BT_INTEGER, ii, OPTIONAL,
+ dist, BT_INTEGER, di, OPTIONAL);
add_sym_0 ("time", GFC_ISYM_TIME, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
di, GFC_STD_GNU, NULL, NULL, gfc_resolve_time);
make_noreturn();
- add_sym_2s ("atomic_define", GFC_ISYM_ATOMIC_DEF, CLASS_ATOMIC,
+ add_sym_3s ("atomic_define", GFC_ISYM_ATOMIC_DEF, CLASS_ATOMIC,
BT_UNKNOWN, 0, GFC_STD_F2008,
gfc_check_atomic_def, NULL, gfc_resolve_atomic_def,
"atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
- "value", BT_INTEGER, di, REQUIRED, INTENT_IN);
+ "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
+ stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
- add_sym_2s ("atomic_ref", GFC_ISYM_ATOMIC_REF, CLASS_ATOMIC,
+ add_sym_3s ("atomic_ref", GFC_ISYM_ATOMIC_REF, CLASS_ATOMIC,
BT_UNKNOWN, 0, GFC_STD_F2008,
gfc_check_atomic_ref, NULL, gfc_resolve_atomic_ref,
"value", BT_INTEGER, di, REQUIRED, INTENT_OUT,
- "atom", BT_INTEGER, di, REQUIRED, INTENT_IN);
+ "atom", BT_INTEGER, di, REQUIRED, INTENT_IN,
+ stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
+
+ add_sym_5s ("atomic_cas", GFC_ISYM_ATOMIC_CAS, CLASS_ATOMIC,
+ BT_UNKNOWN, 0, GFC_STD_F2008_TS,
+ gfc_check_atomic_cas, NULL, NULL,
+ "atom", BT_INTEGER, di, REQUIRED, INTENT_INOUT,
+ "old", BT_INTEGER, di, REQUIRED, INTENT_OUT,
+ "compare", BT_INTEGER, di, REQUIRED, INTENT_IN,
+ "new", BT_INTEGER, di, REQUIRED, INTENT_IN,
+ stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
+
+ add_sym_3s ("atomic_add", GFC_ISYM_ATOMIC_ADD, CLASS_ATOMIC,
+ BT_UNKNOWN, 0, GFC_STD_F2008_TS,
+ gfc_check_atomic_op, NULL, NULL,
+ "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
+ "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
+ stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
+
+ add_sym_3s ("atomic_and", GFC_ISYM_ATOMIC_AND, CLASS_ATOMIC,
+ BT_UNKNOWN, 0, GFC_STD_F2008_TS,
+ gfc_check_atomic_op, NULL, NULL,
+ "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
+ "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
+ stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
+
+ add_sym_3s ("atomic_or", GFC_ISYM_ATOMIC_OR, CLASS_ATOMIC,
+ BT_UNKNOWN, 0, GFC_STD_F2008_TS,
+ gfc_check_atomic_op, NULL, NULL,
+ "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
+ "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
+ stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
+
+ add_sym_3s ("atomic_xor", GFC_ISYM_ATOMIC_XOR, CLASS_ATOMIC,
+ BT_UNKNOWN, 0, GFC_STD_F2008_TS,
+ gfc_check_atomic_op, NULL, NULL,
+ "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
+ "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
+ stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
+
+ add_sym_4s ("atomic_fetch_add", GFC_ISYM_ATOMIC_FETCH_ADD, CLASS_ATOMIC,
+ BT_UNKNOWN, 0, GFC_STD_F2008_TS,
+ gfc_check_atomic_fetch_op, NULL, NULL,
+ "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
+ "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
+ "old", BT_INTEGER, di, REQUIRED, INTENT_OUT,
+ stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
+
+ add_sym_4s ("atomic_fetch_and", GFC_ISYM_ATOMIC_FETCH_AND, CLASS_ATOMIC,
+ BT_UNKNOWN, 0, GFC_STD_F2008_TS,
+ gfc_check_atomic_fetch_op, NULL, NULL,
+ "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
+ "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
+ "old", BT_INTEGER, di, REQUIRED, INTENT_OUT,
+ stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
+
+ add_sym_4s ("atomic_fetch_or", GFC_ISYM_ATOMIC_FETCH_OR, CLASS_ATOMIC,
+ BT_UNKNOWN, 0, GFC_STD_F2008_TS,
+ gfc_check_atomic_fetch_op, NULL, NULL,
+ "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
+ "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
+ "old", BT_INTEGER, di, REQUIRED, INTENT_OUT,
+ stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
+
+ add_sym_4s ("atomic_fetch_xor", GFC_ISYM_ATOMIC_FETCH_XOR, CLASS_ATOMIC,
+ BT_UNKNOWN, 0, GFC_STD_F2008_TS,
+ gfc_check_atomic_fetch_op, NULL, NULL,
+ "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
+ "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
+ "old", BT_INTEGER, di, REQUIRED, INTENT_OUT,
+ stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
add_sym_0s ("backtrace", GFC_ISYM_BACKTRACE, GFC_STD_GNU, NULL);
make_from_module();
/* Coarray collectives. */
+ add_sym_4s ("co_broadcast", GFC_ISYM_CO_BROADCAST, CLASS_IMPURE,
+ BT_UNKNOWN, 0, GFC_STD_F2008_TS,
+ gfc_check_co_broadcast, NULL, NULL,
+ a, BT_REAL, dr, REQUIRED, INTENT_INOUT,
+ "source_image", BT_INTEGER, di, REQUIRED, INTENT_IN,
+ stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
+ errmsg, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT);
+
add_sym_4s ("co_max", GFC_ISYM_CO_MAX, CLASS_IMPURE,
BT_UNKNOWN, 0, GFC_STD_F2008_TS,
gfc_check_co_minmax, NULL, NULL,
stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
errmsg, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT);
+ add_sym_5s ("co_reduce", GFC_ISYM_CO_REDUCE, CLASS_IMPURE,
+ BT_UNKNOWN, 0, GFC_STD_F2008_TS,
+ gfc_check_co_reduce, NULL, NULL,
+ a, BT_REAL, dr, REQUIRED, INTENT_INOUT,
+ "operator", BT_INTEGER, di, REQUIRED, INTENT_IN,
+ result_image, BT_INTEGER, di, OPTIONAL, INTENT_IN,
+ stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
+ errmsg, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT);
+
+
/* The following subroutine is internally used for coarray libray functions.
"make_from_module" makes it inaccessible for external users. */
add_sym_2s (GFC_PREFIX ("caf_send"), GFC_ISYM_CAF_SEND, CLASS_IMPURE,
break;
default:
- gfc_internal_error ("Invalid standard code on intrinsic '%s' (%d)",
+ gfc_internal_error ("Invalid standard code on intrinsic %qs (%d)",
isym->name, isym->standard);
}
/* Larger kinds can hold values of smaller kinds without problems.
Hence, only warn if target kind is smaller than the source
kind - or if -Wconversion-extra is specified. */
- if (gfc_option.warn_conversion_extra)
- gfc_warning_now ("Conversion from %s to %s at %L",
+ if (warn_conversion && from_ts.kind > ts->kind)
+ gfc_warning_now (OPT_Wconversion, "Possible change of value in "
+ "conversion from %s to %s at %L",
gfc_typename (&from_ts), gfc_typename (ts),
&expr->where);
- else if (gfc_option.gfc_warn_conversion
- && from_ts.kind > ts->kind)
- gfc_warning_now ("Possible change of value in conversion "
- "from %s to %s at %L", gfc_typename (&from_ts),
+ else if (warn_conversion_extra)
+ gfc_warning_now (OPT_Wconversion_extra, "Conversion from %s to %s "
+ "at %L", gfc_typename (&from_ts),
gfc_typename (ts), &expr->where);
}
else if ((from_ts.type == BT_REAL && ts->type == BT_INTEGER)
{
/* Conversion from REAL/COMPLEX to INTEGER or COMPLEX to REAL
usually comes with a loss of information, regardless of kinds. */
- if (gfc_option.warn_conversion_extra
- || gfc_option.gfc_warn_conversion)
- gfc_warning_now ("Possible change of value in conversion "
- "from %s to %s at %L", gfc_typename (&from_ts),
- gfc_typename (ts), &expr->where);
+ if (warn_conversion)
+ gfc_warning_now (OPT_Wconversion, "Possible change of value in "
+ "conversion from %s to %s at %L",
+ gfc_typename (&from_ts), gfc_typename (ts),
+ &expr->where);
}
else if (from_ts.type == BT_HOLLERITH || ts->type == BT_HOLLERITH)
{
/* If HOLLERITH is involved, all bets are off. */
- if (gfc_option.warn_conversion_extra
- || gfc_option.gfc_warn_conversion)
- gfc_warning_now ("Conversion from %s to %s at %L",
+ if (warn_conversion)
+ gfc_warning_now (OPT_Wconversion, "Conversion from %s to %s at %L",
gfc_typename (&from_ts), gfc_typename (ts),
&expr->where);
}
return false;
}
- gfc_internal_error ("Can't convert %s to %s at %L",
+ gfc_internal_error ("Can't convert %qs to %qs at %L",
gfc_typename (&from_ts), gfc_typename (ts),
&expr->where);
/* Not reached */
gfc_intrinsic_sym* isym;
/* If the warning is disabled, do nothing at all. */
- if (!gfc_option.warn_intrinsic_shadow)
+ if (!warn_intrinsic_shadow)
return;
/* Try to find an intrinsic of the same name. */
projects / gcc.git / blobdiff