re PR fortran/34112 (Add $!DEC ATTRIBUTE support for 32bit Windows' STDCALL)

2009-06-28  Tobias Burnus  <burnus@net-b.de>
	    Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>

	PR fortran/34112
	* symbol.c (gfc_add_ext_attribute): New function.
	(gfc_get_sym_tree): New argument allow_subroutine.
	(gfc_get_symbol,gfc_get_ha_sym_tree,gen_cptr_param,gen_fptr_param
	gen_shape_param,generate_isocbinding_symbol): Use it.
	* decl.c (find_special): New argument allow_subroutine.
	(add_init_expr_to_sym,add_hidden_procptr_result,attr_decl1,
	match_procedure_in_type,gfc_match_final_decl): Use it.
	(gfc_match_gcc_attributes): New function.
	* gfortran.texi (Mixed-Language Programming): New section
	"GNU Fortran Compiler Directives".
	* gfortran.h (ext_attr_t): New struct.
	(symbol_attributes): Use it.
	(gfc_add_ext_attribute): New prototype.
	(gfc_get_sym_tree): Update pototype.
	* expr.c (gfc_check_pointer_assign): Check whether call
	convention is the same.
	* module.c (import_iso_c_binding_module, create_int_parameter,
	use_iso_fortran_env_module): Update gfc_get_sym_tree call.
	* scanner.c (skip_gcc_attribute): New function.
	(skip_free_comments,skip_fixed_comments): Use it.
	(gfc_next_char_literal): Support !GCC$ lines.
	* resolve.c (check_host_association): Update
	gfc_get_sym_tree call.
	* match.c (gfc_match_sym_tree,gfc_match_call): Update
	gfc_get_sym_tree call.
	* trans-decl.c (add_attributes_to_decl): New function.
	(gfc_get_symbol_decl,get_proc_pointer_decl,
	gfc_get_extern_function_decl,build_function_decl: Use it.
	* match.h (gfc_match_gcc_attributes): Add prototype.
	* parse.c (decode_gcc_attribute): New function.
	(next_free,next_fixed): Support !GCC$ lines.
	* primary.c (match_actual_arg,check_for_implicit_index,
	gfc_match_rvalue,gfc_match_rvalue): Update
	gfc_get_sym_tree call.

2009-06-28  Tobias Burnus  <burnus@net-b.de>

	PR fortran/34112
	* gfortran.dg/compiler-directive_1.f90: New test.
	* gfortran.dg/compiler-directive_2.f: New test.


Co-Authored-By: Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>

From-SVN: r149036

1 files changed, 65 insertions, 9 deletions

diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 0b2cbf3..da16c2b 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -566,6 +566,34 @@ decode_omp_directive (void)
   return ST_NONE;
 }
 
+static gfc_statement
+decode_gcc_attribute (void)
+{
+  locus old_locus;
+
+#ifdef GFC_DEBUG
+  gfc_symbol_state ();
+#endif
+
+  gfc_clear_error ();	/* Clear any pending errors.  */
+  gfc_clear_warning ();	/* Clear any pending warnings.  */
+  old_locus = gfc_current_locus;
+
+  match ("attributes", gfc_match_gcc_attributes, ST_ATTR_DECL);
+
+  /* All else has failed, so give up.  See if any of the matchers has
+     stored an error message of some sort.  */
+
+  if (gfc_error_check () == 0)
+    gfc_error_now ("Unclassifiable GCC directive at %C");
+
+  reject_statement ();
+
+  gfc_error_recovery ();
+
+  return ST_NONE;
+}
+
 #undef match
 
 
@@ -637,21 +665,39 @@ next_free (void)
   else if (c == '!')
     {
       /* Comments have already been skipped by the time we get here,
-	 except for OpenMP directives.  */
-      if (gfc_option.flag_openmp)
+	 except for GCC attributes and OpenMP directives.  */
+
+      gfc_next_ascii_char (); /* Eat up the exclamation sign.  */
+      c = gfc_peek_ascii_char ();
+
+      if (c == 'g')
 	{
 	  int i;
 
 	  c = gfc_next_ascii_char ();
-	  for (i = 0; i < 5; i++, c = gfc_next_ascii_char ())
-	    gcc_assert (c == "!$omp"[i]);
+	  for (i = 0; i < 4; i++, c = gfc_next_ascii_char ())
+	    gcc_assert (c == "gcc$"[i]);
+
+	  gfc_gobble_whitespace ();
+	  return decode_gcc_attribute ();
+
+	}
+      else if (c == '$' && gfc_option.flag_openmp)
+	{
+	  int i;
+
+	  c = gfc_next_ascii_char ();
+	  for (i = 0; i < 4; i++, c = gfc_next_ascii_char ())
+	    gcc_assert (c == "$omp"[i]);
 
 	  gcc_assert (c == ' ' || c == '\t');
 	  gfc_gobble_whitespace ();
 	  return decode_omp_directive ();
 	}
-    }
 
+      gcc_unreachable (); 
+    }
+ 
   if (at_bol && c == ';')
     {
       gfc_error_now ("Semicolon at %C needs to be preceded by statement");
@@ -709,12 +755,22 @@ next_fixed (void)
 	  break;
 
 	  /* Comments have already been skipped by the time we get
-	     here, except for OpenMP directives.  */
+	     here, except for GCC attributes and OpenMP directives.  */
+
 	case '*':
-	  if (gfc_option.flag_openmp)
+	  c = gfc_next_char_literal (0);
+	  
+	  if (TOLOWER (c) == 'g')
+	    {
+	      for (i = 0; i < 4; i++, c = gfc_next_char_literal (0))
+		gcc_assert (TOLOWER (c) == "gcc$"[i]);
+
+	      return decode_gcc_attribute ();
+	    }
+	  else if (c == '$' && gfc_option.flag_openmp)
 	    {
-	      for (i = 0; i < 5; i++, c = gfc_next_char_literal (0))
-		gcc_assert ((char) gfc_wide_tolower (c) == "*$omp"[i]);
+	      for (i = 0; i < 4; i++, c = gfc_next_char_literal (0))
+		gcc_assert ((char) gfc_wide_tolower (c) == "$omp"[i]);
 
 	      if (c != ' ' && c != '0')
 		{