aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/check.c
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran/check.c')
-rw-r--r--gcc/fortran/check.c281
1 files changed, 277 insertions, 4 deletions
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index a63112bd81e..8fae4449fbf 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -401,6 +401,16 @@ gfc_check_abs (gfc_expr * a)
return SUCCESS;
}
+try
+gfc_check_achar (gfc_expr * a)
+{
+
+ if (type_check (a, 0, BT_INTEGER) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+}
+
try
gfc_check_all_any (gfc_expr * mask, gfc_expr * dim)
@@ -565,6 +575,35 @@ gfc_check_char (gfc_expr * i, gfc_expr * kind)
try
+gfc_check_chdir (gfc_expr * dir)
+{
+ if (type_check (dir, 0, BT_CHARACTER) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+}
+
+
+try
+gfc_check_chdir_sub (gfc_expr * dir, gfc_expr * status)
+{
+ 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;
+}
+
+
+try
gfc_check_cmplx (gfc_expr * x, gfc_expr * y, gfc_expr * kind)
{
if (numeric_check (x, 0) == FAILURE)
@@ -936,10 +975,18 @@ gfc_check_index (gfc_expr * string, gfc_expr * substring, gfc_expr * back)
try
gfc_check_int (gfc_expr * x, gfc_expr * kind)
{
- if (numeric_check (x, 0) == FAILURE
- || kind_check (kind, 1, BT_INTEGER) == FAILURE)
+ if (numeric_check (x, 0) == FAILURE)
+ return FAILURE;
+
+ if (kind != NULL)
+ {
+ if (type_check (kind, 1, BT_INTEGER) == FAILURE)
return FAILURE;
+ if (scalar_check (kind, 1) == FAILURE)
+ return FAILURE;
+ }
+
return SUCCESS;
}
@@ -990,6 +1037,41 @@ gfc_check_ishftc (gfc_expr * i, gfc_expr * shift, gfc_expr * size)
try
+gfc_check_kill (gfc_expr * pid, gfc_expr * sig)
+{
+ if (type_check (pid, 0, BT_INTEGER) == FAILURE)
+ return FAILURE;
+
+ if (type_check (sig, 1, BT_INTEGER) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+}
+
+
+try
+gfc_check_kill_sub (gfc_expr * pid, gfc_expr * sig, gfc_expr * status)
+{
+ if (type_check (pid, 0, BT_INTEGER) == FAILURE)
+ return FAILURE;
+
+ if (type_check (sig, 1, BT_INTEGER) == 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;
+}
+
+
+try
gfc_check_kind (gfc_expr * x)
{
if (x->ts.type == BT_DERIVED)
@@ -1021,6 +1103,76 @@ gfc_check_lbound (gfc_expr * array, gfc_expr * dim)
try
+gfc_check_link (gfc_expr * path1, gfc_expr * path2)
+{
+ if (type_check (path1, 0, BT_CHARACTER) == FAILURE)
+ return FAILURE;
+
+ if (type_check (path2, 1, BT_CHARACTER) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+}
+
+
+try
+gfc_check_link_sub (gfc_expr * path1, gfc_expr * path2, gfc_expr * status)
+{
+ 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;
+}
+
+
+try
+gfc_check_symlnk (gfc_expr * path1, gfc_expr * path2)
+{
+ if (type_check (path1, 0, BT_CHARACTER) == FAILURE)
+ return FAILURE;
+
+ if (type_check (path2, 1, BT_CHARACTER) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+}
+
+
+try
+gfc_check_symlnk_sub (gfc_expr * path1, gfc_expr * path2, gfc_expr * status)
+{
+ 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;
+}
+
+
+try
gfc_check_logical (gfc_expr * a, gfc_expr * kind)
{
if (type_check (a, 0, BT_LOGICAL) == FAILURE)
@@ -1196,7 +1348,7 @@ gfc_check_minloc_maxloc (gfc_actual_arglist * ap)
m = ap->next->next->expr;
if (m == NULL && d != NULL && d->ts.type == BT_LOGICAL
- && ap->next->name[0] == '\0')
+ && ap->next->name == NULL)
{
m = d;
d = NULL;
@@ -1241,7 +1393,7 @@ check_reduction (gfc_actual_arglist * ap)
m = ap->next->next->expr;
if (m == NULL && d != NULL && d->ts.type == BT_LOGICAL
- && ap->next->name[0] == '\0')
+ && ap->next->name == NULL)
{
m = d;
d = NULL;
@@ -1436,6 +1588,41 @@ gfc_check_real (gfc_expr * a, gfc_expr * kind)
try
+gfc_check_rename (gfc_expr * path1, gfc_expr * path2)
+{
+ if (type_check (path1, 0, BT_CHARACTER) == FAILURE)
+ return FAILURE;
+
+ if (type_check (path2, 1, BT_CHARACTER) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+}
+
+
+try
+gfc_check_rename_sub (gfc_expr * path1, gfc_expr * path2, gfc_expr * status)
+{
+ 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;
+}
+
+
+try
gfc_check_repeat (gfc_expr * x, gfc_expr * y)
{
if (type_check (x, 0, BT_CHARACTER) == FAILURE)
@@ -1536,6 +1723,20 @@ gfc_check_scan (gfc_expr * x, gfc_expr * y, gfc_expr * z)
try
+gfc_check_selected_int_kind (gfc_expr * r)
+{
+
+ if (type_check (r, 0, BT_INTEGER) == FAILURE)
+ return FAILURE;
+
+ if (scalar_check (r, 0) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+}
+
+
+try
gfc_check_selected_real_kind (gfc_expr * p, gfc_expr * r)
{
if (p == NULL && r == NULL)
@@ -1626,6 +1827,19 @@ gfc_check_size (gfc_expr * array, gfc_expr * dim)
try
+gfc_check_sleep_sub (gfc_expr * seconds)
+{
+ if (type_check (seconds, 0, BT_INTEGER) == FAILURE)
+ return FAILURE;
+
+ if (scalar_check (seconds, 0) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+}
+
+
+try
gfc_check_spread (gfc_expr * source, gfc_expr * dim, gfc_expr * ncopies)
{
if (source->rank >= GFC_MAX_DIMENSIONS)
@@ -2202,6 +2416,16 @@ gfc_check_etime_sub (gfc_expr * values, gfc_expr * time)
try
+gfc_check_gerror (gfc_expr * msg)
+{
+ if (type_check (msg, 0, BT_CHARACTER) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+}
+
+
+try
gfc_check_getcwd_sub (gfc_expr * cwd, gfc_expr * status)
{
if (type_check (cwd, 0, BT_CHARACTER) == FAILURE)
@@ -2221,6 +2445,16 @@ gfc_check_getcwd_sub (gfc_expr * cwd, gfc_expr * status)
try
+gfc_check_getlog (gfc_expr * msg)
+{
+ if (type_check (msg, 0, BT_CHARACTER) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+}
+
+
+try
gfc_check_exit (gfc_expr * status)
{
if (status == NULL)
@@ -2253,6 +2487,45 @@ gfc_check_flush (gfc_expr * unit)
try
+gfc_check_hostnm (gfc_expr * name)
+{
+ if (type_check (name, 0, BT_CHARACTER) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+}
+
+
+try
+gfc_check_hostnm_sub (gfc_expr * name, gfc_expr * status)
+{
+ 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;
+}
+
+
+try
+gfc_check_perror (gfc_expr * string)
+{
+ if (type_check (string, 0, BT_CHARACTER) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+}
+
+
+try
gfc_check_umask (gfc_expr * mask)
{
if (type_check (mask, 0, BT_INTEGER) == FAILURE)
generated by cgit v1.2.3 (git 2.25.1) at 2024-06-01 22:36:21 +0000