📄 check.c

📁 gcc-fortran,linux使用fortran的编译软件。很好用的。
💻 C
📖 第 1 页 / 共 5 页
字号:
上一页 1 2 3 45
      if (variable_check (size, 0) == FAILURE)	return FAILURE;      if (kind_value_check (size, 0, gfc_default_integer_kind) == FAILURE)	return FAILURE;    }  if (put != NULL)    {      if (size != NULL)        gfc_error ("Too many arguments to %s at %L", gfc_current_intrinsic,                    &put->where);      if (array_check (put, 1) == FAILURE)	return FAILURE;      if (rank_check (put, 1, 1) == FAILURE)	return FAILURE;      if (type_check (put, 1, BT_INTEGER) == FAILURE)	return FAILURE;      if (kind_value_check (put, 1, gfc_default_integer_kind) == FAILURE)	return FAILURE;    }  if (get != NULL)    {      if (size != NULL || put != NULL)        gfc_error ("Too many arguments to %s at %L", gfc_current_intrinsic,                    &get->where);      if (array_check (get, 2) == FAILURE)	return FAILURE;      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;      if (kind_value_check (get, 2, gfc_default_integer_kind) == FAILURE)	return FAILURE;    }  return SUCCESS;}trygfc_check_second_sub (gfc_expr * time){  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;}/* The arguments of SYSTEM_CLOCK are scalar, integer variables.  Note,   count, count_rate, and count_max are all optional arguments */trygfc_check_system_clock (gfc_expr * count, gfc_expr * count_rate,                        gfc_expr * count_max){  if (count != NULL)    {      if (scalar_check (count, 0) == FAILURE)        return FAILURE;      if (type_check (count, 0, BT_INTEGER) == FAILURE)        return FAILURE;      if (variable_check (count, 0) == FAILURE)        return FAILURE;    }  if (count_rate != NULL)    {      if (scalar_check (count_rate, 1) == FAILURE)        return FAILURE;      if (type_check (count_rate, 1, BT_INTEGER) == FAILURE)        return FAILURE;      if (variable_check (count_rate, 1) == FAILURE)        return FAILURE;      if (count != NULL	  && same_type_check (count, 0, count_rate, 1) == FAILURE)        return FAILURE;    }  if (count_max != NULL)    {      if (scalar_check (count_max, 2) == FAILURE)        return FAILURE;      if (type_check (count_max, 2, BT_INTEGER) == FAILURE)        return FAILURE;      if (variable_check (count_max, 2) == FAILURE)        return FAILURE;      if (count != NULL	  && same_type_check (count, 0, count_max, 2) == FAILURE)        return FAILURE;      if (count_rate != NULL          && same_type_check (count_rate, 1, count_max, 2) == FAILURE)        return FAILURE;    }  return SUCCESS;}trygfc_check_irand (gfc_expr * x){  if (x == NULL)    return SUCCESS;  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;}trygfc_check_alarm_sub (gfc_expr * seconds, gfc_expr * handler, gfc_expr * status){  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)    {      gfc_error (	"'%s' argument of '%s' intrinsic at %L must be INTEGER or PROCEDURE",	gfc_current_intrinsic_arg[1], gfc_current_intrinsic, &handler->where);      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;  return SUCCESS;}trygfc_check_rand (gfc_expr * x){  if (x == NULL)    return SUCCESS;  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;}trygfc_check_srand (gfc_expr * x){  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;}trygfc_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;  return SUCCESS;}trygfc_check_etime (gfc_expr * x){  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;}trygfc_check_etime_sub (gfc_expr * values, gfc_expr * time){  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;}trygfc_check_fdate_sub (gfc_expr * date){  if (type_check (date, 0, BT_CHARACTER) == FAILURE)    return FAILURE;  return SUCCESS;}trygfc_check_gerror (gfc_expr * msg){  if (type_check (msg, 0, BT_CHARACTER) == FAILURE)    return FAILURE;  return SUCCESS;}trygfc_check_getcwd_sub (gfc_expr * cwd, gfc_expr * status){  if (type_check (cwd, 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;}trygfc_check_getlog (gfc_expr * msg){  if (type_check (msg, 0, BT_CHARACTER) == FAILURE)    return FAILURE;  return SUCCESS;}trygfc_check_exit (gfc_expr * status){  if (status == NULL)    return SUCCESS;  if (type_check (status, 0, BT_INTEGER) == FAILURE)    return FAILURE;  if (scalar_check (status, 0) == FAILURE)    return FAILURE;  return SUCCESS;}trygfc_check_flush (gfc_expr * unit){  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;}trygfc_check_free (gfc_expr * i){  if (type_check (i, 0, BT_INTEGER) == FAILURE)    return FAILURE;  if (scalar_check (i, 0) == FAILURE)    return FAILURE;  return SUCCESS;}trygfc_check_hostnm (gfc_expr * name){  if (type_check (name, 0, BT_CHARACTER) == FAILURE)    return FAILURE;  return SUCCESS;}trygfc_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;}trygfc_check_ttynam_sub (gfc_expr * unit, gfc_expr * name){  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;}trygfc_check_isatty (gfc_expr * unit){  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;}trygfc_check_perror (gfc_expr * string){  if (type_check (string, 0, BT_CHARACTER) == FAILURE)    return FAILURE;  return SUCCESS;}trygfc_check_umask (gfc_expr * mask){  if (type_check (mask, 0, BT_INTEGER) == FAILURE)    return FAILURE;  if (scalar_check (mask, 0) == FAILURE)    return FAILURE;  return SUCCESS;}trygfc_check_umask_sub (gfc_expr * mask, gfc_expr * old){  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;}trygfc_check_unlink (gfc_expr * name){  if (type_check (name, 0, BT_CHARACTER) == FAILURE)    return FAILURE;  return SUCCESS;}trygfc_check_unlink_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;}trygfc_check_signal (gfc_expr * number, gfc_expr * handler){  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)    {      gfc_error (	"'%s' argument of '%s' intrinsic at %L must be INTEGER or PROCEDURE",	gfc_current_intrinsic_arg[1], gfc_current_intrinsic, &handler->where);      return FAILURE;    }  if (handler->ts.type == BT_INTEGER && scalar_check (handler, 1) == FAILURE)    return FAILURE;  return SUCCESS;}trygfc_check_signal_sub (gfc_expr * number, gfc_expr * handler, gfc_expr * status){  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)    {      gfc_error (	"'%s' argument of '%s' intrinsic at %L must be INTEGER or PROCEDURE",	gfc_current_intrinsic_arg[1], gfc_current_intrinsic, &handler->where);      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;}trygfc_check_system_sub (gfc_expr * cmd, gfc_expr * status){  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;}/* This is used for the GNU intrinsics AND, OR and XOR.  */trygfc_check_and (gfc_expr * i, gfc_expr * j){  if (i->ts.type != BT_INTEGER && i->ts.type != BT_LOGICAL)    {      gfc_error (	"'%s' argument of '%s' intrinsic at %L must be INTEGER or LOGICAL",	gfc_current_intrinsic_arg[0], gfc_current_intrinsic, &i->where);      return FAILURE;    }  if (j->ts.type != BT_INTEGER && j->ts.type != BT_LOGICAL)    {      gfc_error (	"'%s' argument of '%s' intrinsic at %L must be INTEGER or LOGICAL",	gfc_current_intrinsic_arg[1], gfc_current_intrinsic, &j->where);      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;}
上一页 1 2 3 45
💿 文件大小 989 K
👤 上传用户 zcflion
📂 所属分类 Linux/Unix编程
🏷️ 相关标签

#gcc-fortran #fortran #linux #编译
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -