Fortran: fix issues with variables in BLOCK DATA [PR58857]

	PR fortran/58857

gcc/fortran/ChangeLog:

	* class.cc (gfc_find_derived_vtab): Declare some frontend generated
	variables and procedures (_vtab, _copy, _deallocate) as artificial.
	(find_intrinsic_vtab): Likewise.
	* trans-decl.cc (check_block_data_decls): New helper function.
	(gfc_generate_block_data): Use it to emit warnings for variables
	declared in a BLOCK DATA program unit but not in a COMMON block.

gcc/testsuite/ChangeLog:

	* gfortran.dg/uncommon_block_data_2.f90: New test.

diff --git a/gcc/fortran/class.cc b/gcc/fortran/class.cc
index 97ff54df5e1cd5c9f085708b38012354c2e6ade5..df18601e45bd5d01ee8ff5302d105d30dc59b244 100644 (file)
--- a/gcc/fortran/class.cc
+++ b/gcc/fortran/class.cc
@@ -2498,6 +2498,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
          vtab->attr.save = SAVE_IMPLICIT;
          vtab->attr.vtab = 1;
          vtab->attr.access = ACCESS_PUBLIC;
+         vtab->attr.artificial = 1;
          gfc_set_sym_referenced (vtab);
          free (name);
          name = xasprintf ("__vtype_%s", tname);
@@ -2610,6 +2611,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
                goto cleanup;
              c->attr.proc_pointer = 1;
              c->attr.access = ACCESS_PRIVATE;
+             c->attr.artificial = 1;
              c->tb = XCNEW (gfc_typebound_proc);
              c->tb->ppc = 1;
              if (derived->attr.unlimited_polymorphic
@@ -2687,6 +2689,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
                goto cleanup;
              c->attr.proc_pointer = 1;
              c->attr.access = ACCESS_PRIVATE;
+             c->attr.artificial = 1;
              c->tb = XCNEW (gfc_typebound_proc);
              c->tb->ppc = 1;
              if (derived->attr.unlimited_polymorphic || derived->attr.abstract
@@ -2951,6 +2954,7 @@ find_intrinsic_vtab (gfc_typespec *ts)
                goto cleanup;
              c->attr.proc_pointer = 1;
              c->attr.access = ACCESS_PRIVATE;
+             c->attr.artificial = 1;
              c->tb = XCNEW (gfc_typebound_proc);
              c->tb->ppc = 1;
 

diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 97bb0a4185811efc06919d018f0dc8509d5352b7..b8fc9a1d89c59f5b44be3ee9f26795ce7b595118 100644 (file)
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -8295,6 +8295,26 @@ gfc_generate_constructors (void)
 #endif
 }
 
+
+/* Helper function for checking of variables declared in a BLOCK DATA program
+   unit.  */
+
+static void
+check_block_data_decls (gfc_symbol * sym)
+{
+  if (warn_unused_variable
+      && sym->attr.flavor == FL_VARIABLE
+      && !sym->attr.in_common
+      && !sym->attr.artificial)
+    {
+      gfc_warning (OPT_Wunused_variable,
+                  "Symbol %qs at %L is declared in a BLOCK DATA "
+                  "program unit but is not in a COMMON block",
+                  sym->name, &sym->declared_at);
+    }
+}
+
+
 /* 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
@@ -8315,6 +8335,9 @@ gfc_generate_block_data (gfc_namespace * ns)
   /* Process the DATA statements.  */
   gfc_trans_common (ns);
 
+  /* Check for variables declared in BLOCK DATA but not used in COMMON.  */
+  gfc_traverse_ns (ns, check_block_data_decls);
+
   /* Create a global symbol with the mane of the block data.  This is to
      generate linker errors if the same name is used twice.  It is never
      really used.  */

diff --git a/gcc/testsuite/gfortran.dg/uncommon_block_data_2.f90 b/gcc/testsuite/gfortran.dg/uncommon_block_data_2.f90
new file mode 100644 (file)
index 0000000..7b1a0b3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/uncommon_block_data_2.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-additional-options "-Wunused-variable" }
+!
+! PR fortran/58857
+
+BLOCK DATA valid
+  integer  :: i
+  integer  :: n  ! { dg-warning "not in a COMMON block" }
+  class(*) :: zz ! { dg-warning "not in a COMMON block" }
+  pointer  :: zz
+  common /com/ i, r
+END BLOCK DATA valid