gfortran.h (gfc_namespace): Add new field is_block_data.
fortran/ * gfortran.h (gfc_namespace): Add new field is_block_data. * parse.c (accept_statement): Remove special handling for BLOCK DATA. (parse_block_data): Record BLOCK DATA name, set is_block_data field. * trans.c (gfc_generate_code): Handle BLOCK DATA units. * trans.h (gfc_generate_block_data): Add prototype. * trans-decl.c (gfc_generate_block_data): New function. testsuite/ * gfortran.dg/blockdata_1.f90: New test. From-SVN: r86796
This commit is contained in:
parent
442c8e31f0
commit
0de4325e0b
|
@ -1,3 +1,12 @@
|
|||
2004-08-30 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
|
||||
|
||||
* gfortran.h (gfc_namespace): Add new field is_block_data.
|
||||
* parse.c (accept_statement): Remove special handling for BLOCK DATA.
|
||||
(parse_block_data): Record BLOCK DATA name, set is_block_data field.
|
||||
* trans.c (gfc_generate_code): Handle BLOCK DATA units.
|
||||
* trans.h (gfc_generate_block_data): Add prototype.
|
||||
* trans-decl.c (gfc_generate_block_data): New function.
|
||||
|
||||
2004-08-29 Richard Henderson <rth@redhat.com>
|
||||
|
||||
* trans-const.c (gfc_conv_mpz_to_tree): Use mpz_export.
|
||||
|
|
|
@ -804,6 +804,9 @@ typedef struct gfc_namespace
|
|||
|
||||
/* A list of all alternate entry points to this procedure (or NULL). */
|
||||
gfc_entry_list *entries;
|
||||
|
||||
/* Set to 1 if namespace is a BLOCK DATA program unit. */
|
||||
int is_block_data;
|
||||
}
|
||||
gfc_namespace;
|
||||
|
||||
|
|
|
@ -1058,24 +1058,6 @@ accept_statement (gfc_statement st)
|
|||
|
||||
break;
|
||||
|
||||
case ST_BLOCK_DATA:
|
||||
{
|
||||
gfc_symbol *block_data = NULL;
|
||||
symbol_attribute attr;
|
||||
|
||||
gfc_get_symbol ("_BLOCK_DATA__", gfc_current_ns, &block_data);
|
||||
gfc_clear_attr (&attr);
|
||||
attr.flavor = FL_PROCEDURE;
|
||||
attr.proc = PROC_UNKNOWN;
|
||||
attr.subroutine = 1;
|
||||
attr.access = ACCESS_PUBLIC;
|
||||
block_data->attr = attr;
|
||||
gfc_current_ns->proc_name = block_data;
|
||||
gfc_commit_symbols ();
|
||||
}
|
||||
|
||||
break;
|
||||
|
||||
case ST_ENTRY:
|
||||
case_executable:
|
||||
case_exec_markers:
|
||||
|
@ -2410,6 +2392,9 @@ parse_block_data (void)
|
|||
static int blank_block=0;
|
||||
gfc_gsymbol *s;
|
||||
|
||||
gfc_current_ns->proc_name = gfc_new_block;
|
||||
gfc_current_ns->is_block_data = 1;
|
||||
|
||||
if (gfc_new_block == NULL)
|
||||
{
|
||||
if (blank_block)
|
||||
|
|
|
@ -2350,4 +2350,30 @@ gfc_generate_constructors (void)
|
|||
#endif
|
||||
}
|
||||
|
||||
/* Translates a BLOCK DATA program unit. This means emitting the
|
||||
commons contained therein plus their initializations. We also emit
|
||||
a globally visible symbol to make sure that each BLOCK DATA program
|
||||
unit remains unique. */
|
||||
|
||||
void
|
||||
gfc_generate_block_data (gfc_namespace * ns)
|
||||
{
|
||||
tree decl;
|
||||
tree id;
|
||||
|
||||
gfc_trans_common (ns);
|
||||
|
||||
if (ns->proc_name)
|
||||
id = gfc_sym_mangled_function_id (ns->proc_name);
|
||||
else
|
||||
id = get_identifier ("__BLOCK_DATA__");
|
||||
|
||||
decl = build_decl (VAR_DECL, id, gfc_array_index_type);
|
||||
TREE_PUBLIC (decl) = 1;
|
||||
TREE_STATIC (decl) = 1;
|
||||
|
||||
pushdecl (decl);
|
||||
rest_of_decl_compilation (decl, 1, 0);
|
||||
}
|
||||
|
||||
#include "gt-fortran-trans-decl.h"
|
||||
|
|
|
@ -647,6 +647,12 @@ gfc_generate_code (gfc_namespace * ns)
|
|||
gfc_symbol *main_program = NULL;
|
||||
symbol_attribute attr;
|
||||
|
||||
if (ns->is_block_data)
|
||||
{
|
||||
gfc_generate_block_data (ns);
|
||||
return;
|
||||
}
|
||||
|
||||
/* Main program subroutine. */
|
||||
if (!ns->proc_name)
|
||||
{
|
||||
|
|
|
@ -396,6 +396,8 @@ tree gfc_advance_chain (tree, int);
|
|||
void gfc_create_function_decl (gfc_namespace *);
|
||||
/* Generate the code for a function. */
|
||||
void gfc_generate_function_code (gfc_namespace *);
|
||||
/* Output a BLOCK DATA program unit. */
|
||||
void gfc_generate_block_data (gfc_namespace *);
|
||||
/* Output a decl for a module variable. */
|
||||
void gfc_generate_module_vars (gfc_namespace *);
|
||||
|
||||
|
|
|
@ -1,3 +1,7 @@
|
|||
2004-08-30 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
|
||||
|
||||
* gfortran.dg/blockdata_1.f90: New test.
|
||||
|
||||
2004-08-30 Richard Henderson <rth@redhat.com>
|
||||
|
||||
* g++.dg/other/offsetof1.C: Use __builtin_offsetof.
|
||||
|
|
|
@ -0,0 +1,28 @@
|
|||
! { dg-do run }
|
||||
! tests basic block data functionality
|
||||
! we didn't allow multiple block data program units
|
||||
block data
|
||||
common /a/ y(3)
|
||||
data y /3*1./
|
||||
end
|
||||
|
||||
blockdata d1
|
||||
common /a/ w(3)
|
||||
common /b/ u
|
||||
data u /1./
|
||||
end blockdata d1
|
||||
|
||||
block data d2
|
||||
common /b/ u
|
||||
common j
|
||||
data j /1/
|
||||
end block data d2
|
||||
!
|
||||
! begin testing code
|
||||
common /a/ x(3)
|
||||
common /b/ y
|
||||
common i
|
||||
|
||||
if (any(x /= 1.)) call abort ()
|
||||
if (y /= 1. .or. i /= 1) call abort ()
|
||||
end
|
Loading…
Reference in New Issue