This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[PATCH] OpenMP parent result references
- From: Jakub Jelinek <jakub at redhat dot com>
- To: Paul Thomas <pault at gcc dot gnu dot org>
- Cc: gcc-patches at gcc dot gnu dot org, fortran at gcc dot gnu dot org
- Date: Mon, 13 Mar 2006 15:52:10 -0500
- Subject: [PATCH] OpenMP parent result references
- Reply-to: Jakub Jelinek <jakub at redhat dot com>
Hi!
The following patch is a port of Paul's gfc_conv_variable changes
for gfc_trans_omp_variable. This fixes the attached testcase.
Ok for trunk?
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.
* testsuite/libgomp.fortran/retval2.f90: New test.
--- gcc/fortran/trans-openmp.c.jj 2006-03-12 09:51:28.000000000 +0100
+++ gcc/fortran/trans-openmp.c 2006-03-13 21:23:00.000000000 +0100
@@ -182,40 +182,56 @@ gfc_trans_add_clause (tree node, tree ta
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, g
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)
--- gcc/fortran/trans-expr.c.jj 2006-03-12 09:51:28.000000000 +0100
+++ gcc/fortran/trans-expr.c 2006-03-13 21:18:55.000000000 +0100
@@ -324,34 +324,31 @@ gfc_conv_variable (gfc_se * se, gfc_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
}
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)
--- libgomp/testsuite/libgomp.fortran/retval2.f90.jj 2006-03-13 21:27:28.000000000 +0100
+++ libgomp/testsuite/libgomp.fortran/retval2.f90 2006-03-13 21:35:09.000000000 +0100
@@ -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
Jakub