decl.c (attr_seen): New static variable.
authorFritz Reese <Reese-Fritz@zai.com>
Thu, 10 Aug 2017 12:19:13 +0000 (12:19 +0000)
committerFritz Reese <foreese@gcc.gnu.org>
Thu, 10 Aug 2017 12:19:13 +0000 (12:19 +0000)
2017-08-10  Fritz Reese <Reese-Fritz@zai.com>

    gcc/fortran/ChangeLog:

* decl.c (attr_seen): New static variable.
* decl.c (variable_decl): Match %FILL in STRUCTURE body.
* gfortran.texi: Update documentation.

    gcc/testsuite/ChangeLog:

    gfortran.dg/
* dec_structure_18.f90, dec_structure_19.f90, dec_structure_20.f90,
dec_structure_21.f90: New.

From-SVN: r251023

gcc/fortran/ChangeLog
gcc/fortran/decl.c
gcc/fortran/gfortran.texi
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/dec_structure_18.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/dec_structure_19.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/dec_structure_20.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/dec_structure_21.f90 [new file with mode: 0644]

index 09138ab..45b16d4 100644 (file)
@@ -1,3 +1,9 @@
+2017-08-10  Fritz Reese <Reese-Fritz@zai.com>
+
+       * decl.c (attr_seen): New static variable.
+       * decl.c (variable_decl): Match %FILL in STRUCTURE body.
+       * gfortran.texi: Update documentation.
+
 2017-08-08  Martin Liska  <mliska@suse.cz>
 
        * trans-types.c: Include header files.
index 54ee5d3..b919f43 100644 (file)
@@ -54,6 +54,7 @@ static gfc_typespec current_ts;
 static symbol_attribute current_attr;
 static gfc_array_spec *current_as;
 static int colon_seen;
+static int attr_seen;
 
 /* The current binding label (if any).  */
 static const char* curr_binding_label;
@@ -2140,6 +2141,7 @@ static match
 variable_decl (int elem)
 {
   char name[GFC_MAX_SYMBOL_LEN + 1];
+  static unsigned int fill_id = 0;
   gfc_expr *initializer, *char_len;
   gfc_array_spec *as;
   gfc_array_spec *cp_as; /* Extra copy for Cray Pointees.  */
@@ -2157,9 +2159,47 @@ variable_decl (int elem)
   /* When we get here, we've just matched a list of attributes and
      maybe a type and a double colon.  The next thing we expect to see
      is the name of the symbol.  */
-  m = gfc_match_name (name);
+
+  /* If we are parsing a structure with legacy support, we allow the symbol
+     name to be '%FILL' which gives it an anonymous (inaccessible) name.  */
+  m = MATCH_NO;
+  gfc_gobble_whitespace ();
+  if (gfc_peek_ascii_char () == '%')
+    {
+      gfc_next_ascii_char ();
+      m = gfc_match ("fill");
+    }
+
   if (m != MATCH_YES)
-    goto cleanup;
+    {
+      m = gfc_match_name (name);
+      if (m != MATCH_YES)
+       goto cleanup;
+    }
+
+  else
+    {
+      m = MATCH_ERROR;
+      if (gfc_current_state () != COMP_STRUCTURE)
+       {
+         if (flag_dec_structure)
+           gfc_error ("%qs not allowed outside STRUCTURE at %C", "%FILL");
+         else
+           gfc_error ("%qs at %C is a DEC extension, enable with "
+                      "%<-fdec-structure%>", "%FILL");
+         goto cleanup;
+       }
+
+      if (attr_seen)
+       {
+         gfc_error ("%qs entity cannot have attributes at %C", "%FILL");
+         goto cleanup;
+       }
+
+      /* %FILL components are given invalid fortran names.  */
+      snprintf (name, GFC_MAX_SYMBOL_LEN + 1, "%%FILL%u", fill_id++);
+      m = MATCH_YES;
+    }
 
   var_locus = gfc_current_locus;
 
@@ -2260,6 +2300,14 @@ variable_decl (int elem)
        }
     }
 
+  /* %FILL components may not have initializers.  */
+  if (strncmp (name, "%FILL", 5) == 0 && gfc_match_eos () != MATCH_YES)
+    {
+      gfc_error ("%qs entity cannot have an initializer at %C", "%FILL");
+      m = MATCH_ERROR;
+      goto cleanup;
+    }
+
   /*  If this symbol has already shown up in a Cray Pointer declaration,
       and this is not a component declaration,
       then we want to set the type & bail out.  */
@@ -3860,6 +3908,7 @@ match_attr_spec (void)
 
   current_as = NULL;
   colon_seen = 0;
+  attr_seen = 0;
 
   /* See if we get all of the keywords up to the final double colon.  */
   for (d = GFC_DECL_BEGIN; d != GFC_DECL_END; d++)
@@ -4228,6 +4277,8 @@ match_attr_spec (void)
     {
       if (seen[d] == 0)
        continue;
+      else
+        attr_seen = 1;
 
       if ((d == DECL_STATIC || d == DECL_AUTOMATIC)
          && !flag_dec_static)
@@ -4436,6 +4487,7 @@ cleanup:
   gfc_current_locus = start;
   gfc_free_array_spec (current_as);
   current_as = NULL;
+  attr_seen = 0;
   return m;
 }
 
index 85afdda..145ec7f 100644 (file)
@@ -2220,6 +2220,20 @@ rules and exceptions:
 @item Structures act like derived types with the @code{SEQUENCE} attribute.
 Otherwise they may contain no specifiers.
 
+@item Structures may contain a special field with the name @code{%FILL}.
+This will create an anonymous component which cannot be accessed but occupies
+space just as if a component of the same type was declared in its place, useful
+for alignment purposes.  As an example, the following structure will consist
+of at least sixteen bytes:
+
+@smallexample
+structure /padded/
+  character(4) start
+  character(8) %FILL
+  character(4) end
+end structure
+@end smallexample
+
 @item Structures may share names with other symbols. For example, the following
 is invalid for derived types, but valid for structures:
 
index 45fe28f..adae3b9 100644 (file)
@@ -1,3 +1,10 @@
+2017-08-10  Fritz Reese <Reese-Fritz@zai.com>
+
+       * gfortran.dg/dec_structure_18.f90: New test.
+       * gfortran.dg/dec_structure_19.f90: New test.
+       * gfortran.dg/dec_structure_20.f90: New test.
+       * gfortran.dg/dec_structure_21.f90: New test.
+
 2017-08-10  Marek Polacek  <polacek@redhat.com>
 
        PR testsuite/81784
diff --git a/gcc/testsuite/gfortran.dg/dec_structure_18.f90 b/gcc/testsuite/gfortran.dg/dec_structure_18.f90
new file mode 100644 (file)
index 0000000..1e6b229
--- /dev/null
@@ -0,0 +1,38 @@
+      ! { dg-do run }
+      ! { dg-options "-fdec-structure -ffixed-form" }
+      !
+      ! Test the %FILL component extension.
+      !
+      implicit none
+
+      structure /s/
+        character(2) i
+        character(2) %fill
+        character(2) j
+      end structure
+
+      structure /s2/
+        character buf(6)
+      end structure
+
+      record /s/ x
+      record /s2/ y
+      equivalence (x, y)
+
+      x.i = '12'
+      x.j = '34'
+
+      if (y.buf(1) .ne. '1') then
+        call abort
+      endif
+      if (y.buf(2) .ne. '2') then
+        call abort
+      endif
+      if (y.buf(5) .ne. '3') then
+        call abort
+      endif
+      if (y.buf(6) .ne. '4') then
+        call abort
+      endif
+
+      end
diff --git a/gcc/testsuite/gfortran.dg/dec_structure_19.f90 b/gcc/testsuite/gfortran.dg/dec_structure_19.f90
new file mode 100644 (file)
index 0000000..9ea0b3e
--- /dev/null
@@ -0,0 +1,38 @@
+! { dg-do compile }
+! { dg-options "-fdec-structure -ffree-form" }
+!
+! Test the %FILL component extension.
+!
+implicit none
+
+structure /s/
+  character(2) i
+  character(2) %fill
+  character(2) j
+end structure
+
+structure /s2/
+  character buf(6)
+end structure
+
+record /s/ x
+record /s2/ y
+equivalence (x, y)
+
+x.i = "12"
+x.j = "34"
+
+if (y.buf(1) .ne. '1') then
+  call abort
+endif
+if (y.buf(2) .ne. '2') then
+  call abort
+endif
+if (y.buf(5) .ne. '3') then
+  call abort
+endif
+if (y.buf(6) .ne. '4') then
+  call abort
+endif
+
+end
diff --git a/gcc/testsuite/gfortran.dg/dec_structure_20.f90 b/gcc/testsuite/gfortran.dg/dec_structure_20.f90
new file mode 100644 (file)
index 0000000..9e95204
--- /dev/null
@@ -0,0 +1,18 @@
+      ! { dg-do compile }
+      ! { dg-options "-fdec-structure" }
+      !
+      ! Test error handling for %FILL
+      !
+      implicit none
+
+      structure /s/
+        integer(2) i /3/
+        integer(2) %fill /4/ ! { dg-error "cannot have an initializer" }
+        integer(2), pointer :: %fill ! { dg-error "cannot have attributes" }
+      end structure
+
+      type t
+        integer %fill ! { dg-error "not allowed outside STRUCTURE" }
+      endtype
+
+      end
diff --git a/gcc/testsuite/gfortran.dg/dec_structure_21.f90 b/gcc/testsuite/gfortran.dg/dec_structure_21.f90
new file mode 100644 (file)
index 0000000..64e8ca3
--- /dev/null
@@ -0,0 +1,10 @@
+      ! { dg-do compile }
+      ! { dg-options "-ffixed-form" }
+      !
+      ! Test errors for %FILL without -fdec-structure.
+      !
+      implicit none
+
+      character(2) %fill ! { dg-error "is a DEC extension" }
+
+      end