2013-07-12 Basile Starynkevitch <basile@starynkevitch.net>

	MELT branch merged with trunk rev 200918 using svnmerge.py



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/melt-branch@200920 138bc75d-0d04-0410-961f-82ee72b054a4

5 files changed, 49 insertions, 18 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f85e2ebfa6b..283521a22ce 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,28 @@
+2013-07-08  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/57834
+	* check.c (is_c_interoperable): Add special case for c_f_pointer.
+	(explicit-size, gfc_check_c_f_pointer, gfc_check_c_loc): Update
+	call.
+
+2013-07-08  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/50554
+	* io.c (match_inquire_element): Add missing do-var check.
+
+2013-07-08  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/57785
+	* simplify.c (compute_dot_product): Complex conjugate for
+	dot_product.
+	(gfc_simplify_dot_product, gfc_simplify_matmul): Update call.
+
+2013-07-08  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/57469
+	* trans-decl.c (generate_local_decl): Don't warn that
+	a dummy is unused, when it is in a namelist.
+
 2013-07-01  Dominique d'Humieres  <dominiq@lps.ens.fr>
 
 	PR fortran/54788
@@ -628,7 +653,7 @@
 
 	* class.c (finalization_scalarizer, finalizer_insert_packed_call,
 	generate_finalization_wrapper): Avoid segfault with absent SIZE=
-	argment to TRANSFER and use correct result kind for SIZE.
+	argument to TRANSFER and use correct result kind for SIZE.
 	* intrinsic.c (gfc_isym_id_by_intmod): Also handle ids of
 	nonmodules.
 	* trans.c (gfc_build_final_call): Handle coarrays.
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index e531deb147a..4024cd45652 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -3650,10 +3650,11 @@ gfc_check_sizeof (gfc_expr *arg)
    otherwise, it is set to NULL.  The msg string can be used in diagnostics.
    If c_loc is true, character with len > 1 are allowed (cf. Fortran
    2003corr5); additionally, assumed-shape/assumed-rank/deferred-shape
-   arrays are permitted.  */
+   arrays are permitted. And if c_f_ptr is true, deferred-shape arrays
+   are permitted. */
 
 static bool
-is_c_interoperable (gfc_expr *expr, const char **msg, bool c_loc)
+is_c_interoperable (gfc_expr *expr, const char **msg, bool c_loc, bool c_f_ptr)
 {
   *msg = NULL;
 
@@ -3734,7 +3735,8 @@ is_c_interoperable (gfc_expr *expr, const char **msg, bool c_loc)
 	  *msg = "Only whole-arrays are interoperable";
 	  return false;
 	}
-      if (ar->as->type != AS_EXPLICIT && ar->as->type != AS_ASSUMED_SIZE)
+      if (!c_f_ptr && ar->as->type != AS_EXPLICIT
+	  && ar->as->type != AS_ASSUMED_SIZE)
 	{
 	  *msg = "Only explicit-size and assumed-size arrays are interoperable";
 	  return false;
@@ -3750,7 +3752,7 @@ gfc_check_c_sizeof (gfc_expr *arg)
 {
   const char *msg;
 
-  if (!is_c_interoperable (arg, &msg, false))
+  if (!is_c_interoperable (arg, &msg, false, false))
     {
       gfc_error ("'%s' argument of '%s' intrinsic at %L must be an "
 		 "interoperable data entity: %s",
@@ -3900,7 +3902,7 @@ gfc_check_c_f_pointer (gfc_expr *cptr, gfc_expr *fptr, gfc_expr *shape)
       return false;
     }
 
-  if (!is_c_interoperable (fptr, &msg, false) && fptr->rank)
+  if (!is_c_interoperable (fptr, &msg, false, true))
     return gfc_notify_std (GFC_STD_F2008_TS, "Noninteroperable array FPTR "
 			   "at %L to C_F_POINTER: %s", &fptr->where, msg);
 
@@ -4029,7 +4031,7 @@ gfc_check_c_loc (gfc_expr *x)
       return false;
     }
 
-  if (!is_c_interoperable (x, &msg, true))
+  if (!is_c_interoperable (x, &msg, true, false))
     {
       if (x->ts.type == BT_CLASS)
 	{
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index c5120dd78b1..678bc5d844e 100644
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -3890,12 +3890,12 @@ match_inquire_element (gfc_inquire *inquire)
   RETM m = match_vtag (&tag_s_async, &inquire->asynchronous);
   RETM m = match_vtag (&tag_s_delim, &inquire->delim);
   RETM m = match_vtag (&tag_s_decimal, &inquire->decimal);
-  RETM m = match_vtag (&tag_size, &inquire->size);
+  RETM m = match_out_tag (&tag_size, &inquire->size);
   RETM m = match_vtag (&tag_s_encoding, &inquire->encoding);
   RETM m = match_vtag (&tag_s_round, &inquire->round);
   RETM m = match_vtag (&tag_s_sign, &inquire->sign);
   RETM m = match_vtag (&tag_s_pad, &inquire->pad);
-  RETM m = match_vtag (&tag_iolength, &inquire->iolength);
+  RETM m = match_out_tag (&tag_iolength, &inquire->iolength);
   RETM m = match_vtag (&tag_convert, &inquire->convert);
   RETM m = match_out_tag (&tag_strm_out, &inquire->strm_pos);
   RETM m = match_vtag (&tag_pending, &inquire->pending);
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 41e1dfbe87f..32b8332fa9e 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -333,13 +333,15 @@ init_result_expr (gfc_expr *e, int init, gfc_expr *array)
 }
 
 
-/* Helper function for gfc_simplify_dot_product() and gfc_simplify_matmul.  */
+/* Helper function for gfc_simplify_dot_product() and gfc_simplify_matmul;
+   if conj_a is true, the matrix_a is complex conjugated.  */
 
 static gfc_expr *
 compute_dot_product (gfc_expr *matrix_a, int stride_a, int offset_a,
-		     gfc_expr *matrix_b, int stride_b, int offset_b)
+		     gfc_expr *matrix_b, int stride_b, int offset_b,
+		     bool conj_a)
 {
-  gfc_expr *result, *a, *b;
+  gfc_expr *result, *a, *b, *c;
 
   result = gfc_get_constant_expr (matrix_a->ts.type, matrix_a->ts.kind,
 				  &matrix_a->where);
@@ -362,9 +364,11 @@ compute_dot_product (gfc_expr *matrix_a, int stride_a, int offset_a,
 	  case BT_INTEGER:
 	  case BT_REAL:
 	  case BT_COMPLEX:
-	    result = gfc_add (result,
-			      gfc_multiply (gfc_copy_expr (a),
-					    gfc_copy_expr (b)));
+	    if (conj_a && a->ts.type == BT_COMPLEX)
+	      c = gfc_simplify_conjg (a);
+	    else
+	      c = gfc_copy_expr (a);
+	    result = gfc_add (result, gfc_multiply (c, gfc_copy_expr (b)));
 	    break;
 
 	  default:
@@ -1882,7 +1886,7 @@ gfc_simplify_dot_product (gfc_expr *vector_a, gfc_expr *vector_b)
   gcc_assert (vector_b->rank == 1);
   gcc_assert (gfc_compare_types (&vector_a->ts, &vector_b->ts));
 
-  return compute_dot_product (vector_a, 1, 0, vector_b, 1, 0);
+  return compute_dot_product (vector_a, 1, 0, vector_b, 1, 0, true);
 }
 
 
@@ -3910,7 +3914,7 @@ gfc_simplify_matmul (gfc_expr *matrix_a, gfc_expr *matrix_b)
       for (row = 0; row < result_rows; ++row)
 	{
 	  gfc_expr *e = compute_dot_product (matrix_a, stride_a, offset_a,
-					     matrix_b, 1, offset_b);
+					     matrix_b, 1, offset_b, false);
 	  gfc_constructor_append_expr (&result->value.constructor,
 				       e, NULL);
 
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index fc3a725aa3d..6a8d98c9d60 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -4726,7 +4726,7 @@ generate_local_decl (gfc_symbol * sym)
 	gfc_get_symbol_decl (sym);
 
       /* Warnings for unused dummy arguments.  */
-      else if (sym->attr.dummy)
+      else if (sym->attr.dummy && !sym->attr.in_namelist)
 	{
 	  /* INTENT(out) dummy arguments are likely meant to be set.  */
 	  if (gfc_option.warn_unused_dummy_argument