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.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@86796 138bc75d-0d04-0410-961f-82ee72b054a4

8 files changed, 81 insertions, 18 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d7a4cebc75b..44c9c487fae 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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.
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 3c5e69a906b..3435665506c 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -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;
 
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index abc3c290d75..b940fd3a8a4 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -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)
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 9f6af8efc58..44ddb656dd8 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -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"
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 74bab19735b..727a7d7bb2d 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -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)
     {
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 504504689ec..1c7c73c0e75 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -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 *);
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index a5f1a49adf2..7f2e91dd374 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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.
diff --git a/gcc/testsuite/gfortran.dg/blockdata_1.f90 b/gcc/testsuite/gfortran.dg/blockdata_1.f90
new file mode 100644
index 00000000000..5c475f1d0f4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/blockdata_1.f90
@@ -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