/* Main parser.
- Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+ Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+ 2009
Free Software Foundation, Inc.
Contributed by Andy Vaught
break;
case 'g':
+ match ("generic", gfc_match_generic, ST_GENERIC);
match ("go to", gfc_match_goto, ST_GOTO);
break;
return ST_NONE;
}
+static gfc_statement
+decode_gcc_attribute (void)
+{
+ locus old_locus;
+
+#ifdef GFC_DEBUG
+ gfc_symbol_state ();
+#endif
+
+ gfc_clear_error (); /* Clear any pending errors. */
+ gfc_clear_warning (); /* Clear any pending warnings. */
+ old_locus = gfc_current_locus;
+
+ match ("attributes", gfc_match_gcc_attributes, ST_ATTR_DECL);
+
+ /* All else has failed, so give up. See if any of the matchers has
+ stored an error message of some sort. */
+
+ if (gfc_error_check () == 0)
+ gfc_error_now ("Unclassifiable GCC directive at %C");
+
+ reject_statement ();
+
+ gfc_error_recovery ();
+
+ return ST_NONE;
+}
+
#undef match
else if (c == '!')
{
/* Comments have already been skipped by the time we get here,
- except for OpenMP directives. */
- if (gfc_option.flag_openmp)
+ except for GCC attributes and OpenMP directives. */
+
+ gfc_next_ascii_char (); /* Eat up the exclamation sign. */
+ c = gfc_peek_ascii_char ();
+
+ if (c == 'g')
+ {
+ int i;
+
+ c = gfc_next_ascii_char ();
+ for (i = 0; i < 4; i++, c = gfc_next_ascii_char ())
+ gcc_assert (c == "gcc$"[i]);
+
+ gfc_gobble_whitespace ();
+ return decode_gcc_attribute ();
+
+ }
+ else if (c == '$' && gfc_option.flag_openmp)
{
int i;
c = gfc_next_ascii_char ();
- for (i = 0; i < 5; i++, c = gfc_next_ascii_char ())
- gcc_assert (c == "!$omp"[i]);
+ for (i = 0; i < 4; i++, c = gfc_next_ascii_char ())
+ gcc_assert (c == "$omp"[i]);
gcc_assert (c == ' ' || c == '\t');
gfc_gobble_whitespace ();
return decode_omp_directive ();
}
- }
+ gcc_unreachable ();
+ }
+
if (at_bol && c == ';')
{
gfc_error_now ("Semicolon at %C needs to be preceded by statement");
break;
/* Comments have already been skipped by the time we get
- here, except for OpenMP directives. */
+ here, except for GCC attributes and OpenMP directives. */
+
case '*':
- if (gfc_option.flag_openmp)
+ c = gfc_next_char_literal (0);
+
+ if (TOLOWER (c) == 'g')
+ {
+ for (i = 0; i < 4; i++, c = gfc_next_char_literal (0))
+ gcc_assert (TOLOWER (c) == "gcc$"[i]);
+
+ return decode_gcc_attribute ();
+ }
+ else if (c == '$' && gfc_option.flag_openmp)
{
- for (i = 0; i < 5; i++, c = gfc_next_char_literal (0))
- gcc_assert ((char) gfc_wide_tolower (c) == "*$omp"[i]);
+ for (i = 0; i < 4; i++, c = gfc_next_char_literal (0))
+ gcc_assert ((char) gfc_wide_tolower (c) == "$omp"[i]);
if (c != ' ' && c != '0')
{
locus old_locus;
gfc_new_block = NULL;
+ gfc_current_ns->old_cl_list = gfc_current_ns->cl_list;
for (;;)
{
gfc_statement_label = NULL;
case ST_FUNCTION:
p = "FUNCTION";
break;
+ case ST_GENERIC:
+ p = "GENERIC";
+ break;
case ST_GOTO:
p = "GOTO";
break;
/* If the statement is the end of a block, lay down a special code
that allows a branch to the end of the block from within the
- construct. */
+ construct. IF and SELECT are treated differently from DO
+ (where EXEC_NOP is added inside the loop) for two
+ reasons:
+ 1. END DO has a meaning in the sense that after a GOTO to
+ it, the loop counter must be increased.
+ 2. IF blocks and SELECT blocks can consist of multiple
+ parallel blocks (IF ... ELSE IF ... ELSE ... END IF).
+ Putting the label before the END IF would make the jump
+ from, say, the ELSE IF block to the END IF illegal. */
case ST_ENDIF:
case ST_END_SELECT:
if (gfc_statement_label != NULL)
{
- new_st.op = EXEC_NOP;
+ new_st.op = EXEC_END_BLOCK;
add_statement ();
}
-
break;
/* The end-of-program unit statements do not get the special
new_st.op = EXEC_RETURN;
add_statement ();
}
+ else
+ {
+ new_st.op = EXEC_END_PROCEDURE;
+ add_statement ();
+ }
break;
static void
reject_statement (void)
{
+ /* Revert to the previous charlen chain. */
+ 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_new_block = NULL;
gfc_undo_symbols ();
gfc_clear_warning ();
*/
+enum state_order
+{
+ ORDER_START,
+ ORDER_USE,
+ ORDER_IMPORT,
+ ORDER_IMPLICIT_NONE,
+ ORDER_IMPLICIT,
+ ORDER_SPEC,
+ ORDER_EXEC
+};
+
typedef struct
{
- enum
- { ORDER_START, ORDER_USE, ORDER_IMPORT, ORDER_IMPLICIT_NONE,
- ORDER_IMPLICIT, ORDER_SPEC, ORDER_EXEC
- }
- state;
+ enum state_order state;
gfc_statement last_statement;
locus where;
}
}
+/* Parse the CONTAINS section of a derived type definition. */
+
+gfc_access gfc_typebound_default_access;
+
+static bool
+parse_derived_contains (void)
+{
+ gfc_state_data s;
+ bool seen_private = false;
+ bool seen_comps = false;
+ bool error_flag = false;
+ bool to_finish;
+
+ gcc_assert (gfc_current_state () == COMP_DERIVED);
+ gcc_assert (gfc_current_block ());
+
+ /* Derived-types with SEQUENCE and/or BIND(C) must not have a CONTAINS
+ section. */
+ if (gfc_current_block ()->attr.sequence)
+ gfc_error ("Derived-type '%s' with SEQUENCE must not have a CONTAINS"
+ " section at %C", gfc_current_block ()->name);
+ if (gfc_current_block ()->attr.is_bind_c)
+ gfc_error ("Derived-type '%s' with BIND(C) must not have a CONTAINS"
+ " section at %C", gfc_current_block ()->name);
+
+ accept_statement (ST_CONTAINS);
+ push_state (&s, COMP_DERIVED_CONTAINS, NULL);
+
+ gfc_typebound_default_access = ACCESS_PUBLIC;
+
+ to_finish = false;
+ while (!to_finish)
+ {
+ gfc_statement st;
+ st = next_statement ();
+ switch (st)
+ {
+ case ST_NONE:
+ unexpected_eof ();
+ break;
+
+ case ST_DATA_DECL:
+ gfc_error ("Components in TYPE at %C must precede CONTAINS");
+ error_flag = true;
+ break;
+
+ case ST_PROCEDURE:
+ if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Type-bound"
+ " procedure at %C") == FAILURE)
+ error_flag = true;
+
+ accept_statement (ST_PROCEDURE);
+ seen_comps = true;
+ break;
+
+ case ST_GENERIC:
+ if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: GENERIC binding"
+ " at %C") == FAILURE)
+ error_flag = true;
+
+ accept_statement (ST_GENERIC);
+ seen_comps = true;
+ break;
+
+ case ST_FINAL:
+ if (gfc_notify_std (GFC_STD_F2003,
+ "Fortran 2003: FINAL procedure declaration"
+ " at %C") == FAILURE)
+ error_flag = true;
+
+ accept_statement (ST_FINAL);
+ seen_comps = true;
+ break;
+
+ case ST_END_TYPE:
+ to_finish = true;
+
+ if (!seen_comps
+ && (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Derived type "
+ "definition at %C with empty CONTAINS "
+ "section") == FAILURE))
+ error_flag = true;
+
+ /* ST_END_TYPE is accepted by parse_derived after return. */
+ break;
+
+ case ST_PRIVATE:
+ if (gfc_find_state (COMP_MODULE) == FAILURE)
+ {
+ gfc_error ("PRIVATE statement in TYPE at %C must be inside "
+ "a MODULE");
+ error_flag = true;
+ break;
+ }
+
+ if (seen_comps)
+ {
+ gfc_error ("PRIVATE statement at %C must precede procedure"
+ " bindings");
+ error_flag = true;
+ break;
+ }
+
+ if (seen_private)
+ {
+ gfc_error ("Duplicate PRIVATE statement at %C");
+ error_flag = true;
+ }
+
+ accept_statement (ST_PRIVATE);
+ gfc_typebound_default_access = ACCESS_PRIVATE;
+ seen_private = true;
+ break;
+
+ case ST_SEQUENCE:
+ gfc_error ("SEQUENCE statement at %C must precede CONTAINS");
+ error_flag = true;
+ break;
+
+ case ST_CONTAINS:
+ gfc_error ("Already inside a CONTAINS block at %C");
+ error_flag = true;
+ break;
+
+ default:
+ unexpected_statement (st);
+ break;
+ }
+ }
+
+ pop_state ();
+ gcc_assert (gfc_current_state () == COMP_DERIVED);
+
+ return error_flag;
+}
+
+
/* Parse a derived type. */
static void
parse_derived (void)
{
int compiling_type, seen_private, seen_sequence, seen_component, error_flag;
- int seen_contains, seen_contains_comp;
gfc_statement st;
gfc_state_data s;
gfc_symbol *derived_sym = NULL;
seen_private = 0;
seen_sequence = 0;
seen_component = 0;
- seen_contains = 0;
- seen_contains_comp = 0;
compiling_type = 1;
case ST_DATA_DECL:
case ST_PROCEDURE:
- if (seen_contains)
- {
- gfc_error ("Components in TYPE at %C must precede CONTAINS");
- error_flag = 1;
- }
-
accept_statement (st);
seen_component = 1;
break;
case ST_FINAL:
- if (!seen_contains)
- {
- gfc_error ("FINAL declaration at %C must be inside CONTAINS");
- error_flag = 1;
- }
-
- if (gfc_notify_std (GFC_STD_F2003,
- "Fortran 2003: FINAL procedure declaration"
- " at %C") == FAILURE)
- error_flag = 1;
-
- accept_statement (ST_FINAL);
- seen_contains_comp = 1;
+ gfc_error ("FINAL declaration at %C must be inside CONTAINS");
+ error_flag = 1;
break;
case ST_END_TYPE:
+endType:
compiling_type = 0;
if (!seen_component
== FAILURE))
error_flag = 1;
- if (seen_contains && !seen_contains_comp
- && (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Derived type "
- "definition at %C with empty CONTAINS "
- "section") == FAILURE))
- error_flag = 1;
-
accept_statement (ST_END_TYPE);
break;
case ST_PRIVATE:
- if (seen_contains)
- {
- gfc_error ("PRIVATE statement at %C must precede CONTAINS");
- error_flag = 1;
- }
-
if (gfc_find_state (COMP_MODULE) == FAILURE)
{
gfc_error ("PRIVATE statement in TYPE at %C must be inside "
}
s.sym->component_access = ACCESS_PRIVATE;
+
accept_statement (ST_PRIVATE);
seen_private = 1;
break;
case ST_SEQUENCE:
- if (seen_contains)
- {
- gfc_error ("SEQUENCE statement at %C must precede CONTAINS");
- error_flag = 1;
- }
-
if (seen_component)
{
gfc_error ("SEQUENCE statement at %C must precede "
" definition at %C") == FAILURE)
error_flag = 1;
- if (seen_contains)
- {
- gfc_error ("Already inside a CONTAINS block at %C");
- error_flag = 1;
- }
-
- seen_contains = 1;
accept_statement (ST_CONTAINS);
- break;
+ if (parse_derived_contains ())
+ error_flag = 1;
+ goto endType;
default:
unexpected_statement (st);
{
/* Look for allocatable components. */
if (c->attr.allocatable
- || (c->ts.type == BT_DERIVED && c->ts.derived->attr.alloc_comp))
- {
- sym->attr.alloc_comp = 1;
- break;
- }
+ || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.alloc_comp))
+ sym->attr.alloc_comp = 1;
/* Look for pointer components. */
if (c->attr.pointer
- || (c->ts.type == BT_DERIVED && c->ts.derived->attr.pointer_comp))
- {
- sym->attr.pointer_comp = 1;
- break;
- }
+ || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.pointer_comp))
+ sym->attr.pointer_comp = 1;
+
+ /* Look for procedure pointer components. */
+ if (c->attr.proc_pointer
+ || (c->ts.type == BT_DERIVED
+ && c->ts.u.derived->attr.proc_pointer_comp))
+ sym->attr.proc_pointer_comp = 1;
/* Look for private components. */
if (sym->component_access == ACCESS_PRIVATE
|| c->attr.access == ACCESS_PRIVATE
- || (c->ts.type == BT_DERIVED && c->ts.derived->attr.private_comp))
- {
- sym->attr.private_comp = 1;
- break;
- }
+ || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.private_comp))
+ sym->attr.private_comp = 1;
}
if (!seen_component)
static void
parse_interface (void)
{
- gfc_compile_state new_state, current_state;
+ gfc_compile_state new_state = COMP_NONE, current_state;
gfc_symbol *prog_unit, *sym;
gfc_interface_info save;
gfc_state_data s1, s2;
gfc_free_namespace (gfc_current_ns);
goto loop;
}
- if (current_interface.type != INTERFACE_ABSTRACT &&
- !gfc_new_block->attr.dummy &&
- gfc_add_external (&gfc_new_block->attr, &gfc_current_locus) == FAILURE)
- {
- reject_statement ();
- gfc_free_namespace (gfc_current_ns);
- goto loop;
- }
break;
case ST_PROCEDURE:
if (current_interface.type == INTERFACE_ABSTRACT)
{
- gfc_new_block->attr.abstract = 1;
+ gfc_add_abstract (&gfc_new_block->attr, &gfc_current_locus);
if (gfc_is_intrinsic_typename (gfc_new_block->name))
gfc_error ("Name '%s' of ABSTRACT INTERFACE at %C "
"cannot be the same as an intrinsic type",
goto decl;
}
+ /* Add EXTERNAL attribute to function or subroutine. */
+ if (current_interface.type != INTERFACE_ABSTRACT && !prog_unit->attr.dummy)
+ gfc_add_external (&prog_unit->attr, &gfc_current_locus);
+
current_interface = save;
gfc_add_interface (prog_unit);
pop_state ();
{
ts->kind = 0;
- if (!ts->derived || !ts->derived->components)
+ if (!ts->u.derived || !ts->u.derived->components)
m = MATCH_ERROR;
}
/* Set the function locus correctly. If we have not found the
function name, there is an error. */
- gfc_match ("function% %n", name);
- if (m == MATCH_YES && strcmp (name, gfc_current_block ()->name) == 0)
+ if (m == MATCH_YES
+ && gfc_match ("function% %n", name) == MATCH_YES
+ && strcmp (name, gfc_current_block ()->name) == 0)
{
gfc_current_block ()->declared_at = gfc_current_locus;
gfc_commit_symbols ();
/* Check type-parameters, at the moment only CHARACTER lengths possible. */
/* TODO: Extend when KIND type parameters are implemented. */
- if (ts->type == BT_CHARACTER && ts->cl && ts->cl->length)
- gfc_expr_check_typed (ts->cl->length, gfc_current_ns, true);
+ if (ts->type == BT_CHARACTER && ts->u.cl && ts->u.cl->length)
+ gfc_expr_check_typed (ts->u.cl->length, gfc_current_ns, true);
}
{
bool verify_now = false;
- if (st == ST_END_FUNCTION)
+ if (st == ST_END_FUNCTION || st == ST_CONTAINS)
verify_now = true;
else
{
gfc_current_block ()->ts.kind = 0;
/* Keep the derived type; if it's bad, it will be discovered later. */
- if (!(ts->type == BT_DERIVED && ts->derived))
+ if (!(ts->type == BT_DERIVED && ts->u.derived))
ts->type = BT_UNKNOWN;
}
push_state (&s, COMP_WHERE, gfc_new_block);
d = add_statement ();
- d->expr = top->expr;
+ d->expr1 = top->expr1;
d->op = EXEC_WHERE;
- top->expr = NULL;
+ top->expr1 = NULL;
top->block = d;
seen_empty_else = 0;
break;
}
- if (new_st.expr == NULL)
+ if (new_st.expr1 == NULL)
seen_empty_else = 1;
d = new_level (gfc_state_stack->head);
d->op = EXEC_WHERE;
- d->expr = new_st.expr;
+ d->expr1 = new_st.expr1;
accept_statement (st);
new_st.op = EXEC_IF;
d = add_statement ();
- d->expr = top->expr;
- top->expr = NULL;
+ d->expr1 = top->expr1;
+ top->expr1 = NULL;
top->block = d;
do
d = new_level (gfc_state_stack->head);
d->op = EXEC_IF;
- d->expr = new_st.expr;
+ d->expr1 = new_st.expr1;
accept_statement (st);
if (p->ext.end_do_label == gfc_statement_label)
{
-
if (p == gfc_state_stack)
return 1;
gfc_state_data s;
gfc_symtree *stree;
- s.ext.end_do_label = new_st.label;
+ s.ext.end_do_label = new_st.label1;
if (new_st.ext.iterator != NULL)
stree = new_st.ext.iterator->var->symtree;
name, but in that case we must have seen ST_ENDDO first).
We only complain about this in pedantic mode. */
if (gfc_current_block () != NULL)
- gfc_error_now ("named block DO at %L requires matching ENDDO name",
+ gfc_error_now ("Named block DO at %L requires matching ENDDO name",
&gfc_current_block()->declared_at);
break;
sym->attr.referenced = 1;
for (ns = siblings; ns; ns = ns->sibling)
{
- gfc_find_sym_tree (sym->name, ns, 0, &st);
+ st = gfc_find_symtree (ns->sym_root, sym->name);
if (!st || (st->n.sym->attr.dummy && ns == st->n.sym->ns))
- continue;
+ goto fixup_contained;
old_sym = st->n.sym;
if (old_sym->ns == ns
gfc_free_symbol (old_sym);
}
+fixup_contained:
/* Do the same for any contained procedures. */
gfc_fixup_sibling_symbols (sym, ns->contained);
}
st = next_statement ();
goto loop;
}
+
+ s->ns = gfc_current_ns;
}
s->type = sub ? GSYM_SUBROUTINE : GSYM_FUNCTION;
s->where = gfc_current_locus;
s->defined = 1;
+ s->ns = gfc_current_ns;
}
}
s->type = GSYM_PROGRAM;
s->where = gfc_current_locus;
s->defined = 1;
+ s->ns = gfc_current_ns;
}
}
+/* Resolve all the program units when whole file scope option
+ is active. */
+static void
+resolve_all_program_units (gfc_namespace *gfc_global_ns_list)
+{
+ gfc_free_dt_list ();
+ gfc_current_ns = gfc_global_ns_list;
+ for (; gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling)
+ {
+ gfc_current_locus = gfc_current_ns->proc_name->declared_at;
+ gfc_resolve (gfc_current_ns);
+ gfc_current_ns->derived_types = gfc_derived_types;
+ gfc_derived_types = NULL;
+ }
+}
+
+
+static void
+clean_up_modules (gfc_gsymbol *gsym)
+{
+ if (gsym == NULL)
+ return;
+
+ clean_up_modules (gsym->left);
+ clean_up_modules (gsym->right);
+
+ if (gsym->type != GSYM_MODULE || !gsym->ns)
+ return;
+
+ gfc_current_ns = gsym->ns;
+ gfc_derived_types = gfc_current_ns->derived_types;
+ gfc_done_2 ();
+ gsym->ns = NULL;
+ return;
+}
+
+
+/* Translate all the program units when whole file scope option
+ is active. This could be in a different order to resolution if
+ there are forward references in the file. */
+static void
+translate_all_program_units (gfc_namespace *gfc_global_ns_list)
+{
+ int errors;
+
+ gfc_current_ns = gfc_global_ns_list;
+ gfc_get_errors (NULL, &errors);
+
+ for (; !errors && gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling)
+ {
+ gfc_current_locus = gfc_current_ns->proc_name->declared_at;
+ gfc_derived_types = gfc_current_ns->derived_types;
+ gfc_generate_code (gfc_current_ns);
+ gfc_current_ns->translated = 1;
+ }
+
+ /* Clean up all the namespaces after translation. */
+ gfc_current_ns = gfc_global_ns_list;
+ for (;gfc_current_ns;)
+ {
+ gfc_namespace *ns = gfc_current_ns->sibling;
+ gfc_derived_types = gfc_current_ns->derived_types;
+ gfc_done_2 ();
+ gfc_current_ns = ns;
+ }
+
+ clean_up_modules (gfc_gsym_root);
+}
+
+
/* Top level parser. */
gfc_try
gfc_state_data top, s;
gfc_statement st;
locus prog_locus;
+ gfc_namespace *next;
gfc_start_source_files ();
if (setjmp (eof_buf))
return FAILURE; /* Come here on unexpected EOF */
+ /* Prepare the global namespace that will contain the
+ program units. */
+ gfc_global_ns_list = next = NULL;
+
seen_program = 0;
/* Exit early for empty files. */
accept_statement (st);
add_global_program ();
parse_progunit (ST_NONE);
+ if (gfc_option.flag_whole_file)
+ goto prog_units;
break;
case ST_SUBROUTINE:
push_state (&s, COMP_SUBROUTINE, gfc_new_block);
accept_statement (st);
parse_progunit (ST_NONE);
+ if (gfc_option.flag_whole_file)
+ goto prog_units;
break;
case ST_FUNCTION:
push_state (&s, COMP_FUNCTION, gfc_new_block);
accept_statement (st);
parse_progunit (ST_NONE);
+ if (gfc_option.flag_whole_file)
+ goto prog_units;
break;
case ST_BLOCK_DATA:
push_state (&s, COMP_PROGRAM, gfc_new_block);
main_program_symbol (gfc_current_ns, "MAIN__");
parse_progunit (st);
+ if (gfc_option.flag_whole_file)
+ goto prog_units;
break;
}
+ /* Handle the non-program units. */
gfc_current_ns->code = s.head;
gfc_resolve (gfc_current_ns);
gfc_dump_module (s.sym->name, errors_before == errors);
if (errors == 0)
gfc_generate_module_code (gfc_current_ns);
+ pop_state ();
+ if (!gfc_option.flag_whole_file)
+ gfc_done_2 ();
+ else
+ {
+ gfc_current_ns->derived_types = gfc_derived_types;
+ gfc_derived_types = NULL;
+ gfc_current_ns = NULL;
+ }
}
else
{
if (errors == 0)
gfc_generate_code (gfc_current_ns);
+ pop_state ();
+ gfc_done_2 ();
}
+ goto loop;
+
+prog_units:
+ /* The main program and non-contained procedures are put
+ in the global namespace list, so that they can be processed
+ later and all their interfaces resolved. */
+ gfc_current_ns->code = s.head;
+ if (next)
+ next->sibling = gfc_current_ns;
+ else
+ gfc_global_ns_list = gfc_current_ns;
+
+ next = gfc_current_ns;
+
pop_state ();
- gfc_done_2 ();
goto loop;
-done:
+ done:
+
+ if (!gfc_option.flag_whole_file)
+ goto termination;
+
+ /* Do the resolution. */
+ resolve_all_program_units (gfc_global_ns_list);
+
+ /* Do the parse tree dump. */
+ gfc_current_ns
+ = gfc_option.dump_parse_tree ? gfc_global_ns_list : NULL;
+
+ for (; gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling)
+ {
+ gfc_dump_parse_tree (gfc_current_ns, stdout);
+ fputs ("------------------------------------------\n\n", stdout);
+ }
+
+ /* Do the translation. */
+ translate_all_program_units (gfc_global_ns_list);
+
+termination:
+
gfc_end_source_files ();
return SUCCESS;
OSDN Git Service
