diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 14 | ||||
| -rw-r--r-- | gcc/fortran/gfortran.h | 1 | ||||
| -rw-r--r-- | gcc/fortran/intrinsic.c | 7 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 18 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/do_concurrent_3.f90 | 13 |
6 files changed, 49 insertions, 9 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 5fbe331..2b34517 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,17 @@ +2013-09-02 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/PR56519 + * gfortran.h: Declare gfc_do_concurrent_flag as extern. + * resolve.c: Rename do_concurrent_flag to gfc_do_concurrent_flag + and make non-static. + (resolve_function): Use gfc_do_concurrent_flag instead of + do_concurrent_flag. + (pure_subroutine): Likewise. + (resolve_code): Likewise. + (resolve_types): Likewise. + * intrinsic.c (gfc_intrinsic_sub_interface): Raise error for + non-pure intrinsic subroutines within DO CONCURRENT. + 2013-08-29 Thomas Koenig <tkoenig@gcc.gnu.org> PR fortran/52243 diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 691aa8c..b28edd8 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2846,6 +2846,7 @@ gfc_expr *gfc_expr_to_initialize (gfc_expr *); bool gfc_type_is_extensible (gfc_symbol *); bool gfc_resolve_intrinsic (gfc_symbol *, locus *); bool gfc_explicit_interface_required (gfc_symbol *, char *, int); +extern int gfc_do_concurrent_flag; /* array.c */ diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index c2e1525..3da3c53 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -4397,6 +4397,13 @@ gfc_intrinsic_sub_interface (gfc_code *c, int error_flag) c->resolved_sym->attr.elemental = isym->elemental; } + if (gfc_do_concurrent_flag && !isym->pure) + { + gfc_error ("Subroutine call to intrinsic '%s' in DO CONCURRENT " + "block at %L is not PURE", name, &c->loc); + return MATCH_ERROR; + } + if (gfc_pure (NULL) && !isym->pure) { gfc_error ("Subroutine call to intrinsic '%s' at %L is not PURE", name, diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 067288d..2929679 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -60,7 +60,7 @@ static code_stack *cs_base = NULL; /* Nonzero if we're inside a FORALL or DO CONCURRENT block. */ static int forall_flag; -static int do_concurrent_flag; +int gfc_do_concurrent_flag; /* True when we are resolving an expression that is an actual argument to a procedure. */ @@ -2986,11 +2986,11 @@ resolve_function (gfc_expr *expr) forall_flag == 2 ? "mask" : "block"); t = false; } - else if (do_concurrent_flag) + else if (gfc_do_concurrent_flag) { gfc_error ("Reference to non-PURE function '%s' at %L inside a " "DO CONCURRENT %s", name, &expr->where, - do_concurrent_flag == 2 ? "mask" : "block"); + gfc_do_concurrent_flag == 2 ? "mask" : "block"); t = false; } else if (gfc_pure (NULL)) @@ -3059,7 +3059,7 @@ pure_subroutine (gfc_code *c, gfc_symbol *sym) if (forall_flag) gfc_error ("Subroutine call to '%s' in FORALL block at %L is not PURE", sym->name, &c->loc); - else if (do_concurrent_flag) + else if (gfc_do_concurrent_flag) gfc_error ("Subroutine call to '%s' in DO CONCURRENT block at %L is not " "PURE", sym->name, &c->loc); else if (gfc_pure (NULL)) @@ -9629,7 +9629,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns) { frame.current = code; forall_save = forall_flag; - do_concurrent_save = do_concurrent_flag; + do_concurrent_save = gfc_do_concurrent_flag; if (code->op == EXEC_FORALL) { @@ -9663,9 +9663,9 @@ resolve_code (gfc_code *code, gfc_namespace *ns) to transform the SELECT TYPE into ASSOCIATE first. */ break; case EXEC_DO_CONCURRENT: - do_concurrent_flag = 1; + gfc_do_concurrent_flag = 1; gfc_resolve_blocks (code->block, ns); - do_concurrent_flag = 2; + gfc_do_concurrent_flag = 2; break; case EXEC_OMP_WORKSHARE: omp_workshare_save = omp_workshare_flag; @@ -9684,7 +9684,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns) if (code->op != EXEC_COMPCALL && code->op != EXEC_CALL_PPC) t = gfc_resolve_expr (code->expr1); forall_flag = forall_save; - do_concurrent_flag = do_concurrent_save; + gfc_do_concurrent_flag = do_concurrent_save; if (!gfc_resolve_expr (code->expr2)) t = false; @@ -14404,7 +14404,7 @@ resolve_types (gfc_namespace *ns) } forall_flag = 0; - do_concurrent_flag = 0; + gfc_do_concurrent_flag = 0; gfc_check_interfaces (ns); gfc_traverse_ns (ns, resolve_values); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index c01c48c..db785f7 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2013-09-02 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/PR56519 + * gfortran.dg/do_concurrent_3.f90: New test case. + 2013-09-02 Jan Hubicka <jh@suse.cz> * gcc.dg/tree-ssa/fnsplit-1.c: New testcase. diff --git a/gcc/testsuite/gfortran.dg/do_concurrent_3.f90 b/gcc/testsuite/gfortran.dg/do_concurrent_3.f90 new file mode 100644 index 0000000..09bb0cc --- /dev/null +++ b/gcc/testsuite/gfortran.dg/do_concurrent_3.f90 @@ -0,0 +1,13 @@ +! { dg-do compile } +! PR 56519 - flag impure intrinsic subroutine calls +! within DO CONCURRENT +program main + implicit none + integer :: i + real :: array(123), val + + do concurrent (i = 1:123) + call random_number (val) ! { dg-error "is not PURE" } + array(i) = val + end do +end program main |