From: jakub Date: Mon, 13 Mar 2006 21:44:04 +0000 (+0000) Subject: * trans-openmp.c (gfc_trans_omp_variable): Handle references X-Git-Url: http://git.sourceforge.jp/view?p=pf3gnuchains%2Fgcc-fork.git;a=commitdiff_plain;h=b01f72f32ae72d8b3c5a5b76693b696ab3fa2cb3 * 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@112026 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index a6490d190ce..b1c5864f6d0 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,5 +1,10 @@ 2006-03-13 Jakub Jelinek + * 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 890b880158f..783583caac8 100644 --- 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 df8723b29b5..56d88296935 100644 --- 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 278cba07e3c..f93bfa56371 100644 --- a/libgomp/ChangeLog +++ b/libgomp/ChangeLog @@ -1,3 +1,7 @@ +2006-03-13 Jakub Jelinek + + * testsuite/libgomp.fortran/retval2.f90: New test. + 2006-03-09 Diego Novillo * 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 index 00000000000..92da15f58f1 --- /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