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, 26 insertions, 0 deletions

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 2049fa4..b1d572e 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3186,6 +3186,32 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
 			      rvalue->symtree->name, &rvalue->where) == FAILURE)
 	    return FAILURE;
 	}
+
+      /* Ensure that the calling convention is the same. As other attributes
+	 such as DLLEXPORT may differ, one explicitly only tests for the
+	 calling conventions.  */
+      if (rvalue->expr_type == EXPR_VARIABLE
+	  && lvalue->symtree->n.sym->attr.ext_attr
+	       != rvalue->symtree->n.sym->attr.ext_attr)
+	{
+	  symbol_attribute cdecl, stdcall, fastcall;
+	  unsigned calls;
+
+	  gfc_add_ext_attribute (&cdecl, (unsigned) EXT_ATTR_CDECL, NULL);
+	  gfc_add_ext_attribute (&stdcall, (unsigned) EXT_ATTR_STDCALL, NULL);
+	  gfc_add_ext_attribute (&fastcall, (unsigned) EXT_ATTR_FASTCALL, NULL);
+	  calls = cdecl.ext_attr | stdcall.ext_attr | fastcall.ext_attr;
+
+	  if ((calls & lvalue->symtree->n.sym->attr.ext_attr)
+	      != (calls & rvalue->symtree->n.sym->attr.ext_attr))
+	    {
+	      gfc_error ("Mismatch in the procedure pointer assignment "
+			 "at %L: mismatch in the calling convention",
+			 &rvalue->where);
+	  return FAILURE;
+	    }
+	}
+
       /* TODO: Enable interface check for PPCs.  */
       if (is_proc_ptr_comp (rvalue, NULL))
 	return SUCCESS;