OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-stable/] [gcc-4.5.1/] [gcc/] [fortran/] [parse.c] - Diff between revs 285 and 378

Go to most recent revision | Show entire file | Details | Blame | View Log

Rev 285 Rev 378
Line 874... Line 874... 
  locus old_locus;
 
  locus old_locus;
 
 
 
 
 
  gfc_new_block = NULL;
 
  gfc_new_block = NULL;
 
 
 
 
 
  gfc_current_ns->old_cl_list = gfc_current_ns->cl_list;
 
  gfc_current_ns->old_cl_list = gfc_current_ns->cl_list;
 
 
 
  gfc_current_ns->old_equiv = gfc_current_ns->equiv;
 
  for (;;)
 
  for (;;)
 
    {
 
    {
 
      gfc_statement_label = NULL;
 
      gfc_statement_label = NULL;
 
      gfc_buffer_error (1);
 
      gfc_buffer_error (1);
 
 
 
 
Line 1606... Line 1607... 
{
 
{
 
  /* Revert to the previous charlen chain.  */
 
  /* Revert to the previous charlen chain.  */
 
  gfc_free_charlen (gfc_current_ns->cl_list, gfc_current_ns->old_cl_list);
 
  gfc_free_charlen (gfc_current_ns->cl_list, gfc_current_ns->old_cl_list);
 
  gfc_current_ns->cl_list = gfc_current_ns->old_cl_list;
 
  gfc_current_ns->cl_list = gfc_current_ns->old_cl_list;
 
 
 
 
 
 
 
  gfc_free_equiv_until (gfc_current_ns->equiv, gfc_current_ns->old_equiv);
 
 
 
  gfc_current_ns->equiv = gfc_current_ns->old_equiv;
 
 
 
 
 
  gfc_new_block = NULL;
 
  gfc_new_block = NULL;
 
  gfc_undo_symbols ();
 
  gfc_undo_symbols ();
 
  gfc_clear_warning ();
 
  gfc_clear_warning ();
 
  undo_new_statement ();
 
  undo_new_statement ();
 
}
 
}
Line 1839... Line 1843... 
          unexpected_eof ();
 
          unexpected_eof ();
 
          break;
 
          break;
 
 
 
 
 
        case ST_DATA_DECL:
 
        case ST_DATA_DECL:
 
          gfc_error ("Components in TYPE at %C must precede CONTAINS");
 
          gfc_error ("Components in TYPE at %C must precede CONTAINS");
 
          error_flag = true;
 
          goto error;
 
          break;
 
 
 
 
 
 
 
        case ST_PROCEDURE:
 
        case ST_PROCEDURE:
 
          if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003:  Type-bound"
 
          if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003:  Type-bound"
 
                                             " procedure at %C") == FAILURE)
 
                                             " procedure at %C") == FAILURE)
 
            error_flag = true;
 
            goto error;
 
 
 
 
 
          accept_statement (ST_PROCEDURE);
 
          accept_statement (ST_PROCEDURE);
 
          seen_comps = true;
 
          seen_comps = true;
 
          break;
 
          break;
 
 
 
 
 
        case ST_GENERIC:
 
        case ST_GENERIC:
 
          if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003:  GENERIC binding"
 
          if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003:  GENERIC binding"
 
                                             " at %C") == FAILURE)
 
                                             " at %C") == FAILURE)
 
            error_flag = true;
 
            goto error;
 
 
 
 
 
          accept_statement (ST_GENERIC);
 
          accept_statement (ST_GENERIC);
 
          seen_comps = true;
 
          seen_comps = true;
 
          break;
 
          break;
 
 
 
 
 
        case ST_FINAL:
 
        case ST_FINAL:
 
          if (gfc_notify_std (GFC_STD_F2003,
 
          if (gfc_notify_std (GFC_STD_F2003,
 
                              "Fortran 2003:  FINAL procedure declaration"
 
                              "Fortran 2003:  FINAL procedure declaration"
 
                              " at %C") == FAILURE)
 
                              " at %C") == FAILURE)
 
            error_flag = true;
 
            goto error;
 
 
 
 
 
          accept_statement (ST_FINAL);
 
          accept_statement (ST_FINAL);
 
          seen_comps = true;
 
          seen_comps = true;
 
          break;
 
          break;
 
 
 
 
Line 1877... Line 1880... 
 
 
 
 
          if (!seen_comps
 
          if (!seen_comps
 
              && (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Derived type "
 
              && (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Derived type "
 
                                  "definition at %C with empty CONTAINS "
 
                                  "definition at %C with empty CONTAINS "
 
                                  "section") == FAILURE))
 
                                  "section") == FAILURE))
 
            error_flag = true;
 
            goto error;
 
 
 
 
 
          /* ST_END_TYPE is accepted by parse_derived after return.  */
 
          /* ST_END_TYPE is accepted by parse_derived after return.  */
 
          break;
 
          break;
 
 
 
 
 
        case ST_PRIVATE:
 
        case ST_PRIVATE:
 
          if (gfc_find_state (COMP_MODULE) == FAILURE)
 
          if (gfc_find_state (COMP_MODULE) == FAILURE)
 
            {
 
            {
 
              gfc_error ("PRIVATE statement in TYPE at %C must be inside "
 
              gfc_error ("PRIVATE statement in TYPE at %C must be inside "
 
                         "a MODULE");
 
                         "a MODULE");
 
              error_flag = true;
 
              goto error;
 
              break;
 
 
 
            }
 
            }
 
 
 
 
 
          if (seen_comps)
 
          if (seen_comps)
 
            {
 
            {
 
              gfc_error ("PRIVATE statement at %C must precede procedure"
 
              gfc_error ("PRIVATE statement at %C must precede procedure"
 
                         " bindings");
 
                         " bindings");
 
              error_flag = true;
 
              goto error;
 
              break;
 
 
 
            }
 
            }
 
 
 
 
 
          if (seen_private)
 
          if (seen_private)
 
            {
 
            {
 
              gfc_error ("Duplicate PRIVATE statement at %C");
 
              gfc_error ("Duplicate PRIVATE statement at %C");
 
              error_flag = true;
 
              goto error;
 
            }
 
            }
 
 
 
 
 
          accept_statement (ST_PRIVATE);
 
          accept_statement (ST_PRIVATE);
 
          gfc_typebound_default_access = ACCESS_PRIVATE;
 
          gfc_typebound_default_access = ACCESS_PRIVATE;
 
          seen_private = true;
 
          seen_private = true;
 
          break;
 
          break;
 
 
 
 
 
        case ST_SEQUENCE:
 
        case ST_SEQUENCE:
 
          gfc_error ("SEQUENCE statement at %C must precede CONTAINS");
 
          gfc_error ("SEQUENCE statement at %C must precede CONTAINS");
 
          error_flag = true;
 
          goto error;
 
          break;
 
 
 
 
 
 
 
        case ST_CONTAINS:
 
        case ST_CONTAINS:
 
          gfc_error ("Already inside a CONTAINS block at %C");
 
          gfc_error ("Already inside a CONTAINS block at %C");
 
          error_flag = true;
 
          goto error;
 
          break;
 
 
 
 
 
 
 
        default:
 
        default:
 
          unexpected_statement (st);
 
          unexpected_statement (st);
 
          break;
 
          break;
 
        }
 
        }
 
 
 
 
 
 
 
      continue;
 
 
 
 
 
 
 
error:
 
 
 
      error_flag = true;
 
 
 
      reject_statement ();
 
    }
 
    }
 
 
 
 
 
  pop_state ();
 
  pop_state ();
 
  gcc_assert (gfc_current_state () == COMP_DERIVED);
 
  gcc_assert (gfc_current_state () == COMP_DERIVED);
 
 
 
 
Line 2359... Line 2364... 
    {
 
    {
 
      gfc_current_block ()->declared_at = gfc_current_locus;
 
      gfc_current_block ()->declared_at = gfc_current_locus;
 
      gfc_commit_symbols ();
 
      gfc_commit_symbols ();
 
    }
 
    }
 
  else
 
  else
 
 
 
    {
 
    gfc_error_check ();
 
    gfc_error_check ();
 
 
 
      gfc_undo_symbols ();
 
 
 
    }
 
 
 
 
 
  gfc_current_locus =loc;
 
  gfc_current_locus =loc;
 
  return m;
 
  return m;
 
}
 
}
 
 
 
 
Line 2431... Line 2439... 
        case ST_COMMON:
 
        case ST_COMMON:
 
        case ST_EQUIVALENCE:
 
        case ST_EQUIVALENCE:
 
        case ST_STATEMENT_FUNCTION:
 
        case ST_STATEMENT_FUNCTION:
 
          gfc_error ("%s statement is not allowed inside of BLOCK at %C",
 
          gfc_error ("%s statement is not allowed inside of BLOCK at %C",
 
                     gfc_ascii_statement (st));
 
                     gfc_ascii_statement (st));
 
 
 
          reject_statement ();
 
          break;
 
          break;
 
 
 
 
 
        default:
 
        default:
 
          break;
 
          break;
 
      }
 
      }
Line 2517... Line 2526... 
        case ST_PRIVATE:
 
        case ST_PRIVATE:
 
          if (gfc_current_state () != COMP_MODULE)
 
          if (gfc_current_state () != COMP_MODULE)
 
            {
 
            {
 
              gfc_error ("%s statement must appear in a MODULE",
 
              gfc_error ("%s statement must appear in a MODULE",
 
                         gfc_ascii_statement (st));
 
                         gfc_ascii_statement (st));
 
 
 
              reject_statement ();
 
              break;
 
              break;
 
            }
 
            }
 
 
 
 
 
          if (gfc_current_ns->default_access != ACCESS_UNKNOWN)
 
          if (gfc_current_ns->default_access != ACCESS_UNKNOWN)
 
            {
 
            {
 
              gfc_error ("%s statement at %C follows another accessibility "
 
              gfc_error ("%s statement at %C follows another accessibility "
 
                         "specification", gfc_ascii_statement (st));
 
                         "specification", gfc_ascii_statement (st));
 
 
 
              reject_statement ();
 
              break;
 
              break;
 
            }
 
            }
 
 
 
 
 
          gfc_current_ns->default_access = (st == ST_PUBLIC)
 
          gfc_current_ns->default_access = (st == ST_PUBLIC)
 
            ? ACCESS_PUBLIC : ACCESS_PRIVATE;
 
            ? ACCESS_PUBLIC : ACCESS_PRIVATE;
Line 3820... Line 3831... 
 
 
 
 
  if (n > 0)
 
  if (n > 0)
 
    {
 
    {
 
      gfc_error ("CONTAINS statement at %C is already in a contained "
 
      gfc_error ("CONTAINS statement at %C is already in a contained "
 
                 "program unit");
 
                 "program unit");
 
 
 
      reject_statement ();
 
      st = next_statement ();
 
      st = next_statement ();
 
      goto loop;
 
      goto loop;
 
    }
 
    }
 
 
 
 
 
  parse_contained (0);
 
  parse_contained (0);

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.