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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a6490d1..b1c5864 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/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.
 

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 890b880..783583c 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/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)

diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index df8723b..56d8829 100644 (file)
--- a/gcc/fortran/trans-openmp.c
+++ b/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)

diff --git a/libgomp/ChangeLog b/libgomp/ChangeLog
index 278cba0..f93bfa5 100644 (file)
--- a/libgomp/ChangeLog
+++ b/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.

diff --git a/libgomp/testsuite/libgomp.fortran/retval2.f90 b/libgomp/testsuite/libgomp.fortran/retval2.f90
new file mode 100644 (file)
index 0000000..92da15f
--- /dev/null
+++ b/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