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

@@ -1,5 +1,10 @@
 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,8 +324,6 @@ 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;
@@ -344,8 +342,7 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
 
       /* 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
+      if (return_value && (se->expr == current_function_decl || parent_flag))
-	    && (se->expr == current_function_decl || parent_flag))
 	se_expr = gfc_get_fake_result_decl (sym, parent_flag);
 
       /* Similarly for alternate entry points.  */

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
+  if (return_value && (t == current_function_decl || parent_flag))
-      && (sym->result == sym))
+    t = gfc_get_fake_result_decl (sym, parent_flag);
-    t = gfc_get_fake_result_decl (sym, 0);
 
   /* Similarly for alternate entry points.  */
-  else if (sym->attr.function && sym->attr.entry
+  else if (alternate_entry
-	   && (sym->result == sym)
+	   && (sym->ns->proc_name->backend_decl == current_function_decl
-	   && 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
+  else if (entry_master
-	   && sym->ns->proc_name->backend_decl == current_function_decl
+	   && (sym->ns->proc_name->backend_decl == current_function_decl
-	   && sym->ns->proc_name->attr.entry_master
+	       || parent_flag))
-	   && !gfc_return_by_reference (sym->ns->proc_name))
+    t = gfc_get_fake_result_decl (sym, parent_flag);
-    t = gfc_get_fake_result_decl (sym, 0);
 
   return t;
 }

libgomp/ChangeLog

@@ -1,3 +1,7 @@
+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

@@ -0,0 +1,27 @@
+! { 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