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.c99
1 files changed, 97 insertions, 2 deletions
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index f0497a1..87d962e 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -492,10 +492,14 @@ gfc_check_access_func (gfc_expr *name, gfc_expr *mode)
if (type_check (name, 0, BT_CHARACTER) == FAILURE
|| scalar_check (name, 0) == FAILURE)
return FAILURE;
+ if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
if (type_check (mode, 1, BT_CHARACTER) == FAILURE
|| scalar_check (mode, 1) == FAILURE)
return FAILURE;
+ if (kind_value_check (mode, 1, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
return SUCCESS;
}
@@ -716,6 +720,8 @@ gfc_check_chdir (gfc_expr *dir)
{
if (type_check (dir, 0, BT_CHARACTER) == FAILURE)
return FAILURE;
+ if (kind_value_check (dir, 0, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
return SUCCESS;
}
@@ -726,13 +732,14 @@ gfc_check_chdir_sub (gfc_expr *dir, gfc_expr *status)
{
if (type_check (dir, 0, BT_CHARACTER) == FAILURE)
return FAILURE;
+ if (kind_value_check (dir, 0, gfc_default_character_kind) == 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;
@@ -745,9 +752,13 @@ gfc_check_chmod (gfc_expr *name, gfc_expr *mode)
{
if (type_check (name, 0, BT_CHARACTER) == FAILURE)
return FAILURE;
+ if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
if (type_check (mode, 1, BT_CHARACTER) == FAILURE)
return FAILURE;
+ if (kind_value_check (mode, 1, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
return SUCCESS;
}
@@ -758,9 +769,13 @@ gfc_check_chmod_sub (gfc_expr *name, gfc_expr *mode, gfc_expr *status)
{
if (type_check (name, 0, BT_CHARACTER) == FAILURE)
return FAILURE;
+ if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
if (type_check (mode, 1, BT_CHARACTER) == FAILURE)
return FAILURE;
+ if (kind_value_check (mode, 1, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
if (status == NULL)
return SUCCESS;
@@ -1497,13 +1512,34 @@ gfc_check_len_lentrim (gfc_expr *s, gfc_expr *kind)
try
+gfc_check_lge_lgt_lle_llt (gfc_expr *a, gfc_expr *b)
+{
+ if (type_check (a, 0, BT_CHARACTER) == FAILURE)
+ return FAILURE;
+ if (kind_value_check (a, 0, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
+
+ if (type_check (b, 1, BT_CHARACTER) == FAILURE)
+ return FAILURE;
+ if (kind_value_check (b, 1, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+}
+
+
+try
gfc_check_link (gfc_expr *path1, gfc_expr *path2)
{
if (type_check (path1, 0, BT_CHARACTER) == FAILURE)
return FAILURE;
+ if (kind_value_check (path1, 0, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
if (type_check (path2, 1, BT_CHARACTER) == FAILURE)
return FAILURE;
+ if (kind_value_check (path2, 1, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
return SUCCESS;
}
@@ -1514,9 +1550,13 @@ gfc_check_link_sub (gfc_expr *path1, gfc_expr *path2, gfc_expr *status)
{
if (type_check (path1, 0, BT_CHARACTER) == FAILURE)
return FAILURE;
+ if (kind_value_check (path1, 0, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
if (type_check (path2, 1, BT_CHARACTER) == FAILURE)
return FAILURE;
+ if (kind_value_check (path2, 0, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
if (status == NULL)
return SUCCESS;
@@ -1543,9 +1583,13 @@ gfc_check_symlnk (gfc_expr *path1, gfc_expr *path2)
{
if (type_check (path1, 0, BT_CHARACTER) == FAILURE)
return FAILURE;
+ if (kind_value_check (path1, 0, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
if (type_check (path2, 1, BT_CHARACTER) == FAILURE)
return FAILURE;
+ if (kind_value_check (path2, 1, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
return SUCCESS;
}
@@ -1556,9 +1600,13 @@ gfc_check_symlnk_sub (gfc_expr *path1, gfc_expr *path2, gfc_expr *status)
{
if (type_check (path1, 0, BT_CHARACTER) == FAILURE)
return FAILURE;
+ if (kind_value_check (path1, 0, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
if (type_check (path2, 1, BT_CHARACTER) == FAILURE)
return FAILURE;
+ if (kind_value_check (path2, 1, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
if (status == NULL)
return SUCCESS;
@@ -2166,9 +2214,13 @@ gfc_check_rename (gfc_expr *path1, gfc_expr *path2)
{
if (type_check (path1, 0, BT_CHARACTER) == FAILURE)
return FAILURE;
+ if (kind_value_check (path1, 0, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
if (type_check (path2, 1, BT_CHARACTER) == FAILURE)
return FAILURE;
+ if (kind_value_check (path2, 1, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
return SUCCESS;
}
@@ -2179,9 +2231,13 @@ gfc_check_rename_sub (gfc_expr *path1, gfc_expr *path2, gfc_expr *status)
{
if (type_check (path1, 0, BT_CHARACTER) == FAILURE)
return FAILURE;
+ if (kind_value_check (path1, 0, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
if (type_check (path2, 1, BT_CHARACTER) == FAILURE)
return FAILURE;
+ if (kind_value_check (path2, 1, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
if (status == NULL)
return SUCCESS;
@@ -2535,6 +2591,8 @@ gfc_check_fgetputc_sub (gfc_expr *unit, gfc_expr *c, gfc_expr *status)
if (type_check (c, 1, BT_CHARACTER) == FAILURE)
return FAILURE;
+ if (kind_value_check (c, 1, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
if (status == NULL)
return SUCCESS;
@@ -2560,6 +2618,8 @@ gfc_check_fgetput_sub (gfc_expr *c, gfc_expr *status)
{
if (type_check (c, 0, BT_CHARACTER) == FAILURE)
return FAILURE;
+ if (kind_value_check (c, 0, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
if (status == NULL)
return SUCCESS;
@@ -2705,6 +2765,8 @@ gfc_check_stat (gfc_expr *name, gfc_expr *array)
{
if (type_check (name, 0, BT_CHARACTER) == FAILURE)
return FAILURE;
+ if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
if (type_check (array, 1, BT_INTEGER) == FAILURE
|| kind_value_check (array, 1, gfc_default_integer_kind) == FAILURE)
@@ -2722,6 +2784,8 @@ gfc_check_stat_sub (gfc_expr *name, gfc_expr *array, gfc_expr *status)
{
if (type_check (name, 0, BT_CHARACTER) == FAILURE)
return FAILURE;
+ if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
if (type_check (array, 1, BT_INTEGER) == FAILURE
|| kind_value_check (array, 1, gfc_default_integer_kind) == FAILURE)
@@ -2914,6 +2978,8 @@ gfc_check_date_and_time (gfc_expr *date, gfc_expr *time,
{
if (type_check (date, 0, BT_CHARACTER) == FAILURE)
return FAILURE;
+ if (kind_value_check (date, 0, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
if (scalar_check (date, 0) == FAILURE)
return FAILURE;
if (variable_check (date, 0) == FAILURE)
@@ -2924,6 +2990,8 @@ gfc_check_date_and_time (gfc_expr *date, gfc_expr *time,
{
if (type_check (time, 1, BT_CHARACTER) == FAILURE)
return FAILURE;
+ if (kind_value_check (time, 1, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
if (scalar_check (time, 1) == FAILURE)
return FAILURE;
if (variable_check (time, 1) == FAILURE)
@@ -2934,6 +3002,8 @@ gfc_check_date_and_time (gfc_expr *date, gfc_expr *time,
{
if (type_check (zone, 2, BT_CHARACTER) == FAILURE)
return FAILURE;
+ if (kind_value_check (zone, 2, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
if (scalar_check (zone, 2) == FAILURE)
return FAILURE;
if (variable_check (zone, 2) == FAILURE)
@@ -3246,12 +3316,13 @@ gfc_check_ctime_sub (gfc_expr *time, gfc_expr *result)
{
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;
+ if (kind_value_check (result, 1, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
return SUCCESS;
}
@@ -3315,6 +3386,8 @@ gfc_check_fdate_sub (gfc_expr *date)
{
if (type_check (date, 0, BT_CHARACTER) == FAILURE)
return FAILURE;
+ if (kind_value_check (date, 0, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
return SUCCESS;
}
@@ -3325,6 +3398,8 @@ gfc_check_gerror (gfc_expr *msg)
{
if (type_check (msg, 0, BT_CHARACTER) == FAILURE)
return FAILURE;
+ if (kind_value_check (msg, 0, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
return SUCCESS;
}
@@ -3335,6 +3410,8 @@ gfc_check_getcwd_sub (gfc_expr *cwd, gfc_expr *status)
{
if (type_check (cwd, 0, BT_CHARACTER) == FAILURE)
return FAILURE;
+ if (kind_value_check (cwd, 0, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
if (status == NULL)
return SUCCESS;
@@ -3366,6 +3443,8 @@ gfc_check_getarg (gfc_expr *pos, gfc_expr *value)
if (type_check (value, 1, BT_CHARACTER) == FAILURE)
return FAILURE;
+ if (kind_value_check (value, 1, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
return SUCCESS;
}
@@ -3376,6 +3455,8 @@ gfc_check_getlog (gfc_expr *msg)
{
if (type_check (msg, 0, BT_CHARACTER) == FAILURE)
return FAILURE;
+ if (kind_value_check (msg, 0, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
return SUCCESS;
}
@@ -3431,6 +3512,8 @@ gfc_check_hostnm (gfc_expr *name)
{
if (type_check (name, 0, BT_CHARACTER) == FAILURE)
return FAILURE;
+ if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
return SUCCESS;
}
@@ -3441,6 +3524,8 @@ gfc_check_hostnm_sub (gfc_expr *name, gfc_expr *status)
{
if (type_check (name, 0, BT_CHARACTER) == FAILURE)
return FAILURE;
+ if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
if (status == NULL)
return SUCCESS;
@@ -3519,6 +3604,8 @@ gfc_check_ttynam_sub (gfc_expr *unit, gfc_expr *name)
if (type_check (name, 1, BT_CHARACTER) == FAILURE)
return FAILURE;
+ if (kind_value_check (name, 1, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
return SUCCESS;
}
@@ -3555,6 +3642,8 @@ gfc_check_perror (gfc_expr *string)
{
if (type_check (string, 0, BT_CHARACTER) == FAILURE)
return FAILURE;
+ if (kind_value_check (string, 0, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
return SUCCESS;
}
@@ -3600,6 +3689,8 @@ gfc_check_unlink (gfc_expr *name)
{
if (type_check (name, 0, BT_CHARACTER) == FAILURE)
return FAILURE;
+ if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
return SUCCESS;
}
@@ -3610,6 +3701,8 @@ gfc_check_unlink_sub (gfc_expr *name, gfc_expr *status)
{
if (type_check (name, 0, BT_CHARACTER) == FAILURE)
return FAILURE;
+ if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
if (status == NULL)
return SUCCESS;
@@ -3686,6 +3779,8 @@ gfc_check_system_sub (gfc_expr *cmd, gfc_expr *status)
{
if (type_check (cmd, 0, BT_CHARACTER) == FAILURE)
return FAILURE;
+ if (kind_value_check (cmd, 0, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
if (scalar_check (status, 1) == FAILURE)
return FAILURE;
generated by cgit v1.1 at 2025-05-31 11:13:03 +0000