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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d7a4cebc75b7d3299683f3ef0a791e7103748deb..44c9c487fae4d1ddd61f9fb37ce0bca459143bdd 100644 (file)
--- 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 3c5e69a906bbe9ae75c22e580cb6fdff135d9694..3435665506c22341d73e0f28f2e6f2094e57855e 100644 (file)
--- 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 abc3c290d75092da319d6c49870171c7b362d530..b940fd3a8a4018f9494deca62e6e31369b79b045 100644 (file)
--- 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 9f6af8efc58149926f3a04036f8f4039fe6fe276..44ddb656dd8c710500b4a3462ac29e84c392f5b8 100644 (file)
--- 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 74bab19735b2e84f7897ddc18027a64c33d42c6a..727a7d7bb2d385fe8a8a1959e097872584a08e75 100644 (file)
--- 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 504504689ecb7b5e6f75f93ef2fc611092747ef3..1c7c73c0e75105112c2cd067c444db00c0ce553a 100644 (file)
--- 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 a5f1a49adf200a074b200fab8ab9d5e34b047674..7f2e91dd3749b7a3519c1a8c2e84e3293d59cbbe 100644 (file)
--- 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 (file)
index 0000000..5c475f1
--- /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