[gfortran] Add support for allocate clause (OpenMP 5.0).
Commit Message
This patch adds support for OpenMP 5.0 allocate clause for fortran. It does not
yet support the allocator-modifier as specified in OpenMP 5.1. The allocate
clause is already supported in C/C++.
gcc/fortran/ChangeLog:
* dump-parse-tree.c (show_omp_clauses): Handle OMP_LIST_ALLOCATE.
* gfortran.h (OMP_LIST_ALLOCATE): New enum value.
(allocate): New member in gfc_symbol.
* openmp.c (enum omp_mask1): Add OMP_CLAUSE_ALLOCATE.
(gfc_match_omp_clauses): Handle OMP_CLAUSE_ALLOCATE
(OMP_PARALLEL_CLAUSES, OMP_DO_CLAUSES, OMP_SECTIONS_CLAUSES)
(OMP_TASK_CLAUSES, OMP_TASKLOOP_CLAUSES, OMP_TARGET_CLAUSES)
(OMP_TEAMS_CLAUSES, OMP_DISTRIBUTE_CLAUSES)
(OMP_SINGLE_CLAUSES): Add OMP_CLAUSE_ALLOCATE.
(OMP_TASKGROUP_CLAUSES): New
(gfc_match_omp_taskgroup): Use 'OMP_TASKGROUP_CLAUSES' instead of
'OMP_CLAUSE_TASK_REDUCTION'
(resolve_omp_clauses): Handle OMP_LIST_ALLOCATE.
(resolve_omp_do): Avoid warning when loop iteration variable is
in allocate clause.
* trans-openmp.c (gfc_trans_omp_clauses): Handle translation of
allocate clause.
(gfc_split_omp_clauses): Update for OMP_LIST_ALLOCATE.
gcc/testsuite/ChangeLog:
* gfortran.dg/gomp/allocate-1.f90: New test.
* gfortran.dg/gomp/allocate-2.f90: New test.
* gfortran.dg/gomp/collapse1.f90: Update error message.
* gfortran.dg/gomp/openmp-simd-4.f90: Likewise.
libgomp/ChangeLog:
* testsuite/libgomp.fortran/allocate-1.c: New test.
* testsuite/libgomp.fortran/allocate-1.f90: New test.
---
gcc/fortran/dump-parse-tree.c | 1 +
gcc/fortran/gfortran.h | 5 +
gcc/fortran/openmp.c | 140 +++++++-
gcc/fortran/trans-openmp.c | 34 ++
gcc/testsuite/gfortran.dg/gomp/allocate-1.f90 | 123 +++++++
gcc/testsuite/gfortran.dg/gomp/allocate-2.f90 | 45 +++
gcc/testsuite/gfortran.dg/gomp/collapse1.f90 | 2 +-
.../gfortran.dg/gomp/openmp-simd-4.f90 | 6 +-
.../testsuite/libgomp.fortran/allocate-1.c | 7 +
.../testsuite/libgomp.fortran/allocate-1.f90 | 333 ++++++++++++++++++
10 files changed, 675 insertions(+), 21 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/gomp/allocate-1.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/allocate-2.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/allocate-1.c
create mode 100644 libgomp/testsuite/libgomp.fortran/allocate-1.f90
Comments
Hi all,
On 22.10.21 15:05, Hafiz Abid Qadeer wrote:
> This patch adds support for OpenMP 5.0 allocate clause for fortran. It does not
> yet support the allocator-modifier as specified in OpenMP 5.1. The allocate
> clause is already supported in C/C++.
I think the following shouldn't block the acceptance of the patch,
but I think we eventually need to handle the following as well:
type t
integer, allocatable :: xx(:)
end type
type(t) :: tt
class(t), allocatable :: cc
allocate(t :: cc)
tt%xx = [1,2,3,4,5,6]
cc%xx = [1,2,3,4,5,6]
! ...
!$omp task firstprivate(tt, cc) allocate(h)
...
In my spec reading, both tt/cc itself and tt%ii and cc%ii should
use the specified allocator.
And unless I missed something (I only glanced at the patch so far),
it is not handled.
But for derived types (except for recursive allocatables, valid since 5.1),
I think it can be handled in gfc_omp_clause_copy_ctor / gfc_omp_clause_dtor,
but I have not checked whether those support it properly.
For CLASS + recursive allocatables, it requires some more changes
(which might be provided by my derived-type deep copy patch,
of which only 1/3 has been written).
Tobias
PS: Just a side note, OpenMP has the following for Fortran:
"If any operation of the base language causes a reallocation
of a variable that is allocated with a memory allocator then
that memory allocator will be used to deallocate the current
memory and to allocate the new memory. For allocated
allocatable components of such variables, the allocator that
will be used for the deallocation and allocation is unspecified."
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
On Fri, Oct 22, 2021 at 02:05:02PM +0100, Hafiz Abid Qadeer wrote:
> This patch adds support for OpenMP 5.0 allocate clause for fortran. It does not
> yet support the allocator-modifier as specified in OpenMP 5.1. The allocate
> clause is already supported in C/C++.
>
> gcc/fortran/ChangeLog:
>
> * dump-parse-tree.c (show_omp_clauses): Handle OMP_LIST_ALLOCATE.
> * gfortran.h (OMP_LIST_ALLOCATE): New enum value.
> (allocate): New member in gfc_symbol.
> * openmp.c (enum omp_mask1): Add OMP_CLAUSE_ALLOCATE.
> (gfc_match_omp_clauses): Handle OMP_CLAUSE_ALLOCATE
Missing . at the end.
> (OMP_PARALLEL_CLAUSES, OMP_DO_CLAUSES, OMP_SECTIONS_CLAUSES)
> (OMP_TASK_CLAUSES, OMP_TASKLOOP_CLAUSES, OMP_TARGET_CLAUSES)
> (OMP_TEAMS_CLAUSES, OMP_DISTRIBUTE_CLAUSES)
> (OMP_SINGLE_CLAUSES): Add OMP_CLAUSE_ALLOCATE.
> (OMP_TASKGROUP_CLAUSES): New
Likewise.
> (gfc_match_omp_taskgroup): Use 'OMP_TASKGROUP_CLAUSES' instead of
> 'OMP_CLAUSE_TASK_REDUCTION'
Likewise. Please also drop the ' characters.
> @@ -1880,6 +1881,10 @@ typedef struct gfc_symbol
> according to the Fortran standard. */
> unsigned pass_as_value:1;
>
> + /* Used to check if a variable used in allocate clause has also been
> + used in privatization clause. */
> + unsigned allocate:1;
I think it would be desirable to use omp_allocate here instead
of allocate and mention OpenMP in the comment too.
Fortran has allocate statement in the language, so not pointing to
OpenMP would only cause confusion.
> @@ -1540,6 +1541,40 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
> }
> continue;
> }
> + if ((mask & OMP_CLAUSE_ALLOCATE)
> + && gfc_match ("allocate ( ") == MATCH_YES)
> + {
> + gfc_expr *allocator = NULL;
> + old_loc = gfc_current_locus;
> + m = gfc_match_expr (&allocator);
> + if (m != MATCH_YES)
> + {
> + gfc_error ("Expected allocator or variable list at %C");
> + goto error;
> + }
> + if (gfc_match (" : ") != MATCH_YES)
> + {
> + /* If no ":" then there is no allocator, we backtrack
> + and read the variable list. */
> + allocator = NULL;
Isn't this a memory leak? I believe Fortran FE expressions are not GC
allocated...
So, shouldn't there be gfc_free_expr or something similar before clearing it?
> + /* Check for 2 things here.
> + 1. There is no duplication of variable in allocate clause.
> + 2. Variable in allocate clause are also present in some
> + privatization clase. */
> + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
> + n->sym->allocate = 0;
> +
> + gfc_omp_namelist *prev = NULL;
> + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n;)
> + {
> + if (n->sym->allocate == 1)
> + {
> + gfc_warning (0, "%qs appears more than once in %<allocate%> "
> + "clauses at %L" , n->sym->name, &n->where);
> + /* We have already seen this variable so it is a duplicate.
> + Remove it. */
> + if (prev != NULL && prev->next == n)
> + {
> + prev->next = n->next;
> + n->next = NULL;
> + gfc_free_omp_namelist (n, 0);
> + n = prev->next;
> + }
> +
> + continue;
> + }
> + n->sym->allocate = 1;
> + prev = n;
> + n = n->next;
> + }
> +
> + for (list = 0; list < OMP_LIST_NUM; list++)
> + switch (list)
> + {
> + case OMP_LIST_PRIVATE:
> + case OMP_LIST_FIRSTPRIVATE:
> + case OMP_LIST_LASTPRIVATE:
> + case OMP_LIST_REDUCTION:
> + case OMP_LIST_REDUCTION_INSCAN:
> + case OMP_LIST_REDUCTION_TASK:
> + case OMP_LIST_IN_REDUCTION:
> + case OMP_LIST_TASK_REDUCTION:
> + case OMP_LIST_LINEAR:
> + for (n = omp_clauses->lists[list]; n; n = n->next)
> + n->sym->allocate = 0;
> + break;
> + default:
> + break;
> + }
> +
> + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
> + if (n->sym->allocate == 1)
> + gfc_error ("%qs specified in 'allocate' clause at %L but not in an "
> + "explicit privatization clause", n->sym->name, &n->where);
I'm not sure this is what the standard says, certainly C/C++ FE do this
quite differently for combined/composite constructs.
In particular, we first split the clauses to the individual leaf constructs
in c_omp_split_clauses, which for allocate clause is even more complicated
because as clarified in 5.2:
"The effect of the allocate clause is as if it is applied to all leaf constructs that permit the clause
and to which a data-sharing attribute clause that may create a private copy of the same list item is
applied."
so there is the has_dup_allocate stuff, we first duplicate it to all leaf
constructs that allow the allocate clause and set has_dup_allocate if it is
put on more than one construct, and then if has_dup_allocate is set, do
more detailed processing. And finally then {,c_}finish_omp_clauses
diagnoses what you are trying above, but only on each leaf construct
separately.
Now, Fortran is performing the splitting of clauses only much later in
trans-openmp.c, I wonder if it doesn't have other issues on
combined/composite constructs if it performs other checks only on the
clauses on the whole combined/composite construct and not just each leaf
separately. I'd say we should move that diagnostics and perhaps other
similar later on into a separate routine that is invoked only after the
clauses are split or for non-combined/composite construct clauses.
Jakub
On Tue, Nov 02, 2021 at 05:27:14PM +0100, Jakub Jelinek via Gcc-patches wrote:
> I'm not sure this is what the standard says, certainly C/C++ FE do this
> quite differently for combined/composite constructs.
> In particular, we first split the clauses to the individual leaf constructs
> in c_omp_split_clauses, which for allocate clause is even more complicated
> because as clarified in 5.2:
> "The effect of the allocate clause is as if it is applied to all leaf constructs that permit the clause
> and to which a data-sharing attribute clause that may create a private copy of the same list item is
> applied."
> so there is the has_dup_allocate stuff, we first duplicate it to all leaf
> constructs that allow the allocate clause and set has_dup_allocate if it is
> put on more than one construct, and then if has_dup_allocate is set, do
> more detailed processing. And finally then {,c_}finish_omp_clauses
> diagnoses what you are trying above, but only on each leaf construct
> separately.
>
> Now, Fortran is performing the splitting of clauses only much later in
> trans-openmp.c, I wonder if it doesn't have other issues on
> combined/composite constructs if it performs other checks only on the
> clauses on the whole combined/composite construct and not just each leaf
> separately. I'd say we should move that diagnostics and perhaps other
> similar later on into a separate routine that is invoked only after the
> clauses are split or for non-combined/composite construct clauses.
Testcases unrelated to allocate clause that have same problematic behavior:
void
foo (int x)
{
#pragma omp parallel for simd shared (x) private (x)
for (int i = 0; i < 32; i++)
;
}
is correctly accepted, as per
Clauses on Combined and Composite Constructs
shared clause goes to parallel construct, private goes to innermost
leaf aka simd, so there is no leaf construct with multiple data sharing
clauses for x.
But:
subroutine foo (x)
integer :: x, i
!$omp parallel do simd shared (x) private (x)
do i = 1, 32
end do
end subroutine
is incorrectly rejected with:
3 | !$omp parallel do simd shared (x) private (x)
| 1
Error: Symbol ‘x’ present on multiple clauses at (1)
Jakub
On 02/11/2021 16:27, Jakub Jelinek wrote:
> On Fri, Oct 22, 2021 at 02:05:02PM +0100, Hafiz Abid Qadeer wrote:
>> This patch adds support for OpenMP 5.0 allocate clause for fortran. It does not
>> yet support the allocator-modifier as specified in OpenMP 5.1. The allocate
>> clause is already supported in C/C++.
>>
>> gcc/fortran/ChangeLog:
>>
>> * dump-parse-tree.c (show_omp_clauses): Handle OMP_LIST_ALLOCATE.
>> * gfortran.h (OMP_LIST_ALLOCATE): New enum value.
>> (allocate): New member in gfc_symbol.
>> * openmp.c (enum omp_mask1): Add OMP_CLAUSE_ALLOCATE.
>> (gfc_match_omp_clauses): Handle OMP_CLAUSE_ALLOCATE
>
> Missing . at the end.
Done.
>
>> (OMP_PARALLEL_CLAUSES, OMP_DO_CLAUSES, OMP_SECTIONS_CLAUSES)
>> (OMP_TASK_CLAUSES, OMP_TASKLOOP_CLAUSES, OMP_TARGET_CLAUSES)
>> (OMP_TEAMS_CLAUSES, OMP_DISTRIBUTE_CLAUSES)
>> (OMP_SINGLE_CLAUSES): Add OMP_CLAUSE_ALLOCATE.
>> (OMP_TASKGROUP_CLAUSES): New
>
> Likewise.
Done.
>
>> (gfc_match_omp_taskgroup): Use 'OMP_TASKGROUP_CLAUSES' instead of
>> 'OMP_CLAUSE_TASK_REDUCTION'
>
> Likewise. Please also drop the ' characters.
Done.
>
>> @@ -1880,6 +1881,10 @@ typedef struct gfc_symbol
>> according to the Fortran standard. */
>> unsigned pass_as_value:1;
>>
>> + /* Used to check if a variable used in allocate clause has also been
>> + used in privatization clause. */
>> + unsigned allocate:1;
>
> I think it would be desirable to use omp_allocate here instead
> of allocate and mention OpenMP in the comment too.
> Fortran has allocate statement in the language, so not pointing to
> OpenMP would only cause confusion.
Done.
>
>> @@ -1540,6 +1541,40 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
>> }
>> continue;
>> }
>> + if ((mask & OMP_CLAUSE_ALLOCATE)
>> + && gfc_match ("allocate ( ") == MATCH_YES)
>> + {
>> + gfc_expr *allocator = NULL;
>> + old_loc = gfc_current_locus;
>> + m = gfc_match_expr (&allocator);
>> + if (m != MATCH_YES)
>> + {
>> + gfc_error ("Expected allocator or variable list at %C");
>> + goto error;
>> + }
>> + if (gfc_match (" : ") != MATCH_YES)
>> + {
>> + /* If no ":" then there is no allocator, we backtrack
>> + and read the variable list. */
>> + allocator = NULL;
>
> Isn't this a memory leak? I believe Fortran FE expressions are not GC
> allocated...
> So, shouldn't there be gfc_free_expr or something similar before clearing it?
Done. Also added a call to gfc_free_expr at the end to free it as n->expr points
to a copy.
>
>> + /* Check for 2 things here.
>> + 1. There is no duplication of variable in allocate clause.
>> + 2. Variable in allocate clause are also present in some
>> + privatization clase. */
>> + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
>> + n->sym->allocate = 0;
>> +
>> + gfc_omp_namelist *prev = NULL;
>> + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n;)
>> + {
>> + if (n->sym->allocate == 1)
>> + {
>> + gfc_warning (0, "%qs appears more than once in %<allocate%> "
>> + "clauses at %L" , n->sym->name, &n->where);
>> + /* We have already seen this variable so it is a duplicate.
>> + Remove it. */
>> + if (prev != NULL && prev->next == n)
>> + {
>> + prev->next = n->next;
>> + n->next = NULL;
>> + gfc_free_omp_namelist (n, 0);
>> + n = prev->next;
>> + }
>> +
>> + continue;
>> + }
>> + n->sym->allocate = 1;
>> + prev = n;
>> + n = n->next;
>> + }
>> +
>> + for (list = 0; list < OMP_LIST_NUM; list++)
>> + switch (list)
>> + {
>> + case OMP_LIST_PRIVATE:
>> + case OMP_LIST_FIRSTPRIVATE:
>> + case OMP_LIST_LASTPRIVATE:
>> + case OMP_LIST_REDUCTION:
>> + case OMP_LIST_REDUCTION_INSCAN:
>> + case OMP_LIST_REDUCTION_TASK:
>> + case OMP_LIST_IN_REDUCTION:
>> + case OMP_LIST_TASK_REDUCTION:
>> + case OMP_LIST_LINEAR:
>> + for (n = omp_clauses->lists[list]; n; n = n->next)
>> + n->sym->allocate = 0;
>> + break;
>> + default:
>> + break;
>> + }
>> +
>> + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
>> + if (n->sym->allocate == 1)
>> + gfc_error ("%qs specified in 'allocate' clause at %L but not in an "
>> + "explicit privatization clause", n->sym->name, &n->where);
>
> I'm not sure this is what the standard says, certainly C/C++ FE do this
> quite differently for combined/composite constructs.
> In particular, we first split the clauses to the individual leaf constructs
> in c_omp_split_clauses, which for allocate clause is even more complicated
> because as clarified in 5.2:
> "The effect of the allocate clause is as if it is applied to all leaf constructs that permit the clause
> and to which a data-sharing attribute clause that may create a private copy of the same list item is
> applied."
> so there is the has_dup_allocate stuff, we first duplicate it to all leaf
> constructs that allow the allocate clause and set has_dup_allocate if it is
> put on more than one construct, and then if has_dup_allocate is set, do
> more detailed processing. And finally then {,c_}finish_omp_clauses
> diagnoses what you are trying above, but only on each leaf construct
> separately.
>
> Now, Fortran is performing the splitting of clauses only much later in
> trans-openmp.c, I wonder if it doesn't have other issues on
> combined/composite constructs if it performs other checks only on the
> clauses on the whole combined/composite construct and not just each leaf
> separately. I'd say we should move that diagnostics and perhaps other
> similar later on into a separate routine that is invoked only after the
> clauses are split or for non-combined/composite construct clauses.
Updated patch keeps the old code but restricts it to non-composite case. For composite constructs, I
have added code at the end of gfc_split_omp_clauses to copy allocate clause to all leaf constructs
which allow it and have a privatization clause. A new testcase checks for error in this case.
Thanks
On Thu, Nov 18, 2021 at 07:30:36PM +0000, Hafiz Abid Qadeer wrote:
> + if (gfc_match (" : ") != MATCH_YES)
> + {
> + /* If no ":" then there is no allocator, we backtrack
> + and read the variable list. */
> + gfc_free_expr (allocator);
> + allocator = NULL;
> + gfc_current_locus = old_loc;
> + }
Ok, no leak above.
> +
> + gfc_omp_namelist **head = NULL;
> + m = gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_ALLOCATE],
> + false, NULL, &head);
> +
> + if (m == MATCH_ERROR)
> + break;
But here it leaks. Just call gfc_free_expr (allocator); before break.
> +
> + gfc_omp_namelist *n;
> + for (n = *head; n; n = n->next)
> + if (allocator)
> + n->expr = gfc_copy_expr (allocator);
> + else
> + n->expr = NULL;
> + gfc_free_expr (allocator);
> + continue;
> + }
> if ((mask & OMP_CLAUSE_AT)
> && (m = gfc_match_dupl_check (c->at == OMP_AT_UNSET, "at", true))
> != MATCH_NO)
> + if (omp_clauses->lists[OMP_LIST_ALLOCATE])
> + {
> + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
> + if (n->expr && (n->expr->ts.type != BT_INTEGER
> + || n->expr->ts.kind != gfc_c_intptr_kind))
> + {
> + gfc_error ("Expected integer expression of the "
> + "'omp_allocator_handle_kind' kind at %L", &n->expr->where);
Formatting, "' should be indented below "Expected
> + break;
> + }
> +
> + /* Check for 2 things here.
> + 1. There is no duplication of variable in allocate clause.
> + 2. Variable in allocate clause are also present in some
> + privatization clase (non-composite case). */
> + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
> + n->sym->omp_allocate_clause = 0;
> +
> + gfc_omp_namelist *prev = NULL;
> + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n;)
> + {
> + if (n->sym->omp_allocate_clause == 1)
> + {
> + gfc_warning (0, "%qs appears more than once in %<allocate%> "
> + "clauses at %L" , n->sym->name, &n->where);
> + /* We have already seen this variable so it is a duplicate.
> + Remove it. */
> + if (prev != NULL && prev->next == n)
> + {
> + prev->next = n->next;
> + n->next = NULL;
> + gfc_free_omp_namelist (n, 0);
> + n = prev->next;
> + }
> + continue;
> + }
> + n->sym->omp_allocate_clause = 1;
> + prev = n;
> + n = n->next;
> + }
> +
> + /* non-composite constructs. */
> + if (code && code->op < EXEC_OMP_DO_SIMD)
> + {
> + for (list = 0; list < OMP_LIST_NUM; list++)
> + switch (list)
> + {
> + case OMP_LIST_PRIVATE:
> + case OMP_LIST_FIRSTPRIVATE:
> + case OMP_LIST_LASTPRIVATE:
> + case OMP_LIST_REDUCTION:
> + case OMP_LIST_REDUCTION_INSCAN:
> + case OMP_LIST_REDUCTION_TASK:
> + case OMP_LIST_IN_REDUCTION:
> + case OMP_LIST_TASK_REDUCTION:
> + case OMP_LIST_LINEAR:
> + for (n = omp_clauses->lists[list]; n; n = n->next)
> + n->sym->omp_allocate_clause = 0;
> + break;
> + default:
> + break;
> + }
> +
> + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
> + if (n->sym->omp_allocate_clause == 1)
> + gfc_error ("%qs specified in 'allocate' clause at %L but not "
> + "in an explicit privatization clause",
> + n->sym->name, &n->where);
> + }
> + }
Do you really need a new omp_allocate_clause bit? From what I can see,
other code uses n->sym->mark for such purposes (temporarily marking some
symbols).
Also, I think allocate clause like the privatization clauses should allow
common blocks and I see code that uses the marks uses something like:
for (list = OMP_LIST_TO; list != OMP_LIST_NUM;
list = (list == OMP_LIST_TO ? OMP_LIST_LINK : OMP_LIST_NUM))
for (n = c->lists[list]; n; n = n->next)
if (n->sym)
n->sym->mark = 0;
else if (n->u.common->head)
n->u.common->head->mark = 0;
So, a question is if the above won't just crash if I specify
firstprivate(/foobar/) allocate(/foobar/)
etc.
> + case OMP_LIST_ALLOCATE:
> + for (; n != NULL; n = n->next)
> + if (n->sym->attr.referenced || declare_simd)
!$omp declare simd doesn't allow allocate clause, so why the
above " || declare_simd"?
> + {
> + tree t = gfc_trans_omp_variable (n->sym, declare_simd);
And not , false); above?
Jakub
Hi Jakub
Thanks for the review. Please see comments inline. Also note that common block is now allowed in
allocate clause as per your comment so there is slight adjustment in the parsing code for that.
On 20/12/2021 20:06, Jakub Jelinek wrote:
> On Thu, Nov 18, 2021 at 07:30:36PM +0000, Hafiz Abid Qadeer wrote:
>> + if (gfc_match (" : ") != MATCH_YES)
>> + {
>> + /* If no ":" then there is no allocator, we backtrack
>> + and read the variable list. */
>> + gfc_free_expr (allocator);
>> + allocator = NULL;
>> + gfc_current_locus = old_loc;
>> + }
>
> Ok, no leak above.
>
>> +
>> + gfc_omp_namelist **head = NULL;
>> + m = gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_ALLOCATE],
>> + false, NULL, &head);
>> +
>> + if (m == MATCH_ERROR)
>> + break;
>
> But here it leaks. Just call gfc_free_expr (allocator); before break.
Done. Although code is a bit different from the last patch.
>
>> +
>> + gfc_omp_namelist *n;
>> + for (n = *head; n; n = n->next)
>> + if (allocator)
>> + n->expr = gfc_copy_expr (allocator);
>> + else
>> + n->expr = NULL;
>> + gfc_free_expr (allocator);
>> + continue;
>> + }
>> if ((mask & OMP_CLAUSE_AT)
>> && (m = gfc_match_dupl_check (c->at == OMP_AT_UNSET, "at", true))
>> != MATCH_NO)
>
>> + if (omp_clauses->lists[OMP_LIST_ALLOCATE])
>> + {
>> + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
>> + if (n->expr && (n->expr->ts.type != BT_INTEGER
>> + || n->expr->ts.kind != gfc_c_intptr_kind))
>> + {
>> + gfc_error ("Expected integer expression of the "
>> + "'omp_allocator_handle_kind' kind at %L", &n->expr->where);
>
> Formatting, "' should be indented below "Expected
Done.
>
>> + break;
>> + }
>> +
>> + /* Check for 2 things here.
>> + 1. There is no duplication of variable in allocate clause.
>> + 2. Variable in allocate clause are also present in some
>> + privatization clase (non-composite case). */
>> + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
>> + n->sym->omp_allocate_clause = 0;
>> +
>> + gfc_omp_namelist *prev = NULL;
>> + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n;)
>> + {
>> + if (n->sym->omp_allocate_clause == 1)
>> + {
>> + gfc_warning (0, "%qs appears more than once in %<allocate%> "
>> + "clauses at %L" , n->sym->name, &n->where);
>> + /* We have already seen this variable so it is a duplicate.
>> + Remove it. */
>> + if (prev != NULL && prev->next == n)
>> + {
>> + prev->next = n->next;
>> + n->next = NULL;
>> + gfc_free_omp_namelist (n, 0);
>> + n = prev->next;
>> + }
>> + continue;
>> + }
>> + n->sym->omp_allocate_clause = 1;
>> + prev = n;
>> + n = n->next;
>> + }
>> +
>> + /* non-composite constructs. */
>> + if (code && code->op < EXEC_OMP_DO_SIMD)
>> + {
>> + for (list = 0; list < OMP_LIST_NUM; list++)
>> + switch (list)
>> + {
>> + case OMP_LIST_PRIVATE:
>> + case OMP_LIST_FIRSTPRIVATE:
>> + case OMP_LIST_LASTPRIVATE:
>> + case OMP_LIST_REDUCTION:
>> + case OMP_LIST_REDUCTION_INSCAN:
>> + case OMP_LIST_REDUCTION_TASK:
>> + case OMP_LIST_IN_REDUCTION:
>> + case OMP_LIST_TASK_REDUCTION:
>> + case OMP_LIST_LINEAR:
>> + for (n = omp_clauses->lists[list]; n; n = n->next)
>> + n->sym->omp_allocate_clause = 0;
>> + break;
>> + default:
>> + break;
>> + }
>> +
>> + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
>> + if (n->sym->omp_allocate_clause == 1)
>> + gfc_error ("%qs specified in 'allocate' clause at %L but not "
>> + "in an explicit privatization clause",
>> + n->sym->name, &n->where);
>> + }
>> + }
>
> Do you really need a new omp_allocate_clause bit? From what I can see,
> other code uses n->sym->mark for such purposes (temporarily marking some
> symbols).
Done.
> Also, I think allocate clause like the privatization clauses should allow
> common blocks and I see code that uses the marks uses something like:
> for (list = OMP_LIST_TO; list != OMP_LIST_NUM;
> list = (list == OMP_LIST_TO ? OMP_LIST_LINK : OMP_LIST_NUM))
> for (n = c->lists[list]; n; n = n->next)
> if (n->sym)
> n->sym->mark = 0;
> else if (n->u.common->head)
> n->u.common->head->mark = 0;
> So, a question is if the above won't just crash if I specify
> firstprivate(/foobar/) allocate(/foobar/)
> etc.
I don't think we need to go and check n->u.common->head as gfc_match_omp_variable_list has already
done it for us. I have added tests to check allocate clause with common blocks and it works fine.
>
>> + case OMP_LIST_ALLOCATE:
>> + for (; n != NULL; n = n->next)
>> + if (n->sym->attr.referenced || declare_simd)
>
> !$omp declare simd doesn't allow allocate clause, so why the
> above " || declare_simd"?
It was an oversight. Fixed now.
>
>> + {
>> + tree t = gfc_trans_omp_variable (n->sym, declare_simd);
>
> And not , false); above?
Done.
Thanks,
On Tue, Jan 11, 2022 at 10:31:54PM +0000, Hafiz Abid Qadeer wrote:
> + gfc_omp_namelist *n;
> + for (n = *head; n; n = n->next)
Better
for (gfc_omp_namelist *n = *head; n; n = n->next)
as we are in C++ and n isn't used after the loop.
> + /* non-composite constructs. */
Capital N
Ok for trunk with these nits fixed, no need to repost.
Jakub
Hi Abid!
(Remember to CC <fortran@gcc.gnu.org> for 'gcc/fortran/' etc. changes.)
On 2022-01-11T22:31:54+0000, Hafiz Abid Qadeer <abid_qadeer@mentor.com> wrote:
> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-2.f90
> @@ -0,0 +1,45 @@
> +! { dg-do compile }
> +
> +module omp_lib_kinds
> + use iso_c_binding, only: c_int, c_intptr_t
> + implicit none
> + private :: c_int, c_intptr_t
> + integer, parameter :: omp_allocator_handle_kind = c_intptr_t
> +
> +end module
> +
> +subroutine foo(x)
> + use omp_lib_kinds
> + implicit none
> + integer :: x
> +
> + !$omp task allocate (x) ! { dg-error "'x' specified in 'allocate' clause at .1. but not in an explicit privatization clause" }
> + x=1
> + !$omp end task
> +
> + !$omp parallel allocate (x) ! { dg-error "'x' specified in 'allocate' clause at .1. but not in an explicit privatization clause" }
> + x=2
> + !$omp end parallel
> +
> + !$omp parallel allocate (x) shared (x) ! { dg-error "'x' specified in 'allocate' clause at .1. but not in an explicit privatization clause" }
> + x=3
> + !$omp end parallel
> +
> + !$omp parallel private (x) allocate (x) allocate (x) ! { dg-warning "'x' appears more than once in 'allocate' clauses at .1." }
> + x=4
> + !$omp end parallel
> +
> + !$omp parallel private (x) allocate (x, x) ! { dg-warning "'x' appears more than once in 'allocate' clauses at .1." }
> + x=5
> + !$omp end parallel
> +
> + !$omp parallel allocate (0: x) private(x) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." }
We do for x86_64 default '-m64', but for '-m32' and '-mx32' compilation,
we're not seeing this latter diagnostic:
PASS: gfortran.dg/gomp/allocate-1.f90 -O (test for excess errors)
PASS: gfortran.dg/gomp/allocate-2.f90 -O (test for errors, line 16)
PASS: gfortran.dg/gomp/allocate-2.f90 -O (test for errors, line 20)
PASS: gfortran.dg/gomp/allocate-2.f90 -O (test for errors, line 24)
FAIL: gfortran.dg/gomp/allocate-2.f90 -O (test for errors, line 36)
PASS: gfortran.dg/gomp/allocate-2.f90 -O (test for errors, line 40)
PASS: gfortran.dg/gomp/allocate-2.f90 -O (test for warnings, line 28)
PASS: gfortran.dg/gomp/allocate-2.f90 -O (test for warnings, line 32)
PASS: gfortran.dg/gomp/allocate-2.f90 -O (test for excess errors)
I suppose the reason is unintended congruence of data types? Would it
work to make 'x' a floating-point data type, for example -- or is this
meant to explicitly check certain integer data type characteristics?
Grüße
Thomas
> + x=6
> + !$omp end parallel
> +
> + !$omp parallel private (x) allocate (0.1 : x) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." }
> + x=7
> + !$omp end parallel
> +
> +end subroutine
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
Hi all,
On 14.01.22 10:10, Thomas Schwinge wrote:
>> + integer :: x
>> ...
>> + !$omp parallel allocate (0: x) private(x) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." }
> We do for x86_64 default '-m64', but for '-m32' and '-mx32' compilation,
> we're not seeing this latter diagnostic:
> FAIL: gfortran.dg/gomp/allocate-2.f90 -O (test for errors, line 36)
>
> I suppose the reason is unintended congruence of data types? Would it
> work to make 'x' a floating-point data type, for example -- or is this
> meant to explicitly check certain integer data type characteristics?
Alternatively, you could use 'integer(kind=1)' (which is a 1-byte/8-bits
type.) I assume we do not have any platform which still uses 8-bit
pointers and supports libgomp :-)
Tobias
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
On Fri, Jan 14, 2022 at 12:45:54PM +0100, Tobias Burnus wrote:
> On 14.01.22 10:10, Thomas Schwinge wrote:
> > > + integer :: x
> > > ...
> > > + !$omp parallel allocate (0: x) private(x) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." }
> > We do for x86_64 default '-m64', but for '-m32' and '-mx32' compilation,
> > we're not seeing this latter diagnostic:
> > FAIL: gfortran.dg/gomp/allocate-2.f90 -O (test for errors, line 36)
> >
> > I suppose the reason is unintended congruence of data types? Would it
> > work to make 'x' a floating-point data type, for example -- or is this
> > meant to explicitly check certain integer data type characteristics?
>
> Alternatively, you could use 'integer(kind=1)' (which is a 1-byte/8-bits
> type.) I assume we do not have any platform which still uses 8-bit
> pointers and supports libgomp :-)
If we want to check intptr_t, we should guard the dg-error with
"" { target { lp64 || llp64 } }
or so.
Otherwise yes, we can add some other kind and hope it is not the
same as omp_allocator_handle_kind. Or we can do both,
keep the current one with the target lp64 || llp64 and
add another one with some integer(kind=1).
Jakub
On 14.01.22 12:55, Jakub Jelinek via Fortran wrote:
> If we want to check intptr_t, we should guard the dg-error with
> "" { target { lp64 || llp64 } }
> or so.
Well, if we want to use intptr_t, we could use be explicitly as with:
use iso_c_binding, only: c_intptr_t
! use omp_lib, only: omp_allocator_handle_kind
... ('implicit none' etc.)
integer, parameter :: omp_allocator_handle_kind = c_intptr_t
...
integer(kind=omp_allocator_handle_kind)
(@Abid: The 'use omp_lib' line is commented as in gcc/testsuite/*/gomp/,
the OpenMP module/header from libgomp is not available - and then a
stub parameter is created.)
> Otherwise yes, we can add some other kind and hope it is not the
> same as omp_allocator_handle_kind. Or we can do both,
> keep the current one with the target lp64 || llp64 and
> add another one with some integer(kind=1).
For just testing something invalid, I think it makes more sense to just
set it to kind=1.
For checking the valid value, using c_intptr_t seems to make more sense
than restricting it to (l)l64.
Tobias
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
On 14/01/2022 12:20, Tobias Burnus wrote:
> On 14.01.22 12:55, Jakub Jelinek via Fortran wrote:
>> If we want to check intptr_t, we should guard the dg-error with
>> "" { target { lp64 || llp64 } }
>> or so.
>
> Well, if we want to use intptr_t, we could use be explicitly as with:
>
> use iso_c_binding, only: c_intptr_t
> ! use omp_lib, only: omp_allocator_handle_kind
> ... ('implicit none' etc.)
> integer, parameter :: omp_allocator_handle_kind = c_intptr_t
> ...
> integer(kind=omp_allocator_handle_kind)
>
> (@Abid: The 'use omp_lib' line is commented as in gcc/testsuite/*/gomp/,
> the OpenMP module/header from libgomp is not available - and then a
> stub parameter is created.)
>
>> Otherwise yes, we can add some other kind and hope it is not the
>> same as omp_allocator_handle_kind. Or we can do both,
>> keep the current one with the target lp64 || llp64 and
>> add another one with some integer(kind=1).
>
> For just testing something invalid, I think it makes more sense to just set it to kind=1.
>
> For checking the valid value, using c_intptr_t seems to make more sense than restricting it to (l)l64.
Problem was with the literal 0 having same kind as c_intptr_t for m32. So there was no diagnostic in
that case. I am going to change it 0_1 to make the test more robust.
Thanks,
Hi Abid!
On 2022-01-11T22:31:54+0000, Hafiz Abid Qadeer <abid_qadeer@mentor.com> wrote:
> From d1fb55bff497a20e6feefa50bd03890e7a903c0e Mon Sep 17 00:00:00 2001
> From: Hafiz Abid Qadeer <abidh@codesourcery.com>
> Date: Fri, 24 Sep 2021 10:04:12 +0100
> Subject: [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0).
>
> This patch adds support for OpenMP 5.0 allocate clause for fortran. It does not
> yet support the allocator-modifier as specified in OpenMP 5.1. The allocate
> clause is already supported in C/C++.
> libgomp/ChangeLog:
>
> * testsuite/libgomp.fortran/allocate-1.c: New test.
> * testsuite/libgomp.fortran/allocate-1.f90: New test.
I'm seeing this test case randomly/non-deterministically FAIL to execute,
differently on different systems and runs, for example:
libgomp:
libgomp:
libgomp: Out of memory allocating 4 bytesOut of memory allocating 4 bytes
libgomp:
libgomp:
libgomp: Out of memory allocating 168 bytes
libgomp: Out of memory allocating 4 bytes
libgomp: Out of memory allocating 4 bytes
libgomp: Out of memory allocating 4 bytes
I'd assume there's some concurrency issue: the problem disappears if I
manually specify a lowerish 'OMP_NUM_THREADS', and conversely, on a
system where I don't normally see the FAILs, I can trigger them with a
largish 'OMP_NUM_THREADS', such as 'OMP_NUM_THREADS=18' and higher.
For example:
Thread 10 "a.out" hit Breakpoint 1, omp_aligned_alloc (alignment=4, size=4, allocator=6326576) at [...]/source-gcc/libgomp/allocator.c:318
318 if (allocator_data)
(gdb) print *allocator_data
$1 = {memspace = omp_default_mem_space, alignment = 64, pool_size = 8192, used_pool_size = 8188, fb_data = omp_null_allocator, sync_hint = 3, access = 7, fallback = 12, pinned = 0, partition = 15}
Given the high 'used_pool_size', is that to be expected, and the test
case shouldn't be requesting "so much" memory? Or might the problem
actually be in 'libgomp/allocator.c' (not touched by your commit)?
All but Thread 10 are in 'gomp_team_barrier_wait_end' -- should memory
have been released at that point?
(gdb) thread apply 10 bt
Thread 10 (Thread 0x7ffff32e2700 (LWP 1601318)):
#0 omp_aligned_alloc (alignment=4, size=4, allocator=6326576) at [...]/source-gcc/libgomp/allocator.c:320
#1 0x00007ffff790b4db in GOMP_alloc (alignment=4, size=4, allocator=6326576) at [...]/source-gcc/libgomp/allocator.c:364
#2 0x0000000000401f3f in foo_._omp_fn.3 () at source-gcc/libgomp/testsuite/libgomp.fortran/allocate-1.f90:136
#3 0x00007ffff78f31e6 in gomp_thread_start (xdata=<optimized out>) at [...]/source-gcc/libgomp/team.c:129
#4 0x00007ffff789e609 in start_thread (arg=<optimized out>) at pthread_create.c:477
#5 0x00007ffff77c5293 in clone () at ../sysdeps/unix/sysv/linux/x86_64/clone.S:95
(gdb) thread apply 1 bt
Thread 1 (Thread 0x7ffff72ec1c0 (LWP 1601309)):
#0 futex_wait (val=96, addr=<optimized out>) at [...]/source-gcc/libgomp/config/linux/x86/futex.h:97
#1 do_wait (val=96, addr=<optimized out>) at [...]/source-gcc/libgomp/config/linux/wait.h:67
#2 gomp_team_barrier_wait_end (bar=<optimized out>, state=96) at [...]/source-gcc/libgomp/config/linux/bar.c:112
#3 0x0000000000401f53 in foo_._omp_fn.3 () at source-gcc/libgomp/testsuite/libgomp.fortran/allocate-1.f90:136
#4 0x00007ffff78ea4f2 in GOMP_parallel (fn=0x401e6b <foo_._omp_fn.3>, data=0x7fffffffd450, num_threads=18, flags=0) at [...]/source-gcc/libgomp/parallel.c:178
#5 0x00000000004012ab in foo (x=42, p=..., q=..., px=2, h=6326576, fl=0) at source-gcc/libgomp/testsuite/libgomp.fortran/allocate-1.f90:122
#6 0x00000000004018e9 in MAIN__ () at source-gcc/libgomp/testsuite/libgomp.fortran/allocate-1.f90:326
Manually compiling the test case, I see a lot of '-Wtabs' diagnostics
(can be ignored, I suppose), but also:
source-gcc/libgomp/testsuite/libgomp.fortran/allocate-1.f90:11:47:
11 | integer(c_int) function is_64bit_aligned (a) bind(C)
| 1
Warning: Variable ‘a’ at (1) is a dummy argument of the BIND(C) procedure ‘is_64bit_aligned’ but may not be C interoperable [-Wc-binding-type]
Is that something to worry about?
And:
source-gcc/libgomp/testsuite/libgomp.fortran/allocate-1.f90:31:19:
31 | integer :: n, n1, n2, n3, n4
| 1
Warning: Unused variable ‘n1’ declared at (1) [-Wunused-variable]
source-gcc/libgomp/testsuite/libgomp.fortran/allocate-1.f90:18:27:
18 | subroutine foo (x, p, q, px, h, fl)
| 1
Warning: Unused dummy argument ‘px’ at (1) [-Wunused-dummy-argument]
For reference, quoting below the new Fortran test case.
Grüße
Thomas
> --- /dev/null
> +++ b/libgomp/testsuite/libgomp.fortran/allocate-1.c
> @@ -0,0 +1,7 @@
> +#include <stdint.h>
> +
> +int
> +is_64bit_aligned_ (uintptr_t a)
> +{
> + return ( (a & 0x3f) == 0);
> +}
> --- /dev/null
> +++ b/libgomp/testsuite/libgomp.fortran/allocate-1.f90
> @@ -0,0 +1,333 @@
> +! { dg-do run }
> +! { dg-additional-sources allocate-1.c }
> +! { dg-prune-output "command-line option '-fintrinsic-modules-path=.*' is valid for Fortran but not for C" }
> +
> +module m
> + use omp_lib
> + use iso_c_binding
> + implicit none
> +
> + interface
> + integer(c_int) function is_64bit_aligned (a) bind(C)
> + import :: c_int
> + integer :: a
> + end
> + end interface
> +end module m
> +
> +subroutine foo (x, p, q, px, h, fl)
> + use omp_lib
> + use iso_c_binding
> + integer :: x
> + integer, dimension(4) :: p
> + integer, dimension(4) :: q
> + integer :: px
> + integer (kind=omp_allocator_handle_kind) :: h
> + integer :: fl
> +
> + integer :: y
> + integer :: r, i, i1, i2, i3, i4, i5
> + integer :: l, l3, l4, l5, l6
> + integer :: n, n1, n2, n3, n4
> + integer :: j2, j3, j4
> + integer, dimension(4) :: l2
> + integer, dimension(4) :: r2
> + integer, target :: xo
> + integer, target :: yo
> + integer, dimension(x) :: v
> + integer, dimension(x) :: w
> +
> + type s_type
> + integer :: a
> + integer :: b
> + end type
> +
> + type (s_type) :: s
> + s%a = 27
> + s%b = 29
> + y = 0
> + r = 0
> + n = 8
> + n2 = 9
> + n3 = 10
> + n4 = 11
> + xo = x
> + yo = y
> +
> + do i = 1, 4
> + r2(i) = 0;
> + end do
> +
> + do i = 1, 4
> + p(i) = 0;
> + end do
> +
> + do i = 1, 4
> + q(i) = 0;
> + end do
> +
> + do i = 1, x
> + w(i) = i
> + end do
> +
> + !$omp parallel private (y, v) firstprivate (x) allocate (x, y, v)
> + if (x /= 42) then
> + stop 1
> + end if
> + v(1) = 7
> + if ( (and(fl, 2) /= 0) .and. &
> + ((is_64bit_aligned(x) == 0) .or. &
> + (is_64bit_aligned(y) == 0) .or. &
> + (is_64bit_aligned(v(1)) == 0))) then
> + stop 2
> + end if
> +
> + !$omp barrier
> + y = 1;
> + x = x + 1
> + v(1) = 7
> + v(41) = 8
> + !$omp barrier
> + if (x /= 43 .or. y /= 1) then
> + stop 3
> + end if
> + if (v(1) /= 7 .or. v(41) /= 8) then
> + stop 4
> + end if
> + !$omp end parallel
> +
> + !$omp teams
> + !$omp parallel private (y) firstprivate (x, w) allocate (h: x, y, w)
> +
> + if (x /= 42 .or. w(17) /= 17 .or. w(41) /= 41) then
> + stop 5
> + end if
> + !$omp barrier
> + y = 1;
> + x = x + 1
> + w(19) = w(19) + 1
> + !$omp barrier
> + if (x /= 43 .or. y /= 1 .or. w(19) /= 20) then
> + stop 6
> + end if
> + if ( (and(fl, 1) /= 0) .and. &
> + ((is_64bit_aligned(x) == 0) .or. &
> + (is_64bit_aligned(y) == 0) .or. &
> + (is_64bit_aligned(w(1)) == 0))) then
> + stop 7
> + end if
> + !$omp end parallel
> + !$omp end teams
> +
> + !$omp parallel do private (y) firstprivate (x) reduction(+: r) allocate (h: x, y, r, l, n) lastprivate (l) linear (n: 16)
> + do i = 0, 63
> + if (x /= 42) then
> + stop 8
> + end if
> + y = 1;
> + l = i;
> + n = n + y + 15;
> + r = r + i;
> + if ( (and(fl, 1) /= 0) .and. &
> + ((is_64bit_aligned(x) == 0) .or. &
> + (is_64bit_aligned(y) == 0) .or. &
> + (is_64bit_aligned(r) == 0) .or. &
> + (is_64bit_aligned(l) == 0) .or. &
> + (is_64bit_aligned(n) == 0))) then
> + stop 9
> + end if
> + end do
> + !$omp end parallel do
> +
> + !$omp parallel
> + !$omp do lastprivate (l2) private (i1) allocate (h: l2, l3, i1) lastprivate (conditional: l3)
> + do i1 = 0, 63
> + l2(1) = i1
> + l2(2) = i1 + 1
> + l2(3) = i1 + 2
> + l2(4) = i1 + 3
> + if (i1 < 37) then
> + l3 = i1
> + end if
> + if ( (and(fl, 1) /= 0) .and. &
> + ((is_64bit_aligned(l2(1)) == 0) .or. &
> + (is_64bit_aligned(l3) == 0) .or. &
> + (is_64bit_aligned(i1) == 0))) then
> + stop 10
> + end if
> + end do
> +
> + !$omp do collapse(2) lastprivate(l4, i2, j2) linear (n2:17) allocate (h: n2, l4, i2, j2)
> + do i2 = 3, 4
> + do j2 = 17, 22, 2
> + n2 = n2 + 17
> + l4 = i2 * 31 + j2
> + if ( (and(fl, 1) /= 0) .and. &
> + ((is_64bit_aligned(l4) == 0) .or. &
> + (is_64bit_aligned(n2) == 0) .or. &
> + (is_64bit_aligned(i2) == 0) .or. &
> + (is_64bit_aligned(j2) == 0))) then
> + stop 11
> + end if
> + end do
> + end do
> +
> + !$omp do collapse(2) lastprivate(l5, i3, j3) linear (n3:17) schedule (static, 3) allocate (n3, l5, i3, j3)
> + do i3 = 3, 4
> + do j3 = 17, 22, 2
> + n3 = n3 + 17
> + l5 = i3 * 31 + j3
> + if ( (and(fl, 2) /= 0) .and. &
> + ((is_64bit_aligned(l5) == 0) .or. &
> + (is_64bit_aligned(n3) == 0) .or. &
> + (is_64bit_aligned(i3) == 0) .or. &
> + (is_64bit_aligned(j3) == 0))) then
> + stop 12
> + end if
> + end do
> + end do
> +
> + !$omp do collapse(2) lastprivate(l6, i4, j4) linear (n4:17) schedule (dynamic) allocate (h: n4, l6, i4, j4)
> + do i4 = 3, 4
> + do j4 = 17, 22,2
> + n4 = n4 + 17;
> + l6 = i4 * 31 + j4;
> + if ( (and(fl, 1) /= 0) .and. &
> + ((is_64bit_aligned(l6) == 0) .or. &
> + (is_64bit_aligned(n4) == 0) .or. &
> + (is_64bit_aligned(i4) == 0) .or. &
> + (is_64bit_aligned(j4) == 0))) then
> + stop 13
> + end if
> + end do
> + end do
> +
> + !$omp do lastprivate (i5) allocate (i5)
> + do i5 = 1, 17, 3
> + if ( (and(fl, 2) /= 0) .and. &
> + (is_64bit_aligned(i5) == 0)) then
> + stop 14
> + end if
> + end do
> +
> + !$omp do reduction(+:p, q, r2) allocate(h: p, q, r2)
> + do i = 0, 31
> + p(3) = p(3) + i;
> + p(4) = p(4) + (2 * i)
> + q(1) = q(1) + (3 * i)
> + q(3) = q(3) + (4 * i)
> + r2(1) = r2(1) + (5 * i)
> + r2(4) = r2(4) + (6 * i)
> + if ( (and(fl, 1) /= 0) .and. &
> + ((is_64bit_aligned(q(1)) == 0) .or. &
> + (is_64bit_aligned(p(1)) == 0) .or. &
> + (is_64bit_aligned(r2(1)) == 0) )) then
> + stop 15
> + end if
> + end do
> +
> + !$omp task private(y) firstprivate(x) allocate(x, y)
> + if (x /= 42) then
> + stop 16
> + end if
> +
> + if ( (and(fl, 2) /= 0) .and. &
> + ((is_64bit_aligned(x) == 0) .or. &
> + (is_64bit_aligned(y) == 0) )) then
> + stop 17
> + end if
> + !$omp end task
> +
> + !$omp task private(y) firstprivate(x) allocate(h: x, y)
> + if (x /= 42) then
> + stop 16
> + end if
> +
> + if ( (and(fl, 1) /= 0) .and. &
> + ((is_64bit_aligned(x) == 0) .or. &
> + (is_64bit_aligned(y) == 0) )) then
> + stop 17
> + end if
> + !$omp end task
> +
> + !$omp task private(y) firstprivate(s) allocate(s, y)
> + if (s%a /= 27 .or. s%b /= 29) then
> + stop 18
> + end if
> +
> + if ( (and(fl, 2) /= 0) .and. &
> + ((is_64bit_aligned(s%a) == 0) .or. &
> + (is_64bit_aligned(y) == 0) )) then
> + stop 19
> + end if
> + !$omp end task
> +
> + !$omp task private(y) firstprivate(s) allocate(h: s, y)
> + if (s%a /= 27 .or. s%b /= 29) then
> + stop 18
> + end if
> +
> + if ( (and(fl, 1) /= 0) .and. &
> + ((is_64bit_aligned(s%a) == 0) .or. &
> + (is_64bit_aligned(y) == 0) )) then
> + stop 19
> + end if
> + !$omp end task
> +
> + !$omp end parallel
> +
> + if (r /= ((64 * 63) / 2) .or. l /= 63 .or. n /= (8 + 16 * 64)) then
> + stop 20
> + end if
> +
> + if (l2(1) /= 63 .or. l2(2) /= 64 .or. l2(3) /= 65 .or. l2(4) /= 66 .or. l3 /= 36) then
> + stop 21
> + end if
> +
> + if (i2 /= 5 .or. j2 /= 23 .or. n2 /= (9 + (17 * 6)) .or. l4 /= (4 * 31 + 21)) then
> + stop 22
> + end if
> +
> + if (i3 /= 5 .or. j3 /= 23 .or. n3 /= (10 + (17 * 6)) .or. l5 /= (4 * 31 + 21)) then
> + stop 23
> + end if
> +
> + if (i4 /= 5 .or. j4 /= 23 .or. n4 /= (11 + (17 * 6)) .or. l6 /= (4 * 31 + 21)) then
> + stop 24
> + end if
> +
> + if (i5 /= 19) then
> + stop 24
> + end if
> +
> + if (p(3) /= ((32 * 31) / 2) .or. p(4) /= (2 * p(3)) &
> + .or. q(1) /= (3 * p(3)) .or. q(3) /= (4 * p(3)) &
> + .or. r2(1) /= (5 * p(3)) .or. r2(4) /= (6 * p(3))) then
> + stop 25
> + end if
> +
> +end subroutine
> +
> +program main
> + use omp_lib
> + integer, dimension(4) :: p
> + integer, dimension(4) :: q
> +
> + type (omp_alloctrait) :: traits(3)
> + integer (omp_allocator_handle_kind) :: a
> +
> + traits = [omp_alloctrait (omp_atk_alignment, 64), &
> + omp_alloctrait (omp_atk_fallback, omp_atv_null_fb), &
> + omp_alloctrait (omp_atk_pool_size, 8192)]
> + a = omp_init_allocator (omp_default_mem_space, 3, traits)
> + if (a == omp_null_allocator) stop 1
> +
> + call omp_set_default_allocator (omp_default_mem_alloc);
> + call foo (42, p, q, 2, a, 0);
> + call foo (42, p, q, 2, omp_default_mem_alloc, 0);
> + call foo (42, p, q, 2, a, 1);
> + call omp_set_default_allocator (a);
> + call foo (42, p, q, 2, omp_null_allocator, 3);
> + call foo (42, p, q, 2, omp_default_mem_alloc, 2);
> + call omp_destroy_allocator (a);
> +end
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
On 21.01.22 18:15, Thomas Schwinge wrote:
> source-gcc/libgomp/testsuite/libgomp.fortran/allocate-1.f90:11:47:
>
> 11 | integer(c_int) function is_64bit_aligned (a) bind(C)
> | 1
> Warning: Variable ‘a’ at (1) is a dummy argument of the BIND(C) procedure ‘is_64bit_aligned’ but may not be C interoperable [-Wc-binding-type]
>
> Is that something to worry about?
I think it is not very elegant – but should be okay.
On the Fortran side:
integer(c_int) function is_64bit_aligned (a) bind(C)
import :: c_int
integer :: a
end
that matches 'int is_64bit_aligned (int *a);'
While 'integer' in principle may not be 'int',
the call by reference makes this independent of the
actually used integer kind.
HOWEVER: That interface it not used! While it
defines that interface in 'module m', there is
no 'use m' in 'subroutine foo'.
(or alternatively: 'foo' being after 'contains' inside
the 'module m' - and then 'use m' in the main program)
That means that 'is_64bit_aligned(...)' gets implicitly
types as 'integer' with unknown arguments, which get
passed by value. By gfortran convention, that function
has a tailing underscore.
That matches the C side, which such an underscore:
int
is_64bit_aligned_ (uintptr_t a)
{
return ( (a & 0x3f) == 0);
}
With pass by reference, a pointer is passed, which
should be handled by 'uintptr_t'.
* * *
Side remark: I really recommend 'implicit none'
when writing Fortran code - which disables implicit
typing. I personally have started to use
implicit none (type, external)
which also rejects 'call something()' unless
'something' has been explicitly declared, e.g. by
an interface block.
* * *
Side remark: A Fortran-only variant has been used in
libgomp/testsuite/libgomp.fortran/alloc-11.f90:
if (mod (TRANSFER (p, iptr), 64) /= 0)
As optimization, also 'iand(..., z'3f') == 0' would work ;-)
Tobias
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
On 21.01.22 18:43, Tobias Burnus wrote:
> On 21.01.22 18:15, Thomas Schwinge wrote:
>> 11 | integer(c_int) function is_64bit_aligned (a) bind(C)
>> Warning: Variable ‘a’ at (1) is a dummy argument of the BIND(C)
>> procedure ‘is_64bit_aligned’ but may not be C interoperable
>> [-Wc-binding-type]
>>
>> Is that something to worry about?
I have attached a patch (not commited), which silences the three kind of
warnings and fixes the interface issue.
TODO: commit it.
On 21.01.22 18:15, Thomas Schwinge wrote:
> I'm seeing this test case randomly/non-deterministically FAIL to execute,
> differently on different systems and runs, for example: [...]
> I'd assume there's some concurrency issue: the problem disappears if I
> manually specify a lowerish 'OMP_NUM_THREADS'
If one compiles the program with -fsanitize=thread, it shows tons of errors :-(
The first one is:
WARNING: ThreadSanitizer: data race (pid=3034413)
Read of size 8 at 0x7fff8b5a8340 by thread T1:
#0 __m_MOD_foo._omp_fn.2 ../../libgomp/testsuite/libgomp.fortran/allocate-1.f90:116 (a.out+0x402a88)
#1 gomp_thread_start ../../../repos/gcc-trunk-commit/libgomp/team.c:129 (libgomp.so.1+0x1e5ed)
Previous write of size 8 at 0x7fff8b5a8340 by main thread:
#0 __m_MOD_foo._omp_fn.1 ../../libgomp/testsuite/libgomp.fortran/allocate-1.f90:116 (a.out+0x4029c0)
#1 GOMP_teams_reg ../../../repos/gcc-trunk-commit/libgomp/teams.c:51 (libgomp.so.1+0x3638c)
#2 MAIN__ ../../libgomp/testsuite/libgomp.fortran/allocate-1.f90:328 (a.out+0x4024c0)
#3 main ../../libgomp/testsuite/libgomp.fortran/allocate-1.f90:312 (a.out+0x4025b0)
Location is stack of main thread.
Location is global '<null>' at 0x000000000000 ([stack]+0x1f340)
Thread T1 (tid=3034416, running) created by main thread at:
#0 pthread_create ../../../../repos/gcc-trunk-commit/libsanitizer/tsan/tsan_interceptors_posix.cpp:1001 (libtsan.so.2+0x62c76)
#1 gomp_team_start ../../../repos/gcc-trunk-commit/libgomp/team.c:858 (libgomp.so.1+0x1ec18)
#2 MAIN__ ../../libgomp/testsuite/libgomp.fortran/allocate-1.f90:328 (a.out+0x4024c0)
#3 main ../../libgomp/testsuite/libgomp.fortran/allocate-1.f90:312 (a.out+0x4025b0)
SUMMARY: ThreadSanitizer: data race ../../libgomp/testsuite/libgomp.fortran/allocate-1.f90:116 in __m_MOD_foo._omp_fn.2
Tobias
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
On 24/01/2022 08:45, Tobias Burnus wrote:
> On 21.01.22 18:43, Tobias Burnus wrote:
>> On 21.01.22 18:15, Thomas Schwinge wrote:
>>> 11 | integer(c_int) function is_64bit_aligned (a) bind(C)
>>> Warning: Variable ‘a’ at (1) is a dummy argument of the BIND(C) procedure ‘is_64bit_aligned’
>>> but may not be C interoperable [-Wc-binding-type]
>>>
>>> Is that something to worry about?
> I have attached a patch (not commited), which silences the three kind of warnings and fixes the
> interface issue.
> TODO: commit it.
>
> On 21.01.22 18:15, Thomas Schwinge wrote:
>> I'm seeing this test case randomly/non-deterministically FAIL to execute,
>> differently on different systems and runs, for example: [...]
>> I'd assume there's some concurrency issue: the problem disappears if I
>> manually specify a lowerish 'OMP_NUM_THREADS'
>
> If one compiles the program with -fsanitize=thread, it shows tons of errors :-(
> The first one is:
>
> WARNING: ThreadSanitizer: data race (pid=3034413)
> Read of size 8 at 0x7fff8b5a8340 by thread T1:
> #0 __m_MOD_foo._omp_fn.2 ../../libgomp/testsuite/libgomp.fortran/allocate-1.f90:116
> (a.out+0x402a88)
> #1 gomp_thread_start ../../../repos/gcc-trunk-commit/libgomp/team.c:129 (libgomp.so.1+0x1e5ed)
>
> Previous write of size 8 at 0x7fff8b5a8340 by main thread:
> #0 __m_MOD_foo._omp_fn.1 ../../libgomp/testsuite/libgomp.fortran/allocate-1.f90:116
> (a.out+0x4029c0)
> #1 GOMP_teams_reg ../../../repos/gcc-trunk-commit/libgomp/teams.c:51 (libgomp.so.1+0x3638c)
> #2 MAIN__ ../../libgomp/testsuite/libgomp.fortran/allocate-1.f90:328 (a.out+0x4024c0)
> #3 main ../../libgomp/testsuite/libgomp.fortran/allocate-1.f90:312 (a.out+0x4025b0)
>
> Location is stack of main thread.
>
> Location is global '<null>' at 0x000000000000 ([stack]+0x1f340)
>
> Thread T1 (tid=3034416, running) created by main thread at:
> #0 pthread_create
> ../../../../repos/gcc-trunk-commit/libsanitizer/tsan/tsan_interceptors_posix.cpp:1001
> (libtsan.so.2+0x62c76)
> #1 gomp_team_start ../../../repos/gcc-trunk-commit/libgomp/team.c:858 (libgomp.so.1+0x1ec18)
> #2 MAIN__ ../../libgomp/testsuite/libgomp.fortran/allocate-1.f90:328 (a.out+0x4024c0)
> #3 main ../../libgomp/testsuite/libgomp.fortran/allocate-1.f90:312 (a.out+0x4025b0)
>
> SUMMARY: ThreadSanitizer: data race ../../libgomp/testsuite/libgomp.fortran/allocate-1.f90:116 in
> __m_MOD_foo._omp_fn.2
>
> Tobias
@Tobias: Thanks for your comments and the patch.
@Thomas: Thanks for reporting the problem. Did you notice similar behavior with
libgomp/testsuite/libgomp.c-c++-common/allocate-1.c? It was used as base for fortran testcase and it
shows similar warnings with -fthread=sanitize. I am trying to figure out if the problem you observed
is a general one or just specific to fortran testcase.
Hi!
On 2022-01-24T12:54:27+0000, Hafiz Abid Qadeer <abid_qadeer@mentor.com> wrote:
> On 24/01/2022 08:45, Tobias Burnus wrote:
>> On 21.01.22 18:15, Thomas Schwinge wrote:
>>> I'm seeing this test case randomly/non-deterministically FAIL to execute,
>>> differently on different systems and runs, for example: [...]
>>> I'd assume there's some concurrency issue: the problem disappears if I
>>> manually specify a lowerish 'OMP_NUM_THREADS'
>>
>> If one compiles the program with -fsanitize=thread, it shows tons of errors :-(
Confirmed.
> Did you notice similar behavior with
> libgomp/testsuite/libgomp.c-c++-common/allocate-1.c?
No, this one I always saw PASS. (... which only means so much, of
course...)
> It was used as base for fortran testcase and it
> shows similar warnings with -fthread=sanitize.
Confirmed.
> I am trying to figure out if the problem you observed
> is a general one or just specific to fortran testcase.
So, unless the '-fsanitize=thread' issues are bogus -- unlikely ;-) -- it
seems a latent issue generally, now fatal with
'libgomp.fortran/allocate-1.f90'.
Grüße
Thomas
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
On 25.01.22 10:19, Thomas Schwinge wrote:
>> I am trying to figure out if the problem you observed
>> is a general one or just specific to fortran testcase.
> So, unless the '-fsanitize=thread' issues are bogus -- unlikely ;-) -- it
> seems a latent issue generally, now fatal with
> 'libgomp.fortran/allocate-1.f90'.
There is one known issue with libgomp and TSAN (-fsanitize=thread)
that I tend to forget about :-(
That's according to Jakub, who wrote a while ago:
"TSAN doesn't understand what libgomp is doing, unless built with --disable-linux-futex"
However, I now tried to disable futex and still get the following.
(First result for libgomp.c-c++-common/allocate-1.c).
On the other hand, I have the feeling that the configure option is
a no op for libgomp. This can also be seen in the configure.ac script,
which only for libstdc++ uses the result and the others have a no-op
call to 'true' (alias ':'):
libgomp/configure.ac:GCC_LINUX_FUTEX(:)
libitm/configure.ac:GCC_LINUX_FUTEX(:)
libstdc++-v3/configure.ac:GCC_LINUX_FUTEX([AC_DEFINE(HAVE_LINUX_FUTEX, 1, [Define if futex syscall is available.])])
(The check is not completely pointless as some checks are still done;
e.g. 'SYS_gettid and SYS_futex required'.)
(TSAN did find issues in libgomp in the past, however. But those
habe been fixed.)
Thus, there might or might not be an issue when TSAN reports one.
* * *
Glancing at the Fortran testcase, I noted the following,
which probably does not cause the problems. But still,
I want to mention it:
!$omp parallel private (y, v) firstprivate (x) allocate (x, y, v)
if (x /= 42) then
stop 1
end if
v(1) = 7
if ( (and(fl, 2) /= 0) .and. &
((is_64bit_aligned(x) == 0) .or. &
(is_64bit_aligned(y) == 0) .or. &
(is_64bit_aligned(v(1)) == 0))) then
stop 2
end if
If one compares this with the C/C++ testcase, I note that there
is a barrier before the alignment check in C/C++ but not in
Fortran. Additionally, 'v(1) = 7' is set twice and the
alignment check happens earlier than in C/C++. Not that that
should really matter, but I just saw it.
In C/C++:
int v[x], w[x];
...
v[0] = 7;
v[41] = 8;
In Fortran:
integer, dimension(x) :: v
...
v(1) = 7
v(41) = 8
where 'x == 42'. The Fortran version is not really wrong, but I think
the idea is to set the first and last array element - and that's here
v(42) and not v(41).
BTW: Fortran permits to specify a different lower bound. When converting
C/C++ testcases, it can be useful to use the same lower bound also in
Fortran: integer :: v(0:x-1) (or: 'integer, dimension(0:x-1) :: v')
uses then 0 ... 41 for the indices instead of 1 ... 42.
But one has to be careful as Fortran uses the upper bound and C uses the
number of elements. (Same with OpenMP array sections in Fortran vs. C.)
Tobias
PS: The promised data-race warning:
==================
WARNING: ThreadSanitizer: data race (pid=4135381)
Read of size 8 at 0x7ffc0888bdc0 by thread T10:
#0 foo._omp_fn.2 libgomp.c-c++-common/allocate-1.c:47 (a.out+0x402c05)
#1 gomp_thread_start ../../../repos/gcc/libgomp/team.c:129 (libgomp.so.1+0x1e5ed)
Previous write of size 8 at 0x7ffc0888bdc0 by main thread:
#0 foo._omp_fn.1 libgomp.c-c++-common/allocate-1.c:47 (a.out+0x402aee)
#1 GOMP_teams_reg ../../../repos/gcc/libgomp/teams.c:51 (libgomp.so.1+0x3638c)
#2 main libgomp.c-c++-common/allocate-1.c:366 (a.out+0x40273e)
Location is stack of main thread.
Location is global '<null>' at 0x000000000000 ([stack]+0x1ddc0)
Thread T10 (tid=4135398, running) created by main thread at:
#0 pthread_create ../../../../repos/gcc/libsanitizer/tsan/tsan_interceptors_posix.cpp:1001 (libtsan.so.2+0x62c76)
#1 gomp_team_start ../../../repos/gcc/libgomp/team.c:858 (libgomp.so.1+0x1ec18)
#2 main libgomp.c-c++-common/allocate-1.c:366 (a.out+0x40273e)
SUMMARY: ThreadSanitizer: data race libgomp.c-c++-common/allocate-1.c:47 in foo._omp_fn.2
==================
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
On 25/01/2022 10:32, Tobias Burnus wrote:
> On 25.01.22 10:19, Thomas Schwinge wrote:
>>> I am trying to figure out if the problem you observed
>>> is a general one or just specific to fortran testcase.
>> So, unless the '-fsanitize=thread' issues are bogus -- unlikely ;-) -- it
>> seems a latent issue generally, now fatal with
>> 'libgomp.fortran/allocate-1.f90'.
>
> There is one known issue with libgomp and TSAN (-fsanitize=thread)
> that I tend to forget about :-(
>
> That's according to Jakub, who wrote a while ago:
>
> "TSAN doesn't understand what libgomp is doing, unless built with --disable-linux-futex"
>
>
>
> However, I now tried to disable futex and still get the following.
> (First result for libgomp.c-c++-common/allocate-1.c).
>
> On the other hand, I have the feeling that the configure option is
> a no op for libgomp. This can also be seen in the configure.ac script,
> which only for libstdc++ uses the result and the others have a no-op
> call to 'true' (alias ':'):
>
> libgomp/configure.ac:GCC_LINUX_FUTEX(:)
> libitm/configure.ac:GCC_LINUX_FUTEX(:)
> libstdc++-v3/configure.ac:GCC_LINUX_FUTEX([AC_DEFINE(HAVE_LINUX_FUTEX, 1, [Define if futex syscall
> is available.])])
>
> (The check is not completely pointless as some checks are still done;
> e.g. 'SYS_gettid and SYS_futex required'.)
>
> (TSAN did find issues in libgomp in the past, however. But those
> habe been fixed.)
>
>
> Thus, there might or might not be an issue when TSAN reports one.
>
> * * *
>
> Glancing at the Fortran testcase, I noted the following,
> which probably does not cause the problems. But still,
> I want to mention it:
>
> !$omp parallel private (y, v) firstprivate (x) allocate (x, y, v)
> if (x /= 42) then
> stop 1
> end if
>
> v(1) = 7
> if ( (and(fl, 2) /= 0) .and. &
> ((is_64bit_aligned(x) == 0) .or. &
> (is_64bit_aligned(y) == 0) .or. &
> (is_64bit_aligned(v(1)) == 0))) then
> stop 2
> end if
>
> If one compares this with the C/C++ testcase, I note that there
> is a barrier before the alignment check in C/C++ but not in
> Fortran. Additionally, 'v(1) = 7' is set twice and the
> alignment check happens earlier than in C/C++. Not that that
> should really matter, but I just saw it.
>
>
> In C/C++:
> int v[x], w[x];
> ...
> v[0] = 7;
> v[41] = 8;
>
> In Fortran:
> integer, dimension(x) :: v
> ...
> v(1) = 7
> v(41) = 8
>
> where 'x == 42'. The Fortran version is not really wrong, but I think
> the idea is to set the first and last array element - and that's here
> v(42) and not v(41).
>
> BTW: Fortran permits to specify a different lower bound. When converting
> C/C++ testcases, it can be useful to use the same lower bound also in
> Fortran: integer :: v(0:x-1) (or: 'integer, dimension(0:x-1) :: v')
> uses then 0 ... 41 for the indices instead of 1 ... 42.
>
> But one has to be careful as Fortran uses the upper bound and C uses the
> number of elements. (Same with OpenMP array sections in Fortran vs. C.)
>
>
> Tobias
>
> PS: The promised data-race warning:
> ==================
> WARNING: ThreadSanitizer: data race (pid=4135381)
> Read of size 8 at 0x7ffc0888bdc0 by thread T10:
> #0 foo._omp_fn.2 libgomp.c-c++-common/allocate-1.c:47 (a.out+0x402c05)
> #1 gomp_thread_start ../../../repos/gcc/libgomp/team.c:129 (libgomp.so.1+0x1e5ed)
>
> Previous write of size 8 at 0x7ffc0888bdc0 by main thread:
> #0 foo._omp_fn.1 libgomp.c-c++-common/allocate-1.c:47 (a.out+0x402aee)
> #1 GOMP_teams_reg ../../../repos/gcc/libgomp/teams.c:51 (libgomp.so.1+0x3638c)
> #2 main libgomp.c-c++-common/allocate-1.c:366 (a.out+0x40273e)
>
> Location is stack of main thread.
>
> Location is global '<null>' at 0x000000000000 ([stack]+0x1ddc0)
>
> Thread T10 (tid=4135398, running) created by main thread at:
> #0 pthread_create ../../../../repos/gcc/libsanitizer/tsan/tsan_interceptors_posix.cpp:1001
> (libtsan.so.2+0x62c76)
> #1 gomp_team_start ../../../repos/gcc/libgomp/team.c:858 (libgomp.so.1+0x1ec18)
> #2 main libgomp.c-c++-common/allocate-1.c:366 (a.out+0x40273e)
>
> SUMMARY: ThreadSanitizer: data race libgomp.c-c++-common/allocate-1.c:47 in foo._omp_fn.2
> ==================
>
Problem was with the pool_size trait. It has limited size which this testcase exceeded. I have
removed it now which seems to fix the problem. Ok to commit the attached patch?
Thanks,
Hi Tobias!
On 2022-01-24T09:45:48+0100, Tobias Burnus <tobias@codesourcery.com> wrote:
> On 21.01.22 18:43, Tobias Burnus wrote:
>> On 21.01.22 18:15, Thomas Schwinge wrote:
>>> 11 | integer(c_int) function is_64bit_aligned (a) bind(C)
>>> Warning: Variable ‘a’ at (1) is a dummy argument of the BIND(C)
>>> procedure ‘is_64bit_aligned’ but may not be C interoperable
>>> [-Wc-binding-type]
>>>
>>> Is that something to worry about?
> I have attached a patch (not commited), which silences the three kind of
> warnings and fixes the interface issue.
> TODO: commit it.
Still "TODO: commit it" ;-) -- and while I haven't reviewed the changes
in detail, I did spot one item that should be addressed, I suppose:
> --- a/libgomp/testsuite/libgomp.fortran/allocate-1.c
> +++ b/libgomp/testsuite/libgomp.fortran/allocate-1.c
> @@ -1,7 +1,7 @@
> #include <stdint.h>
>
> int
> -is_64bit_aligned_ (uintptr_t a)
> +is_64bit_aligned (uintptr_t a)
> {
> return ( (a & 0x3f) == 0);
> }
> --- a/libgomp/testsuite/libgomp.fortran/allocate-1.f90
> +++ b/libgomp/testsuite/libgomp.fortran/allocate-1.f90
> @@ -5,30 +5,30 @@
> module m
> use omp_lib
> use iso_c_binding
> - implicit none
> + implicit none (type, external)
>
> interface
> integer(c_int) function is_64bit_aligned (a) bind(C)
> import :: c_int
> - integer :: a
> + type(*) :: a
> end
> end interface
> -end module m
>
> -subroutine foo (x, p, q, px, h, fl)
> +contains
> +
> +subroutine foo (x, p, q, h, fl)
> use omp_lib
> use iso_c_binding
> integer :: x
> integer, dimension(4) :: p
> integer, dimension(4) :: q
> - integer :: px
> integer (kind=omp_allocator_handle_kind) :: h
> integer :: fl
>
> integer :: y
> integer :: r, i, i1, i2, i3, i4, i5
> integer :: l, l3, l4, l5, l6
> - integer :: n, n1, n2, n3, n4
> + integer :: n, n2, n3, n4
> integer :: j2, j3, j4
> integer, dimension(4) :: l2
> integer, dimension(4) :: r2
> @@ -118,6 +118,7 @@ subroutine foo (x, p, q, px, h, fl)
> end if
> !$omp end parallel
> !$omp end teams
> +stop
>
> !$omp parallel do private (y) firstprivate (x) reduction(+: r) allocate (h: x, y, r, l, n) lastprivate (l) linear (n: 16)
> do i = 0, 63
That early 'stop' should probably be backed out? ;-)
Grüße
Thomas
> @@ -153,77 +154,77 @@ subroutine foo (x, p, q, px, h, fl)
> ((is_64bit_aligned(l2(1)) == 0) .or. &
> (is_64bit_aligned(l3) == 0) .or. &
> (is_64bit_aligned(i1) == 0))) then
> - stop 10
> + stop 10
> end if
> end do
>
> !$omp do collapse(2) lastprivate(l4, i2, j2) linear (n2:17) allocate (h: n2, l4, i2, j2)
> do i2 = 3, 4
> do j2 = 17, 22, 2
> - n2 = n2 + 17
> - l4 = i2 * 31 + j2
> - if ( (and(fl, 1) /= 0) .and. &
> - ((is_64bit_aligned(l4) == 0) .or. &
> - (is_64bit_aligned(n2) == 0) .or. &
> - (is_64bit_aligned(i2) == 0) .or. &
> - (is_64bit_aligned(j2) == 0))) then
> - stop 11
> - end if
> + n2 = n2 + 17
> + l4 = i2 * 31 + j2
> + if ( (and(fl, 1) /= 0) .and. &
> + ((is_64bit_aligned(l4) == 0) .or. &
> + (is_64bit_aligned(n2) == 0) .or. &
> + (is_64bit_aligned(i2) == 0) .or. &
> + (is_64bit_aligned(j2) == 0))) then
> + stop 11
> + end if
> end do
> end do
>
> !$omp do collapse(2) lastprivate(l5, i3, j3) linear (n3:17) schedule (static, 3) allocate (n3, l5, i3, j3)
> do i3 = 3, 4
> do j3 = 17, 22, 2
> - n3 = n3 + 17
> - l5 = i3 * 31 + j3
> - if ( (and(fl, 2) /= 0) .and. &
> - ((is_64bit_aligned(l5) == 0) .or. &
> - (is_64bit_aligned(n3) == 0) .or. &
> - (is_64bit_aligned(i3) == 0) .or. &
> - (is_64bit_aligned(j3) == 0))) then
> - stop 12
> - end if
> + n3 = n3 + 17
> + l5 = i3 * 31 + j3
> + if ( (and(fl, 2) /= 0) .and. &
> + ((is_64bit_aligned(l5) == 0) .or. &
> + (is_64bit_aligned(n3) == 0) .or. &
> + (is_64bit_aligned(i3) == 0) .or. &
> + (is_64bit_aligned(j3) == 0))) then
> + stop 12
> + end if
> end do
> end do
>
> !$omp do collapse(2) lastprivate(l6, i4, j4) linear (n4:17) schedule (dynamic) allocate (h: n4, l6, i4, j4)
> do i4 = 3, 4
> do j4 = 17, 22,2
> - n4 = n4 + 17;
> - l6 = i4 * 31 + j4;
> - if ( (and(fl, 1) /= 0) .and. &
> - ((is_64bit_aligned(l6) == 0) .or. &
> - (is_64bit_aligned(n4) == 0) .or. &
> - (is_64bit_aligned(i4) == 0) .or. &
> - (is_64bit_aligned(j4) == 0))) then
> - stop 13
> - end if
> + n4 = n4 + 17;
> + l6 = i4 * 31 + j4;
> + if ( (and(fl, 1) /= 0) .and. &
> + ((is_64bit_aligned(l6) == 0) .or. &
> + (is_64bit_aligned(n4) == 0) .or. &
> + (is_64bit_aligned(i4) == 0) .or. &
> + (is_64bit_aligned(j4) == 0))) then
> + stop 13
> + end if
> end do
> end do
>
> !$omp do lastprivate (i5) allocate (i5)
> do i5 = 1, 17, 3
> if ( (and(fl, 2) /= 0) .and. &
> - (is_64bit_aligned(i5) == 0)) then
> - stop 14
> + (is_64bit_aligned(i5) == 0)) then
> + stop 14
> end if
> end do
>
> !$omp do reduction(+:p, q, r2) allocate(h: p, q, r2)
> do i = 0, 31
> - p(3) = p(3) + i;
> - p(4) = p(4) + (2 * i)
> - q(1) = q(1) + (3 * i)
> - q(3) = q(3) + (4 * i)
> - r2(1) = r2(1) + (5 * i)
> - r2(4) = r2(4) + (6 * i)
> - if ( (and(fl, 1) /= 0) .and. &
> - ((is_64bit_aligned(q(1)) == 0) .or. &
> - (is_64bit_aligned(p(1)) == 0) .or. &
> - (is_64bit_aligned(r2(1)) == 0) )) then
> - stop 15
> - end if
> + p(3) = p(3) + i;
> + p(4) = p(4) + (2 * i)
> + q(1) = q(1) + (3 * i)
> + q(3) = q(3) + (4 * i)
> + r2(1) = r2(1) + (5 * i)
> + r2(4) = r2(4) + (6 * i)
> + if ( (and(fl, 1) /= 0) .and. &
> + ((is_64bit_aligned(q(1)) == 0) .or. &
> + (is_64bit_aligned(p(1)) == 0) .or. &
> + (is_64bit_aligned(r2(1)) == 0) )) then
> + stop 15
> + end if
> end do
>
> !$omp task private(y) firstprivate(x) allocate(x, y)
> @@ -305,11 +306,13 @@ subroutine foo (x, p, q, px, h, fl)
> .or. r2(1) /= (5 * p(3)) .or. r2(4) /= (6 * p(3))) then
> stop 25
> end if
> -
> end subroutine
> +end module m
>
> program main
> use omp_lib
> + use m
> + implicit none (type, external)
> integer, dimension(4) :: p
> integer, dimension(4) :: q
>
> @@ -323,11 +326,11 @@ program main
> if (a == omp_null_allocator) stop 1
>
> call omp_set_default_allocator (omp_default_mem_alloc);
> - call foo (42, p, q, 2, a, 0);
> - call foo (42, p, q, 2, omp_default_mem_alloc, 0);
> - call foo (42, p, q, 2, a, 1);
> + call foo (42, p, q, a, 0);
> + call foo (42, p, q, omp_default_mem_alloc, 0);
> + call foo (42, p, q, a, 1);
> call omp_set_default_allocator (a);
> - call foo (42, p, q, 2, omp_null_allocator, 3);
> - call foo (42, p, q, 2, omp_default_mem_alloc, 2);
> + call foo (42, p, q, omp_null_allocator, 3);
> + call foo (42, p, q, omp_default_mem_alloc, 2);
> call omp_destroy_allocator (a);
> end
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
Hi!
On 2022-01-31T19:13:09+0000, Hafiz Abid Qadeer <abid_qadeer@mentor.com> wrote:
> On 25/01/2022 10:32, Tobias Burnus wrote:
>> On 25.01.22 10:19, Thomas Schwinge wrote:
>>>> I am trying to figure out if the problem you observed
>>>> is a general one or just specific to fortran testcase.
>>> So, unless the '-fsanitize=thread' issues are bogus -- unlikely ;-) -- it
>>> seems a latent issue generally, now fatal with
>>> 'libgomp.fortran/allocate-1.f90'.
>>
>> There is one known issue with libgomp and TSAN (-fsanitize=thread)
>> that I tend to forget about :-(
>>
>> That's according to Jakub, who wrote a while ago:
>>
>> "TSAN doesn't understand what libgomp is doing, unless built with --disable-linux-futex"
Uh. Anything that can reasonably be done to address this? At least, to
make this obvious to the user of '-fsanitize=thread'?
>> However, I now tried to disable futex and still get the following.
>> (First result for libgomp.c-c++-common/allocate-1.c).
>>
>> On the other hand, I have the feeling that the configure option is
>> a no op for libgomp. This can also be seen in the configure.ac script,
>> which only for libstdc++ uses the result and the others have a no-op
>> call to 'true' (alias ':'):
>>
>> libgomp/configure.ac:GCC_LINUX_FUTEX(:)
>> libitm/configure.ac:GCC_LINUX_FUTEX(:)
>> libstdc++-v3/configure.ac:GCC_LINUX_FUTEX([AC_DEFINE(HAVE_LINUX_FUTEX, 1, [Define if futex syscall
>> is available.])])
>>
>> (The check is not completely pointless as some checks are still done;
>> e.g. 'SYS_gettid and SYS_futex required'.)
Uh. That (make '--disable-linux-futex' work) should be fixed, I suppose?
>> (TSAN did find issues in libgomp in the past, however. But those
>> habe been fixed.)
>>
>>
>> Thus, there might or might not be an issue when TSAN reports one.
>>
>> * * *
>>
>> Glancing at the Fortran testcase, I noted the following,
>> which probably does not cause the problems. But still,
>> I want to mention it:
>>
>> !$omp parallel private (y, v) firstprivate (x) allocate (x, y, v)
>> if (x /= 42) then
>> stop 1
>> end if
>>
>> v(1) = 7
>> if ( (and(fl, 2) /= 0) .and. &
>> ((is_64bit_aligned(x) == 0) .or. &
>> (is_64bit_aligned(y) == 0) .or. &
>> (is_64bit_aligned(v(1)) == 0))) then
>> stop 2
>> end if
>>
>> If one compares this with the C/C++ testcase, I note that there
>> is a barrier before the alignment check in C/C++ but not in
>> Fortran. Additionally, 'v(1) = 7' is set twice and the
>> alignment check happens earlier than in C/C++. Not that that
>> should really matter, but I just saw it.
>>
>>
>> In C/C++:
>> int v[x], w[x];
>> ...
>> v[0] = 7;
>> v[41] = 8;
>>
>> In Fortran:
>> integer, dimension(x) :: v
>> ...
>> v(1) = 7
>> v(41) = 8
>>
>> where 'x == 42'. The Fortran version is not really wrong, but I think
>> the idea is to set the first and last array element - and that's here
>> v(42) and not v(41).
>>
>> BTW: Fortran permits to specify a different lower bound. When converting
>> C/C++ testcases, it can be useful to use the same lower bound also in
>> Fortran: integer :: v(0:x-1) (or: 'integer, dimension(0:x-1) :: v')
>> uses then 0 ... 41 for the indices instead of 1 ... 42.
>>
>> But one has to be careful as Fortran uses the upper bound and C uses the
>> number of elements. (Same with OpenMP array sections in Fortran vs. C.)
Abid, are you going to address these? I think it does make sense if the
C/C++ and Fortran test cases match as much as feasible.
>> PS: The promised data-race warning:
>> ==================
>> WARNING: ThreadSanitizer: data race (pid=4135381)
>> Read of size 8 at 0x7ffc0888bdc0 by thread T10:
>> #0 foo._omp_fn.2 libgomp.c-c++-common/allocate-1.c:47 (a.out+0x402c05)
>> #1 gomp_thread_start ../../../repos/gcc/libgomp/team.c:129 (libgomp.so.1+0x1e5ed)
>>
>> Previous write of size 8 at 0x7ffc0888bdc0 by main thread:
>> #0 foo._omp_fn.1 libgomp.c-c++-common/allocate-1.c:47 (a.out+0x402aee)
>> #1 GOMP_teams_reg ../../../repos/gcc/libgomp/teams.c:51 (libgomp.so.1+0x3638c)
>> #2 main libgomp.c-c++-common/allocate-1.c:366 (a.out+0x40273e)
>>
>> Location is stack of main thread.
>>
>> Location is global '<null>' at 0x000000000000 ([stack]+0x1ddc0)
>>
>> Thread T10 (tid=4135398, running) created by main thread at:
>> #0 pthread_create ../../../../repos/gcc/libsanitizer/tsan/tsan_interceptors_posix.cpp:1001
>> (libtsan.so.2+0x62c76)
>> #1 gomp_team_start ../../../repos/gcc/libgomp/team.c:858 (libgomp.so.1+0x1ec18)
>> #2 main libgomp.c-c++-common/allocate-1.c:366 (a.out+0x40273e)
>>
>> SUMMARY: ThreadSanitizer: data race libgomp.c-c++-common/allocate-1.c:47 in foo._omp_fn.2
>> ==================
>>
>
> Problem was with the pool_size trait. It has limited size which this testcase exceeded. I have
> removed it now which seems to fix the problem. Ok to commit the attached patch?
First, I do confirm that this (testing together with Tobias' patch "which
silences the three kind of warnings and fixes the interface issue" plus
my suggestion that the "early 'stop' [...] be backed out") does resolve
the execution FAILs, thanks.
However: really (a) remove 'omp_alloctrait (omp_atk_pool_size, 8192)'
altogether, or instead: (b) increase its size (if that can be computed)
-- and/or (c) limit the number of OpenMP threads executing in parallel?
Due to unfamiliarity with all that, I don't know what's best here.
Grüße
Thomas
> From 98b5493bd94520dd78b3963d3a4e67cba6bfb6aa Mon Sep 17 00:00:00 2001
> From: Hafiz Abid Qadeer <abidh@codesourcery.com>
> Date: Mon, 31 Jan 2022 19:02:14 +0000
> Subject: [PATCH] [libgomp] Fix testcase to remove out of memory error.
>
> Thomas reported in
> https://gcc.gnu.org/pipermail/gcc-patches/2022-January/589039.html
> that this testcase is randomly failing. The problem was fixed pool
> size which was exhausted when there were a lot of threads. Fixed it
> by removing pool_size trait which causes default pool size to be used
> which should be big enough.
>
> libgomp/ChangeLog:
>
> * testsuite/libgomp.fortran/allocate-1.f90: Remove pool_size trait.
> ---
> libgomp/testsuite/libgomp.fortran/allocate-1.f90 | 7 +++----
> 1 file changed, 3 insertions(+), 4 deletions(-)
>
> diff --git a/libgomp/testsuite/libgomp.fortran/allocate-1.f90 b/libgomp/testsuite/libgomp.fortran/allocate-1.f90
> index 35d1750b878..04bf2307462 100644
> --- a/libgomp/testsuite/libgomp.fortran/allocate-1.f90
> +++ b/libgomp/testsuite/libgomp.fortran/allocate-1.f90
> @@ -313,13 +313,12 @@ program main
> integer, dimension(4) :: p
> integer, dimension(4) :: q
>
> - type (omp_alloctrait) :: traits(3)
> + type (omp_alloctrait) :: traits(2)
> integer (omp_allocator_handle_kind) :: a
>
> traits = [omp_alloctrait (omp_atk_alignment, 64), &
> - omp_alloctrait (omp_atk_fallback, omp_atv_null_fb), &
> - omp_alloctrait (omp_atk_pool_size, 8192)]
> - a = omp_init_allocator (omp_default_mem_space, 3, traits)
> + omp_alloctrait (omp_atk_fallback, omp_atv_null_fb)]
> + a = omp_init_allocator (omp_default_mem_space, 2, traits)
> if (a == omp_null_allocator) stop 1
>
> call omp_set_default_allocator (omp_default_mem_alloc);
> --
> 2.25.1
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
On 04/02/2022 09:46, Thomas Schwinge wrote:
>
> Abid, are you going to address these? I think it does make sense if the
> C/C++ and Fortran test cases match as much as feasible.
>
Sure. I will do that.
> However: really (a) remove 'omp_alloctrait (omp_atk_pool_size, 8192)'
> altogether, or instead: (b) increase its size (if that can be computed)
> -- and/or (c) limit the number of OpenMP threads executing in parallel?
> Due to unfamiliarity with all that, I don't know what's best here.
>
C testcase also does not have the pool_size trait. So it makes sense to me to not have it in fortran
testcase too. It also seems more cleaner than putting some limits on number of threads or increasing
the size which will be a bit fragile.
Thanks,
On 04/02/2022 11:25, Hafiz Abid Qadeer wrote:
> On 04/02/2022 09:46, Thomas Schwinge wrote:
>
>>
>> Abid, are you going to address these? I think it does make sense if the
>> C/C++ and Fortran test cases match as much as feasible.
>>
> Sure. I will do that.
The attached patch address those issues apart from removing pool_size trait.
Thanks
On 05/02/2022 19:09, Hafiz Abid Qadeer wrote:
> On 04/02/2022 11:25, Hafiz Abid Qadeer wrote:
>> On 04/02/2022 09:46, Thomas Schwinge wrote:
>>
>>>
>>> Abid, are you going to address these? I think it does make sense if the
>>> C/C++ and Fortran test cases match as much as feasible.
>>>
>> Sure. I will do that.
>
> The attached patch address those issues apart from removing pool_size trait.
Is this change ok to commit?
Thanks,
@@ -1685,6 +1685,7 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
case OMP_LIST_USE_DEVICE_PTR: type = "USE_DEVICE_PTR"; break;
case OMP_LIST_USE_DEVICE_ADDR: type = "USE_DEVICE_ADDR"; break;
case OMP_LIST_NONTEMPORAL: type = "NONTEMPORAL"; break;
+ case OMP_LIST_ALLOCATE: type = "ALLOCATE"; break;
case OMP_LIST_SCAN_IN: type = "INCLUSIVE"; break;
case OMP_LIST_SCAN_EX: type = "EXCLUSIVE"; break;
default:
@@ -1388,6 +1388,7 @@ enum
OMP_LIST_USE_DEVICE_PTR,
OMP_LIST_USE_DEVICE_ADDR,
OMP_LIST_NONTEMPORAL,
+ OMP_LIST_ALLOCATE,
OMP_LIST_NUM
};
@@ -1880,6 +1881,10 @@ typedef struct gfc_symbol
according to the Fortran standard. */
unsigned pass_as_value:1;
+ /* Used to check if a variable used in allocate clause has also been
+ used in privatization clause. */
+ unsigned allocate:1;
+
int refs;
struct gfc_namespace *ns; /* namespace containing this symbol */
@@ -911,6 +911,7 @@ enum omp_mask1
OMP_CLAUSE_MEMORDER, /* OpenMP 5.0. */
OMP_CLAUSE_DETACH, /* OpenMP 5.0. */
OMP_CLAUSE_AFFINITY, /* OpenMP 5.0. */
+ OMP_CLAUSE_ALLOCATE, /* OpenMP 5.0. */
OMP_CLAUSE_BIND, /* OpenMP 5.0. */
OMP_CLAUSE_FILTER, /* OpenMP 5.1. */
OMP_CLAUSE_AT, /* OpenMP 5.1. */
@@ -1540,6 +1541,40 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
}
continue;
}
+ if ((mask & OMP_CLAUSE_ALLOCATE)
+ && gfc_match ("allocate ( ") == MATCH_YES)
+ {
+ gfc_expr *allocator = NULL;
+ old_loc = gfc_current_locus;
+ m = gfc_match_expr (&allocator);
+ if (m != MATCH_YES)
+ {
+ gfc_error ("Expected allocator or variable list at %C");
+ goto error;
+ }
+ if (gfc_match (" : ") != MATCH_YES)
+ {
+ /* If no ":" then there is no allocator, we backtrack
+ and read the variable list. */
+ allocator = NULL;
+ gfc_current_locus = old_loc;
+ }
+
+ gfc_omp_namelist **head = NULL;
+ m = gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_ALLOCATE],
+ false, NULL, &head);
+
+ if (m == MATCH_ERROR)
+ break;
+
+ gfc_omp_namelist *n;
+ for (n = *head; n; n = n->next)
+ if (allocator)
+ n->expr = gfc_copy_expr (allocator);
+ else
+ n->expr = NULL;
+ continue;
+ }
if ((mask & OMP_CLAUSE_AT)
&& (m = gfc_match_dupl_check (c->at == OMP_AT_UNSET, "at", true))
!= MATCH_NO)
@@ -3511,7 +3546,7 @@ cleanup:
(omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \
| OMP_CLAUSE_SHARED | OMP_CLAUSE_COPYIN | OMP_CLAUSE_REDUCTION \
| OMP_CLAUSE_IF | OMP_CLAUSE_NUM_THREADS | OMP_CLAUSE_DEFAULT \
- | OMP_CLAUSE_PROC_BIND)
+ | OMP_CLAUSE_PROC_BIND | OMP_CLAUSE_ALLOCATE)
#define OMP_DECLARE_SIMD_CLAUSES \
(omp_mask (OMP_CLAUSE_SIMDLEN) | OMP_CLAUSE_LINEAR \
| OMP_CLAUSE_UNIFORM | OMP_CLAUSE_ALIGNED | OMP_CLAUSE_INBRANCH \
@@ -3520,15 +3555,16 @@ cleanup:
(omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \
| OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION \
| OMP_CLAUSE_SCHEDULE | OMP_CLAUSE_ORDERED | OMP_CLAUSE_COLLAPSE \
- | OMP_CLAUSE_LINEAR | OMP_CLAUSE_ORDER)
+ | OMP_CLAUSE_LINEAR | OMP_CLAUSE_ORDER | OMP_CLAUSE_ALLOCATE)
#define OMP_LOOP_CLAUSES \
(omp_mask (OMP_CLAUSE_BIND) | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_ORDER \
| OMP_CLAUSE_PRIVATE | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION)
+
#define OMP_SCOPE_CLAUSES \
(omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_REDUCTION)
#define OMP_SECTIONS_CLAUSES \
(omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \
- | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION)
+ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_ALLOCATE)
#define OMP_SIMD_CLAUSES \
(omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_LASTPRIVATE \
| OMP_CLAUSE_REDUCTION | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_SAFELEN \
@@ -3539,19 +3575,22 @@ cleanup:
| OMP_CLAUSE_SHARED | OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT \
| OMP_CLAUSE_UNTIED | OMP_CLAUSE_FINAL | OMP_CLAUSE_MERGEABLE \
| OMP_CLAUSE_DEPEND | OMP_CLAUSE_PRIORITY | OMP_CLAUSE_IN_REDUCTION \
- | OMP_CLAUSE_DETACH | OMP_CLAUSE_AFFINITY)
+ | OMP_CLAUSE_DETACH | OMP_CLAUSE_AFFINITY | OMP_CLAUSE_ALLOCATE)
#define OMP_TASKLOOP_CLAUSES \
(omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \
| OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_SHARED | OMP_CLAUSE_IF \
| OMP_CLAUSE_DEFAULT | OMP_CLAUSE_UNTIED | OMP_CLAUSE_FINAL \
| OMP_CLAUSE_MERGEABLE | OMP_CLAUSE_PRIORITY | OMP_CLAUSE_GRAINSIZE \
| OMP_CLAUSE_NUM_TASKS | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_NOGROUP \
- | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_IN_REDUCTION)
+ | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_IN_REDUCTION | OMP_CLAUSE_ALLOCATE)
+#define OMP_TASKGROUP_CLAUSES \
+ (omp_mask (OMP_CLAUSE_TASK_REDUCTION) | OMP_CLAUSE_ALLOCATE)
#define OMP_TARGET_CLAUSES \
(omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF \
| OMP_CLAUSE_DEPEND | OMP_CLAUSE_NOWAIT | OMP_CLAUSE_PRIVATE \
| OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_DEFAULTMAP \
- | OMP_CLAUSE_IS_DEVICE_PTR | OMP_CLAUSE_IN_REDUCTION)
+ | OMP_CLAUSE_IS_DEVICE_PTR | OMP_CLAUSE_IN_REDUCTION \
+ | OMP_CLAUSE_ALLOCATE)
#define OMP_TARGET_DATA_CLAUSES \
(omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF \
| OMP_CLAUSE_USE_DEVICE_PTR | OMP_CLAUSE_USE_DEVICE_ADDR)
@@ -3567,13 +3606,14 @@ cleanup:
#define OMP_TEAMS_CLAUSES \
(omp_mask (OMP_CLAUSE_NUM_TEAMS) | OMP_CLAUSE_THREAD_LIMIT \
| OMP_CLAUSE_DEFAULT | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \
- | OMP_CLAUSE_SHARED | OMP_CLAUSE_REDUCTION)
+ | OMP_CLAUSE_SHARED | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_ALLOCATE)
#define OMP_DISTRIBUTE_CLAUSES \
(omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \
| OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_DIST_SCHEDULE \
- | OMP_CLAUSE_ORDER)
+ | OMP_CLAUSE_ORDER | OMP_CLAUSE_ALLOCATE)
#define OMP_SINGLE_CLAUSES \
- (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE)
+ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \
+ | OMP_CLAUSE_ALLOCATE)
#define OMP_ORDERED_CLAUSES \
(omp_mask (OMP_CLAUSE_THREADS) | OMP_CLAUSE_SIMD)
#define OMP_DECLARE_TARGET_CLAUSES \
@@ -5836,7 +5876,7 @@ gfc_match_omp_barrier (void)
match
gfc_match_omp_taskgroup (void)
{
- return match_omp (EXEC_OMP_TASKGROUP, OMP_CLAUSE_TASK_REDUCTION);
+ return match_omp (EXEC_OMP_TASKGROUP, OMP_TASKGROUP_CLAUSES);
}
@@ -6174,7 +6214,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
"IN_REDUCTION", "TASK_REDUCTION",
"DEVICE_RESIDENT", "LINK", "USE_DEVICE",
"CACHE", "IS_DEVICE_PTR", "USE_DEVICE_PTR", "USE_DEVICE_ADDR",
- "NONTEMPORAL" };
+ "NONTEMPORAL", "ALLOCATE" };
STATIC_ASSERT (ARRAY_SIZE (clause_names) == OMP_LIST_NUM);
if (omp_clauses == NULL)
@@ -6457,7 +6497,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
&& list != OMP_LIST_REDUCTION_INSCAN
&& list != OMP_LIST_REDUCTION_TASK
&& list != OMP_LIST_IN_REDUCTION
- && list != OMP_LIST_TASK_REDUCTION)
+ && list != OMP_LIST_TASK_REDUCTION
+ && list != OMP_LIST_ALLOCATE)
for (n = omp_clauses->lists[list]; n; n = n->next)
{
bool component_ref_p = false;
@@ -6526,6 +6567,70 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
n->sym->mark = 1;
}
+ for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
+ if (n->expr && (n->expr->ts.type != BT_INTEGER
+ || n->expr->ts.kind != gfc_c_intptr_kind))
+ {
+ gfc_error ("Expected integer expression of the "
+ "'omp_allocator_handle_kind' kind at %L", &n->expr->where);
+ break;
+ }
+
+ /* Check for 2 things here.
+ 1. There is no duplication of variable in allocate clause.
+ 2. Variable in allocate clause are also present in some
+ privatization clase. */
+ for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
+ n->sym->allocate = 0;
+
+ gfc_omp_namelist *prev = NULL;
+ for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n;)
+ {
+ if (n->sym->allocate == 1)
+ {
+ gfc_warning (0, "%qs appears more than once in %<allocate%> "
+ "clauses at %L" , n->sym->name, &n->where);
+ /* We have already seen this variable so it is a duplicate.
+ Remove it. */
+ if (prev != NULL && prev->next == n)
+ {
+ prev->next = n->next;
+ n->next = NULL;
+ gfc_free_omp_namelist (n, 0);
+ n = prev->next;
+ }
+
+ continue;
+ }
+ n->sym->allocate = 1;
+ prev = n;
+ n = n->next;
+ }
+
+ for (list = 0; list < OMP_LIST_NUM; list++)
+ switch (list)
+ {
+ case OMP_LIST_PRIVATE:
+ case OMP_LIST_FIRSTPRIVATE:
+ case OMP_LIST_LASTPRIVATE:
+ case OMP_LIST_REDUCTION:
+ case OMP_LIST_REDUCTION_INSCAN:
+ case OMP_LIST_REDUCTION_TASK:
+ case OMP_LIST_IN_REDUCTION:
+ case OMP_LIST_TASK_REDUCTION:
+ case OMP_LIST_LINEAR:
+ for (n = omp_clauses->lists[list]; n; n = n->next)
+ n->sym->allocate = 0;
+ break;
+ default:
+ break;
+ }
+
+ for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
+ if (n->sym->allocate == 1)
+ gfc_error ("%qs specified in 'allocate' clause at %L but not in an "
+ "explicit privatization clause", n->sym->name, &n->where);
+
/* OpenACC reductions. */
if (openacc)
{
@@ -8233,19 +8338,20 @@ resolve_omp_do (gfc_code *code)
if (code->ext.omp_clauses)
for (list = 0; list < OMP_LIST_NUM; list++)
if (!is_simd || code->ext.omp_clauses->collapse > 1
- ? (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE)
+ ? (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE
+ && list != OMP_LIST_ALLOCATE)
: (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE
- && list != OMP_LIST_LINEAR))
+ && list != OMP_LIST_ALLOCATE && list != OMP_LIST_LINEAR))
for (n = code->ext.omp_clauses->lists[list]; n; n = n->next)
if (dovar == n->sym)
{
if (!is_simd || code->ext.omp_clauses->collapse > 1)
gfc_error ("%s iteration variable present on clause "
- "other than PRIVATE or LASTPRIVATE at %L",
- name, &do_code->loc);
+ "other than PRIVATE, LASTPRIVATE or "
+ "ALLOCATE at %L", name, &do_code->loc);
else
gfc_error ("%s iteration variable present on clause "
- "other than PRIVATE, LASTPRIVATE or "
+ "other than PRIVATE, LASTPRIVATE, ALLOCATE or "
"LINEAR at %L", name, &do_code->loc);
break;
}
@@ -2646,6 +2646,28 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
}
}
break;
+ case OMP_LIST_ALLOCATE:
+ for (; n != NULL; n = n->next)
+ if (n->sym->attr.referenced || declare_simd)
+ {
+ tree t = gfc_trans_omp_variable (n->sym, declare_simd);
+ if (t != error_mark_node)
+ {
+ tree node = build_omp_clause (input_location,
+ OMP_CLAUSE_ALLOCATE);
+ OMP_CLAUSE_DECL (node) = t;
+ if (n->expr)
+ {
+ tree allocator_;
+ gfc_init_se (&se, NULL);
+ gfc_conv_expr (&se, n->expr);
+ allocator_ = gfc_evaluate_now (se.expr, block);
+ OMP_CLAUSE_ALLOCATE_ALLOCATOR (node) = allocator_;
+ }
+ omp_clauses = gfc_trans_add_clause (node, omp_clauses);
+ }
+ }
+ break;
case OMP_LIST_LINEAR:
{
gfc_expr *last_step_expr = NULL;
@@ -5857,6 +5879,8 @@ gfc_split_omp_clauses (gfc_code *code,
/* First the clauses that are unique to some constructs. */
clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_MAP]
= code->ext.omp_clauses->lists[OMP_LIST_MAP];
+ clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_ALLOCATE]
+ = code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE];
clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_IS_DEVICE_PTR]
= code->ext.omp_clauses->lists[OMP_LIST_IS_DEVICE_PTR];
clausesa[GFC_OMP_SPLIT_TARGET].device
@@ -5883,6 +5907,8 @@ gfc_split_omp_clauses (gfc_code *code,
= code->ext.omp_clauses->lists[OMP_LIST_SHARED];
clausesa[GFC_OMP_SPLIT_TEAMS].default_sharing
= code->ext.omp_clauses->default_sharing;
+ clausesa[GFC_OMP_SPLIT_TEAMS].lists[OMP_LIST_ALLOCATE]
+ = code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE];
}
if (mask & GFC_OMP_MASK_DISTRIBUTE)
{
@@ -5900,6 +5926,8 @@ gfc_split_omp_clauses (gfc_code *code,
= code->ext.omp_clauses->order_unconstrained;
clausesa[GFC_OMP_SPLIT_DISTRIBUTE].order_reproducible
= code->ext.omp_clauses->order_reproducible;
+ clausesa[GFC_OMP_SPLIT_DISTRIBUTE].lists[OMP_LIST_ALLOCATE]
+ = code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE];
}
if (mask & GFC_OMP_MASK_PARALLEL)
{
@@ -5921,6 +5949,8 @@ gfc_split_omp_clauses (gfc_code *code,
/* And this is copied to all. */
clausesa[GFC_OMP_SPLIT_PARALLEL].if_expr
= code->ext.omp_clauses->if_expr;
+ clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_ALLOCATE]
+ = code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE];
}
if (mask & GFC_OMP_MASK_MASKED)
clausesa[GFC_OMP_SPLIT_MASKED].filter = code->ext.omp_clauses->filter;
@@ -5958,6 +5988,8 @@ gfc_split_omp_clauses (gfc_code *code,
= code->ext.omp_clauses->order_unconstrained;
clausesa[GFC_OMP_SPLIT_DO].order_reproducible
= code->ext.omp_clauses->order_reproducible;
+ clausesa[GFC_OMP_SPLIT_DO].lists[OMP_LIST_ALLOCATE]
+ = code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE];
}
if (mask & GFC_OMP_MASK_SIMD)
{
@@ -6005,6 +6037,8 @@ gfc_split_omp_clauses (gfc_code *code,
= code->ext.omp_clauses->mergeable;
clausesa[GFC_OMP_SPLIT_TASKLOOP].if_exprs[OMP_IF_TASKLOOP]
= code->ext.omp_clauses->if_exprs[OMP_IF_TASKLOOP];
+ clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[OMP_LIST_ALLOCATE]
+ = code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE];
/* And this is copied to all. */
clausesa[GFC_OMP_SPLIT_TASKLOOP].if_expr
= code->ext.omp_clauses->if_expr;
new file mode 100644
@@ -0,0 +1,123 @@
+! { dg-do compile }
+
+module omp_lib_kinds
+ use iso_c_binding, only: c_int, c_intptr_t
+ implicit none
+ private :: c_int, c_intptr_t
+ integer, parameter :: omp_allocator_handle_kind = c_intptr_t
+
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_null_allocator = 0
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_default_mem_alloc = 1
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_large_cap_mem_alloc = 2
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_const_mem_alloc = 3
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_high_bw_mem_alloc = 4
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_low_lat_mem_alloc = 5
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_cgroup_mem_alloc = 6
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_pteam_mem_alloc = 7
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_thread_mem_alloc = 8
+end module
+
+subroutine bar (a, b, c)
+ implicit none
+ integer :: a
+ integer :: b
+ integer :: c
+ c = a + b
+end
+
+subroutine bar2 (a, b, c)
+ implicit none
+ integer :: a
+ integer :: b(15)
+ integer :: c
+ c = a + b(1)
+end
+
+subroutine foo(x, y)
+ use omp_lib_kinds
+ implicit none
+ integer :: x
+ integer :: z
+
+ integer, dimension(15) :: y
+ integer :: r
+ integer :: i
+ integer (kind=omp_allocator_handle_kind) :: h
+ r = 0
+ h = omp_default_mem_alloc;
+
+ !$omp parallel allocate (x) allocate (h : y) &
+ !$omp allocate (omp_large_cap_mem_alloc:z) firstprivate (x, y, z)
+ call bar2 (x, y, z);
+ !$omp end parallel
+
+ !$omp task private (x) firstprivate (z) allocate (omp_low_lat_mem_alloc:x,z)
+ call bar (0, x, z);
+ !$omp end task
+
+ !$omp target teams distribute parallel do private (x) firstprivate (y) &
+ !$omp allocate ((omp_default_mem_alloc + 0):z) allocate &
+ !$omp (omp_default_mem_alloc: x, y) allocate (h: r) lastprivate (z) reduction(+:r)
+ do i = 1, 10
+ call bar (0, x, z);
+ call bar2 (1, y, r);
+ end do
+ !$omp end target teams distribute parallel do
+
+ !$omp single private (x) allocate (omp_low_lat_mem_alloc:x)
+ x=1
+ !$omp end single
+
+ !$omp single allocate (omp_low_lat_mem_alloc:x) private (x)
+ !$omp end single
+
+ !$omp parallel
+ !$omp do allocate (x) private (x)
+ do i = 1, 64
+ x = 1;
+ end do
+ !$omp end parallel
+
+ !$omp sections private (x) allocate (omp_low_lat_mem_alloc: x)
+ x = 1;
+ !$omp section
+ x = 2;
+ !$omp section
+ x = 3;
+ !$omp end sections
+
+ !$omp taskgroup task_reduction(+:r) allocate (omp_default_mem_alloc : r)
+ call bar (r, r, r);
+ !$omp end taskgroup
+
+ !$omp teams private (x) firstprivate (y) allocate (h : x, y)
+ call bar2 (x, y, r);
+ !$omp end teams
+
+ !$omp taskloop lastprivate (x) reduction (+:r) allocate (h : x, r)
+ do i = 1, 16
+ call bar (0, r, r);
+ x = i;
+ end do
+ !$omp end taskloop
+
+ !$omp taskgroup task_reduction(+:r) allocate (omp_default_mem_alloc : r)
+ !$omp taskloop firstprivate (x) in_reduction (+:r) &
+ !$omp allocate (omp_default_mem_alloc : x, r)
+ do i = 1, 16
+ call bar (x, r, r);
+ end do
+ !$omp end taskloop
+ !$omp end taskgroup
+ !$omp taskwait
+end subroutine
+
new file mode 100644
@@ -0,0 +1,45 @@
+! { dg-do compile }
+
+module omp_lib_kinds
+ use iso_c_binding, only: c_int, c_intptr_t
+ implicit none
+ private :: c_int, c_intptr_t
+ integer, parameter :: omp_allocator_handle_kind = c_intptr_t
+
+end module
+
+subroutine foo(x)
+ use omp_lib_kinds
+ implicit none
+ integer :: x
+
+ !$omp task allocate (x) ! { dg-error "'x' specified in 'allocate' clause at .1. but not in an explicit privatization clause" }
+ x=1
+ !$omp end task
+
+ !$omp parallel allocate (x) ! { dg-error "'x' specified in 'allocate' clause at .1. but not in an explicit privatization clause" }
+ x=2
+ !$omp end parallel
+
+ !$omp parallel allocate (x) shared (x) ! { dg-error "'x' specified in 'allocate' clause at .1. but not in an explicit privatization clause" }
+ x=3
+ !$omp end parallel
+
+ !$omp parallel private (x) allocate (x) allocate (x) ! { dg-warning "'x' appears more than once in 'allocate' clauses at .1." }
+ x=4
+ !$omp end parallel
+
+ !$omp parallel private (x) allocate (x, x) ! { dg-warning "'x' appears more than once in 'allocate' clauses at .1." }
+ x=5
+ !$omp end parallel
+
+ !$omp parallel allocate (0: x) private(x) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." }
+ x=6
+ !$omp end parallel
+
+ !$omp parallel private (x) allocate (0.1 : x) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." }
+ x=7
+ !$omp end parallel
+
+end subroutine
+
@@ -24,7 +24,7 @@ subroutine collapse1
end do
!$omp parallel do collapse(2) shared(j)
do i = 1, 3
- do j = 4, 6 ! { dg-error "iteration variable present on clause other than PRIVATE or LASTPRIVATE" }
+ do j = 4, 6 ! { dg-error "iteration variable present on clause other than PRIVATE, LASTPRIVATE or ALLOCATE" }
end do
end do
!$omp parallel do collapse(2)
@@ -45,17 +45,17 @@ do i = 1, 5
end do
!$omp parallel do firstprivate(i)
-do i = 1, 5 ! { dg-error "PARALLEL DO iteration variable present on clause other than PRIVATE or LASTPRIVATE" }
+do i = 1, 5 ! { dg-error "PARALLEL DO iteration variable present on clause other than PRIVATE, LASTPRIVATE or ALLOCATE" }
x(i) = 42
end do
!$omp parallel do simd firstprivate(i)
-do i = 1, 5 ! { dg-error "PARALLEL DO SIMD iteration variable present on clause other than PRIVATE, LASTPRIVATE or LINEAR" }
+do i = 1, 5 ! { dg-error "PARALLEL DO SIMD iteration variable present on clause other than PRIVATE, LASTPRIVATE, ALLOCATE or LINEAR" }
x(i) = 42
end do
!$omp simd linear(i) collapse(2)
-do i = 1, 5 ! { dg-error "SIMD iteration variable present on clause other than PRIVATE or LASTPRIVATE" }
+do i = 1, 5 ! { dg-error "SIMD iteration variable present on clause other than PRIVATE, LASTPRIVATE or ALLOCATE" }
do j = 1, 2
y(j, i) = 52
end do
new file mode 100644
@@ -0,0 +1,7 @@
+#include <stdint.h>
+
+int
+is_64bit_aligned_ (uintptr_t a)
+{
+ return ( (a & 0x3f) == 0);
+}
new file mode 100644
@@ -0,0 +1,333 @@
+! { dg-do run }
+! { dg-additional-sources allocate-1.c }
+! { dg-prune-output "command-line option '-fintrinsic-modules-path=.*' is valid for Fortran but not for C" }
+
+module m
+ use omp_lib
+ use iso_c_binding
+ implicit none
+
+ interface
+ integer(c_int) function is_64bit_aligned (a) bind(C)
+ import :: c_int
+ integer :: a
+ end
+ end interface
+end module m
+
+subroutine foo (x, p, q, px, h, fl)
+ use omp_lib
+ use iso_c_binding
+ integer :: x
+ integer, dimension(4) :: p
+ integer, dimension(4) :: q
+ integer :: px
+ integer (kind=omp_allocator_handle_kind) :: h
+ integer :: fl
+
+ integer :: y
+ integer :: r, i, i1, i2, i3, i4, i5
+ integer :: l, l3, l4, l5, l6
+ integer :: n, n1, n2, n3, n4
+ integer :: j2, j3, j4
+ integer, dimension(4) :: l2
+ integer, dimension(4) :: r2
+ integer, target :: xo
+ integer, target :: yo
+ integer, dimension(x) :: v
+ integer, dimension(x) :: w
+
+ type s_type
+ integer :: a
+ integer :: b
+ end type
+
+ type (s_type) :: s
+ s%a = 27
+ s%b = 29
+ y = 0
+ r = 0
+ n = 8
+ n2 = 9
+ n3 = 10
+ n4 = 11
+ xo = x
+ yo = y
+
+ do i = 1, 4
+ r2(i) = 0;
+ end do
+
+ do i = 1, 4
+ p(i) = 0;
+ end do
+
+ do i = 1, 4
+ q(i) = 0;
+ end do
+
+ do i = 1, x
+ w(i) = i
+ end do
+
+ !$omp parallel private (y, v) firstprivate (x) allocate (x, y, v)
+ if (x /= 42) then
+ stop 1
+ end if
+ v(1) = 7
+ if ( (and(fl, 2) /= 0) .and. &
+ ((is_64bit_aligned(x) == 0) .or. &
+ (is_64bit_aligned(y) == 0) .or. &
+ (is_64bit_aligned(v(1)) == 0))) then
+ stop 2
+ end if
+
+ !$omp barrier
+ y = 1;
+ x = x + 1
+ v(1) = 7
+ v(41) = 8
+ !$omp barrier
+ if (x /= 43 .or. y /= 1) then
+ stop 3
+ end if
+ if (v(1) /= 7 .or. v(41) /= 8) then
+ stop 4
+ end if
+ !$omp end parallel
+
+ !$omp teams
+ !$omp parallel private (y) firstprivate (x, w) allocate (h: x, y, w)
+
+ if (x /= 42 .or. w(17) /= 17 .or. w(41) /= 41) then
+ stop 5
+ end if
+ !$omp barrier
+ y = 1;
+ x = x + 1
+ w(19) = w(19) + 1
+ !$omp barrier
+ if (x /= 43 .or. y /= 1 .or. w(19) /= 20) then
+ stop 6
+ end if
+ if ( (and(fl, 1) /= 0) .and. &
+ ((is_64bit_aligned(x) == 0) .or. &
+ (is_64bit_aligned(y) == 0) .or. &
+ (is_64bit_aligned(w(1)) == 0))) then
+ stop 7
+ end if
+ !$omp end parallel
+ !$omp end teams
+
+ !$omp parallel do private (y) firstprivate (x) reduction(+: r) allocate (h: x, y, r, l, n) lastprivate (l) linear (n: 16)
+ do i = 0, 63
+ if (x /= 42) then
+ stop 8
+ end if
+ y = 1;
+ l = i;
+ n = n + y + 15;
+ r = r + i;
+ if ( (and(fl, 1) /= 0) .and. &
+ ((is_64bit_aligned(x) == 0) .or. &
+ (is_64bit_aligned(y) == 0) .or. &
+ (is_64bit_aligned(r) == 0) .or. &
+ (is_64bit_aligned(l) == 0) .or. &
+ (is_64bit_aligned(n) == 0))) then
+ stop 9
+ end if
+ end do
+ !$omp end parallel do
+
+ !$omp parallel
+ !$omp do lastprivate (l2) private (i1) allocate (h: l2, l3, i1) lastprivate (conditional: l3)
+ do i1 = 0, 63
+ l2(1) = i1
+ l2(2) = i1 + 1
+ l2(3) = i1 + 2
+ l2(4) = i1 + 3
+ if (i1 < 37) then
+ l3 = i1
+ end if
+ if ( (and(fl, 1) /= 0) .and. &
+ ((is_64bit_aligned(l2(1)) == 0) .or. &
+ (is_64bit_aligned(l3) == 0) .or. &
+ (is_64bit_aligned(i1) == 0))) then
+ stop 10
+ end if
+ end do
+
+ !$omp do collapse(2) lastprivate(l4, i2, j2) linear (n2:17) allocate (h: n2, l4, i2, j2)
+ do i2 = 3, 4
+ do j2 = 17, 22, 2
+ n2 = n2 + 17
+ l4 = i2 * 31 + j2
+ if ( (and(fl, 1) /= 0) .and. &
+ ((is_64bit_aligned(l4) == 0) .or. &
+ (is_64bit_aligned(n2) == 0) .or. &
+ (is_64bit_aligned(i2) == 0) .or. &
+ (is_64bit_aligned(j2) == 0))) then
+ stop 11
+ end if
+ end do
+ end do
+
+ !$omp do collapse(2) lastprivate(l5, i3, j3) linear (n3:17) schedule (static, 3) allocate (n3, l5, i3, j3)
+ do i3 = 3, 4
+ do j3 = 17, 22, 2
+ n3 = n3 + 17
+ l5 = i3 * 31 + j3
+ if ( (and(fl, 2) /= 0) .and. &
+ ((is_64bit_aligned(l5) == 0) .or. &
+ (is_64bit_aligned(n3) == 0) .or. &
+ (is_64bit_aligned(i3) == 0) .or. &
+ (is_64bit_aligned(j3) == 0))) then
+ stop 12
+ end if
+ end do
+ end do
+
+ !$omp do collapse(2) lastprivate(l6, i4, j4) linear (n4:17) schedule (dynamic) allocate (h: n4, l6, i4, j4)
+ do i4 = 3, 4
+ do j4 = 17, 22,2
+ n4 = n4 + 17;
+ l6 = i4 * 31 + j4;
+ if ( (and(fl, 1) /= 0) .and. &
+ ((is_64bit_aligned(l6) == 0) .or. &
+ (is_64bit_aligned(n4) == 0) .or. &
+ (is_64bit_aligned(i4) == 0) .or. &
+ (is_64bit_aligned(j4) == 0))) then
+ stop 13
+ end if
+ end do
+ end do
+
+ !$omp do lastprivate (i5) allocate (i5)
+ do i5 = 1, 17, 3
+ if ( (and(fl, 2) /= 0) .and. &
+ (is_64bit_aligned(i5) == 0)) then
+ stop 14
+ end if
+ end do
+
+ !$omp do reduction(+:p, q, r2) allocate(h: p, q, r2)
+ do i = 0, 31
+ p(3) = p(3) + i;
+ p(4) = p(4) + (2 * i)
+ q(1) = q(1) + (3 * i)
+ q(3) = q(3) + (4 * i)
+ r2(1) = r2(1) + (5 * i)
+ r2(4) = r2(4) + (6 * i)
+ if ( (and(fl, 1) /= 0) .and. &
+ ((is_64bit_aligned(q(1)) == 0) .or. &
+ (is_64bit_aligned(p(1)) == 0) .or. &
+ (is_64bit_aligned(r2(1)) == 0) )) then
+ stop 15
+ end if
+ end do
+
+ !$omp task private(y) firstprivate(x) allocate(x, y)
+ if (x /= 42) then
+ stop 16
+ end if
+
+ if ( (and(fl, 2) /= 0) .and. &
+ ((is_64bit_aligned(x) == 0) .or. &
+ (is_64bit_aligned(y) == 0) )) then
+ stop 17
+ end if
+ !$omp end task
+
+ !$omp task private(y) firstprivate(x) allocate(h: x, y)
+ if (x /= 42) then
+ stop 16
+ end if
+
+ if ( (and(fl, 1) /= 0) .and. &
+ ((is_64bit_aligned(x) == 0) .or. &
+ (is_64bit_aligned(y) == 0) )) then
+ stop 17
+ end if
+ !$omp end task
+
+ !$omp task private(y) firstprivate(s) allocate(s, y)
+ if (s%a /= 27 .or. s%b /= 29) then
+ stop 18
+ end if
+
+ if ( (and(fl, 2) /= 0) .and. &
+ ((is_64bit_aligned(s%a) == 0) .or. &
+ (is_64bit_aligned(y) == 0) )) then
+ stop 19
+ end if
+ !$omp end task
+
+ !$omp task private(y) firstprivate(s) allocate(h: s, y)
+ if (s%a /= 27 .or. s%b /= 29) then
+ stop 18
+ end if
+
+ if ( (and(fl, 1) /= 0) .and. &
+ ((is_64bit_aligned(s%a) == 0) .or. &
+ (is_64bit_aligned(y) == 0) )) then
+ stop 19
+ end if
+ !$omp end task
+
+ !$omp end parallel
+
+ if (r /= ((64 * 63) / 2) .or. l /= 63 .or. n /= (8 + 16 * 64)) then
+ stop 20
+ end if
+
+ if (l2(1) /= 63 .or. l2(2) /= 64 .or. l2(3) /= 65 .or. l2(4) /= 66 .or. l3 /= 36) then
+ stop 21
+ end if
+
+ if (i2 /= 5 .or. j2 /= 23 .or. n2 /= (9 + (17 * 6)) .or. l4 /= (4 * 31 + 21)) then
+ stop 22
+ end if
+
+ if (i3 /= 5 .or. j3 /= 23 .or. n3 /= (10 + (17 * 6)) .or. l5 /= (4 * 31 + 21)) then
+ stop 23
+ end if
+
+ if (i4 /= 5 .or. j4 /= 23 .or. n4 /= (11 + (17 * 6)) .or. l6 /= (4 * 31 + 21)) then
+ stop 24
+ end if
+
+ if (i5 /= 19) then
+ stop 24
+ end if
+
+ if (p(3) /= ((32 * 31) / 2) .or. p(4) /= (2 * p(3)) &
+ .or. q(1) /= (3 * p(3)) .or. q(3) /= (4 * p(3)) &
+ .or. r2(1) /= (5 * p(3)) .or. r2(4) /= (6 * p(3))) then
+ stop 25
+ end if
+
+end subroutine
+
+program main
+ use omp_lib
+ integer, dimension(4) :: p
+ integer, dimension(4) :: q
+
+ type (omp_alloctrait) :: traits(3)
+ integer (omp_allocator_handle_kind) :: a
+
+ traits = [omp_alloctrait (omp_atk_alignment, 64), &
+ omp_alloctrait (omp_atk_fallback, omp_atv_null_fb), &
+ omp_alloctrait (omp_atk_pool_size, 8192)]
+ a = omp_init_allocator (omp_default_mem_space, 3, traits)
+ if (a == omp_null_allocator) stop 1
+
+ call omp_set_default_allocator (omp_default_mem_alloc);
+ call foo (42, p, q, 2, a, 0);
+ call foo (42, p, q, 2, omp_default_mem_alloc, 0);
+ call foo (42, p, q, 2, a, 1);
+ call omp_set_default_allocator (a);
+ call foo (42, p, q, 2, omp_null_allocator, 3);
+ call foo (42, p, q, 2, omp_default_mem_alloc, 2);
+ call omp_destroy_allocator (a);
+end