fix bugs exposed by --enable-checking

From-SVN: r26181

gcc/f/ChangeLog

+Mon Apr  5 02:11:23 1999  Craig Burley  <craig@jcb-sc.com>
+
+	Fix bugs exposed by configuring with --enable-checking:
+	* com.c (ffecom_do_entry_, ffecom_expr_, ffecom_arg_ptr_to_expr,
+	ffecom_list_expr, ffecom_list_ptr_to_expr, finish_function,
+	pop_f_function_context, store_parm_decls, poplevel): Handle
+	error_mark_node properly.
+	* ste.c (ffeste_begin_iterdo_, ffeste_end_iterdo_): Ditto.
+	* version.c: Bump version.
+
 Sat Apr  3 23:57:56 1999  Craig Burley  <craig@jcb-sc.com>
 
 	* g77.texi: Fix up docs for -fset-g77-defaults, and

gcc/f/com.c

@@ -2599,7 +2599,8 @@ ffecom_do_entry_ (ffesymbol fn, int entrynum)
 	if (ffebld_op (arg) != FFEBLD_opSYMTER)
 	  continue;
 	s = ffebld_symter (arg);
-	if (ffesymbol_hook (s).decl_tree == NULL_TREE)
+	if (ffesymbol_hook (s).decl_tree == NULL_TREE
+	    || ffesymbol_hook (s).decl_tree == error_mark_node)
 	  actarg = null_pointer_node;	/* We don't have this arg. */
 	else
 	  actarg = ffesymbol_hook (s).decl_tree;
@@ -2622,7 +2623,8 @@ ffecom_do_entry_ (ffesymbol fn, int entrynum)
 	  continue;		/* Only looking for CHARACTER arguments. */
 	if (ffesymbol_kind (s) != FFEINFO_kindENTITY)
 	  continue;		/* Only looking for variables and arrays. */
-	if (ffesymbol_hook (s).length_tree == NULL_TREE)
+	if (ffesymbol_hook (s).length_tree == NULL_TREE
+	    || ffesymbol_hook (s).length_tree == error_mark_node)
 	  actarg = ffecom_f2c_ftnlen_zero_node;	/* We don't have this arg. */
 	else
 	  actarg = ffesymbol_hook (s).length_tree;
@@ -3282,6 +3284,9 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest,
 	args = ffecom_list_ptr_to_expr (ffebld_right (expr));
       ffecom_pop_calltemps ();
 
+      if (args == error_mark_node)
+	return error_mark_node;
+
       item = ffecom_call_ (item, kt,
 			   ffesymbol_is_f2c (s)
 			   && (bt == FFEINFO_basictypeCOMPLEX)
@@ -10977,6 +10982,9 @@ ffecom_arg_ptr_to_expr (ffebld expr, tree *length)
 	tree temp_length;
 
 	temp_exp = ffecom_arg_ptr_to_expr (ffebld_left (expr), &temp_length);
+	if (temp_exp == error_mark_node)
+	  return error_mark_node;
+
 	return ffecom_1 (INDIRECT_REF, TREE_TYPE (TREE_TYPE (temp_exp)),
 			 temp_exp);
       }
@@ -12703,9 +12711,12 @@ ffecom_list_expr (ffebld expr)
 
   while (expr != NULL)
     {
-      *plist
-	= build_tree_list (NULL_TREE, ffecom_arg_expr (ffebld_head (expr),
-						       &length));
+      tree texpr = ffecom_arg_expr (ffebld_head (expr), &length);
+
+      if (texpr == error_mark_node)
+	return error_mark_node;
+
+      *plist = build_tree_list (NULL_TREE, texpr);
       plist = &TREE_CHAIN (*plist);
       expr = ffebld_trail (expr);
       if (length != NULL_TREE)
@@ -12742,10 +12753,12 @@ ffecom_list_ptr_to_expr (ffebld expr)
 
   while (expr != NULL)
     {
-      *plist
-	= build_tree_list (NULL_TREE,
-			   ffecom_arg_ptr_to_expr (ffebld_head (expr),
-						   &length));
+      tree texpr = ffecom_arg_ptr_to_expr (ffebld_head (expr), &length);
+
+      if (texpr == error_mark_node)
+	return error_mark_node;
+
+      *plist = build_tree_list (NULL_TREE, texpr);
       plist = &TREE_CHAIN (*plist);
       expr = ffebld_trail (expr);
       if (length != NULL_TREE)
@@ -14366,7 +14379,9 @@ finish_function (int nested)
   if (!nested)
     permanent_allocation (1);
 
-  if (DECL_SAVED_INSNS (fndecl) == 0 && !nested && (TREE_CODE (fndecl) != ERROR_MARK))
+  if (TREE_CODE (fndecl) != ERROR_MARK
+      && !nested
+      && DECL_SAVED_INSNS (fndecl) == 0)
     {
       /* Stop pointing to the local nodes about to be freed.  */
       /* But DECL_INITIAL must remain nonzero so we know this was an actual
@@ -14544,7 +14559,8 @@ pop_f_function_context ()
       IDENTIFIER_LABEL_VALUE (DECL_NAME (TREE_VALUE (link)))
 	= TREE_VALUE (link);
 
-  if (DECL_SAVED_INSNS (current_function_decl) == 0)
+  if (current_function_decl != error_mark_node
+      && DECL_SAVED_INSNS (current_function_decl) == 0)
     {
       /* Stop pointing to the local nodes about to be freed.  */
       /* But DECL_INITIAL must remain nonzero so we know this was an actual
@@ -14648,6 +14664,9 @@ store_parm_decls (int is_main_program UNUSED)
 {
   register tree fndecl = current_function_decl;
 
+  if (fndecl == error_mark_node)
+    return;
+
   /* This is a chain of PARM_DECLs from old-style parm declarations.  */
   DECL_ARGUMENTS (fndecl) = storedecls (nreverse (getdecls ()));
 
@@ -15193,7 +15212,8 @@ poplevel (keep, reverse, functionbody)
   }
 
   /* Dispose of the block that we just made inside some higher level.  */
-  if (functionbody)
+  if (functionbody
+      && current_function_decl != error_mark_node)
     DECL_INITIAL (current_function_decl) = block;
   else if (block)
     {

gcc/f/ste.c

@@ -317,6 +317,17 @@ ffeste_begin_iterdo_ (ffestw block, tree *xtvar, tree *xtincr,
   tvar = ffecom_expr_rw (var);
   tincr = ffecom_expr (incr);
 
+  if (TREE_CODE (tvar) == ERROR_MARK
+      || TREE_CODE (tincr) == ERROR_MARK)
+    {
+      if (block)
+	ffestw_set_do_tvar (block, error_mark_node);
+      else
+	*xtvar = error_mark_node;
+      pop_momentary ();
+      return;
+    }
+
   /* Check whether incr is known to be zero, complain and fix.  */
 
   if (integer_zerop (tincr) || real_zerop (tincr))
@@ -336,6 +347,18 @@ ffeste_begin_iterdo_ (ffestw block, tree *xtvar, tree *xtincr,
   tstart = ffecom_expr (start);
   tend = ffecom_expr (end);
 
+  if (TREE_CODE (tstart) == ERROR_MARK
+      || TREE_CODE (tend) == ERROR_MARK)
+    {
+      if (block)
+	ffestw_set_do_tvar (block, error_mark_node);
+      else
+	*xtvar = error_mark_node;
+      pop_momentary ();
+      pop_momentary ();
+      return;
+    }
+
   {				/* For warnings only, nothing else
 				   happens here.  */
     tree try;
@@ -492,6 +515,9 @@ ffeste_end_iterdo_ (tree tvar, tree tincr, tree itersvar)
   tree expr;
   tree niters = itersvar;
 
+  if (tvar == error_mark_node)
+    return;
+
   expand_loop_continue_here ();
 
   if (ffe_is_onetrip ())

gcc/f/version.c

-const char *ffe_version_string = "0.5.24-19990403";
+const char *ffe_version_string = "0.5.24-19990405";