trans-openmp.c (gfc_trans_omp_variable): Handle references to parent result.

	* trans-openmp.c (gfc_trans_omp_variable): Handle references
	to parent result.
	* trans-expr.c (gfc_conv_variable): Remove useless setting
	of parent_flag, formatting.

	* testsuite/libgomp.fortran/retval2.f90: New test.

From-SVN: r112026

gcc/fortran/ChangeLog

 2006-03-13  Jakub Jelinek  <jakub@redhat.com>
 
+	* trans-openmp.c (gfc_trans_omp_variable): Handle references
+	to parent result.
+	* trans-expr.c (gfc_conv_variable): Remove useless setting
+	of parent_flag, formatting.
+
 	* trans-decl.c (gfc_get_fake_result_decl): Re-add setting of
 	GFC_DECL_RESULT flag.
 

gcc/fortran/trans-expr.c

@@ -324,34 +324,31 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
 
       /* Deal with references to a parent results or entries by storing
 	 the current_function_decl and moving to the parent_decl.  */
-      parent_flag = 0;
-
       return_value = sym->attr.function && sym->result == sym;
       alternate_entry = sym->attr.function && sym->attr.entry
-			  && sym->result == sym;
+			&& sym->result == sym;
       entry_master = sym->attr.result
-			&& sym->ns->proc_name->attr.entry_master
-			&& !gfc_return_by_reference (sym->ns->proc_name);
+		     && sym->ns->proc_name->attr.entry_master
+		     && !gfc_return_by_reference (sym->ns->proc_name);
       parent_decl = DECL_CONTEXT (current_function_decl);
 
       if ((se->expr == parent_decl && return_value)
-	    || (sym->ns  && sym->ns->proc_name
-		  && sym->ns->proc_name->backend_decl == parent_decl
-		  && (alternate_entry || entry_master)))
+	   || (sym->ns && sym->ns->proc_name
+	       && sym->ns->proc_name->backend_decl == parent_decl
+	       && (alternate_entry || entry_master)))
 	parent_flag = 1;
       else
 	parent_flag = 0;
 
       /* Special case for assigning the return value of a function.
 	 Self recursive functions must have an explicit return value.  */
-      if (sym->attr.function && sym->result == sym
-	    && (se->expr == current_function_decl || parent_flag))
+      if (return_value && (se->expr == current_function_decl || parent_flag))
 	se_expr = gfc_get_fake_result_decl (sym, parent_flag);
 
       /* Similarly for alternate entry points.  */
       else if (alternate_entry 
-		 && (sym->ns->proc_name->backend_decl == current_function_decl
-		        || parent_flag))
+	       && (sym->ns->proc_name->backend_decl == current_function_decl
+		   || parent_flag))
 	{
 	  gfc_entry_list *el = NULL;
 
@@ -364,8 +361,8 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
 	}
 
       else if (entry_master
-		 && (sym->ns->proc_name->backend_decl == current_function_decl
-			|| parent_flag))
+	       && (sym->ns->proc_name->backend_decl == current_function_decl
+		   || parent_flag))
 	se_expr = gfc_get_fake_result_decl (sym, parent_flag);
 
       if (se_expr)

gcc/fortran/trans-openmp.c

@@ -182,40 +182,56 @@ gfc_trans_add_clause (tree node, tree tail)
   return node;
 }
 
-/* TODO make references to parent function results, as done in
-   gfc_conv_variable.  */
-
 static tree
 gfc_trans_omp_variable (gfc_symbol *sym)
 {
   tree t = gfc_get_symbol_decl (sym);
+  tree parent_decl;
+  int parent_flag;
+  bool return_value;
+  bool alternate_entry;
+  bool entry_master;
+
+  return_value = sym->attr.function && sym->result == sym;
+  alternate_entry = sym->attr.function && sym->attr.entry
+		    && sym->result == sym;
+  entry_master = sym->attr.result
+		 && sym->ns->proc_name->attr.entry_master
+		 && !gfc_return_by_reference (sym->ns->proc_name);
+  parent_decl = DECL_CONTEXT (current_function_decl);
+
+  if ((t == parent_decl && return_value)
+       || (sym->ns && sym->ns->proc_name
+	   && sym->ns->proc_name->backend_decl == parent_decl
+	   && (alternate_entry || entry_master)))
+    parent_flag = 1;
+  else
+    parent_flag = 0;
 
   /* Special case for assigning the return value of a function.
      Self recursive functions must have an explicit return value.  */
-  if (t == current_function_decl && sym->attr.function
-      && (sym->result == sym))
-    t = gfc_get_fake_result_decl (sym, 0);
+  if (return_value && (t == current_function_decl || parent_flag))
+    t = gfc_get_fake_result_decl (sym, parent_flag);
 
   /* Similarly for alternate entry points.  */
-  else if (sym->attr.function && sym->attr.entry
-	   && (sym->result == sym)
-	   && sym->ns->proc_name->backend_decl == current_function_decl)
+  else if (alternate_entry
+	   && (sym->ns->proc_name->backend_decl == current_function_decl
+	       || parent_flag))
     {
       gfc_entry_list *el = NULL;
 
       for (el = sym->ns->entries; el; el = el->next)
 	if (sym == el->sym)
 	  {
-	    t = gfc_get_fake_result_decl (sym, 0);
+	    t = gfc_get_fake_result_decl (sym, parent_flag);
 	    break;
 	  }
     }
 
-  else if (sym->attr.result
-	   && sym->ns->proc_name->backend_decl == current_function_decl
-	   && sym->ns->proc_name->attr.entry_master
-	   && !gfc_return_by_reference (sym->ns->proc_name))
-    t = gfc_get_fake_result_decl (sym, 0);
+  else if (entry_master
+	   && (sym->ns->proc_name->backend_decl == current_function_decl
+	       || parent_flag))
+    t = gfc_get_fake_result_decl (sym, parent_flag);
 
   return t;
 }
@@ -408,7 +424,7 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where)
 
 static tree
 gfc_trans_omp_reduction_list (gfc_namelist *namelist, tree list, 
-                              enum tree_code reduction_code, locus where)
+			      enum tree_code reduction_code, locus where)
 {
   for (; namelist != NULL; namelist = namelist->next)
     if (namelist->sym->attr.referenced)

libgomp/ChangeLog

+2006-03-13  Jakub Jelinek  <jakub@redhat.com>
+
+	* testsuite/libgomp.fortran/retval2.f90: New test.
+
 2006-03-09  Diego Novillo  <dnovillo@redhat.com>
 
 	* testsuite/libgomp.c++: New directory.

libgomp/testsuite/libgomp.fortran/retval2.f90

+! { dg-do run }
+
+function f1 ()
+  real :: f1
+  f1 = 6.5
+  call sub1
+contains
+  subroutine sub1
+    use omp_lib
+    logical :: l
+    l = .false.
+!$omp parallel firstprivate (f1) num_threads (2) reduction (.or.:l)
+    l = f1 .ne. 6.5
+    if (omp_get_thread_num () .eq. 0) f1 = 8.5
+    if (omp_get_thread_num () .eq. 1) f1 = 14.5
+!$omp barrier
+    l = l .or. (omp_get_thread_num () .eq. 0 .and. f1 .ne. 8.5)
+    l = l .or. (omp_get_thread_num () .eq. 1 .and. f1 .ne. 14.5)
+!$omp end parallel
+    if (l) call abort
+    f1 = -2.5
+  end subroutine sub1
+end function f1
+
+  real :: f1
+  if (f1 () .ne. -2.5) call abort
+end