2008-04-05 Basile Starynkevitch <basile@starynkevitch.net>

	MELT branch merged with trunk r133930



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

12 files changed, 132 insertions, 70 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 67dc49b7da8..851008ed395 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,64 @@
+2008-04-03  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/35786
+	* openmp.c (resolve_omp_clauses): Diagnose if a clause symbol
+	isn't a variable.
+
+2008-04-03  Tom Tromey  <tromey@redhat.com>
+
+	* Make-lang.in (fortran_OBJS): New variable.
+
+2008-04-03  Paolo Bonzini  <bonzini@gnu.org>
+
+        * f95-lang.c (insert_block): Kill.
+
+2008-04-01  George Helffrich <george@gcc.gnu.org>
+
+	* trans-common.c (create_common):  Add decl to function
+	chain to preserve identifier scope in debug output.
+
+2008-04-01  Joseph Myers  <joseph@codesourcery.com>
+
+	* gfortran.texi: Include gpl_v3.texi instead of gpl.texi
+	* Make-lang.in (GFORTRAN_TEXI): Include gpl_v3.texi instead of
+	gpl.texi.
+
+2008-03-30  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/35740
+	* resolve.c (resolve_function, resolve_call): If the procedure
+	is elemental do not look for noncopying intrinsics.
+
+2008-03-29  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/35698
+	* trans-array.c (gfc_array_init_size): Set 'size' zero if
+	negative in one dimension.
+
+	PR fortran/35702
+	* trans-expr.c (gfc_trans_string_copy): Only assign a char
+	directly if the lhs and rhs types are the same.
+
+2008-03-28  Daniel Franke  <franke.daniel@gmail.com>
+	    Paul Richard Thomas <paul.richard.thomas@gmail.com>
+
+	PR fortran/34714
+	* primary.c (match_variable): Improved matching of function 
+	result variables.
+	* resolve.c (resolve_allocate_deallocate): Removed checks if
+	the actual argument for STAT is a variable.
+
+2008-03-28  Tobias Burnus  <burnus@net-b.de>
+
+	* symbol.c (gfc_get_default_type): Fix error message; option
+	-fallow_leading_underscore should be -fallow-leading-underscore
+
+2008-03-27  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/35724
+	* iresolve.c (gfc_resolve_cshift): Check for NULL symtree in test for
+	optional argument attribute.
+
 2008-03-27  Tom Tromey  <tromey@redhat.com>
 
 	* Make-lang.in: Revert automatic dependency patch.
diff --git a/gcc/fortran/Make-lang.in b/gcc/fortran/Make-lang.in
index 1702b9f124f..bc9947b3942 100644
--- a/gcc/fortran/Make-lang.in
+++ b/gcc/fortran/Make-lang.in
@@ -1,6 +1,7 @@
 # -*- makefile -*-
 # Top level makefile fragment for GNU gfortran, the GNU Fortran 95 compiler.
-# Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+# Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software
+# Foundation, Inc.
 # Contributed by Paul Brook <paul@nowt.org
 # and Steven Bosscher <s.bosscher@student.tudelft.nl>
 
@@ -67,6 +68,8 @@ F95_OBJS = $(F95_PARSER_OBJS) \
     fortran/trans-intrinsic.o fortran/trans-io.o fortran/trans-openmp.o \
     fortran/trans-stmt.o fortran/trans-types.o
 
+fortran_OBJS = $(F95_OBJS) gfortranspec.o
+
 #
 # Define the names for selecting gfortran in LANGUAGES.
 fortran: f951$(exeext)
@@ -149,7 +152,7 @@ GFORTRAN_TEXI = \
   $(srcdir)/fortran/intrinsic.texi \
   $(srcdir)/fortran/invoke.texi \
   $(srcdir)/doc/include/fdl.texi \
-  $(srcdir)/doc/include/gpl.texi \
+  $(srcdir)/doc/include/gpl_v3.texi \
   $(srcdir)/doc/include/funding.texi \
   $(srcdir)/doc/include/gcc-common.texi \
   gcc-vers.texi
diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c
index 52c0a819025..4639d6c27b6 100644
--- a/gcc/fortran/f95-lang.c
+++ b/gcc/fortran/f95-lang.c
@@ -95,7 +95,6 @@ static void gfc_print_identifier (FILE *, tree, int);
 static bool gfc_mark_addressable (tree);
 void do_function_end (void);
 int global_bindings_p (void);
-void insert_block (tree);
 static void clear_binding_stack (void);
 static void gfc_be_parse_file (int);
 static alias_set_type gfc_get_alias_set (tree);
@@ -473,19 +472,6 @@ poplevel (int keep, int reverse, int functionbody)
 }
 
 
-/* Insert BLOCK at the end of the list of subblocks of the
-   current binding level.  This is used when a BIND_EXPR is expanded,
-   to handle the BLOCK node inside the BIND_EXPR.  */
-
-void
-insert_block (tree block)
-{
-  TREE_USED (block) = 1;
-  current_binding_level->blocks
-    = chainon (current_binding_level->blocks, block);
-}
-
-
 /* Records a ..._DECL node DECL as belonging to the current lexical scope.
    Returns the ..._DECL node.  */
 
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index afbfe03317f..085de7668da 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -1933,7 +1933,7 @@ Environment variable forcing standard output to be line buffered (unix).
 @c GNU General Public License
 @c ---------------------------------------------------------------------
 
-@include gpl.texi
+@include gpl_v3.texi
 
 
 
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index bdb6928c4a5..c166d8f2d60 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -597,7 +597,8 @@ gfc_resolve_cshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
  
   if (dim != NULL)
     {
-      if (dim->expr_type != EXPR_CONSTANT && dim->symtree->n.sym->attr.optional)
+      if (dim->expr_type != EXPR_CONSTANT && dim->symtree != NULL
+	  && dim->symtree->n.sym->attr.optional)
 	{
 	  /* Mark this for later setting the type in gfc_conv_missing_dummy.  */
 	  dim->representation.length = shift->ts.kind;
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 8c2d2577440..245f7951ddc 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -717,7 +717,41 @@ resolve_omp_clauses (gfc_code *code)
      a symbol can appear on both firstprivate and lastprivate.  */
   for (list = 0; list < OMP_LIST_NUM; list++)
     for (n = omp_clauses->lists[list]; n; n = n->next)
-      n->sym->mark = 0;
+      {
+	n->sym->mark = 0;
+	if (n->sym->attr.flavor == FL_VARIABLE)
+	  continue;
+	if (n->sym->attr.flavor == FL_PROCEDURE
+	    && n->sym->result == n->sym
+	    && n->sym->attr.function)
+	  {
+	    if (gfc_current_ns->proc_name == n->sym
+		|| (gfc_current_ns->parent
+		    && gfc_current_ns->parent->proc_name == n->sym))
+	      continue;
+	    if (gfc_current_ns->proc_name->attr.entry_master)
+	      {
+		gfc_entry_list *el = gfc_current_ns->entries;
+		for (; el; el = el->next)
+		  if (el->sym == n->sym)
+		    break;
+		if (el)
+		  continue;
+	      }
+	    if (gfc_current_ns->parent
+		&& gfc_current_ns->parent->proc_name->attr.entry_master)
+	      {
+		gfc_entry_list *el = gfc_current_ns->parent->entries;
+		for (; el; el = el->next)
+		  if (el->sym == n->sym)
+		    break;
+		if (el)
+		  continue;
+	      }
+	  }
+	gfc_error ("Object '%s' is not a variable at %L", n->sym->name,
+		   &code->loc);
+      }
 
   for (list = 0; list < OMP_LIST_NUM; list++)
     if (list != OMP_LIST_FIRSTPRIVATE && list != OMP_LIST_LASTPRIVATE)
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index f6b163503b3..8f85873ce03 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -2561,8 +2561,18 @@ match_variable (gfc_expr **result, int equiv_flag, int host_flag)
       break;
 
     case FL_PROCEDURE:
-      /* Check for a nonrecursive function result */
-      if (sym->attr.function && sym->result == sym && !sym->attr.external)
+      /* Check for a nonrecursive function result variable.  */
+      if (sym->attr.function
+          && !sym->attr.external
+          && sym->result == sym
+          && ((sym == gfc_current_ns->proc_name
+               && sym == gfc_current_ns->proc_name->result)
+              || (gfc_current_ns->parent
+                  && sym == gfc_current_ns->parent->proc_name->result)
+              || (sym->attr.entry
+                  && sym->ns == gfc_current_ns)
+              || (sym->attr.entry
+                  && sym->ns == gfc_current_ns->parent)))
 	{
 	  /* If a function result is a derived type, then the derived
 	     type may still have to be resolved.  */
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 0d39b2df849..af9ef55ce41 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -2374,7 +2374,12 @@ resolve_function (gfc_expr *expr)
       gfc_expr_set_symbols_referenced (expr->ts.cl->length);
     }
 
-  if (t == SUCCESS)
+  if (t == SUCCESS
+	&& !((expr->value.function.esym
+		&& expr->value.function.esym->attr.elemental)
+			||
+	     (expr->value.function.isym
+		&& expr->value.function.isym->elemental)))
     find_noncopying_intrinsics (expr->value.function.esym,
 				expr->value.function.actual);
 
@@ -2845,7 +2850,7 @@ resolve_call (gfc_code *c)
   if (resolve_elemental_actual (NULL, c) == FAILURE)
     return FAILURE;
 
-  if (t == SUCCESS)
+  if (t == SUCCESS && !(c->resolved_sym && c->resolved_sym->attr.elemental))
     find_noncopying_intrinsics (c->resolved_sym, c->ext.actual);
   return t;
 }
@@ -4878,7 +4883,6 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn)
 {
   gfc_symbol *s = NULL;
   gfc_alloc *a;
-  bool is_variable;
 
   if (code->expr)
     s = code->expr->symtree->n.sym;
@@ -4892,45 +4896,6 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn)
       if (gfc_pure (NULL) && gfc_impure_variable (s))
 	gfc_error ("Illegal STAT variable in %s statement at %C "
 		   "for a PURE procedure", fcn);
-
-      is_variable = false;
-      if (s->attr.flavor == FL_VARIABLE)
-	is_variable = true;
-      else if (s->attr.function && s->result == s
-		 && (gfc_current_ns->proc_name == s
-			||
-		    (gfc_current_ns->parent
-		       && gfc_current_ns->parent->proc_name == s)))
-	is_variable = true;
-      else if (gfc_current_ns->entries && s->result == s)
-	{
-	  gfc_entry_list *el;
-	  for (el = gfc_current_ns->entries; el; el = el->next)
-	    if (el->sym == s)
-	      {
-		is_variable = true;
-	      }
-	}
-      else if (gfc_current_ns->parent && gfc_current_ns->parent->entries
-	         && s->result == s)
-	{
-	  gfc_entry_list *el;
-	  for (el = gfc_current_ns->parent->entries; el; el = el->next)
-	    if (el->sym == s)
-	      {
-		is_variable = true;
-	      }
-	}
-
-      if (s->attr.flavor == FL_UNKNOWN
-	    && gfc_add_flavor (&s->attr, FL_VARIABLE,
-			       s->name, NULL) == SUCCESS)
-	is_variable = true;
-
-      if (!is_variable)
-	gfc_error ("STAT tag in %s statement at %L must be "
-		   "a variable", fcn, &code->expr->where);
-
     }
 
   if (s && code->expr->ts.type != BT_INTEGER)
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index c86fa9ae40e..6e878817363 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -212,7 +212,7 @@ gfc_get_default_type (gfc_symbol *sym, gfc_namespace *ns)
   letter = sym->name[0];
 
   if (gfc_option.flag_allow_leading_underscore && letter == '_')
-    gfc_internal_error ("Option -fallow_leading_underscore is for use only by "
+    gfc_internal_error ("Option -fallow-leading-underscore is for use only by "
 			"gfortran developers, and should not be used for "
 			"implicitly typed variables");
 
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 30b2a1ca611..3de1fb71f20 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -3505,7 +3505,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop)
         size = 1 - lbound;
         a.ubound[n] = specified_upper_bound;
         a.stride[n] = stride;
-        size = ubound + size; //size = ubound + 1 - lbound
+        size = siz >= 0 ? ubound + size : 0; //size = ubound + 1 - lbound
         stride = stride * size;
       }
     return (stride);
@@ -3605,6 +3605,9 @@ gfc_array_init_size (tree descriptor, int rank, tree * poffset,
       else
 	or_expr = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, or_expr, cond);
 
+      size = fold_build3 (COND_EXPR, gfc_array_index_type, cond,
+			  gfc_index_zero_node, size);
+
       /* Multiply the stride by the number of elements in this dimension.  */
       stride = fold_build2 (MULT_EXPR, gfc_array_index_type, stride, size);
       stride = gfc_evaluate_now (stride, pblock);
diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c
index 7086a6ceabd..f7042cb29d6 100644
--- a/gcc/fortran/trans-common.c
+++ b/gcc/fortran/trans-common.c
@@ -687,10 +687,7 @@ create_common (gfc_common_head *com, segment_info *head, bool saw_equiv)
       /* This is a fake variable just for debugging purposes.  */
       TREE_ASM_WRITTEN (var_decl) = 1;
 
-      if (com)
-	var_decl = pushdecl_top_level (var_decl);
-      else
-	gfc_add_decl_to_function (var_decl);
+      gfc_add_decl_to_function (var_decl);
 
       SET_DECL_VALUE_EXPR (var_decl,
 			   fold_build3 (COMPONENT_REF, TREE_TYPE (s->field),
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 9b33d378107..01672470331 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -2858,7 +2858,9 @@ gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest,
     dsc = gfc_to_single_character (dlen, dest);
 
 
-  if (dsc != NULL_TREE && ssc != NULL_TREE)
+  /* Assign directly if the types are compatible.  */
+  if (dsc != NULL_TREE && ssc != NULL_TREE
+	&& TREE_TYPE (dsc) == TREE_TYPE (ssc))
     {
       gfc_add_modify_expr (block, dsc, ssc);
       return;