aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJakub Jelinek <jakub@redhat.com>2006-03-13 22:44:04 +0100
committerJakub Jelinek <jakub@gcc.gnu.org>2006-03-13 22:44:04 +0100
commit11a5f60849d2c6b080eac43e496ffec1b3e93219 (patch)
treea57d6f733c78bc82586aadfe97600fb307eae75f
parent4b8ae4dbb7b517474580c4e7a6f15fb4c8bb3e8d (diff)
downloadgcc-11a5f60849d2c6b080eac43e496ffec1b3e93219.zip
gcc-11a5f60849d2c6b080eac43e496ffec1b3e93219.tar.gz
gcc-11a5f60849d2c6b080eac43e496ffec1b3e93219.tar.bz2
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
-rw-r--r--gcc/fortran/ChangeLog5
-rw-r--r--gcc/fortran/trans-expr.c25
-rw-r--r--gcc/fortran/trans-openmp.c48
-rw-r--r--libgomp/ChangeLog4
-rw-r--r--libgomp/testsuite/libgomp.fortran/retval2.f9027
5 files changed, 79 insertions, 30 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a6490d1..b1c5864 100644
--- 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
--- 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
--- 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
--- 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
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