fix bugs exposed by --enable-checking

From-SVN: r26181

diff --git a/gcc/f/ChangeLog b/gcc/f/ChangeLog
index a04b2f5d99b7eebbc2c9e9db0dcfac2b5d994960..fc4d26279c548bc10de3a79fcdc19bef71b8415e 100644 (file)
--- a/gcc/f/ChangeLog
+++ b/gcc/f/ChangeLog
@@ -1,3 +1,13 @@
+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

diff --git a/gcc/f/com.c b/gcc/f/com.c
index 2c03fae27101c1c1c36fed2f234409b1f40e8069..dabf049be4d41df1cec9bcaad2b0e5346ec7d93e 100644 (file)
--- a/gcc/f/com.c
+++ b/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)
     {

diff --git a/gcc/f/ste.c b/gcc/f/ste.c
index d6741399fcabaf39476734a7307bda6d0732a461..e8c066ef361fe9e66768f1d1384d5eb16c9ff478 100644 (file)
--- a/gcc/f/ste.c
+++ b/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 ())

diff --git a/gcc/f/version.c b/gcc/f/version.c
index 5ec5a80800676fd683f1c1dca03c788ed1ca7d80..de648d527271f5a92b604c4cd76487b412a35682 100644 (file)
--- a/gcc/f/version.c
+++ b/gcc/f/version.c
@@ -1 +1 @@
-const char *ffe_version_string = "0.5.24-19990403";
+const char *ffe_version_string = "0.5.24-19990405";