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

1 files changed, 91 insertions, 0 deletions

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 25601f7..d5218d3 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -2430,6 +2430,40 @@ gfc_check_irand (gfc_expr * x)
   return SUCCESS;
 }
 
+
+try
+gfc_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;
+}
+
+
 try
 gfc_check_rand (gfc_expr * x)
 {
@@ -2722,6 +2756,63 @@ gfc_check_unlink_sub (gfc_expr * name, gfc_expr * status)
 
 
 try
+gfc_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;
+}
+
+
+try
+gfc_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;
+}
+
+
+try
 gfc_check_system_sub (gfc_expr * cmd, gfc_expr * status)
 {
   if (type_check (cmd, 0, BT_CHARACTER) == FAILURE)