gcc/fortran/

2006-02-14 Jakub Jelinek <jakub@redhat.com> Richard Henderson <rth@redhat.com> Diego Novillo <dnovillo@redhat.com> * invoke.texi: Document -fopenmp. * gfortran.texi (Extensions): Document OpenMP. Backport from gomp-20050608-branch * trans-openmp.c: Call build_omp_clause instead of make_node when creating OMP_CLAUSE_* trees. (gfc_trans_omp_reduction_list): Remove argument 'code'. Adjust all callers. * trans.h (build4_v): Define. * trans-openmp.c: Call build4_v to create OMP_PARALLEL nodes. Call build3_v to create OMP_SECTIONS nodes. PR fortran/25162 * openmp.c (gfc_match_omp_variable_list): Call gfc_set_sym_referenced on all symbols added to the variable list. * openmp.c (gfc_match_omp_clauses): Fix check for non-INTRINSIC procedure symbol in REDUCTION. * trans-openmp.c (gfc_trans_omp_array_reduction): Use gfc_add for MINUS_EXPR OMP_CLAUSE_REDUCTION_CODE. * trans-openmp.c (gfc_trans_omp_do): Add PBLOCK argument. If PBLOCK is non-NULL, evaluate INIT/COND/INCR and chunk size expressions in that statement block. (gfc_trans_omp_parallel_do): Pass non-NULL PBLOCK to gfc_trans_omp_do for non-ordered non-static combined loops. (gfc_trans_omp_directive): Pass NULL PBLOCK to gfc_trans_omp_do. * openmp.c: Include target.h and toplev.h. (gfc_match_omp_threadprivate): Emit diagnostic if target does not support TLS. * Make-lang.in (fortran/openmp.o): Add dependencies on target.h and toplev.h. * trans-decl.c (gfc_get_fake_result_decl): Set GFC_DECL_RESULT. * trans-openmp.c (gfc_omp_privatize_by_reference): Make DECL_ARTIFICIAL vars predetermined shared except GFC_DECL_RESULT. (gfc_omp_disregard_value_expr): Handle GFC_DECL_RESULT. (gfc_trans_omp_variable): New function. (gfc_trans_omp_variable_list, gfc_trans_omp_reduction_list): Use it. * trans.h (GFC_DECL_RESULT): Define. * trans-openmp.c (gfc_omp_firstprivatize_type_sizes): New function. * f95-lang.c (LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES): Define. * trans.h (gfc_omp_firstprivatize_type_sizes): New prototype. * trans-openmp.c (gfc_omp_privatize_by_reference): Return true if a pointer has GFC_DECL_SAVED_DESCRIPTOR set. (gfc_trans_omp_array_reduction, gfc_trans_omp_reduction_list): New functions. (gfc_trans_omp_clauses): Add WHERE argument. Call gfc_trans_omp_reduction_list rather than gfc_trans_omp_variable_list for reductions. (gfc_trans_omp_do, gfc_trans_omp_parallel, gfc_trans_omp_parallel_do, gfc_trans_omp_parallel_sections, gfc_trans_omp_parallel_workshare, gfc_trans_omp_sections, gfc_trans_omp_single): Adjust gfc_trans_omp_clauses callers. * openmp.c (omp_current_do_code): New var. (gfc_resolve_omp_do_blocks): New function. (gfc_resolve_omp_parallel_blocks): Call it. (gfc_resolve_do_iterator): Add CODE argument. Don't propagate predetermination if argument is !$omp do or !$omp parallel do iteration variable. * resolve.c (resolve_code): Call gfc_resolve_omp_do_blocks for EXEC_OMP_DO. Adjust gfc_resolve_do_iterator caller. * fortran.h (gfc_resolve_omp_do_blocks): New prototype. (gfc_resolve_do_iterator): Add CODE argument. * trans.h (gfc_omp_predetermined_sharing, gfc_omp_disregard_value_expr, gfc_omp_private_debug_clause): New prototypes. (GFC_DECL_COMMON_OR_EQUIV, GFC_DECL_CRAY_POINTEE): Define. * trans-openmp.c (gfc_omp_predetermined_sharing, gfc_omp_disregard_value_expr, gfc_omp_private_debug_clause): New functions. * trans-common.c (build_equiv_decl, build_common_decl, create_common): Set GFC_DECL_COMMON_OR_EQUIV flag on the decls. * trans-decl.c (gfc_finish_cray_pointee): Set GFC_DECL_CRAY_POINTEE on the decl. * f95-lang.c (LANG_HOOKS_OMP_PREDETERMINED_SHARING, LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR, LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE): Define. * openmp.c (resolve_omp_clauses): Remove extraneous comma. * symbol.c (check_conflict): Add conflict between cray_pointee and threadprivate. * openmp.c (gfc_match_omp_threadprivate): Fail if gfc_add_threadprivate returned FAILURE. (resolve_omp_clauses): Diagnose Cray pointees in SHARED, {,FIRST,LAST}PRIVATE and REDUCTION clauses and Cray pointers in {FIRST,LAST}PRIVATE and REDUCTION clauses. * resolve.c (omp_workshare_flag): New variable. (resolve_function): Diagnose use of non-ELEMENTAL user defined function in WORKSHARE construct. (resolve_code): Cleanup forall_save use. Make sure omp_workshare_flag is set to correct value in different contexts. * openmp.c (resolve_omp_clauses): Replace %s with '%s' when printing variable name. (resolve_omp_atomic): Likewise. PR fortran/24493 * scanner.c (skip_free_comments): Set at_bol at the beginning of the loop, not before it. (skip_fixed_comments): Handle ! comments in the middle of line here as well. (gfc_skip_comments): Use skip_fixed_comments for FIXED_FORM even if not at BOL. (gfc_next_char_literal): Fix expected canonicalized *$omp string. * trans-openmp.c (gfc_trans_omp_do): Use make_node and explicit initialization to build OMP_FOR instead of build. * trans-decl.c (gfc_gimplify_function): Invoke diagnose_omp_structured_block_errors. * trans-openmp.c (gfc_trans_omp_master): Use OMP_MASTER. (gfc_trans_omp_ordered): Use OMP_ORDERED. * gfortran.h (gfc_resolve_do_iterator, gfc_resolve_blocks, gfc_resolve_omp_parallel_blocks): New prototypes. * resolve.c (resolve_blocks): Renamed to... (gfc_resolve_blocks): ... this. Remove static. (gfc_resolve_forall): Adjust caller. (resolve_code): Only call gfc_resolve_blocks if code->block != 0 and not for EXEC_OMP_PARALLEL* directives. Call gfc_resolve_omp_parallel_blocks for EXEC_OMP_PARALLEL* directives. Call gfc_resolve_do_iterator if resolved successfully EXEC_DO iterator. * openmp.c: Include pointer-set.h. (omp_current_ctx): New variable. (gfc_resolve_omp_parallel_blocks, gfc_resolve_do_iterator): New functions. * Make-lang.in (fortran/openmp.o): Depend on pointer-set.h. * openmp.c (gfc_match_omp_clauses): For max/min/iand/ior/ieor, look up symbol if it exists, use its name instead and, if it is not INTRINSIC, issue diagnostics. * parse.c (parse_omp_do): Handle implied end do properly. (parse_executable): If parse_omp_do returned ST_IMPLIED_ENDDO, return it instead of continuing. * trans-openmp.c (gfc_trans_omp_critical): Update for changed operand numbering. (gfc_trans_omp_do, gfc_trans_omp_parallel, gfc_trans_omp_parallel_do, gfc_trans_omp_parallel_sections, gfc_trans_omp_parallel_workshare, gfc_trans_omp_sections, gfc_trans_omp_single): Likewise. * trans.h (gfc_omp_privatize_by_reference): New prototype. * f95-lang.c (LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE): Redefine to gfc_omp_privatize_by_reference. * trans-openmp.c (gfc_omp_privatize_by_reference): New function. * trans-stmt.h (gfc_trans_omp_directive): Add comment. * openmp.c (gfc_match_omp_variable_list): Add ALLOW_COMMON argument. Disallow COMMON matching if it is set. (gfc_match_omp_clauses, gfc_match_omp_flush): Adjust all callers. (resolve_omp_clauses): Show locus in error messages. Check that variable types in reduction clauses are appropriate for reduction operators. * resolve.c (resolve_symbol): Don't error if a threadprivate module variable isn't SAVEd. * trans-openmp.c (gfc_trans_omp_do): Put count into BLOCK, not BODY. Fix typo in condition. Fix DOVAR initialization. * openmp.c (gfc_match_omp_clauses): Match min/iand/ior/ieor rather than .min. etc. * trans-openmpc.c (omp_not_yet): Remove. (gfc_trans_omp_parallel_do): Keep listprivate clause on parallel. Force creation of BIND_EXPR around the workshare construct. (gfc_trans_omp_parallel_sections): Likewise. (gfc_trans_omp_parallel_workshare): Likewise. * types.def (BT_I16, BT_FN_I16_VPTR_I16, BT_FN_BOOL_VPTR_I16_I16, BT_FN_I16_VPTR_I16_I16): Add. * trans-openmp.c (gfc_trans_omp_clauses): Create OMP_CLAUSE_DEFAULT. (gfc_trans_omp_code): New function. (gfc_trans_omp_do): Use it, remove omp_not_yet uses. (gfc_trans_omp_parallel, gfc_trans_omp_single): Likewise. (gfc_trans_omp_sections): Likewise. Only treat empty last section specially if lastprivate clause is present. * f95-lang.c (gfc_init_builtin_functions): Create BUILT_IN_TRAP builtin. * trans-openmp.c (gfc_trans_omp_variable_list): Update for OMP_CLAUSE_DECL name change. (gfc_trans_omp_do): Likewise. * trans-openmp.c (gfc_trans_omp_clauses): Create OMP_CLAUSE_REDUCTION clauses. (gfc_trans_omp_atomic): Build OMP_ATOMIC instead of expanding sync builtins directly. (gfc_trans_omp_single): Build OMP_SINGLE statement. * trans-openmp.c (gfc_trans_add_clause): New. (gfc_trans_omp_variable_list): Take a tree code and build the clause node here. Link it to the head of a list. (gfc_trans_omp_clauses): Update to match. (gfc_trans_omp_do): Use gfc_trans_add_clause. * trans-openmp.c (gfc_trans_omp_clauses): Change second argument to gfc_omp_clauses *. Use gfc_evaluate_now instead of creating temporaries by hand. (gfc_trans_omp_atomic, gfc_trans_omp_critical): Use buildN_v macros. (gfc_trans_omp_do): New function. (gfc_trans_omp_master): Dont' check for gfc_trans_code returning NULL. (gfc_trans_omp_parallel): Adjust gfc_trans_omp_clauses caller. Use buildN_v macros. (gfc_trans_omp_parallel_do, gfc_trans_omp_parallel_sections, gfc_trans_omp_parallel_workshare, gfc_trans_omp_sections, gfc_trans_omp_single, gfc_trans_omp_workshare): New functions. (gfc_trans_omp_directive): Use them. * parse.c (parse_omp_do): Allow new_st.op == EXEC_NOP. * openmp.c (resolve_omp_clauses): Check for list items present in multiple clauses. (resolve_omp_do): Check that iteration variable is not THREADPRIVATE and is not present in any clause variable lists other than PRIVATE or LASTPRIVATE. * gfortran.h (symbol_attribute): Add threadprivate bit. (gfc_common_head): Add threadprivate member, change use_assoc and saved into char to save space. (gfc_add_threadprivate): New prototype. * symbol.c (check_conflict): Handle threadprivate. (gfc_add_threadprivate): New function. (gfc_copy_attr): Copy threadprivate. * trans-openmp.c (gfc_trans_omp_clauses): Avoid creating a temporary if IF or NUM_THREADS is constant. Create OMP_CLAUSE_SCHEDULE and OMP_CLAUSE_ORDERED. * resolve.c (resolve_symbol): Complain if a THREADPRIVATE symbol outside a module and not in COMMON has is not SAVEd. (resolve_equivalence): Ensure THREADPRIVATE objects don't get EQUIVALENCEd. * trans-common.c: Include target.h and rtl.h. (build_common_decl): Set DECL_TLS_MODEL if THREADPRIVATE. * trans-decl.c: Include rtl.h. (gfc_finish_var_decl): Set DECL_TLS_MODEL if THREADPRIVATE. * dump-parse-tree.c (gfc_show_attr): Handle THREADPRIVATE. * Make-lang.in (fortran/trans-decl.o): Depend on $(RTL_H). (fortran/trans-common.o): Depend on $(RTL_H) and $(TARGET_H). * openmp.c (gfc_match_omp_variable_list): Ensure COMMON block is from current namespace. (gfc_match_omp_threadprivate): Rewrite. (resolve_omp_clauses): Check some clause restrictions. * module.c (ab_attribute): Add AB_THREADPRIVATE. (attr_bits): Add THREADPRIVATE. (mio_symbol_attribute, mio_symbol_attribute): Handle threadprivate. (load_commons, write_common, write_blank_common): Adjust for type change of saved, store/load threadprivate bit from the integer as well. * types.def (BT_FN_UINT_UINT): New. (BT_FN_VOID_UINT_UINT): Remove. * trans-openmp.c (gfc_trans_omp_clauses, gfc_trans_omp_barrier, gfc_trans_omp_critical, gfc_trans_omp_flush, gfc_trans_omp_master, gfc_trans_omp_ordered, gfc_trans_omp_parallel): New functions. (gfc_trans_omp_directive): Use them. * openmp.c (expr_references_sym): Add SE argument, don't look into SE tree. (is_conversion): New function. (resolve_omp_atomic): Adjust expr_references_sym callers. Handle promoted expressions. * trans-openmp.c (gfc_trans_omp_atomic): New function. (gfc_trans_omp_directive): Call it. * f95-lang.c (builtin_type_for_size): New function. (gfc_init_builtin_functions): Initialize synchronization and OpenMP builtins. * types.def: New file. * Make-lang.in (f95-lang.o): Depend on $(BUILTINS_DEF) and fortran/types.def. * trans-openmp.c: Rename GOMP_* tree codes into OMP_*. * dump-parse-tree.c (show_symtree): Don't crash if ns->proc_name is NULL. * dump-parse-tree.c (gfc_show_namelist, gfc_show_omp_node): New functions. (gfc_show_code_node): Call gfc_show_omp_node for EXEC_OMP_* nodes. * parse.c (parse_omp_do): Call pop_state before next_statement. * openmp.c (expr_references_sym, resolve_omp_atomic, resolve_omp_do): New functions. (gfc_resolve_omp_directive): Call them. * match.c (match_exit_cycle): Issue error if EXIT or CYCLE statement leaves an OpenMP structured block or if EXIT terminates !$omp do loop. * Make-lang.in (F95_PARSER_OBJS): Add fortran/openmp.o. (F95_OBJS): Add fortran/trans-openmp.o. (fortran/trans-openmp.o): Depend on $(GFORTRAN_TRANS_DEPS). * lang.opt: Add -fopenmp option. * options.c (gfc_init_options): Initialize it. (gfc_handle_option): Handle it. * gfortran.h (ST_OMP_ATOMIC, ST_OMP_BARRIER, ST_OMP_CRITICAL, ST_OMP_END_CRITICAL, ST_OMP_END_DO, ST_OMP_END_MASTER, ST_OMP_END_ORDERED, ST_OMP_END_PARALLEL, ST_OMP_END_PARALLEL_DO, ST_OMP_END_PARALLEL_SECTIONS, ST_OMP_END_PARALLEL_WORKSHARE, ST_OMP_END_SECTIONS, ST_OMP_END_SINGLE, ST_OMP_END_WORKSHARE, ST_OMP_DO, ST_OMP_FLUSH, ST_OMP_MASTER, ST_OMP_ORDERED, ST_OMP_PARALLEL, ST_OMP_PARALLEL_DO, ST_OMP_PARALLEL_SECTIONS, ST_OMP_PARALLEL_WORKSHARE, ST_OMP_SECTIONS, ST_OMP_SECTION, ST_OMP_SINGLE, ST_OMP_THREADPRIVATE, ST_OMP_WORKSHARE): New statement codes. (OMP_LIST_PRIVATE, OMP_LIST_FIRSTPRIVATE, OMP_LIST_LASTPRIVATE, OMP_LIST_COPYPRIVATE, OMP_LIST_SHARED, OMP_LIST_COPYIN, OMP_LIST_PLUS, OMP_LIST_REDUCTION_FIRST, OMP_LIST_MULT, OMP_LIST_SUB, OMP_LIST_AND, OMP_LIST_OR, OMP_LIST_EQV, OMP_LIST_NEQV, OMP_LIST_MAX, OMP_LIST_MIN, OMP_LIST_IAND, OMP_LIST_IOR, OMP_LIST_IEOR, OMP_LIST_REDUCTION_LAST, OMP_LIST_NUM): New OpenMP variable list types. (gfc_omp_clauses): New typedef. (gfc_get_omp_clauses): Define. (EXEC_OMP_CRITICAL, EXEC_OMP_DO, EXEC_OMP_FLUSH, EXEC_OMP_MASTER, EXEC_OMP_ORDERED, EXEC_OMP_PARALLEL, EXEC_OMP_PARALLEL_DO, EXEC_OMP_PARALLEL_SECTIONS, EXEC_OMP_PARALLEL_WORKSHARE, EXEC_OMP_SECTIONS, EXEC_OMP_SINGLE, EXEC_OMP_WORKSHARE, EXEC_OMP_ATOMIC, EXEC_OMP_BARRIER, EXEC_OMP_END_NOWAIT, EXEC_OMP_END_SINGLE): New OpenMP gfc_exec_op codes. (struct gfc_code): Add omp_clauses, omp_name, omp_namelist and omp_bool fields to ext union. (flag_openmp): Declare. (gfc_free_omp_clauses, gfc_resolve_omp_directive): New prototypes. * scanner.c (openmp_flag, openmp_locus): New variables. (skip_free_comments, skip_fixed_comments, gfc_next_char_literal): Handle OpenMP directive lines and conditional compilation magic comments. * parse.h (COMP_OMP_STRUCTURED_BLOCK): New compile state. * parse.c (decode_omp_directive, parse_omp_do, parse_omp_atomic, parse_omp_structured_block): New functions. (next_free, next_fixed): Parse OpenMP directives. (case_executable, case_exec_markers, case_decl): Add ST_OMP_* codes. (gfc_ascii_statement): Handle ST_OMP_* codes. (parse_executable): Rearrange the loop slightly, so that parse_omp_do can return next_statement. * match.h (gfc_match_omp_eos, gfc_match_omp_atomic, gfc_match_omp_barrier, gfc_match_omp_critical, gfc_match_omp_do, gfc_match_omp_flush, gfc_match_omp_master, gfc_match_omp_ordered, gfc_match_omp_parallel, gfc_match_omp_parallel_do, gfc_match_omp_parallel_sections, gfc_match_omp_parallel_workshare, gfc_match_omp_sections, gfc_match_omp_single, gfc_match_omp_threadprivate, gfc_match_omp_workshare, gfc_match_omp_end_nowait, gfc_match_omp_end_single): New prototypes. * resolve.c (resolve_blocks): Ignore EXEC_OMP_* block directives. (resolve_code): Call gfc_resolve_omp_directive on EXEC_OMP_* directives. * trans.c (gfc_trans_code): Call gfc_trans_omp_directive for EXEC_OMP_* directives. * st.c (gfc_free_statement): Handle EXEC_OMP_* statement freeing. * trans-stmt.h (gfc_trans_omp_directive): New prototype. * openmp.c: New file. * trans-openmp.c: New file. gcc/testsuite/ 2006-02-14 Jakub Jelinek <jakub@redhat.com> Diego Novillo <dnovillo@redhat.com> Uros Bizjak <uros@kss-loka.si> * gfortran.dg/gomp: New directory. libgomp/ 2006-02-14 Jakub Jelinek <jakub@redhat.com> * testsuite/libgomp.fortran/vla7.f90: Add -w to options. Remove tests for returning assumed character length arrays. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@110984 138bc75d-0d04-0410-961f-82ee72b054a4
author: jakub <jakub@138bc75d-0d04-0410-961f-82ee72b054a4> 2006-02-14 16:38:03 +0000
committer: jakub <jakub@138bc75d-0d04-0410-961f-82ee72b054a4> 2006-02-14 16:38:03 +0000
commit: 764f11758d254e1dee25b04620786ef89ad6ccce (patch)
tree: 869f129d646d69ab3554ebb97c0c1c603b0f77c0 /libgomp
parent: 2244ee93d466d8af82d22ec3c4b6d2df60033cb1 (diff)
download: gcc-764f11758d254e1dee25b04620786ef89ad6ccce.tar.gz
76 files changed, 5061 insertions, 0 deletions
diff --git a/libgomp/ChangeLog b/libgomp/ChangeLog
index 260d9680dc0..fd21de23a52 100644
--- a/libgomp/ChangeLog
+++ b/libgomp/ChangeLog
@@ -1,3 +1,8 @@
+2006-02-13  Jakub Jelinek  <jakub@redhat.com>
+
+	* testsuite/libgomp.fortran/vla7.f90: Add -w to options.
+	Remove tests for returning assumed character length arrays.
+
 2006-02-12  Roger Sayle  <roger@eyesopen.com>
 	    John David Anglin  <dave@hiauly1.hia.nrc.ca>
 
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.15.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.15.1.f90
new file mode 100644
index 00000000000..3d95451eaff
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.15.1.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+      SUBROUTINE WORK(N)
+        INTEGER N
+      END SUBROUTINE WORK
+      SUBROUTINE SUB3(N)
+      INTEGER N
+        CALL WORK(N)
+!$OMP BARRIER
+        CALL WORK(N)
+      END SUBROUTINE SUB3
+      SUBROUTINE SUB2(K)
+      INTEGER K
+!$OMP PARALLEL SHARED(K)
+          CALL SUB3(K)
+!$OMP END PARALLEL
+      END SUBROUTINE SUB2
+      SUBROUTINE SUB1(N)
+      INTEGER N
+        INTEGER I
+!$OMP PARALLEL PRIVATE(I) SHARED(N)
+!$OMP DO
+          DO I = 1, N
+             CALL SUB2(I)
+          END DO
+!$OMP END PARALLEL
+      END SUBROUTINE SUB1
+      PROGRAM A15
+        CALL SUB1(2)
+        CALL SUB2(2)
+        CALL SUB3(2)
+      END PROGRAM A15
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.16.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.16.1.f90
new file mode 100644
index 00000000000..014d4fd5ac4
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.16.1.f90
@@ -0,0 +1,41 @@
+! { dg-do run }
+        REAL FUNCTION WORK1(I)
+            INTEGER I
+            WORK1 = 1.0 * I
+            RETURN
+        END FUNCTION WORK1
+
+        REAL FUNCTION WORK2(I)
+            INTEGER I
+            WORK2 = 2.0 * I
+            RETURN
+        END FUNCTION WORK2
+
+        SUBROUTINE SUBA16(X, Y, INDEX, N)
+        REAL X(*), Y(*)
+        INTEGER INDEX(*), N
+        INTEGER I
+!$OMP PARALLEL DO SHARED(X, Y, INDEX, N)
+          DO I=1,N
+!$OMP ATOMIC
+              X(INDEX(I)) = X(INDEX(I)) + WORK1(I)
+            Y(I) = Y(I) + WORK2(I)
+          ENDDO
+      END SUBROUTINE SUBA16
+
+      PROGRAM A16
+        REAL X(1000), Y(10000)
+        INTEGER INDEX(10000)
+        INTEGER I
+        DO I=1,10000
+          INDEX(I) = MOD(I, 1000) + 1
+          Y(I) = 0.0
+        ENDDO
+        DO I = 1,1000
+          X(I) = 0.0
+        ENDDO
+        CALL SUBA16(X, Y, INDEX, 10000)
+        DO I = 1,10
+          PRINT *, "X(", I, ") = ", X(I), ", Y(", I, ") = ", Y(I)
+        ENDDO
+      END PROGRAM A16
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.18.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.18.1.f90
new file mode 100644
index 00000000000..3321485efc3
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.18.1.f90
@@ -0,0 +1,59 @@
+! { dg-do run }
+! { dg-options "-ffixed-form" }
+      REAL FUNCTION FN1(I)
+        INTEGER I
+        FN1 = I * 2.0
+        RETURN
+      END FUNCTION FN1
+
+      REAL FUNCTION FN2(A, B)
+        REAL A, B
+        FN2 = A + B
+        RETURN
+      END FUNCTION FN2
+
+      PROGRAM A18
+      INCLUDE "omp_lib.h"     ! or USE OMP_LIB
+      INTEGER ISYNC(256)
+      REAL    WORK(256)
+      REAL    RESULT(256)
+      INTEGER IAM, NEIGHBOR
+!$OMP PARALLEL PRIVATE(IAM, NEIGHBOR) SHARED(WORK, ISYNC) NUM_THREADS(4)
+          IAM = OMP_GET_THREAD_NUM() + 1
+          ISYNC(IAM) = 0
+!$OMP BARRIER
+!     Do computation into my portion of work array
+          WORK(IAM) = FN1(IAM)
+!     Announce that I am done with my work.
+!     The first flush ensures that my work is made visible before
+!     synch. The second flush ensures that synch is made visible.
+!$OMP FLUSH(WORK,ISYNC)
+       ISYNC(IAM) = 1
+!$OMP FLUSH(ISYNC)
+
+!      Wait until neighbor is done. The first flush ensures that
+!      synch is read from memory, rather than from the temporary
+!      view of memory. The second flush ensures that work is read
+!      from memory, and is done so after the while loop exits.
+       IF (IAM .EQ. 1) THEN
+            NEIGHBOR = OMP_GET_NUM_THREADS()
+        ELSE
+            NEIGHBOR = IAM - 1
+        ENDIF
+        DO WHILE (ISYNC(NEIGHBOR) .EQ. 0)
+!$OMP FLUSH(ISYNC)
+        END DO
+!$OMP FLUSH(WORK, ISYNC)
+        RESULT(IAM) = FN2(WORK(NEIGHBOR), WORK(IAM))
+!$OMP END PARALLEL
+        DO I=1,4
+          IF (I .EQ. 1) THEN
+                NEIGHBOR = 4
+          ELSE
+                NEIGHBOR = I - 1
+          ENDIF
+          IF (RESULT(I) .NE. I * 2 + NEIGHBOR * 2) THEN
+            CALL ABORT
+          ENDIF
+        ENDDO
+        END PROGRAM A18
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.19.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.19.1.f90
new file mode 100644
index 00000000000..1fe1c424726
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.19.1.f90
@@ -0,0 +1,60 @@
+! { dg-do run }
+        SUBROUTINE F1(Q)
+        COMMON /DATA/ P, X
+        INTEGER, TARGET :: X
+        INTEGER, POINTER :: P
+        INTEGER Q
+        Q=1
+!$OMP FLUSH
+        ! X, P and Q are flushed
+        ! because they are shared and accessible
+      END SUBROUTINE F1
+      SUBROUTINE F2(Q)
+        COMMON /DATA/ P, X
+        INTEGER, TARGET :: X
+        INTEGER, POINTER :: P
+        INTEGER Q
+!$OMP BARRIER
+          Q=2
+!$OMP BARRIER
+          ! a barrier implies a flush
+          ! X, P and Q are flushed
+          ! because they are shared and accessible
+        END SUBROUTINE F2
+
+      INTEGER FUNCTION G(N)
+          COMMON /DATA/ P, X
+          INTEGER, TARGET :: X
+          INTEGER, POINTER :: P
+          INTEGER N
+          INTEGER I, J, SUM
+          I=1
+          SUM = 0
+          P=1
+!$OMP PARALLEL REDUCTION(+: SUM) NUM_THREADS(2)
+          CALL F1(J)
+                ! I, N and SUM were not flushed
+                !   because they were not accessible in F1
+                ! J was flushed because it was accessible
+          SUM = SUM + J
+          CALL F2(J)
+                ! I, N, and SUM were not flushed
+                ! because they were not accessible in f2
+                ! J was flushed because it was accessible
+          SUM = SUM + I + J + P + N
+!$OMP END PARALLEL
+          G = SUM
+      END FUNCTION G
+
+      PROGRAM A19
+        COMMON /DATA/ P, X
+        INTEGER, TARGET :: X
+        INTEGER, POINTER :: P
+        INTEGER RESULT, G
+        P => X
+        RESULT = G(10)
+        PRINT *, RESULT
+        IF (RESULT .NE. 30) THEN
+          CALL ABORT
+        ENDIF
+      END PROGRAM A19
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.2.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.2.1.f90
new file mode 100644
index 00000000000..2b09f5b1fd5
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.2.1.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+PROGRAM A2
+  INCLUDE "omp_lib.h"      ! or USE OMP_LIB
+  INTEGER X
+  X=2
+!$OMP PARALLEL NUM_THREADS(2) SHARED(X)
+    IF (OMP_GET_THREAD_NUM() .EQ. 0) THEN
+       X=5
+    ELSE
+    ! PRINT 1: The following read of x has a race
+      PRINT *,"1: THREAD# ", OMP_GET_THREAD_NUM(), "X = ", X
+    ENDIF
+!$OMP BARRIER
+    IF (OMP_GET_THREAD_NUM() .EQ. 0) THEN
+    ! PRINT 2
+      PRINT *,"2: THREAD# ", OMP_GET_THREAD_NUM(), "X = ", X
+    ELSE
+    ! PRINT 3
+      PRINT *,"3: THREAD# ", OMP_GET_THREAD_NUM(), "X = ", X
+    ENDIF
+!$OMP END PARALLEL
+END PROGRAM A2
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.21.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.21.1.f90
new file mode 100644
index 00000000000..c22fa116927
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.21.1.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+      SUBROUTINE WORK(K)
+        INTEGER k
+!$OMP ORDERED
+        WRITE(*,*) K
+!$OMP END ORDERED
+      END SUBROUTINE WORK
+      SUBROUTINE SUBA21(LB, UB, STRIDE)
+        INTEGER LB, UB, STRIDE
+        INTEGER I
+!$OMP PARALLEL DO ORDERED SCHEDULE(DYNAMIC)
+        DO I=LB,UB,STRIDE
+          CALL WORK(I)
+        END DO
+!$OMP END PARALLEL DO
+      END SUBROUTINE SUBA21
+      PROGRAM A21
+        CALL SUBA21(1,100,5)
+      END PROGRAM A21
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.22.7.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.22.7.f90
new file mode 100644
index 00000000000..fff4e6d4997
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.22.7.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+! { dg-require-effective-target tls_runtime }
+
+      PROGRAM A22_7_GOOD
+        INTEGER, ALLOCATABLE, SAVE :: A(:)
+        INTEGER, POINTER, SAVE :: PTR
+        INTEGER, SAVE :: I
+        INTEGER, TARGET :: TARG
+        LOGICAL :: FIRSTIN = .TRUE.
+!$OMP THREADPRIVATE(A, I, PTR)
+        ALLOCATE (A(3))
+        A = (/1,2,3/)
+        PTR => TARG
+        I=5
+!$OMP PARALLEL COPYIN(I, PTR)
+!$OMP CRITICAL
+            IF (FIRSTIN) THEN
+              TARG = 4           ! Update target of ptr
+              I = I + 10
+              IF (ALLOCATED(A)) A = A + 10
+              FIRSTIN = .FALSE.
+            END IF
+            IF (ALLOCATED(A)) THEN
+              PRINT *, "a = ", A
+            ELSE
+              PRINT *, "A is not allocated"
+            END IF
+            PRINT *, "ptr = ", PTR
+            PRINT *, "i = ", I
+            PRINT *
+!$OMP END CRITICAL
+!$OMP END PARALLEL
+      END PROGRAM A22_7_GOOD
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.22.8.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.22.8.f90
new file mode 100644
index 00000000000..cf6d90ee828
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.22.8.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+! { dg-require-effective-target tls_runtime }
+       MODULE A22_MODULE8
+         REAL, POINTER :: WORK(:)
+         SAVE WORK
+!$OMP THREADPRIVATE(WORK)
+       END MODULE A22_MODULE8
+       SUBROUTINE SUB1(N)
+       USE A22_MODULE8
+!$OMP PARALLEL PRIVATE(THE_SUM)
+         ALLOCATE(WORK(N))
+         CALL SUB2(THE_SUM)
+        WRITE(*,*)THE_SUM
+!$OMP END PARALLEL
+       END SUBROUTINE SUB1
+       SUBROUTINE SUB2(THE_SUM)
+        USE A22_MODULE8
+        WORK(:) = 10
+        THE_SUM=SUM(WORK)
+        END SUBROUTINE SUB2
+        PROGRAM A22_8_GOOD
+        N = 10
+        CALL SUB1(N)
+        END PROGRAM A22_8_GOOD
+
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.26.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.26.1.f90
new file mode 100644
index 00000000000..e9ebf87af73
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.26.1.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+       PROGRAM A26
+         INTEGER I, J
+         I=1
+         J=2
+!$OMP PARALLEL PRIVATE(I) FIRSTPRIVATE(J)
+           I=3
+           J=J+2
+!$OMP END PARALLEL
+          PRINT *, I, J ! I and J are undefined
+      END PROGRAM A26
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.1.f90
new file mode 100644
index 00000000000..c271333a86d
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.1.f90
@@ -0,0 +1,14 @@
+! { dg-do run }
+
+       SUBROUTINE SUB()
+       COMMON /BLOCK/ X
+       PRINT *,X              ! X is undefined
+       END SUBROUTINE SUB
+       PROGRAM A28_1
+         COMMON /BLOCK/ X
+         X = 1.0
+!$OMP PARALLEL PRIVATE (X)
+         X = 2.0
+         CALL SUB()
+!$OMP END PARALLEL
+      END PROGRAM A28_1
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.2.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.2.f90
new file mode 100644
index 00000000000..1145e541026
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.2.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+
+      PROGRAM A28_2
+        COMMON /BLOCK2/ X
+        X = 1.0
+!$OMP PARALLEL PRIVATE (X)
+          X = 2.0
+          CALL SUB()
+!$OMP END PARALLEL
+       CONTAINS
+        SUBROUTINE SUB()
+        COMMON /BLOCK2/ Y
+        PRINT *,X                 ! X is undefined
+        PRINT *,Y                 ! Y is undefined
+        END SUBROUTINE SUB
+      END PROGRAM A28_2
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.3.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.3.f90
new file mode 100644
index 00000000000..a337f3bc7d5
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.3.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+
+        PROGRAM A28_3
+        EQUIVALENCE (X,Y)
+        X = 1.0
+!$OMP PARALLEL PRIVATE(X)
+          PRINT *,Y         ! Y is undefined
+          Y = 10
+          PRINT *,X         ! X is undefined
+!$OMP END PARALLEL
+      END PROGRAM A28_3
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.4.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.4.f90
new file mode 100644
index 00000000000..c5a5cd74cf5
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.4.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+
+       PROGRAM A28_4
+         INTEGER I, J
+         INTEGER A(100), B(100)
+         EQUIVALENCE (A(51), B(1))
+!$OMP PARALLEL DO DEFAULT(PRIVATE) PRIVATE(I,J) LASTPRIVATE(A)
+           DO I=1,100
+               DO J=1,100
+                 B(J) = J - 1
+               ENDDO
+               DO J=1,100
+                 A(J) = J    ! B becomes undefined at this point
+               ENDDO
+               DO J=1,50
+                 B(J) = B(J) + 1 ! B is undefined
+                            ! A becomes undefined at this point
+               ENDDO
+           ENDDO
+!$OMP END PARALLEL DO          ! The LASTPRIVATE write for A has
+                               ! undefined results
+        PRINT *, B  ! B is undefined since the LASTPRIVATE
+                    ! write of A was not defined
+        END PROGRAM A28_4
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.5.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.5.f90
new file mode 100644
index 00000000000..e3775822f10
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.5.f90
@@ -0,0 +1,29 @@
+! { dg-do compile }
+
+      SUBROUTINE SUB1(X)
+        DIMENSION X(10)
+        ! This use of X does not conform to the
+        ! specification. It would be legal Fortran 90,
+        ! but the OpenMP private directive allows the
+        ! compiler to break the sequence association that
+        ! A had with the rest of the common block.
+        FORALL (I = 1:10) X(I) = I
+      END SUBROUTINE SUB1
+      PROGRAM A28_5
+        COMMON /BLOCK5/ A
+        DIMENSION B(10)
+        EQUIVALENCE (A,B(1))
+        ! the common block has to be at least 10 words
+        A=0
+!$OMP PARALLEL PRIVATE(/BLOCK5/)
+          ! Without the private clause,
+          ! we would be passing a member of a sequence
+          ! that is at least ten elements long.
+          ! With the private clause, A may no longer be
+          ! sequence-associated.
+          CALL SUB1(A)
+!$OMP MASTER
+            PRINT *, A
+!$OMP END MASTER
+!$OMP END PARALLEL
+      END PROGRAM A28_5
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.3.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.3.1.f90
new file mode 100644
index 00000000000..0a175727279
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.3.1.f90
@@ -0,0 +1,6 @@
+! { dg-do run }
+! { dg-options "-ffixed-form" }
+      PROGRAM A3
+!234567890
+!$    PRINT *, "Compiled by an OpenMP-compliant implementation."
+      END PROGRAM A3
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.31.4.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.31.4.f90
new file mode 100644
index 00000000000..69882c1e6b9
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.31.4.f90
@@ -0,0 +1,12 @@
+! { dg-do run }
+        MODULE M
+        INTRINSIC MAX
+        END MODULE M
+        PROGRAM A31_4
+        USE M, REN => MAX
+        N=0
+!$OMP PARALLEL DO REDUCTION(REN: N) ! still does MAX
+        DO I = 1, 100
+            N = MAX(N,I)
+        END DO
+        END PROGRAM A31_4
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.31.5.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.31.5.f90
new file mode 100644
index 00000000000..91a97cd829d
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.31.5.f90
@@ -0,0 +1,14 @@
+! { dg-do run }
+            MODULE MOD
+            INTRINSIC MAX, MIN
+            END MODULE MOD
+            PROGRAM A31_5
+            USE MOD, MIN=>MAX, MAX=>MIN
+            REAL :: R
+            R = -HUGE(0.0)
+            !$OMP PARALLEL DO REDUCTION(MIN: R) ! still does MAX
+            DO I = 1, 1000
+                R = MIN(R, SIN(REAL(I)))
+            END DO
+            PRINT *, R
+            END PROGRAM A31_5
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.33.3.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.33.3.f90
new file mode 100644
index 00000000000..adc493fcf0a
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.33.3.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+
+      FUNCTION NEW_LOCK()
+      USE OMP_LIB       ! or INCLUDE "omp_lib.h"
+        INTEGER(OMP_LOCK_KIND), POINTER :: NEW_LOCK
+!$OMP SINGLE
+          ALLOCATE(NEW_LOCK)
+          CALL OMP_INIT_LOCK(NEW_LOCK)
+!$OMP END SINGLE COPYPRIVATE(NEW_LOCK)
+      END FUNCTION NEW_LOCK
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.38.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.38.1.f90
new file mode 100644
index 00000000000..55541303cea
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.38.1.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+
+      FUNCTION NEW_LOCKS()
+        USE OMP_LIB        ! or INCLUDE "omp_lib.h"
+        INTEGER(OMP_LOCK_KIND), DIMENSION(1000) :: NEW_LOCKS
+        INTEGER I
+!$OMP PARALLEL DO PRIVATE(I)
+          DO I=1,1000
+            CALL OMP_INIT_LOCK(NEW_LOCKS(I))
+          END DO
+!$OMP END PARALLEL DO
+      END FUNCTION NEW_LOCKS
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.39.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.39.1.f90
new file mode 100644
index 00000000000..540d17f5b02
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.39.1.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+
+      SUBROUTINE SKIP(ID)
+      END SUBROUTINE SKIP
+      SUBROUTINE WORK(ID)
+      END SUBROUTINE WORK
+      PROGRAM A39
+        INCLUDE "omp_lib.h"      ! or USE OMP_LIB
+        INTEGER(OMP_LOCK_KIND) LCK
+        INTEGER ID
+        CALL OMP_INIT_LOCK(LCK)
+!$OMP PARALLEL SHARED(LCK) PRIVATE(ID)
+          ID = OMP_GET_THREAD_NUM()
+          CALL OMP_SET_LOCK(LCK)
+          PRINT *, "My thread id is ", ID
+          CALL OMP_UNSET_LOCK(LCK)
+          DO WHILE (.NOT. OMP_TEST_LOCK(LCK))
+            CALL SKIP(ID)     ! We do not yet have the lock
+                              ! so we must do something else
+          END DO
+          CALL WORK(ID)       ! We now have the lock
+                              ! and can do the work
+          CALL OMP_UNSET_LOCK( LCK )
+!$OMP END PARALLEL
+        CALL OMP_DESTROY_LOCK( LCK )
+        END PROGRAM A39
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.4.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.4.1.f90
new file mode 100644
index 00000000000..3c2a74a4fdd
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.4.1.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+      SUBROUTINE SUBDOMAIN(X, ISTART, IPOINTS)
+          INTEGER ISTART, IPOINTS
+          REAL X(*)
+          INTEGER I
+          DO 100 I=1,IPOINTS
+             X(ISTART+I) = 123.456
+ 100      CONTINUE
+      END SUBROUTINE SUBDOMAIN
+      SUBROUTINE SUB(X, NPOINTS)
+          INCLUDE "omp_lib.h"      ! or USE OMP_LIB
+          REAL X(*)
+          INTEGER NPOINTS
+          INTEGER IAM, NT, IPOINTS, ISTART
+!$OMP PARALLEL DEFAULT(PRIVATE) SHARED(X,NPOINTS)
+          IAM = OMP_GET_THREAD_NUM()
+          NT = OMP_GET_NUM_THREADS()
+          IPOINTS = NPOINTS/NT
+          ISTART = IAM * IPOINTS
+          IF (IAM .EQ. NT-1) THEN
+              IPOINTS = NPOINTS - ISTART
+          ENDIF
+          CALL SUBDOMAIN(X,ISTART,IPOINTS)
+!$OMP END PARALLEL
+      END SUBROUTINE SUB
+      PROGRAM A4
+          REAL ARRAY(10000)
+          CALL SUB(ARRAY, 10000)
+      END PROGRAM A4
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.40.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.40.1.f90
new file mode 100644
index 00000000000..38fbca3fced
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.40.1.f90
@@ -0,0 +1,52 @@
+! { dg-do compile }
+! { dg-options "-ffixed-form" }
+        MODULE DATA
+        USE OMP_LIB, ONLY: OMP_NEST_LOCK_KIND
+        TYPE LOCKED_PAIR
+        INTEGER A
+        INTEGER B
+        INTEGER (OMP_NEST_LOCK_KIND) LCK
+        END TYPE
+            END MODULE DATA
+        SUBROUTINE INCR_A(P, A)
+            ! called only from INCR_PAIR, no need to lock
+            USE DATA
+            TYPE(LOCKED_PAIR) :: P
+            INTEGER A
+            P%A = P%A + A
+        END SUBROUTINE INCR_A
+        SUBROUTINE INCR_B(P, B)
+            ! called from both INCR_PAIR and elsewhere,
+            ! so we need a nestable lock
+            USE OMP_LIB       ! or INCLUDE "omp_lib.h"
+            USE DATA
+            TYPE(LOCKED_PAIR) :: P
+            INTEGER B
+            CALL OMP_SET_NEST_LOCK(P%LCK)
+            P%B = P%B + B
+            CALL OMP_UNSET_NEST_LOCK(P%LCK)
+        END SUBROUTINE INCR_B
+        SUBROUTINE INCR_PAIR(P, A, B)
+            USE OMP_LIB         ! or INCLUDE "omp_lib.h"
+            USE DATA
+            TYPE(LOCKED_PAIR) :: P
+            INTEGER A
+            INTEGER B
+        CALL OMP_SET_NEST_LOCK(P%LCK)
+        CALL INCR_A(P, A)
+        CALL INCR_B(P, B)
+        CALL OMP_UNSET_NEST_LOCK(P%LCK)
+      END SUBROUTINE INCR_PAIR
+      SUBROUTINE A40(P)
+        USE OMP_LIB        ! or INCLUDE "omp_lib.h"
+        USE DATA
+        TYPE(LOCKED_PAIR) :: P
+        INTEGER WORK1, WORK2, WORK3
+        EXTERNAL WORK1, WORK2, WORK3
+!$OMP PARALLEL SECTIONS
+!$OMP SECTION
+          CALL INCR_PAIR(P, WORK1(), WORK2())
+!$OMP SECTION
+          CALL INCR_B(P, WORK3())
+!$OMP END PARALLEL SECTIONS
+      END SUBROUTINE A40
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.5.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.5.1.f90
new file mode 100644
index 00000000000..13e451e506a
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.5.1.f90
@@ -0,0 +1,8 @@
+! { dg-do run }
+      PROGRAM A5
+        INCLUDE "omp_lib.h"      ! or USE OMP_LIB
+        CALL OMP_SET_DYNAMIC(.TRUE.)
+!$OMP PARALLEL NUM_THREADS(10)
+            ! do work here
+!$OMP END PARALLEL
+      END PROGRAM A5
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a10.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a10.1.f90
new file mode 100644
index 00000000000..c1564bf4b3f
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a10.1.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+      SUBROUTINE WORK1()
+      END SUBROUTINE WORK1
+      SUBROUTINE WORK2()
+      END SUBROUTINE WORK2
+      PROGRAM A10
+!$OMP PARALLEL
+!$OMP SINGLE
+        print *, "Beginning work1."
+!$OMP END SINGLE
+        CALL WORK1()
+!$OMP SINGLE
+        print *, "Finishing work1."
+!$OMP END SINGLE
+!$OMP SINGLE
+        print *, "Finished work1 and beginning work2."
+!$OMP END SINGLE NOWAIT
+        CALL WORK2()
+!$OMP END PARALLEL
+      END PROGRAM A10
diff --git a/libgomp/testsuite/libgomp.fortran/character1.f90 b/libgomp/testsuite/libgomp.fortran/character1.f90
new file mode 100644
index 00000000000..f75ae27e8f9
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/character1.f90
@@ -0,0 +1,72 @@
+! { dg-do run }
+!$ use omp_lib
+
+  character (len = 8) :: h, i
+  character (len = 4) :: j, k
+  h = '01234567'
+  i = 'ABCDEFGH'
+  j = 'IJKL'
+  k = 'MN'
+  call test (h, j)
+contains
+  subroutine test (p, q)
+    character (len = 8) :: p
+    character (len = 4) :: q, r
+    character (len = 16) :: f
+    character (len = 32) :: g
+    integer, dimension (18) :: s
+    logical :: l
+    integer :: m
+    f = 'test16'
+    g = 'abcdefghijklmnopqrstuvwxyz'
+    r = ''
+    l = .false.
+    s = -6
+!$omp parallel firstprivate (f, p, s) private (r, m) reduction (.or.:l) &
+!$omp & num_threads (4)
+    m = omp_get_thread_num ()
+    if (any (s .ne. -6)) l = .true.
+    l = l .or. f .ne. 'test16' .or. p .ne. '01234567'
+    l = l .or. g .ne. 'abcdefghijklmnopqrstuvwxyz'
+    l = l .or. i .ne. 'ABCDEFGH' .or. q .ne. 'IJKL'
+    l = l .or. k .ne. 'MN'
+!$omp barrier
+    if (m .eq. 0) then
+      f = 'ffffffff0'
+      g = 'xyz'
+      i = '123'
+      k = '9876'
+      p = '_abc'
+      q = '_def'
+      r = '1_23'
+    else if (m .eq. 1) then
+      f = '__'
+      p = 'xxx'
+      r = '7575'
+    else if (m .eq. 2) then
+      f = 'ZZ'
+      p = 'm2'
+      r = 'M2'
+    else if (m .eq. 3) then
+      f = 'YY'
+      p = 'm3'
+      r = 'M3'
+    end if
+    s = m
+!$omp barrier
+    l = l .or. g .ne. 'xyz' .or. i .ne. '123' .or. k .ne. '9876'
+    l = l .or. q .ne. '_def'
+    if (any (s .ne. m)) l = .true.
+    if (m .eq. 0) then
+      l = l .or. f .ne. 'ffffffff0' .or. p .ne. '_abc' .or. r .ne. '1_23'
+    else if (m .eq. 1) then
+      l = l .or. f .ne. '__' .or. p .ne. 'xxx' .or. r .ne. '7575'
+    else if (m .eq. 2) then
+      l = l .or. f .ne. 'ZZ' .or. p .ne. 'm2' .or. r .ne. 'M2'
+    else if (m .eq. 3) then
+      l = l .or. f .ne. 'YY' .or. p .ne. 'm3' .or. r .ne. 'M3'
+    end if
+!$omp end parallel
+    if (l) call abort
+  end subroutine test
+end
diff --git a/libgomp/testsuite/libgomp.fortran/character2.f90 b/libgomp/testsuite/libgomp.fortran/character2.f90
new file mode 100644
index 00000000000..d59032b57a0
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/character2.f90
@@ -0,0 +1,61 @@
+! { dg-do run }
+!$ use omp_lib
+
+  character (len = 8) :: h
+  character (len = 9) :: i
+  h = '01234567'
+  i = 'ABCDEFGHI'
+  call test (h, i, 9)
+contains
+  subroutine test (p, q, n)
+    character (len = *) :: p
+    character (len = n) :: q
+    character (len = n) :: r
+    character (len = n) :: t
+    character (len = n) :: u
+    integer, dimension (n + 4) :: s
+    logical :: l
+    integer :: m
+    r = ''
+    if (n .gt. 8) r = 'jklmnopqr'
+    do m = 1, n + 4
+      s(m) = m
+    end do
+    u = 'abc'
+    l = .false.
+!$omp parallel firstprivate (p, q, r) private (t, m) reduction (.or.:l) &
+!$omp & num_threads (2)
+    do m = 1, 13
+      if (s(m) .ne. m) l = .true.
+    end do
+    m = omp_get_thread_num ()
+    l = l .or. p .ne. '01234567' .or. q .ne. 'ABCDEFGHI'
+    l = l .or. r .ne. 'jklmnopqr' .or. u .ne. 'abc'
+!$omp barrier
+    if (m .eq. 0) then
+      p = 'A'
+      q = 'B'
+      r = 'C'
+      t = '123'
+      u = '987654321'
+    else if (m .eq. 1) then
+      p = 'D'
+      q = 'E'
+      r = 'F'
+      t = '456'
+      s = m
+    end if
+!$omp barrier
+    l = l .or. u .ne. '987654321'
+    if (any (s .ne. 1)) l = .true.
+    if (m .eq. 0) then
+      l = l .or. p .ne. 'A' .or. q .ne. 'B' .or. r .ne. 'C'
+      l = l .or. t .ne. '123'
+    else
+      l = l .or. p .ne. 'D' .or. q .ne. 'E' .or. r .ne. 'F'
+      l = l .or. t .ne. '456'
+    end if
+!$omp end parallel
+    if (l) call abort
+  end subroutine test
+end
diff --git a/libgomp/testsuite/libgomp.fortran/crayptr1.f90 b/libgomp/testsuite/libgomp.fortran/crayptr1.f90
new file mode 100644
index 00000000000..57c59f71f9f
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/crayptr1.f90
@@ -0,0 +1,46 @@
+! { dg-do run }
+! { dg-options "-fopenmp -fcray-pointer" }
+
+  use omp_lib
+  integer :: a, b, c, p
+  logical :: l
+  pointer (ip, p)
+  a = 1
+  b = 2
+  c = 3
+  l = .false.
+  ip = loc (a)
+
+!$omp parallel num_threads (2) reduction (.or.:l)
+  l = p .ne. 1
+!$omp barrier
+!$omp master
+  ip = loc (b)
+!$omp end master
+!$omp barrier
+  l = l .or. p .ne. 2
+!$omp barrier
+  if (omp_get_thread_num () .eq. 1 .or. omp_get_num_threads () .lt. 2) &
+    ip = loc (c)
+!$omp barrier
+  l = l .or. p .ne. 3
+!$omp end parallel
+
+  if (l) call abort
+
+  l = .false.
+!$omp parallel num_threads (2) reduction (.or.:l) default (private)
+  ip = loc (a)
+  a = 3 * omp_get_thread_num () + 4
+  b = a + 1
+  c = a + 2
+  l = p .ne. 3 * omp_get_thread_num () + 4
+  ip = loc (c)
+  l = l .or. p .ne. 3 * omp_get_thread_num () + 6
+  ip = loc (b)
+  l = l .or. p .ne. 3 * omp_get_thread_num () + 5
+!$omp end parallel
+
+  if (l) call abort
+
+end
diff --git a/libgomp/testsuite/libgomp.fortran/do1.f90 b/libgomp/testsuite/libgomp.fortran/do1.f90
new file mode 100644
index 00000000000..2a48c7345fc
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/do1.f90
@@ -0,0 +1,179 @@
+! { dg-do run }
+
+  integer, dimension (128) :: a, b
+  integer :: i
+  a = -1
+  b = -1
+  do i = 1, 128
+    if (i .ge. 8 .and. i .le. 15) then
+      b(i) = 1 * 256 + i
+    else if (i .ge. 19 .and. i .le. 23) then
+      b(i) = 2 * 256 + i
+    else if (i .ge. 28 .and. i .le. 38) then
+      if (iand (i, 1) .eq. 0) b(i) = 3 * 256 + i
+    else if (i .ge. 59 .and. i .le. 79) then
+      if (iand (i - 59, 3) .eq. 0) b(i) = 4 * 256 + i
+    else if (i .ge. 101 .and. i .le. 125) then
+      if (mod (i - 101, 12) .eq. 0) b(i) = 5 * 256 + i
+    end if
+  end do
+
+!$omp parallel num_threads (4)
+
+!$omp do
+  do i = 8, 15
+    a(i) = 1 * 256 + i
+  end do
+
+!$omp do
+  do i = 23, 19, -1
+    a(i) = 2 * 256 + i
+  end do
+
+!$omp do
+  do i = 28, 39, 2
+    a(i) = 3 * 256 + i
+  end do
+
+!$omp do
+  do i = 79, 59, -4
+    a(i) = 4 * 256 + i
+  end do
+
+!$omp do
+  do i = 125, 90, -12
+    a(i) = 5 * 256 + i
+  end do
+
+!$omp end parallel
+
+  if (any (a .ne. b)) call abort
+  a = -1
+
+!$omp parallel num_threads (4)
+
+!$omp do schedule (static)
+  do i = 8, 15
+    a(i) = 1 * 256 + i
+  end do
+
+!$omp do schedule (static, 1)
+  do i = 23, 19, -1
+    a(i) = 2 * 256 + i
+  end do
+
+!$omp do schedule (static, 3)
+  do i = 28, 39, 2
+    a(i) = 3 * 256 + i
+  end do
+
+!$omp do schedule (static, 6)
+  do i = 79, 59, -4
+    a(i) = 4 * 256 + i
+  end do
+
+!$omp do schedule (static, 2)
+  do i = 125, 90, -12
+    a(i) = 5 * 256 + i
+  end do
+
+!$omp end parallel
+
+  if (any (a .ne. b)) call abort
+  a = -1
+
+!$omp parallel num_threads (4)
+
+!$omp do schedule (dynamic)
+  do i = 8, 15
+    a(i) = 1 * 256 + i
+  end do
+
+!$omp do schedule (dynamic, 4)
+  do i = 23, 19, -1
+    a(i) = 2 * 256 + i
+  end do
+
+!$omp do schedule (dynamic, 1)
+  do i = 28, 39, 2
+    a(i) = 3 * 256 + i
+  end do
+
+!$omp do schedule (dynamic, 2)
+  do i = 79, 59, -4
+    a(i) = 4 * 256 + i
+  end do
+
+!$omp do schedule (dynamic, 3)
+  do i = 125, 90, -12
+    a(i) = 5 * 256 + i
+  end do
+
+!$omp end parallel
+
+  if (any (a .ne. b)) call abort
+  a = -1
+
+!$omp parallel num_threads (4)
+
+!$omp do schedule (guided)
+  do i = 8, 15
+    a(i) = 1 * 256 + i
+  end do
+
+!$omp do schedule (guided, 4)
+  do i = 23, 19, -1
+    a(i) = 2 * 256 + i
+  end do
+
+!$omp do schedule (guided, 1)
+  do i = 28, 39, 2
+    a(i) = 3 * 256 + i
+  end do
+
+!$omp do schedule (guided, 2)
+  do i = 79, 59, -4
+    a(i) = 4 * 256 + i
+  end do
+
+!$omp do schedule (guided, 3)
+  do i = 125, 90, -12
+    a(i) = 5 * 256 + i
+  end do
+
+!$omp end parallel
+
+  if (any (a .ne. b)) call abort
+  a = -1
+
+!$omp parallel num_threads (4)
+
+!$omp do schedule (runtime)
+  do i = 8, 15
+    a(i) = 1 * 256 + i
+  end do
+
+!$omp do schedule (runtime)
+  do i = 23, 19, -1
+    a(i) = 2 * 256 + i
+  end do
+
+!$omp do schedule (runtime)
+  do i = 28, 39, 2
+    a(i) = 3 * 256 + i
+  end do
+
+!$omp do schedule (runtime)
+  do i = 79, 59, -4
+    a(i) = 4 * 256 + i
+  end do
+
+!$omp do schedule (runtime)
+  do i = 125, 90, -12
+    a(i) = 5 * 256 + i
+  end do
+
+!$omp end parallel
+
+  if (any (a .ne. b)) call abort
+end
diff --git a/libgomp/testsuite/libgomp.fortran/do2.f90 b/libgomp/testsuite/libgomp.fortran/do2.f90
new file mode 100644
index 00000000000..b90ccddd80b
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/do2.f90
@@ -0,0 +1,366 @@
+! { dg-do run }
+
+  integer, dimension (128) :: a, b
+  integer :: i, j
+  logical :: k
+  a = -1
+  b = -1
+  do i = 1, 128
+    if (i .ge. 8 .and. i .le. 15) then
+      b(i) = 1 * 256 + i
+    else if (i .ge. 19 .and. i .le. 23) then
+      b(i) = 2 * 256 + i
+    else if (i .ge. 28 .and. i .le. 38) then
+      if (iand (i, 1) .eq. 0) b(i) = 3 * 256 + i
+    else if (i .ge. 59 .and. i .le. 79) then
+      if (iand (i - 59, 3) .eq. 0) b(i) = 4 * 256 + i
+    else if (i .ge. 101 .and. i .le. 125) then
+      if (mod (i - 101, 12) .eq. 0) b(i) = 5 * 256 + i
+    end if
+  end do
+
+  k = .false.
+  j = 8
+!$omp parallel num_threads (4)
+
+!$omp do ordered
+  do i = 8, 15
+    a(i) = 1 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j + 1
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 23
+!$omp end single
+
+!$omp do ordered
+  do i = 23, 19, -1
+    a(i) = 2 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j - 1
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 28
+!$omp end single
+
+!$omp do ordered
+  do i = 28, 39, 2
+    a(i) = 3 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j + 2
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 79
+!$omp end single
+
+!$omp do ordered
+  do i = 79, 59, -4
+    a(i) = 4 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j - 4
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 125
+!$omp end single
+
+!$omp do ordered
+  do i = 125, 90, -12
+    a(i) = 5 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j - 12
+!$omp end ordered
+  end do
+
+!$omp end parallel
+
+  if (any (a .ne. b) .or. k) call abort
+  a = -1
+  k = .false.
+  j = 8
+!$omp parallel num_threads (4)
+
+!$omp do ordered schedule (static)
+  do i = 8, 15
+    a(i) = 1 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j + 1
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 23
+!$omp end single
+
+!$omp do ordered schedule (static, 1)
+  do i = 23, 19, -1
+    a(i) = 2 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j - 1
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 28
+!$omp end single
+
+!$omp do ordered schedule (static, 3)
+  do i = 28, 39, 2
+    a(i) = 3 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j + 2
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 79
+!$omp end single
+
+!$omp do ordered schedule (static, 6)
+  do i = 79, 59, -4
+    a(i) = 4 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j - 4
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 125
+!$omp end single
+
+!$omp do ordered schedule (static, 2)
+  do i = 125, 90, -12
+    a(i) = 5 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j - 12
+!$omp end ordered
+  end do
+
+!$omp end parallel
+
+  if (any (a .ne. b) .or. k) call abort
+  a = -1
+  k = .false.
+  j = 8
+!$omp parallel num_threads (4)
+
+!$omp do ordered schedule (dynamic)
+  do i = 8, 15
+    a(i) = 1 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j + 1
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 23
+!$omp end single
+
+!$omp do ordered schedule (dynamic, 4)
+  do i = 23, 19, -1
+    a(i) = 2 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j - 1
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 28
+!$omp end single
+
+!$omp do ordered schedule (dynamic, 1)
+  do i = 28, 39, 2
+    a(i) = 3 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j + 2
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 79
+!$omp end single
+
+!$omp do ordered schedule (dynamic, 2)
+  do i = 79, 59, -4
+    a(i) = 4 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j - 4
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 125
+!$omp end single
+
+!$omp do ordered schedule (dynamic, 3)
+  do i = 125, 90, -12
+    a(i) = 5 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j - 12
+!$omp end ordered
+  end do
+
+!$omp end parallel
+
+  if (any (a .ne. b) .or. k) call abort
+  a = -1
+  k = .false.
+  j = 8
+!$omp parallel num_threads (4)
+
+!$omp do ordered schedule (guided)
+  do i = 8, 15
+    a(i) = 1 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j + 1
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 23
+!$omp end single
+
+!$omp do ordered schedule (guided, 4)
+  do i = 23, 19, -1
+    a(i) = 2 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j - 1
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 28
+!$omp end single
+
+!$omp do ordered schedule (guided, 1)
+  do i = 28, 39, 2
+    a(i) = 3 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j + 2
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 79
+!$omp end single
+
+!$omp do ordered schedule (guided, 2)
+  do i = 79, 59, -4
+    a(i) = 4 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j - 4
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 125
+!$omp end single
+
+!$omp do ordered schedule (guided, 3)
+  do i = 125, 90, -12
+    a(i) = 5 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j - 12
+!$omp end ordered
+  end do
+
+!$omp end parallel
+
+  if (any (a .ne. b) .or. k) call abort
+  a = -1
+  k = .false.
+  j = 8
+!$omp parallel num_threads (4)
+
+!$omp do ordered schedule (runtime)
+  do i = 8, 15
+    a(i) = 1 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j + 1
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 23
+!$omp end single
+
+!$omp do ordered schedule (runtime)
+  do i = 23, 19, -1
+    a(i) = 2 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j - 1
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 28
+!$omp end single
+
+!$omp do ordered schedule (runtime)
+  do i = 28, 39, 2
+    a(i) = 3 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j + 2
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 79
+!$omp end single
+
+!$omp do ordered schedule (runtime)
+  do i = 79, 59, -4
+    a(i) = 4 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j - 4
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 125
+!$omp end single
+
+!$omp do ordered schedule (runtime)
+  do i = 125, 90, -12
+    a(i) = 5 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j - 12
+!$omp end ordered
+  end do
+
+!$omp end parallel
+
+  if (any (a .ne. b) .or. k) call abort
+end
diff --git a/libgomp/testsuite/libgomp.fortran/fortran.exp b/libgomp/testsuite/libgomp.fortran/fortran.exp
new file mode 100644
index 00000000000..e7ee746c282
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/fortran.exp
@@ -0,0 +1,20 @@
+set lang_library_path	"../libgfortran/.libs"
+set lang_test_file	"${lang_library_path}/libgfortranbegin.a"
+set lang_link_flags	"-lgfortranbegin -lgfortran"
+
+load_lib libgomp-dg.exp
+
+# Initialize dg.
+dg-init
+
+if [file exists "${blddir}/${lang_test_file}"] {
+
+    # Gather a list of all tests.
+    set tests [lsort [find $srcdir/$subdir *.\[fF\]{,90,95}]]
+
+    # Main loop.
+    gfortran-dg-runtest $tests ""
+}
+
+# All done.
+dg-finish
diff --git a/libgomp/testsuite/libgomp.fortran/jacobi.f b/libgomp/testsuite/libgomp.fortran/jacobi.f
new file mode 100644
index 00000000000..b27e20f2766
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/jacobi.f
@@ -0,0 +1,261 @@
+* { dg-do run }
+
+      program main 
+************************************************************
+* program to solve a finite difference 
+* discretization of Helmholtz equation :  
+* (d2/dx2)u + (d2/dy2)u - alpha u = f 
+* using Jacobi iterative method. 
+*
+* Modified: Sanjiv Shah,       Kuck and Associates, Inc. (KAI), 1998
+* Author:   Joseph Robicheaux, Kuck and Associates, Inc. (KAI), 1998
+* 
+* Directives are used in this code to achieve paralleism. 
+* All do loops are parallized with default 'static' scheduling.
+* 
+* Input :  n - grid dimension in x direction 
+*          m - grid dimension in y direction
+*          alpha - Helmholtz constant (always greater than 0.0)
+*          tol   - error tolerance for iterative solver
+*          relax - Successice over relaxation parameter
+*          mits  - Maximum iterations for iterative solver
+*
+* On output 
+*       : u(n,m) - Dependent variable (solutions)
+*       : f(n,m) - Right hand side function 
+*************************************************************
+      implicit none 
+
+      integer n,m,mits,mtemp
+      include "omp_lib.h"
+      double precision tol,relax,alpha 
+
+      common /idat/ n,m,mits,mtemp
+      common /fdat/tol,alpha,relax
+* 
+* Read info 
+* 
+      write(*,*) "Input n,m - grid dimension in x,y direction " 
+      n = 64
+      m = 64
+*     read(5,*) n,m 
+      write(*,*) n, m
+      write(*,*) "Input alpha - Helmholts constant " 
+      alpha = 0.5
+*     read(5,*) alpha
+      write(*,*) alpha
+      write(*,*) "Input relax - Successive over-relaxation parameter"
+      relax = 0.9
+*     read(5,*) relax 
+      write(*,*) relax
+      write(*,*) "Input tol - error tolerance for iterative solver" 
+      tol = 1.0E-12
+*     read(5,*) tol 
+      write(*,*) tol
+      write(*,*) "Input mits - Maximum iterations for solver" 
+      mits = 100
+*     read(5,*) mits
+      write(*,*) mits
+
+      call omp_set_num_threads (2)
+
+*
+* Calls a driver routine 
+* 
+      call driver () 
+
+      stop
+      end 
+
+      subroutine driver ( ) 
+*************************************************************
+* Subroutine driver () 
+* This is where the arrays are allocated and initialzed. 
+*
+* Working varaibles/arrays 
+*     dx  - grid spacing in x direction 
+*     dy  - grid spacing in y direction 
+*************************************************************
+      implicit none 
+
+      integer n,m,mits,mtemp 
+      double precision tol,relax,alpha 
+
+      common /idat/ n,m,mits,mtemp
+      common /fdat/tol,alpha,relax
+
+      double precision u(n,m),f(n,m),dx,dy
+
+* Initialize data
+
+      call initialize (n,m,alpha,dx,dy,u,f)
+
+* Solve Helmholtz equation
+
+      call jacobi (n,m,dx,dy,alpha,relax,u,f,tol,mits)
+
+* Check error between exact solution
+
+      call  error_check (n,m,alpha,dx,dy,u,f)
+
+      return 
+      end 
+
+      subroutine initialize (n,m,alpha,dx,dy,u,f) 
+******************************************************
+* Initializes data 
+* Assumes exact solution is u(x,y) = (1-x^2)*(1-y^2)
+*
+******************************************************
+      implicit none 
+     
+      integer n,m
+      double precision u(n,m),f(n,m),dx,dy,alpha
+      
+      integer i,j, xx,yy
+      double precision PI 
+      parameter (PI=3.1415926)
+
+      dx = 2.0 / (n-1)
+      dy = 2.0 / (m-1)
+
+* Initilize initial condition and RHS
+
+!$omp parallel do private(xx,yy)
+      do j = 1,m
+         do i = 1,n
+            xx = -1.0 + dx * dble(i-1)        ! -1 < x < 1
+            yy = -1.0 + dy * dble(j-1)        ! -1 < y < 1
+            u(i,j) = 0.0 
+            f(i,j) = -alpha *(1.0-xx*xx)*(1.0-yy*yy) 
+     &           - 2.0*(1.0-xx*xx)-2.0*(1.0-yy*yy)
+         enddo
+      enddo
+!$omp end parallel do
+
+      return 
+      end 
+
+      subroutine jacobi (n,m,dx,dy,alpha,omega,u,f,tol,maxit)
+******************************************************************
+* Subroutine HelmholtzJ
+* Solves poisson equation on rectangular grid assuming : 
+* (1) Uniform discretization in each direction, and 
+* (2) Dirichlect boundary conditions 
+* 
+* Jacobi method is used in this routine 
+*
+* Input : n,m   Number of grid points in the X/Y directions 
+*         dx,dy Grid spacing in the X/Y directions 
+*         alpha Helmholtz eqn. coefficient 
+*         omega Relaxation factor 
+*         f(n,m) Right hand side function 
+*         u(n,m) Dependent variable/Solution
+*         tol    Tolerance for iterative solver 
+*         maxit  Maximum number of iterations 
+*
+* Output : u(n,m) - Solution 
+*****************************************************************
+      implicit none 
+      integer n,m,maxit
+      double precision dx,dy,f(n,m),u(n,m),alpha, tol,omega
+*
+* Local variables 
+* 
+      integer i,j,k,k_local 
+      double precision error,resid,rsum,ax,ay,b
+      double precision error_local, uold(n,m)
+
+      real ta,tb,tc,td,te,ta1,ta2,tb1,tb2,tc1,tc2,td1,td2
+      real te1,te2
+      real second
+      external second
+*
+* Initialize coefficients 
+      ax = 1.0/(dx*dx) ! X-direction coef 
+      ay = 1.0/(dy*dy) ! Y-direction coef
+      b  = -2.0/(dx*dx)-2.0/(dy*dy) - alpha ! Central coeff  
+
+      error = 10.0 * tol 
+      k = 1
+
+      do while (k.le.maxit .and. error.gt. tol) 
+
+         error = 0.0    
+
+* Copy new solution into old
+!$omp parallel
+
+!$omp do 
+         do j=1,m
+            do i=1,n
+               uold(i,j) = u(i,j) 
+            enddo
+         enddo
+
+* Compute stencil, residual, & update
+
+!$omp do private(resid) reduction(+:error)
+         do j = 2,m-1
+            do i = 2,n-1 
+*     Evaluate residual 
+               resid = (ax*(uold(i-1,j) + uold(i+1,j)) 
+     &                + ay*(uold(i,j-1) + uold(i,j+1))
+     &                 + b * uold(i,j) - f(i,j))/b
+* Update solution 
+               u(i,j) = uold(i,j) - omega * resid
+* Accumulate residual error
+               error = error + resid*resid 
+            end do
+         enddo
+!$omp enddo nowait
+
+!$omp end parallel
+
+* Error check 
+
+         k = k + 1
+
+         error = sqrt(error)/dble(n*m)
+*
+      enddo                     ! End iteration loop 
+*
+      print *, 'Total Number of Iterations ', k 
+      print *, 'Residual                   ', error 
+
+      return 
+      end 
+
+      subroutine error_check (n,m,alpha,dx,dy,u,f) 
+      implicit none 
+************************************************************
+* Checks error between numerical and exact solution 
+*
+************************************************************ 
+     
+      integer n,m
+      double precision u(n,m),f(n,m),dx,dy,alpha 
+      
+      integer i,j
+      double precision xx,yy,temp,error 
+
+      dx = 2.0 / (n-1)
+      dy = 2.0 / (m-1)
+      error = 0.0 
+
+!$omp parallel do private(xx,yy,temp) reduction(+:error)
+      do j = 1,m
+         do i = 1,n
+            xx = -1.0d0 + dx * dble(i-1)
+            yy = -1.0d0 + dy * dble(j-1)
+            temp  = u(i,j) - (1.0-xx*xx)*(1.0-yy*yy)
+            error = error + temp*temp 
+         enddo
+      enddo
+  
+      error = sqrt(error)/dble(n*m)
+
+      print *, 'Solution Error : ',error
+
+      return 
+      end 
diff --git a/libgomp/testsuite/libgomp.fortran/lib1.f90 b/libgomp/testsuite/libgomp.fortran/lib1.f90
new file mode 100644
index 00000000000..8840018674a
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/lib1.f90
@@ -0,0 +1,76 @@
+! { dg-do run }
+
+  use omp_lib
+
+  double precision :: d, e
+  logical :: l
+  integer (kind = omp_lock_kind) :: lck
+  integer (kind = omp_nest_lock_kind) :: nlck
+
+  d = omp_get_wtime ()
+
+  call omp_init_lock (lck)
+  call omp_set_lock (lck)
+  if (omp_test_lock (lck)) call abort
+  call omp_unset_lock (lck)
+  if (.not. omp_test_lock (lck)) call abort
+  if (omp_test_lock (lck)) call abort
+  call omp_unset_lock (lck)
+  call omp_destroy_lock (lck)
+
+  call omp_init_nest_lock (nlck)
+  if (omp_test_nest_lock (nlck) .ne. 1) call abort
+  call omp_set_nest_lock (nlck)
+  if (omp_test_nest_lock (nlck) .ne. 3) call abort
+  call omp_unset_nest_lock (nlck)
+  call omp_unset_nest_lock (nlck)
+  if (omp_test_nest_lock (nlck) .ne. 2) call abort
+  call omp_unset_nest_lock (nlck)
+  call omp_unset_nest_lock (nlck)
+  call omp_destroy_nest_lock (nlck)
+
+  call omp_set_dynamic (.true.)
+  if (.not. omp_get_dynamic ()) call abort
+  call omp_set_dynamic (.false.)
+  if (omp_get_dynamic ()) call abort
+
+  call omp_set_nested (.true.)
+  if (.not. omp_get_nested ()) call abort
+  call omp_set_nested (.false.)
+  if (omp_get_nested ()) call abort
+
+  call omp_set_num_threads (5)
+  if (omp_get_num_threads () .ne. 1) call abort
+  if (omp_get_max_threads () .ne. 5) call abort
+  if (omp_get_thread_num () .ne. 0) call abort
+  call omp_set_num_threads (3)
+  if (omp_get_num_threads () .ne. 1) call abort
+  if (omp_get_max_threads () .ne. 3) call abort
+  if (omp_get_thread_num () .ne. 0) call abort
+  l = .false.
+!$omp parallel reduction (.or.:l)
+  l = omp_get_num_threads () .ne. 3
+  l = l .or. (omp_get_thread_num () .lt. 0)
+  l = l .or. (omp_get_thread_num () .ge. 3)
+!$omp master
+  l = l .or. (omp_get_thread_num () .ne. 0)
+!$omp end master
+!$omp end parallel
+  if (l) call abort
+
+  if (omp_get_num_procs () .le. 0) call abort
+  if (omp_in_parallel ()) call abort
+!$omp parallel reduction (.or.:l)
+  l = .not. omp_in_parallel ()
+!$omp end parallel
+!$omp parallel reduction (.or.:l) if (.true.)
+  l = .not. omp_in_parallel ()
+!$omp end parallel
+
+  e = omp_get_wtime ()
+  if (d .gt. e) call abort
+  d = omp_get_wtick ()
+  ! Negative precision is definitely wrong,
+  ! bigger than 1s clock resolution is also strange
+  if (d .le. 0 .or. d .gt. 1.) call abort
+end
diff --git a/libgomp/testsuite/libgomp.fortran/lib2.f b/libgomp/testsuite/libgomp.fortran/lib2.f
new file mode 100644
index 00000000000..75510827043
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/lib2.f
@@ -0,0 +1,76 @@
+C { dg-do run }
+
+      USE OMP_LIB
+
+      DOUBLE PRECISION :: D, E
+      LOGICAL :: L
+      INTEGER (KIND = OMP_LOCK_KIND) :: LCK
+      INTEGER (KIND = OMP_NEST_LOCK_KIND) :: NLCK
+
+      D = OMP_GET_WTIME ()
+
+      CALL OMP_INIT_LOCK (LCK)
+      CALL OMP_SET_LOCK (LCK)
+      IF (OMP_TEST_LOCK (LCK)) CALL ABORT
+      CALL OMP_UNSET_LOCK (LCK)
+      IF (.NOT. OMP_TEST_LOCK (LCK)) CALL ABORT
+      IF (OMP_TEST_LOCK (LCK)) CALL ABORT
+      CALL OMP_UNSET_LOCK (LCK)
+      CALL OMP_DESTROY_LOCK (LCK)
+
+      CALL OMP_INIT_NEST_LOCK (NLCK)
+      IF (OMP_TEST_NEST_LOCK (NLCK) .NE. 1) CALL ABORT
+      CALL OMP_SET_NEST_LOCK (NLCK)
+      IF (OMP_TEST_NEST_LOCK (NLCK) .NE. 3) CALL ABORT
+      CALL OMP_UNSET_NEST_LOCK (NLCK)
+      CALL OMP_UNSET_NEST_LOCK (NLCK)
+      IF (OMP_TEST_NEST_LOCK (NLCK) .NE. 2) CALL ABORT
+      CALL OMP_UNSET_NEST_LOCK (NLCK)
+      CALL OMP_UNSET_NEST_LOCK (NLCK)
+      CALL OMP_DESTROY_NEST_LOCK (NLCK)
+
+      CALL OMP_SET_DYNAMIC (.TRUE.)
+      IF (.NOT. OMP_GET_DYNAMIC ()) CALL ABORT
+      CALL OMP_SET_DYNAMIC (.FALSE.)
+      IF (OMP_GET_DYNAMIC ()) CALL ABORT
+
+      CALL OMP_SET_NESTED (.TRUE.)
+      IF (.NOT. OMP_GET_NESTED ()) CALL ABORT
+      CALL OMP_SET_NESTED (.FALSE.)
+      IF (OMP_GET_NESTED ()) CALL ABORT
+
+      CALL OMP_SET_NUM_THREADS (5)
+      IF (OMP_GET_NUM_THREADS () .NE. 1) CALL ABORT
+      IF (OMP_GET_MAX_THREADS () .NE. 5) CALL ABORT
+      IF (OMP_GET_THREAD_NUM () .NE. 0) CALL ABORT
+      CALL OMP_SET_NUM_THREADS (3)
+      IF (OMP_GET_NUM_THREADS () .NE. 1) CALL ABORT
+      IF (OMP_GET_MAX_THREADS () .NE. 3) CALL ABORT
+      IF (OMP_GET_THREAD_NUM () .NE. 0) CALL ABORT
+      L = .FALSE.
+C$OMP PARALLEL REDUCTION (.OR.:L)
+      L = OMP_GET_NUM_THREADS () .NE. 3
+      L = L .OR. (OMP_GET_THREAD_NUM () .LT. 0)
+      L = L .OR. (OMP_GET_THREAD_NUM () .GE. 3)
+C$OMP MASTER
+      L = L .OR. (OMP_GET_THREAD_NUM () .NE. 0)
+C$OMP END MASTER
+C$OMP END PARALLEL
+      IF (L) CALL ABORT
+
+      IF (OMP_GET_NUM_PROCS () .LE. 0) CALL ABORT
+      IF (OMP_IN_PARALLEL ()) CALL ABORT
+C$OMP PARALLEL REDUCTION (.OR.:L)
+      L = .NOT. OMP_IN_PARALLEL ()
+C$OMP END PARALLEL
+C$OMP PARALLEL REDUCTION (.OR.:L) IF (.TRUE.)
+      L = .NOT. OMP_IN_PARALLEL ()
+C$OMP END PARALLEL
+
+      E = OMP_GET_WTIME ()
+      IF (D .GT. E) CALL ABORT
+      D = OMP_GET_WTICK ()
+C Negative precision is definitely wrong,
+C bigger than 1s clock resolution is also strange
+      IF (D .LE. 0 .OR. D .GT. 1.) CALL ABORT
+      END
diff --git a/libgomp/testsuite/libgomp.fortran/lib3.f b/libgomp/testsuite/libgomp.fortran/lib3.f
new file mode 100644
index 00000000000..fa7b227c0ef
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/lib3.f
@@ -0,0 +1,76 @@
+C { dg-do run }
+
+      INCLUDE "omp_lib.h"
+
+      DOUBLE PRECISION :: D, E
+      LOGICAL :: L
+      INTEGER (KIND = OMP_LOCK_KIND) :: LCK
+      INTEGER (KIND = OMP_NEST_LOCK_KIND) :: NLCK
+
+      D = OMP_GET_WTIME ()
+
+      CALL OMP_INIT_LOCK (LCK)
+      CALL OMP_SET_LOCK (LCK)
+      IF (OMP_TEST_LOCK (LCK)) CALL ABORT
+      CALL OMP_UNSET_LOCK (LCK)
+      IF (.NOT. OMP_TEST_LOCK (LCK)) CALL ABORT
+      IF (OMP_TEST_LOCK (LCK)) CALL ABORT
+      CALL OMP_UNSET_LOCK (LCK)
+      CALL OMP_DESTROY_LOCK (LCK)
+
+      CALL OMP_INIT_NEST_LOCK (NLCK)
+      IF (OMP_TEST_NEST_LOCK (NLCK) .NE. 1) CALL ABORT
+      CALL OMP_SET_NEST_LOCK (NLCK)
+      IF (OMP_TEST_NEST_LOCK (NLCK) .NE. 3) CALL ABORT
+      CALL OMP_UNSET_NEST_LOCK (NLCK)
+      CALL OMP_UNSET_NEST_LOCK (NLCK)
+      IF (OMP_TEST_NEST_LOCK (NLCK) .NE. 2) CALL ABORT
+      CALL OMP_UNSET_NEST_LOCK (NLCK)
+      CALL OMP_UNSET_NEST_LOCK (NLCK)
+      CALL OMP_DESTROY_NEST_LOCK (NLCK)
+
+      CALL OMP_SET_DYNAMIC (.TRUE.)
+      IF (.NOT. OMP_GET_DYNAMIC ()) CALL ABORT
+      CALL OMP_SET_DYNAMIC (.FALSE.)
+      IF (OMP_GET_DYNAMIC ()) CALL ABORT
+
+      CALL OMP_SET_NESTED (.TRUE.)
+      IF (.NOT. OMP_GET_NESTED ()) CALL ABORT
+      CALL OMP_SET_NESTED (.FALSE.)
+      IF (OMP_GET_NESTED ()) CALL ABORT
+
+      CALL OMP_SET_NUM_THREADS (5)
+      IF (OMP_GET_NUM_THREADS () .NE. 1) CALL ABORT
+      IF (OMP_GET_MAX_THREADS () .NE. 5) CALL ABORT
+      IF (OMP_GET_THREAD_NUM () .NE. 0) CALL ABORT
+      CALL OMP_SET_NUM_THREADS (3)
+      IF (OMP_GET_NUM_THREADS () .NE. 1) CALL ABORT
+      IF (OMP_GET_MAX_THREADS () .NE. 3) CALL ABORT
+      IF (OMP_GET_THREAD_NUM () .NE. 0) CALL ABORT
+      L = .FALSE.
+C$OMP PARALLEL REDUCTION (.OR.:L)
+      L = OMP_GET_NUM_THREADS () .NE. 3
+      L = L .OR. (OMP_GET_THREAD_NUM () .LT. 0)
+      L = L .OR. (OMP_GET_THREAD_NUM () .GE. 3)
+C$OMP MASTER
+      L = L .OR. (OMP_GET_THREAD_NUM () .NE. 0)
+C$OMP END MASTER
+C$OMP END PARALLEL
+      IF (L) CALL ABORT
+
+      IF (OMP_GET_NUM_PROCS () .LE. 0) CALL ABORT
+      IF (OMP_IN_PARALLEL ()) CALL ABORT
+C$OMP PARALLEL REDUCTION (.OR.:L)
+      L = .NOT. OMP_IN_PARALLEL ()
+C$OMP END PARALLEL
+C$OMP PARALLEL REDUCTION (.OR.:L) IF (.TRUE.)
+      L = .NOT. OMP_IN_PARALLEL ()
+C$OMP END PARALLEL
+
+      E = OMP_GET_WTIME ()
+      IF (D .GT. E) CALL ABORT
+      D = OMP_GET_WTICK ()
+C Negative precision is definitely wrong,
+C bigger than 1s clock resolution is also strange
+      IF (D .LE. 0 .OR. D .GT. 1.) CALL ABORT
+      END
diff --git a/libgomp/testsuite/libgomp.fortran/nestedfn1.f90 b/libgomp/testsuite/libgomp.fortran/nestedfn1.f90
new file mode 100644
index 00000000000..67dadd6dfc1
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/nestedfn1.f90
@@ -0,0 +1,43 @@
+! { dg-do run }
+
+  integer :: a, b, c
+  a = 1
+  b = 2
+  c = 3
+  call foo
+  if (a .ne. 7) call abort
+contains
+  subroutine foo
+    use omp_lib
+    logical :: l
+    l = .false.
+!$omp parallel shared (a) private (b) firstprivate (c) &
+!$omp num_threads (2) reduction (.or.:l)
+    if (a .ne. 1 .or. c .ne. 3) l = .true.
+!$omp barrier
+    if (omp_get_thread_num () .eq. 0) then
+      a = 4
+      b = 5
+      c = 6
+    end if
+!$omp barrier
+    if (omp_get_thread_num () .eq. 1) then
+      if (a .ne. 4 .or. c .ne. 3) l = .true.
+      a = 7
+      b = 8
+      c = 9
+    else if (omp_get_num_threads () .eq. 1) then
+      a = 7
+    end if
+!$omp barrier
+    if (omp_get_thread_num () .eq. 0) then
+      if (a .ne. 7 .or. b .ne. 5 .or. c .ne. 6) l = .true.
+    end if
+!$omp barrier
+    if (omp_get_thread_num () .eq. 1) then
+      if (a .ne. 7 .or. b .ne. 8 .or. c .ne. 9) l = .true.
+    end if
+!$omp end parallel
+    if (l) call abort
+  end subroutine foo
+end
diff --git a/libgomp/testsuite/libgomp.fortran/nestedfn2.f90 b/libgomp/testsuite/libgomp.fortran/nestedfn2.f90
new file mode 100644
index 00000000000..dfb12ae6622
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/nestedfn2.f90
@@ -0,0 +1,34 @@
+! { dg-do run }
+
+  integer :: i
+  common /c/ i
+  i = -1
+!$omp parallel shared (i) num_threads (4)
+  call test1
+!$omp end parallel
+end
+subroutine test1
+  integer :: vari
+  call test2
+  call test3
+contains
+  subroutine test2
+    use omp_lib
+    integer :: i
+    common /c/ i
+!$omp single
+    i = omp_get_thread_num ()
+    call test4
+!$omp end single copyprivate (vari)
+  end subroutine test2
+  subroutine test3
+    integer :: i
+    common /c/ i
+    if (i .lt. 0 .or. i .ge. 4) call abort
+    if (i + 10 .ne. vari) call abort
+  end subroutine test3
+  subroutine test4
+    use omp_lib
+    vari = omp_get_thread_num () + 10
+  end subroutine test4
+end subroutine test1
diff --git a/libgomp/testsuite/libgomp.fortran/omp_atomic1.f90 b/libgomp/testsuite/libgomp.fortran/omp_atomic1.f90
new file mode 100644
index 00000000000..f9ce94b9ad7
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/omp_atomic1.f90
@@ -0,0 +1,39 @@
+! { dg-do run }
+    integer (kind = 4) :: a
+    integer (kind = 2) :: b
+    real :: c, f
+    double precision :: d
+    integer, dimension (10) :: e
+    a = 1
+    b = 2
+    c = 3
+    d = 4
+    e = 5
+    f = 6
+!$omp atomic
+    a = a + 4
+!$omp atomic
+    b = 4 - b
+!$omp atomic
+    c = c * 2
+!$omp atomic
+    d = 2 / d
+    if (a .ne. 5 .or. b .ne. 2 .or. c .ne. 6 .or. d .ne. 0.5) call abort
+    d = 1.2
+!$omp atomic
+    a = a + c + d
+!$omp atomic
+    b = b - (a + c + d)
+    if (a .ne. 12 .or. b .ne. -17) call abort
+!$omp atomic
+    a = c + d + a
+!$omp atomic
+    b = a + c + d - b
+    if (a .ne. 19 .or. b .ne. 43) call abort
+!$omp atomic
+    b = (a + c + d) - b
+    a = 32
+!$omp atomic
+    a = a / 3.4
+    if (a .ne. 9 .or. b .ne. -16) call abort
+end
diff --git a/libgomp/testsuite/libgomp.fortran/omp_atomic2.f90 b/libgomp/testsuite/libgomp.fortran/omp_atomic2.f90
new file mode 100644
index 00000000000..1dea2c8ebd8
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/omp_atomic2.f90
@@ -0,0 +1,54 @@
+! { dg-do run }
+  real, dimension (20) :: r
+  integer, dimension (20) :: d
+  integer :: i, j, k, n
+  integer (kind = 2) :: a, b, c
+
+  do 10 i = 1, 20
+    r(i) = i
+10  d(i) = 21 - i
+
+  n = 20
+  call foo (r, d, n)
+
+  if (n .ne. 22) call abort
+  if (any (r .ne. 33)) call abort
+
+  i = 1
+  j = 18
+  k = 23
+!$omp atomic
+  i = min (i, j, k, n)
+  if (i .ne. 1) call abort
+!$omp atomic
+  i = max (j, n, k, i)
+  if (i .ne. 23) call abort
+
+  a = 1
+  b = 18
+  c = 23
+!$omp atomic
+  a = min (a, b, c)
+  if (a .ne. 1) call abort
+!$omp atomic
+  a = max (a, b, c)
+  if (a .ne. 23) call abort
+
+contains
+  function bar (i)
+    real bar
+    integer i
+    bar = 12.0 + i
+  end function bar
+
+  subroutine foo (x, y, n)
+    integer i, y (*), n
+    real x (*)
+    do i = 1, n
+!$omp atomic
+      x(y(i)) = x(y(i)) + bar (i)
+    end do
+!$omp atomic
+    n = n + 2
+  end subroutine foo
+end
diff --git a/libgomp/testsuite/libgomp.fortran/omp_cond1.f b/libgomp/testsuite/libgomp.fortran/omp_cond1.f
new file mode 100644
index 00000000000..b557d908003
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/omp_cond1.f
@@ -0,0 +1,22 @@
+C Test conditional compilation in fixed form if -fopenmp
+! { dg-options "-fopenmp" }
+   10 foo = 2
+     &56
+      if (foo.ne.256) call abort
+      bar = 26
+!$2 0 ba
+c$   +r = 42
+      !$ bar = 62
+!$    bar = bar + 1
+      if (bar.ne.43) call abort
+      baz = bar
+*$   0baz = 5
+C$   +12! Comment
+c$   !4
+!$   +!Another comment
+*$   &2
+!$ X  baz = 0 ! Not valid OpenMP conditional compilation lines
+! $   baz = 1
+c$ 10&baz = 2
+      if (baz.ne.51242) call abort
+      end
diff --git a/libgomp/testsuite/libgomp.fortran/omp_cond2.f b/libgomp/testsuite/libgomp.fortran/omp_cond2.f
new file mode 100644
index 00000000000..6df891c6c67
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/omp_cond2.f
@@ -0,0 +1,22 @@
+c Test conditional compilation in fixed form if -fno-openmp
+! { dg-options "-fno-openmp" }
+   10 foo = 2
+     &56
+      if (foo.ne.256) call abort
+      bar = 26
+!$2 0 ba
+c$   +r = 42
+      !$ bar = 62
+!$    bar = bar + 1
+      if (bar.ne.26) call abort
+      baz = bar
+*$   0baz = 5
+C$   +12! Comment
+c$   !4
+!$   +!Another comment
+*$   &2
+!$ X  baz = 0 ! Not valid OpenMP conditional compilation lines
+! $   baz = 1
+c$ 10&baz = 2
+      if (baz.ne.26) call abort
+      end
diff --git a/libgomp/testsuite/libgomp.fortran/omp_cond3.F90 b/libgomp/testsuite/libgomp.fortran/omp_cond3.F90
new file mode 100644
index 00000000000..6c4e36e2293
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/omp_cond3.F90
@@ -0,0 +1,24 @@
+! Test conditional compilation in free form if -fopenmp
+! { dg-options "-fopenmp" }
+   10 foo = 2&
+  &56
+  if (foo.ne.256) call abort
+  bar = 26
+   !$  20 ba&
+!$   &r = 4&
+  !$2
+      !$bar = 62
+   !$ bar = bar + 2
+#ifdef _OPENMP
+bar = bar - 1
+#endif
+  if (bar.ne.43) call abort
+      baz = bar
+!$ 30 baz = 5&     ! Comment
+!$12  &  
+  !$ + 2
+!$X baz = 0 ! Not valid OpenMP conditional compilation lines
+! $   baz = 1
+baz = baz + 1 !$ baz = 2
+      if (baz.ne.515) call abort
+      end
diff --git a/libgomp/testsuite/libgomp.fortran/omp_cond4.F90 b/libgomp/testsuite/libgomp.fortran/omp_cond4.F90
new file mode 100644
index 00000000000..aa4c5cb76d6
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/omp_cond4.F90
@@ -0,0 +1,24 @@
+! Test conditional compilation in free form if -fno-openmp
+! { dg-options "-fno-openmp" }
+   10 foo = 2&
+  &56
+  if (foo.ne.256) call abort
+  bar = 26
+   !$  20 ba&
+!$   &r = 4&
+  !$2
+      !$bar = 62
+   !$ bar = bar + 2
+#ifdef _OPENMP
+bar = bar - 1
+#endif
+  if (bar.ne.26) call abort
+      baz = bar
+!$ 30 baz = 5&     ! Comment
+!$12  &  
+  !$ + 2
+!$X baz = 0 ! Not valid OpenMP conditional compilation lines
+! $   baz = 1
+baz = baz + 1 !$ baz = 2
+      if (baz.ne.27) call abort
+      end
diff --git a/libgomp/testsuite/libgomp.fortran/omp_hello.f b/libgomp/testsuite/libgomp.fortran/omp_hello.f
new file mode 100644
index 00000000000..ba445312625
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/omp_hello.f
@@ -0,0 +1,36 @@
+C******************************************************************************
+C FILE: omp_hello.f
+C DESCRIPTION:
+C   OpenMP Example - Hello World - Fortran Version
+C   In this simple example, the master thread forks a parallel region.
+C   All threads in the team obtain their unique thread number and print it.
+C   The master thread only prints the total number of threads.  Two OpenMP
+C   library routines are used to obtain the number of threads and each
+C   thread's number.
+C AUTHOR: Blaise Barney  5/99
+C LAST REVISED:
+C******************************************************************************
+
+      PROGRAM HELLO
+
+      INTEGER NTHREADS, TID, OMP_GET_NUM_THREADS,
+     +        OMP_GET_THREAD_NUM
+
+C     Fork a team of threads giving them their own copies of variables
+!$OMP PARALLEL PRIVATE(NTHREADS, TID)
+
+
+C     Obtain thread number
+      TID = OMP_GET_THREAD_NUM()
+      PRINT *, 'Hello World from thread = ', TID
+
+C     Only master thread does this
+      IF (TID .EQ. 0) THEN
+        NTHREADS = OMP_GET_NUM_THREADS()
+        PRINT *, 'Number of threads = ', NTHREADS
+      END IF
+
+C     All threads join master thread and disband
+!$OMP END PARALLEL
+
+      END
diff --git a/libgomp/testsuite/libgomp.fortran/omp_orphan.f b/libgomp/testsuite/libgomp.fortran/omp_orphan.f
new file mode 100644
index 00000000000..7653c78d2e4
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/omp_orphan.f
@@ -0,0 +1,44 @@
+C******************************************************************************
+C FILE: omp_orphan.f
+C DESCRIPTION:
+C   OpenMP Example - Parallel region with an orphaned directive - Fortran
+C   Version
+C   This example demonstrates a dot product being performed by an orphaned
+C   loop reduction construct.  Scoping of the reduction variable is critical.
+C AUTHOR: Blaise Barney  5/99
+C LAST REVISED:
+C******************************************************************************
+
+      PROGRAM ORPHAN
+      COMMON /DOTDATA/ A, B, SUM
+      INTEGER I, VECLEN
+      PARAMETER (VECLEN = 100)
+      REAL*8 A(VECLEN), B(VECLEN), SUM
+
+      DO I=1, VECLEN
+         A(I) = 1.0 * I
+         B(I) = A(I)
+      ENDDO
+      SUM = 0.0
+!$OMP PARALLEL
+      CALL DOTPROD
+!$OMP END PARALLEL
+      WRITE(*,*) "Sum = ", SUM
+      END
+
+
+
+      SUBROUTINE DOTPROD
+      COMMON /DOTDATA/ A, B, SUM
+      INTEGER I, TID, OMP_GET_THREAD_NUM, VECLEN
+      PARAMETER (VECLEN = 100)
+      REAL*8 A(VECLEN), B(VECLEN), SUM
+
+      TID = OMP_GET_THREAD_NUM()
+!$OMP DO REDUCTION(+:SUM)
+      DO I=1, VECLEN
+         SUM = SUM + (A(I)*B(I))
+         PRINT *, '  TID= ',TID,'I= ',I
+      ENDDO
+      RETURN
+      END
diff --git a/libgomp/testsuite/libgomp.fortran/omp_parse1.f90 b/libgomp/testsuite/libgomp.fortran/omp_parse1.f90
new file mode 100644
index 00000000000..9cd8cc2ba13
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/omp_parse1.f90
@@ -0,0 +1,185 @@
+! { dg-do run }
+use omp_lib
+  call test_parallel
+  call test_do
+  call test_sections
+  call test_single
+
+contains
+  subroutine test_parallel
+    integer :: a, b, c, e, f, g, i, j
+    integer, dimension (20) :: d
+    logical :: h
+    a = 6
+    b = 8
+    c = 11
+    d(:) = -1
+    e = 13
+    f = 24
+    g = 27
+    h = .false.
+    i = 1
+    j = 16
+!$omp para&
+!$omp&llel &
+!$omp if (a .eq. 6) private (b, c) shared (d) private (e) &
+  !$omp firstprivate(f) num_threads (a - 1) first&
+!$ompprivate(g)default (shared) reduction (.or. : h) &
+!$omp reduction(*:i)
+    if (i .ne. 1) h = .true.
+    i = 2
+    if (f .ne. 24) h = .true.
+    if (g .ne. 27) h = .true.
+    e = 7
+    b = omp_get_thread_num ()
+    if (b .eq. 0) j = 24
+    f = b
+    g = f
+    c = omp_get_num_threads ()
+    if (c .gt. a - 1 .or. c .le. 0) h = .true.
+    if (b .ge. c) h = .true.
+    d(b + 1) = c
+    if (f .ne. g .or. f .ne. b) h = .true.
+!$omp endparallel
+    if (h) call abort
+    if (a .ne. 6) call abort
+    if (j .ne. 24) call abort
+    if (d(1) .eq. -1) call abort
+    e = 1
+    do g = 1, d(1)
+      if (d(g) .ne. d(1)) call abort
+      e = e * 2
+    end do
+    if (e .ne. i) call abort
+  end subroutine test_parallel
+
+  subroutine test_do_orphan
+    integer :: k, l
+!$omp parallel do private (l)
+    do 600 k = 1, 16, 2
+600   l = k
+  end subroutine test_do_orphan
+
+  subroutine test_do
+    integer :: i, j, k, l, n
+    integer, dimension (64) :: d
+    logical :: m
+
+    j = 16
+    d(:) = -1
+    m = .true.
+    n = 24
+!$omp parallel num_threads (4) shared (i, k, d) private (l) &
+!$omp&reduction (.and. : m)
+    if (omp_get_thread_num () .eq. 0) then
+      k = omp_get_num_threads ()
+    end if
+    call test_do_orphan
+!$omp do schedule (static) firstprivate (n)
+    do 200 i = 1, j
+      if (i .eq. 1 .and. n .ne. 24) call abort
+      n = i
+200   d(n) = omp_get_thread_num ()
+!$omp enddo nowait
+
+!$omp do lastprivate (i) schedule (static, 5)
+    do 201 i = j + 1, 2 * j
+201   d(i) = omp_get_thread_num () + 1024
+    ! Implied omp end do here
+
+    if (i .ne. 33) m = .false.
+
+!$omp do private (j) schedule (dynamic)
+    do i = 33, 48
+      d(i) = omp_get_thread_num () + 2048
+    end do
+!$omp end do nowait
+
+!$omp do schedule (runtime)
+    do i = 49, 4 * j
+      d(i) = omp_get_thread_num () + 4096
+    end do
+    ! Implied omp end do here
+!$omp end parallel
+    if (.not. m) call abort
+
+    j = 0
+    do i = 1, 64
+      if (d(i) .lt. j .or. d(i) .ge. j + k) call abort
+      if (i .eq. 16) j = 1024
+      if (i .eq. 32) j = 2048
+      if (i .eq. 48) j = 4096
+    end do
+  end subroutine test_do
+
+  subroutine test_sections
+    integer :: i, j, k, l, m, n
+    i = 9
+    j = 10
+    k = 11
+    l = 0
+    m = 0
+    n = 30
+    call omp_set_dynamic (.false.)
+    call omp_set_num_threads (4)
+!$omp parallel num_threads (4)
+!$omp sections private (i) firstprivate (j, k) lastprivate (j) &
+!$omp& reduction (+ : l, m)
+!$omp section
+    i = 24
+    if (j .ne. 10 .or. k .ne. 11 .or. m .ne. 0) l = 1
+    m = m + 4
+!$omp section
+    i = 25
+    if (j .ne. 10 .or. k .ne. 11) l = 1
+    m = m + 6
+!$omp section
+    i = 26
+    if (j .ne. 10 .or. k .ne. 11) l = 1
+    m = m + 8
+!$omp section
+    i = 27
+    if (j .ne. 10 .or. k .ne. 11) l = 1
+    m = m + 10
+    j = 271
+!$omp end sections nowait
+!$omp sections lastprivate (n)
+!$omp section
+    n = 6
+!$omp section
+    n = 7
+!$omp endsections
+!$omp end parallel
+    if (j .ne. 271 .or. l .ne. 0) call abort
+    if (m .ne. 4 + 6 + 8 + 10) call abort
+    if (n .ne. 7) call abort
+  end subroutine test_sections
+
+  subroutine test_single
+    integer :: i, j, k, l
+    logical :: m
+    i = 200
+    j = 300
+    k = 400
+    l = 500
+    m = .false.
+!$omp parallel num_threads (4), private (i, j), reduction (.or. : m)
+    i = omp_get_thread_num ()
+    j = omp_get_thread_num ()
+!$omp single private (k)
+    k = 64
+!$omp end single nowait
+!$omp single private (k) firstprivate (l)
+    if (i .ne. omp_get_thread_num () .or. i .ne. j) then
+      j = -1
+    else
+      j = -2
+    end if
+    if (l .ne. 500) j = -1
+    l = 265
+!$omp end single copyprivate (j)
+    if (i .ne. omp_get_thread_num () .or. j .ne. -2) m = .true.
+!$omp endparallel
+    if (m) call abort
+  end subroutine test_single
+end
diff --git a/libgomp/testsuite/libgomp.fortran/omp_parse2.f90 b/libgomp/testsuite/libgomp.fortran/omp_parse2.f90
new file mode 100644
index 00000000000..da54a987275
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/omp_parse2.f90
@@ -0,0 +1,102 @@
+! { dg-do run }
+use omp_lib
+  call test_master
+  call test_critical
+  call test_barrier
+  call test_atomic
+
+contains
+  subroutine test_master
+    logical :: i, j
+    i = .false.
+    j = .false.
+!$omp parallel num_threads (4)
+!$omp master
+    i = .true.
+    j = omp_get_thread_num () .eq. 0
+!$omp endmaster
+!$omp end parallel
+    if (.not. (i .or. j)) call abort
+  end subroutine test_master
+
+  subroutine test_critical_1 (i, j)
+    integer :: i, j
+!$omp critical(critical_foo) 
+    i = i + 1
+!$omp end critical (critical_foo)
+!$omp critical
+    j = j + 1
+!$omp end critical
+    end subroutine test_critical_1
+
+  subroutine test_critical
+    integer :: i, j, n
+    n = -1
+    i = 0
+    j = 0
+!$omp parallel num_threads (4)
+    if (omp_get_thread_num () .eq. 0) n = omp_get_num_threads ()
+    call test_critical_1 (i, j)
+    call test_critical_1 (i, j)
+!$omp critical
+    j = j + 1
+!$omp end critical
+!$omp critical (critical_foo)
+    i = i + 1
+!$omp endcritical (critical_foo)
+!$omp end parallel
+    if (n .lt. 1 .or. i .ne. n * 3 .or. j .ne. n * 3) call abort
+  end subroutine test_critical
+
+  subroutine test_barrier
+    integer :: i
+    logical :: j
+    i = 23
+    j = .false.
+!$omp parallel num_threads (4)
+    if (omp_get_thread_num () .eq. 0) i = 5
+!$omp flush (i)
+!$omp barrier
+    if (i .ne. 5) then
+!$omp atomic
+      j = j .or. .true.
+    end if
+!$omp end parallel
+    if (i .ne. 5 .or. j) call abort
+  end subroutine test_barrier
+
+  subroutine test_atomic
+    integer :: a, b, c, d, e, f, g
+    a = 0
+    b = 1
+    c = 0
+    d = 1024
+    e = 1024
+    f = -1
+    g = -1
+!$omp parallel num_threads (8)
+!$omp atomic
+    a = a + 2 + 4
+!$omp atomic
+    b = 3 * b
+!$omp atomic
+    c = 8 - c
+!$omp atomic
+    d = d / 2
+!$omp atomic
+    e = min (e, omp_get_thread_num ())
+!$omp atomic
+    f = max (omp_get_thread_num (), f)
+    if (omp_get_thread_num () .eq. 0) g = omp_get_num_threads ()
+!$omp end parallel
+    if (g .le. 0 .or. g .gt. 8) call abort
+    if (a .ne. 6 * g .or. b .ne. 3 ** g) call abort
+    if (iand (g, 1) .eq. 1) then
+      if (c .ne. 8) call abort
+    else if (c .ne. 0) then
+      call abort
+    end if
+    if (d .ne. 1024 / (2 ** g)) call abort
+    if (e .ne. 0 .or. f .ne. g - 1) call abort
+  end subroutine test_atomic
+end
diff --git a/libgomp/testsuite/libgomp.fortran/omp_parse3.f90 b/libgomp/testsuite/libgomp.fortran/omp_parse3.f90
new file mode 100644
index 00000000000..98c94b93b79
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/omp_parse3.f90
@@ -0,0 +1,95 @@
+! { dg-do run }
+! { dg-require-effective-target tls_runtime }
+use omp_lib
+  common /tlsblock/ x, y
+  integer :: x, y, z
+  save z
+!$omp threadprivate (/tlsblock/, z)
+
+  call test_flush
+  call test_ordered
+  call test_threadprivate
+
+contains
+  subroutine test_flush
+    integer :: i, j
+    i = 0
+    j = 0
+!$omp parallel num_threads (4)
+    if (omp_get_thread_num () .eq. 0) i = omp_get_num_threads ()
+    if (omp_get_thread_num () .eq. 0) j = j + 1
+!$omp flush (i, j)
+!$omp barrier
+    if (omp_get_thread_num () .eq. 1) j = j + 2
+!$omp flush
+!$omp barrier
+    if (omp_get_thread_num () .eq. 2) j = j + 3
+!$omp flush (i)
+!$omp flush (j)
+!$omp barrier
+    if (omp_get_thread_num () .eq. 3) j = j + 4
+!$omp end parallel
+  end subroutine test_flush
+
+  subroutine test_ordered
+    integer :: i, j
+    integer, dimension (100) :: d
+    d(:) = -1
+!$omp parallel do ordered schedule (dynamic) num_threads (4)
+    do i = 1, 100, 5
+!$omp ordered
+      d(i) = i
+!$omp end ordered
+    end do
+    j = 1
+    do 100 i = 1, 100
+      if (i .eq. j) then
+	if (d(i) .ne. i) call abort
+	j = i + 5
+      else
+	if (d(i) .ne. -1) call abort
+      end if
+100   d(i) = -1
+  end subroutine test_ordered
+
+  subroutine test_threadprivate
+    common /tlsblock/ x, y
+!$omp threadprivate (/tlsblock/)
+    integer :: i, j
+    logical :: m, n
+    call omp_set_num_threads (4)
+    call omp_set_dynamic (.false.)
+    i = -1
+    x = 6
+    y = 7
+    z = 8
+    n = .false.
+    m = .false.
+!$omp parallel copyin (/tlsblock/, z) reduction (.or.:m) &
+!$omp& num_threads (4)
+    if (omp_get_thread_num () .eq. 0) i = omp_get_num_threads ()
+    if (x .ne. 6 .or. y .ne. 7 .or. z .ne. 8) call abort
+    x = omp_get_thread_num ()
+    y = omp_get_thread_num () + 1024
+    z = omp_get_thread_num () + 4096
+!$omp end parallel
+    if (x .ne. 0 .or. y .ne. 1024 .or. z .ne. 4096) call abort
+!$omp parallel num_threads (4), private (j) reduction (.or.:n)
+    if (omp_get_num_threads () .eq. i) then
+      j = omp_get_thread_num ()
+      if (x .ne. j .or. y .ne. j + 1024 .or. z .ne. j + 4096) &
+&       call abort
+    end if
+!$omp end parallel
+    m = m .or. n
+    n = .false.
+!$omp parallel num_threads (4), copyin (z) reduction (.or. : n)
+    if (z .ne. 4096) n = .true.
+    if (omp_get_num_threads () .eq. i) then
+      j = omp_get_thread_num ()
+      if (x .ne. j .or. y .ne. j + 1024) call abort
+    end if
+!$omp end parallel
+    if (m .or. n) call abort
+  end subroutine test_threadprivate
+end
diff --git a/libgomp/testsuite/libgomp.fortran/omp_parse4.f90 b/libgomp/testsuite/libgomp.fortran/omp_parse4.f90
new file mode 100644
index 00000000000..ba35bcb2ad4
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/omp_parse4.f90
@@ -0,0 +1,72 @@
+! { dg-do run }
+!$ use omp_lib
+  call test_workshare
+
+contains
+  subroutine test_workshare
+    integer :: i, j, k, l, m
+    double precision, dimension (64) :: d, e
+    integer, dimension (10) :: f, g
+    integer, dimension (16, 16) :: a, b, c
+    integer, dimension (16) :: n
+    d(:) = 1
+    e = 7
+    f = 10
+    l = 256
+    m = 512
+    g(1:3) = -1
+    g(4:6) = 0
+    g(7:8) = 5
+    g(9:10) = 10
+    forall (i = 1:16, j = 1:16) a (i, j) = i * 16 + j
+    forall (j = 1:16) n (j) = j
+!$omp parallel num_threads (4) private (j, k)
+!$omp barrier
+!$omp workshare
+    i = 6
+    e(:) = d(:)
+    where (g .lt. 0)
+      f = 100
+    elsewhere (g .eq. 0)
+      f = 200 + f
+    elsewhere
+      where (g .gt. 6) f = f + sum (g)
+      f = 300 + f
+    end where
+    where (f .gt. 210) g = 0
+!$omp end workshare nowait
+!$omp workshare
+    forall (j = 1:16, k = 1:16) b (k, j) = a (j, k)
+    forall (k = 1:16) c (k, 1:16) = a (1:16, k)
+    forall (j = 2:16, n (17 - j) / 4 * 4 .ne. n (17 - j))
+      n (j) = n (j - 1) * n (j)
+    end forall
+!$omp endworkshare
+!$omp workshare
+!$omp atomic
+    i = i + 8 + 6
+!$omp critical
+!$omp critical (critical_foox)
+    l = 128
+!$omp end critical (critical_foox)
+!$omp endcritical
+!$omp parallel num_threads (2)
+!$  if (omp_get_thread_num () .eq. 0) m = omp_get_num_threads ()
+!$omp atomic
+    l = 1 + l
+!$omp end parallel
+!$omp end workshare
+!$omp end parallel
+
+    if (any (f .ne. (/100, 100, 100, 210, 210, 210, 310, 310, 337, 337/))) &
+&     call abort
+    if (any (g .ne. (/-1, -1, -1, 0, 0, 0, 0, 0, 0, 0/))) call abort
+    if (i .ne. 20) call abort
+!$  if (l .ne. 128 + m) call abort
+    if (any (d .ne. 1 .or. e .ne. 1)) call abort
+    if (any (b .ne. transpose (a))) call abort
+    if (any (c .ne. b)) call abort
+    if (any (n .ne. (/1, 2, 6, 12, 5, 30, 42, 56, 9, 90, &
+&                     110, 132, 13, 182, 210, 240/))) call abort
+  end subroutine test_workshare
+end
diff --git a/libgomp/testsuite/libgomp.fortran/omp_reduction.f b/libgomp/testsuite/libgomp.fortran/omp_reduction.f
new file mode 100644
index 00000000000..0560bd8963d
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/omp_reduction.f
@@ -0,0 +1,33 @@
+C******************************************************************************
+C FILE: omp_reduction.f
+C DESCRIPTION:
+C   OpenMP Example - Combined Parallel Loop Reduction - Fortran Version
+C   This example demonstrates a sum reduction within a combined parallel loop
+C   construct.  Notice that default data element scoping is assumed - there
+C   are no clauses specifying shared or private variables.  OpenMP will
+C   automatically make loop index variables private within team threads, and
+C   global variables shared.
+C AUTHOR: Blaise Barney  5/99
+C LAST REVISED:
+C******************************************************************************
+
+      PROGRAM REDUCTION
+
+      INTEGER I, N
+      REAL A(100), B(100), SUM
+
+!     Some initializations
+      N = 100
+      DO I = 1, N
+        A(I) = I *1.0
+        B(I) = A(I)
+      ENDDO
+      SUM = 0.0
+
+!$OMP PARALLEL DO REDUCTION(+:SUM)
+      DO I = 1, N
+        SUM = SUM + (A(I) * B(I))
+      ENDDO
+
+      PRINT *, '   Sum = ', SUM
+      END
diff --git a/libgomp/testsuite/libgomp.fortran/omp_workshare1.f b/libgomp/testsuite/libgomp.fortran/omp_workshare1.f
new file mode 100644
index 00000000000..8aef69406de
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/omp_workshare1.f
@@ -0,0 +1,48 @@
+C******************************************************************************
+C FILE: omp_workshare1.f
+C DESCRIPTION:
+C   OpenMP Example - Loop Work-sharing - Fortran Version
+C   In this example, the iterations of a loop are scheduled dynamically
+C   across the team of threads.  A thread will perform CHUNK iterations
+C   at a time before being scheduled for the next CHUNK of work.
+C AUTHOR: Blaise Barney  5/99
+C LAST REVISED: 01/09/04
+C******************************************************************************
+
+      PROGRAM WORKSHARE1
+
+      INTEGER NTHREADS, TID, OMP_GET_NUM_THREADS,
+     +  OMP_GET_THREAD_NUM, N, CHUNKSIZE, CHUNK, I
+      PARAMETER (N=100)
+      PARAMETER (CHUNKSIZE=10)
+      REAL A(N), B(N), C(N)
+
+!     Some initializations
+      DO I = 1, N
+        A(I) = I * 1.0
+        B(I) = A(I)
+      ENDDO
+      CHUNK = CHUNKSIZE
+
+!$OMP PARALLEL SHARED(A,B,C,NTHREADS,CHUNK) PRIVATE(I,TID)
+
+      TID = OMP_GET_THREAD_NUM()
+      IF (TID .EQ. 0) THEN
+        NTHREADS = OMP_GET_NUM_THREADS()
+        PRINT *, 'Number of threads =', NTHREADS
+      END IF
+      PRINT *, 'Thread',TID,' starting...'
+
+!$OMP DO SCHEDULE(DYNAMIC,CHUNK)
+      DO I = 1, N
+        C(I) = A(I) + B(I)
+        WRITE(*,100) TID,I,C(I)
+ 100    FORMAT(' Thread',I2,': C(',I3,')=',F8.2)
+      ENDDO
+!$OMP END DO NOWAIT
+
+      PRINT *, 'Thread',TID,' done.'
+
+!$OMP END PARALLEL
+
+      END
diff --git a/libgomp/testsuite/libgomp.fortran/omp_workshare2.f b/libgomp/testsuite/libgomp.fortran/omp_workshare2.f
new file mode 100644
index 00000000000..9e61da91e9b
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/omp_workshare2.f
@@ -0,0 +1,56 @@
+C******************************************************************************
+C FILE: omp_workshare2.f
+C DESCRIPTION:
+C   OpenMP Example - Sections Work-sharing - Fortran Version
+C   In this example, the OpenMP SECTION directive is used to assign
+C   different array operations to threads that execute a SECTION. Each
+C   thread receives its own copy of the result array to work with.
+C AUTHOR: Blaise Barney  5/99
+C LAST REVISED: 01/09/04
+C******************************************************************************
+
+      PROGRAM WORKSHARE2
+
+      INTEGER N, I, NTHREADS, TID, OMP_GET_NUM_THREADS,
+     +        OMP_GET_THREAD_NUM
+      PARAMETER (N=50)
+      REAL A(N), B(N), C(N)
+
+!     Some initializations
+      DO I = 1, N
+        A(I) = I * 1.0
+        B(I) = A(I)
+      ENDDO
+
+!$OMP PARALLEL SHARED(A,B,NTHREADS), PRIVATE(C,I,TID)
+      TID = OMP_GET_THREAD_NUM()
+      IF (TID .EQ. 0) THEN
+        NTHREADS = OMP_GET_NUM_THREADS()
+        PRINT *, 'Number of threads =', NTHREADS
+      END IF
+      PRINT *, 'Thread',TID,' starting...'
+
+!$OMP SECTIONS
+
+!$OMP SECTION
+      PRINT *, 'Thread',TID,' doing section 1'
+      DO I = 1, N
+         C(I) = A(I) + B(I)
+         WRITE(*,100) TID,I,C(I)
+ 100     FORMAT(' Thread',I2,': C(',I2,')=',F8.2)
+      ENDDO
+
+!$OMP SECTION
+      PRINT *, 'Thread',TID,' doing section 2'
+      DO I = 1+N/2, N
+         C(I) = A(I) * B(I)
+         WRITE(*,100) TID,I,C(I)
+      ENDDO
+
+!$OMP END SECTIONS NOWAIT
+
+      PRINT *, 'Thread',TID,' done.'
+
+!$OMP END PARALLEL
+
+      END
diff --git a/libgomp/testsuite/libgomp.fortran/pr25162.f b/libgomp/testsuite/libgomp.fortran/pr25162.f
new file mode 100644
index 00000000000..a868ea4c9b2
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/pr25162.f
@@ -0,0 +1,40 @@
+C PR fortran/25162
+C { dg-do run }
+C { dg-require-effective-target tls_runtime }
+      PROGRAM PR25162
+      CALL TEST1
+      CALL TEST2
+      END
+      SUBROUTINE TEST1
+      DOUBLE PRECISION BPRIM
+      COMMON /TESTCOM/ BPRIM(100)
+C$OMP THREADPRIVATE(/TESTCOM/)
+      INTEGER I
+      DO I = 1, 100
+         BPRIM( I ) = DBLE( I )
+      END DO
+      RETURN
+      END
+      SUBROUTINE TEST2
+      DOUBLE PRECISION BPRIM
+      COMMON /TESTCOM/ BPRIM(100)
+C$OMP THREADPRIVATE(/TESTCOM/)
+      INTEGER I, IDUM(50)
+      DO I = 1, 50
+         IDUM(I) = I
+      END DO
+C$OMP PARALLEL COPYIN(/TESTCOM/) NUM_THREADS(4)
+      CALL TEST3
+C$OMP END PARALLEL
+      RETURN
+      END
+      SUBROUTINE TEST3
+      DOUBLE PRECISION BPRIM
+      COMMON /TESTCOM/ BPRIM(100)
+C$OMP THREADPRIVATE(/TESTCOM/)
+      INTEGER K
+      DO K = 1, 10
+         IF (K.NE.BPRIM(K)) CALL ABORT
+      END DO
+      RETURN
+      END
diff --git a/libgomp/testsuite/libgomp.fortran/pr25219.f90 b/libgomp/testsuite/libgomp.fortran/pr25219.f90
new file mode 100644
index 00000000000..7fe1a53aa1c
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/pr25219.f90
@@ -0,0 +1,15 @@
+! PR fortran/25219
+
+  implicit none
+  save
+  integer :: i, k
+  k = 3
+!$omp parallel
+!$omp do lastprivate (k)
+  do i = 1, 100
+    k = i
+  end do
+!$omp end do
+!$omp end parallel
+  if (k .ne. 100) call abort
+end
diff --git a/libgomp/testsuite/libgomp.fortran/reduction1.f90 b/libgomp/testsuite/libgomp.fortran/reduction1.f90
new file mode 100644
index 00000000000..d6ceb081443
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/reduction1.f90
@@ -0,0 +1,181 @@
+! { dg-do run }
+!$ use omp_lib
+
+  integer :: i, ia (6), n, cnt
+  real :: r, ra (4)
+  double precision :: d, da (5)
+  complex :: c, ca (3)
+  logical :: v
+
+  i = 1
+  ia = 2
+  r = 3
+  ra = 4
+  d = 5.5
+  da = 6.5
+  c = cmplx (7.5, 1.5)
+  ca = cmplx (8.5, -3.0)
+  v = .false.
+  cnt = -1
+
+!$omp parallel num_threads (3) private (n) reduction (.or.:v) &
+!$omp & reduction (+:i, ia, r, ra, d, da, c, ca)
+!$ if (i .ne. 0 .or. any (ia .ne. 0)) v = .true.
+!$ if (r .ne. 0 .or. any (ra .ne. 0)) v = .true.
+!$ if (d .ne. 0 .or. any (da .ne. 0)) v = .true.
+!$ if (c .ne. cmplx (0) .or. any (ca .ne. cmplx (0))) v = .true.
+  n = omp_get_thread_num ()
+  if (n .eq. 0) then
+    cnt = omp_get_num_threads ()
+    i = 4
+    ia(3:5) = -2
+    r = 5
+    ra(1:2) = 6.5
+    d = -2.5
+    da(2:4) = 8.5
+    c = cmplx (2.5, -3.5)
+    ca(1) = cmplx (4.5, 5)
+  else if (n .eq. 1) then
+    i = 2
+    ia(4:6) = 5
+    r = 1
+    ra(2:4) = -1.5
+    d = 8.5
+    da(1:3) = 2.5
+    c = cmplx (0.5, -3)
+    ca(2:3) = cmplx (-1, 6)
+  else
+    i = 1
+    ia = 1
+    r = -1
+    ra = -1
+    d = 1
+    da = -1
+    c = 1
+    ca = cmplx (-1, 0)
+  end if
+!$omp end parallel
+  if (v) call abort
+  if (cnt .eq. 3) then
+    if (i .ne. 8 .or. any (ia .ne. (/3, 3, 1, 6, 6, 8/))) call abort
+    if (r .ne. 8 .or. any (ra .ne. (/9.5, 8.0, 1.5, 1.5/))) call abort
+    if (d .ne. 12.5 .or. any (da .ne. (/8.0, 16.5, 16.5, 14.0, 5.5/))) call abort
+    if (c .ne. cmplx (11.5, -5)) call abort
+    if (ca(1) .ne. cmplx (12, 2)) call abort
+    if (ca(2) .ne. cmplx (6.5, 3) .or. ca(2) .ne. ca(3)) call abort
+  end if
+
+  i = 1
+  ia = 2
+  r = 3
+  ra = 4
+  d = 5.5
+  da = 6.5
+  c = cmplx (7.5, 1.5)
+  ca = cmplx (8.5, -3.0)
+  v = .false.
+  cnt = -1
+
+!$omp parallel num_threads (3) private (n) reduction (.or.:v) &
+!$omp & reduction (-:i, ia, r, ra, d, da, c, ca)
+!$ if (i .ne. 0 .or. any (ia .ne. 0)) v = .true.
+!$ if (r .ne. 0 .or. any (ra .ne. 0)) v = .true.
+!$ if (d .ne. 0 .or. any (da .ne. 0)) v = .true.
+!$ if (c .ne. cmplx (0) .or. any (ca .ne. cmplx (0))) v = .true.
+  n = omp_get_thread_num ()
+  if (n .eq. 0) then
+    cnt = omp_get_num_threads ()
+    i = 4
+    ia(3:5) = -2
+    r = 5
+    ra(1:2) = 6.5
+    d = -2.5
+    da(2:4) = 8.5
+    c = cmplx (2.5, -3.5)
+    ca(1) = cmplx (4.5, 5)
+  else if (n .eq. 1) then
+    i = 2
+    ia(4:6) = 5
+    r = 1
+    ra(2:4) = -1.5
+    d = 8.5
+    da(1:3) = 2.5
+    c = cmplx (0.5, -3)
+    ca(2:3) = cmplx (-1, 6)
+  else
+    i = 1
+    ia = 1
+    r = -1
+    ra = -1
+    d = 1
+    da = -1
+    c = 1
+    ca = cmplx (-1, 0)
+  end if
+!$omp end parallel
+  if (v) call abort
+  if (cnt .eq. 3) then
+    if (i .ne. 8 .or. any (ia .ne. (/3, 3, 1, 6, 6, 8/))) call abort
+    if (r .ne. 8 .or. any (ra .ne. (/9.5, 8.0, 1.5, 1.5/))) call abort
+    if (d .ne. 12.5 .or. any (da .ne. (/8.0, 16.5, 16.5, 14.0, 5.5/))) call abort
+    if (c .ne. cmplx (11.5, -5)) call abort
+    if (ca(1) .ne. cmplx (12, 2)) call abort
+    if (ca(2) .ne. cmplx (6.5, 3) .or. ca(2) .ne. ca(3)) call abort
+  end if
+
+  i = 1
+  ia = 2
+  r = 4
+  ra = 8
+  d = 16
+  da = 32
+  c = 2
+  ca = cmplx (0, 2)
+  v = .false.
+  cnt = -1
+
+!$omp parallel num_threads (3) private (n) reduction (.or.:v) &
+!$omp & reduction (*:i, ia, r, ra, d, da, c, ca)
+!$ if (i .ne. 1 .or. any (ia .ne. 1)) v = .true.
+!$ if (r .ne. 1 .or. any (ra .ne. 1)) v = .true.
+!$ if (d .ne. 1 .or. any (da .ne. 1)) v = .true.
+!$ if (c .ne. cmplx (1) .or. any (ca .ne. cmplx (1))) v = .true.
+  n = omp_get_thread_num ()
+  if (n .eq. 0) then
+    cnt = omp_get_num_threads ()
+    i = 3
+    ia(3:5) = 2
+    r = 0.5
+    ra(1:2) = 2
+    d = -1
+    da(2:4) = -2
+    c = 2.5
+    ca(1) = cmplx (-5, 0)
+  else if (n .eq. 1) then
+    i = 2
+    ia(4:6) = -2
+    r = 8
+    ra(2:4) = -0.5
+    da(1:3) = -1
+    c = -3
+    ca(2:3) = cmplx (0, -1)
+  else
+    ia = 2
+    r = 0.5
+    ra = 0.25
+    d = 2.5
+    da = -1
+    c = cmplx (0, -1)
+    ca = cmplx (-1, 0)
+  end if
+!$omp end parallel
+  if (v) call abort
+  if (cnt .eq. 3) then
+    if (i .ne. 6 .or. any (ia .ne. (/4, 4, 8, -16, -16, -8/))) call abort
+    if (r .ne. 8 .or. any (ra .ne. (/4., -2., -1., -1./))) call abort
+    if (d .ne. -40 .or. any (da .ne. (/32., -64., -64., 64., -32./))) call abort
+    if (c .ne. cmplx (0, 15)) call abort
+    if (ca(1) .ne. cmplx (0, 10)) call abort
+    if (ca(2) .ne. cmplx (-2, 0) .or. ca(2) .ne. ca(3)) call abort
+  end if
+end
diff --git a/libgomp/testsuite/libgomp.fortran/reduction2.f90 b/libgomp/testsuite/libgomp.fortran/reduction2.f90
new file mode 100644
index 00000000000..9bdeb77de85
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/reduction2.f90
@@ -0,0 +1,73 @@
+! { dg-do run }
+!$ use omp_lib
+
+  logical :: l, la (4), m, ma (4), v
+  integer :: n, cnt
+
+  l = .true.
+  la = (/.true., .false., .true., .true./)
+  m = .false.
+  ma = (/.false., .false., .false., .true./)
+  v = .false.
+  cnt = -1
+
+!$omp parallel num_threads (3) private (n) reduction (.or.:v) &
+!$omp & reduction (.and.:l, la) reduction (.or.:m, ma)
+!$ if (.not. l .or. any (.not. la)) v = .true.
+!$ if (m .or. any (ma)) v = .true.
+  n = omp_get_thread_num ()
+  if (n .eq. 0) then
+    cnt = omp_get_num_threads ()
+    l = .false.
+    la(3) = .false.
+    ma(2) = .true.
+  else if (n .eq. 1) then
+    l = .false.
+    la(4) = .false.
+    ma(1) = .true.
+  else
+    la(3) = .false.
+    m = .true.
+    ma(1) = .true.
+  end if
+!$omp end parallel
+  if (v) call abort
+  if (cnt .eq. 3) then
+    if (l .or. any (la .neqv. (/.true., .false., .false., .false./))) call abort
+    if (.not. m .or. any (ma .neqv. (/.true., .true., .false., .true./))) call abort
+  end if
+
+  l = .true.
+  la = (/.true., .false., .true., .true./)
+  m = .false.
+  ma = (/.false., .false., .false., .true./)
+  v = .false.
+  cnt = -1
+
+!$omp parallel num_threads (3) private (n) reduction (.or.:v) &
+!$omp & reduction (.eqv.:l, la) reduction (.neqv.:m, ma)
+!$ if (.not. l .or. any (.not. la)) v = .true.
+!$ if (m .or. any (ma)) v = .true.
+  n = omp_get_thread_num ()
+  if (n .eq. 0) then
+    cnt = omp_get_num_threads ()
+    l = .false.
+    la(3) = .false.
+    ma(2) = .true.
+  else if (n .eq. 1) then
+    l = .false.
+    la(4) = .false.
+    ma(1) = .true.
+  else
+    la(3) = .false.
+    m = .true.
+    ma(1) = .true.
+  end if
+!$omp end parallel
+  if (v) call abort
+  if (cnt .eq. 3) then
+    if (.not. l .or. any (la .neqv. (/.true., .false., .true., .false./))) call abort
+    if (.not. m .or. any (ma .neqv. (/.false., .true., .false., .true./))) call abort
+  end if
+
+end
diff --git a/libgomp/testsuite/libgomp.fortran/reduction3.f90 b/libgomp/testsuite/libgomp.fortran/reduction3.f90
new file mode 100644
index 00000000000..a0786eca008
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/reduction3.f90
@@ -0,0 +1,103 @@
+! { dg-do run }
+!$ use omp_lib
+
+  integer (kind = 4) :: i, ia (6), n, cnt
+  real :: r, ra (4)
+  double precision :: d, da (5)
+  logical :: v
+
+  i = 1
+  ia = 2
+  r = 3
+  ra = 4
+  d = 5.5
+  da = 6.5
+  v = .false.
+  cnt = -1
+
+!$omp parallel num_threads (3) private (n) reduction (.or.:v) &
+!$omp & reduction (max:i, ia, r, ra, d, da)
+!$ if (i .ne. -2147483648 .or. any (ia .ne. -2147483648)) v = .true.
+!$ if (r .ge. -1.0d38 .or. any (ra .ge. -1.0d38)) v = .true.
+!$ if (d .ge. -1.0d300 .or. any (da .ge. -1.0d300)) v = .true.
+  n = omp_get_thread_num ()
+  if (n .eq. 0) then
+    cnt = omp_get_num_threads ()
+    i = 4
+    ia(3:5) = -2
+    ia(1) = 7
+    r = 5
+    ra(1:2) = 6.5
+    d = -2.5
+    da(2:4) = 8.5
+  else if (n .eq. 1) then
+    i = 2
+    ia(4:6) = 5
+    r = 1
+    ra(2:4) = -1.5
+    d = 8.5
+    da(1:3) = 2.5
+  else
+    i = 1
+    ia = 1
+    r = -1
+    ra = -1
+    d = 1
+    da = -1
+  end if
+!$omp end parallel
+  if (v) call abort
+  if (cnt .eq. 3) then
+    if (i .ne. 4 .or. any (ia .ne. (/7, 2, 2, 5, 5, 5/))) call abort
+    if (r .ne. 5 .or. any (ra .ne. (/6.5, 6.5, 4., 4./))) call abort
+    if (d .ne. 8.5 .or. any (da .ne. (/6.5, 8.5, 8.5, 8.5, 6.5/))) call abort
+  end if
+
+  i = 1
+  ia = 2
+  r = 3
+  ra = 4
+  d = 5.5
+  da = 6.5
+  v = .false.
+  cnt = -1
+
+!$omp parallel num_threads (3) private (n) reduction (.or.:v) &
+!$omp & reduction (min:i, ia, r, ra, d, da)
+!$ if (i .ne. 2147483647 .or. any (ia .ne. 2147483647)) v = .true.
+!$ if (r .le. 1.0d38 .or. any (ra .le. 1.0d38)) v = .true.
+!$ if (d .le. 1.0d300 .or. any (da .le. 1.0d300)) v = .true.
+  n = omp_get_thread_num ()
+  if (n .eq. 0) then
+    cnt = omp_get_num_threads ()
+    i = 4
+    ia(3:5) = -2
+    ia(1) = 7
+    r = 5
+    ra(1:2) = 6.5
+    d = -2.5
+    da(2:4) = 8.5
+  else if (n .eq. 1) then
+    i = 2
+    ia(4:6) = 5
+    r = 1
+    ra(2:4) = -1.5
+    d = 8.5
+    da(1:3) = 2.5
+  else
+    i = 1
+    ia = 1
+    r = -1
+    ra = 7
+    ra(3) = -8.5
+    d = 1
+    da(1:4) = 6
+  end if
+!$omp end parallel
+  if (v) call abort
+  if (cnt .eq. 3) then
+    if (i .ne. 1 .or. any (ia .ne. (/1, 1, -2, -2, -2, 1/))) call abort
+    if (r .ne. -1 .or. any (ra .ne. (/4., -1.5, -8.5, -1.5/))) call abort
+    if (d .ne. -2.5 .or. any (da .ne. (/2.5, 2.5, 2.5, 6., 6.5/))) call abort
+  end if
+end
diff --git a/libgomp/testsuite/libgomp.fortran/reduction4.f90 b/libgomp/testsuite/libgomp.fortran/reduction4.f90
new file mode 100644
index 00000000000..5a5e852bea7
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/reduction4.f90
@@ -0,0 +1,56 @@
+! { dg-do run }
+!$ use omp_lib
+
+  integer (kind = 4) :: i, ia (6), j, ja (6), k, ka (6), ta (6), n, cnt, x
+  logical :: v
+
+  i = Z'ffff0f'
+  ia = Z'f0ff0f'
+  j = Z'0f0000'
+  ja = Z'0f5a00'
+  k = Z'055aa0'
+  ka = Z'05a5a5'
+  v = .false.
+  cnt = -1
+  x = Z'ffffffff'
+
+!$omp parallel num_threads (3) private (n) reduction (.or.:v) &
+!$omp & reduction (iand:i, ia) reduction (ior:j, ja) reduction (ieor:k, ka)
+!$ if (i .ne. x .or. any (ia .ne. x)) v = .true.
+!$ if (j .ne. 0 .or. any (ja .ne. 0)) v = .true.
+!$ if (k .ne. 0 .or. any (ka .ne. 0)) v = .true.
+  n = omp_get_thread_num ()
+  if (n .eq. 0) then
+    cnt = omp_get_num_threads ()
+    i = Z'ff7fff'
+    ia(3:5) = Z'fffff1'
+    j = Z'078000'
+    ja(1:3) = 1
+    k = Z'78'
+    ka(3:6) = Z'f0f'
+  else if (n .eq. 1) then
+    i = Z'ffff77'
+    ia(2:5) = Z'ffafff'
+    j = Z'007800'
+    ja(2:5) = 8
+    k = Z'57'
+    ka(3:4) = Z'f0108'
+  else
+    i = Z'777fff'
+    ia(1:2) = Z'fffff3'
+    j = Z'000780'
+    ja(5:6) = Z'f00'
+    k = Z'1000'
+    ka(6:6) = Z'777'
+  end if
+!$omp end parallel
+  if (v) call abort
+  if (cnt .eq. 3) then
+    ta = (/Z'f0ff03', Z'f0af03', Z'f0af01', Z'f0af01', Z'f0af01', Z'f0ff0f'/)
+    if (i .ne. Z'777f07' .or. any (ia .ne. ta)) call abort
+    ta = (/Z'f5a01', Z'f5a09', Z'f5a09', Z'f5a08', Z'f5f08', Z'f5f00'/)
+    if (j .ne. Z'fff80' .or. any (ja .ne. ta)) call abort
+    ta = (/Z'5a5a5', Z'5a5a5', Z'aaba2', Z'aaba2', Z'5aaaa', Z'5addd'/)
+    if (k .ne. Z'54a8f' .or. any (ka .ne. ta)) call abort
+  end if
+end
diff --git a/libgomp/testsuite/libgomp.fortran/reduction5.f90 b/libgomp/testsuite/libgomp.fortran/reduction5.f90
new file mode 100644
index 00000000000..bfdd43a93fa
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/reduction5.f90
@@ -0,0 +1,41 @@
+! { dg-do run }
+
+module reduction5
+  intrinsic ior, min, max
+end module reduction5
+
+  call test1
+  call test2
+contains
+  subroutine test1
+    use reduction5, bitwise_or => ior
+    integer :: n
+    n = Z'f'
+!$omp parallel sections num_threads (3) reduction (bitwise_or: n)
+    n = ior (n, Z'20')
+!$omp section
+    n = bitwise_or (Z'410', n)
+!$omp section
+    n = bitwise_or (n, Z'2000')
+!$omp end parallel sections
+    if (n .ne. Z'243f') call abort
+  end subroutine
+  subroutine test2
+    use reduction5, min => max, max => min
+    integer :: m, n
+    m = 8
+    n = 4
+!$omp parallel sections num_threads (3) reduction (min: n) &
+!$omp & reduction (max: m)
+    if (m .gt. 13) m = 13
+    if (n .lt. 11) n = 11
+!$omp section
+    if (m .gt. 5) m = 5
+    if (n .lt. 15) n = 15
+!$omp section
+    if (m .gt. 3) m = 3
+    if (n .lt. -1) n = -1
+!$omp end parallel sections
+    if (m .ne. 3 .or. n .ne. 15) call abort
+  end subroutine test2
+end
diff --git a/libgomp/testsuite/libgomp.fortran/reduction6.f90 b/libgomp/testsuite/libgomp.fortran/reduction6.f90
new file mode 100644
index 00000000000..9f3ec6ca893
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/reduction6.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+
+  integer, dimension (6, 6) :: a
+  character (36) :: c
+  integer nthreads
+  a = 9
+  nthreads = -1
+  call foo (a (2:4, 3:5), nthreads)
+  if (nthreads .eq. 3) then
+    write (c, '(36i1)') a
+    if (c .ne. '999999999999966699966699966699999999') call abort
+  end if
+contains
+  subroutine foo (b, nthreads)
+    use omp_lib
+    integer, dimension (3:, 5:) :: b
+    integer :: err, nthreads
+    b = 0
+    err = 0
+!$omp parallel num_threads (3) reduction (+:b)
+    if (any (b .ne. 0)) then
+!$omp atomic
+      err = err + 1
+    end if
+!$omp master
+    nthreads = omp_get_num_threads ()
+!$omp end master
+    b = 2
+!$omp end parallel
+    if (err .gt. 0) call abort
+  end subroutine foo
+end
diff --git a/libgomp/testsuite/libgomp.fortran/reference1.f90 b/libgomp/testsuite/libgomp.fortran/reference1.f90
new file mode 100644
index 00000000000..b959e2716b8
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/reference1.f90
@@ -0,0 +1,34 @@
+! { dg-do run }
+!$ use omp_lib
+
+  integer :: i, j, k
+  double precision :: d
+  i = 6
+  j = 19
+  k = 0
+  d = 24.5
+  call test (i, j, k, d)
+  if (i .ne. 38) call abort
+  if (iand (k, 255) .ne. 0) call abort
+  if (iand (k, 65280) .eq. 0) then
+    if (k .ne. 65536 * 4) call abort
+  end if
+contains
+  subroutine test (i, j, k, d)
+    integer :: i, j, k
+    double precision :: d
+
+!$omp parallel firstprivate (d) private (j) num_threads (4) reduction (+:k)
+    if (i .ne. 6 .or. d .ne. 24.5 .or. k .ne. 0) k = k + 1
+    if (omp_get_num_threads () .ne. 4) k = k + 256
+    d = d / 2
+    j = 8
+    k = k + 65536
+!$omp barrier
+    if (d .ne. 12.25 .or. j .ne. 8) k = k + 1
+!$omp single
+    i = i + 32
+!$omp end single nowait
+!$omp end parallel
+  end subroutine test
+end
diff --git a/libgomp/testsuite/libgomp.fortran/reference2.f90 b/libgomp/testsuite/libgomp.fortran/reference2.f90
new file mode 100644
index 00000000000..1232b6926cb
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/reference2.f90
@@ -0,0 +1,21 @@
+! { dg-do run }
+  real, dimension (5) :: b
+  b = 5
+  call foo (b)
+contains
+  subroutine foo (a)
+    real, dimension (5) :: a
+    logical :: l
+    l = .false.
+!$omp parallel private (a) reduction (.or.:l)
+    a = 15
+    l = bar (a)
+!$omp end parallel
+    if (l) call abort
+  end subroutine
+  function bar (a)
+    real, dimension (5) :: a
+    logical :: bar
+    bar = any (a .ne. 15)
+  end function
+end
diff --git a/libgomp/testsuite/libgomp.fortran/retval1.f90 b/libgomp/testsuite/libgomp.fortran/retval1.f90
new file mode 100644
index 00000000000..8bb07f8fce6
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/retval1.f90
@@ -0,0 +1,120 @@
+! { dg-do run }
+
+function f1 ()
+  use omp_lib
+  real :: f1
+  logical :: l
+  f1 = 6.5
+  l = .false.
+!$omp parallel firstprivate (f1) num_threads (2) reduction (.or.:l)
+  l = f1 .ne. 6.5
+  if (omp_get_thread_num () .eq. 0) f1 = 8.5
+  if (omp_get_thread_num () .eq. 1) f1 = 14.5
+!$omp barrier
+  l = l .or. (omp_get_thread_num () .eq. 0 .and. f1 .ne. 8.5)
+  l = l .or. (omp_get_thread_num () .eq. 1 .and. f1 .ne. 14.5)
+!$omp end parallel
+  if (l) call abort
+  f1 = -2.5
+end function f1
+function f2 ()
+  use omp_lib
+  real :: f2, e2
+  logical :: l
+entry e2 ()
+  f2 = 6.5
+  l = .false.
+!$omp parallel firstprivate (e2) num_threads (2) reduction (.or.:l)
+  l = e2 .ne. 6.5
+  if (omp_get_thread_num () .eq. 0) e2 = 8.5
+  if (omp_get_thread_num () .eq. 1) e2 = 14.5
+!$omp barrier
+  l = l .or. (omp_get_thread_num () .eq. 0 .and. e2 .ne. 8.5)
+  l = l .or. (omp_get_thread_num () .eq. 1 .and. e2 .ne. 14.5)
+!$omp end parallel
+  if (l) call abort
+  e2 = 7.5
+end function f2
+function f3 ()
+  use omp_lib
+  real :: f3, e3
+  logical :: l
+entry e3 ()
+  f3 = 6.5
+  l = .false.
+!$omp parallel firstprivate (f3, e3) num_threads (2) reduction (.or.:l)
+  l = e3 .ne. 6.5
+  l = l .or. f3 .ne. 6.5
+  if (omp_get_thread_num () .eq. 0) e3 = 8.5
+  if (omp_get_thread_num () .eq. 1) e3 = 14.5
+  f3 = e3 - 4.5
+!$omp barrier
+  l = l .or. (omp_get_thread_num () .eq. 0 .and. e3 .ne. 8.5)
+  l = l .or. (omp_get_thread_num () .eq. 1 .and. e3 .ne. 14.5)
+  l = l .or. f3 .ne. e3 - 4.5
+!$omp end parallel
+  if (l) call abort
+  e3 = 0.5
+end function f3
+function f4 () result (r4)
+  use omp_lib
+  real :: r4, s4
+  logical :: l
+entry e4 () result (s4)
+  r4 = 6.5
+  l = .false.
+!$omp parallel firstprivate (r4, s4) num_threads (2) reduction (.or.:l)
+  l = s4 .ne. 6.5
+  l = l .or. r4 .ne. 6.5
+  if (omp_get_thread_num () .eq. 0) s4 = 8.5
+  if (omp_get_thread_num () .eq. 1) s4 = 14.5
+  r4 = s4 - 4.5
+!$omp barrier
+  l = l .or. (omp_get_thread_num () .eq. 0 .and. s4 .ne. 8.5)
+  l = l .or. (omp_get_thread_num () .eq. 1 .and. s4 .ne. 14.5)
+  l = l .or. r4 .ne. s4 - 4.5
+!$omp end parallel
+  if (l) call abort
+  s4 = -0.5
+end function f4
+function f5 (is_f5)
+  use omp_lib
+  real :: f5
+  integer :: e5
+  logical :: l, is_f5
+entry e5 (is_f5)
+  if (is_f5) then
+    f5 = 6.5
+  else
+    e5 = 8
+  end if
+  l = .false.
+!$omp parallel firstprivate (f5, e5) shared (is_f5) num_threads (2) &
+!$omp reduction (.or.:l)
+  l = .not. is_f5 .and. e5 .ne. 8
+  l = l .or. (is_f5 .and. f5 .ne. 6.5)
+  if (omp_get_thread_num () .eq. 0) e5 = 8
+  if (omp_get_thread_num () .eq. 1) e5 = 14
+  f5 = e5 - 4.5
+!$omp barrier
+  l = l .or. (omp_get_thread_num () .eq. 0 .and. e5 .ne. 8)
+  l = l .or. (omp_get_thread_num () .eq. 1 .and. e5 .ne. 14)
+  l = l .or. f5 .ne. e5 - 4.5
+!$omp end parallel
+  if (l) call abort
+  if (is_f5) f5 = -2.5
+  if (.not. is_f5) e5 = 8
+end function f5
+
+  real :: f1, f2, e2, f3, e3, f4, e4, f5
+  integer :: e5
+  if (f1 () .ne. -2.5) call abort
+  if (f2 () .ne. 7.5) call abort
+  if (e2 () .ne. 7.5) call abort
+  if (f3 () .ne. 0.5) call abort
+  if (e3 () .ne. 0.5) call abort
+  if (f4 () .ne. -0.5) call abort
+  if (e4 () .ne. -0.5) call abort
+  if (f5 (.true.) .ne. -2.5) call abort
+  if (e5 (.false.) .ne. 8) call abort
+end
diff --git a/libgomp/testsuite/libgomp.fortran/sharing1.f90 b/libgomp/testsuite/libgomp.fortran/sharing1.f90
new file mode 100644
index 00000000000..063e7db8357
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/sharing1.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+
+  use omp_lib
+  integer :: i, j, k
+  logical :: l
+  common /b/ i, j
+  i = 4
+  j = 8
+  l = .false.
+!$omp parallel private (k) firstprivate (i) shared (j) num_threads (2) &
+!$omp& reduction (.or.:l)
+  if (i .ne. 4 .or. j .ne. 8) l = .true.
+!$omp barrier
+  k = omp_get_thread_num ()
+  if (k .eq. 0) then
+    i = 14
+    j = 15
+  end if
+!$omp barrier
+  if (k .eq. 1) then
+    if (i .ne. 4 .or. j .ne. 15) l = .true.
+    i = 24
+    j = 25
+  end if
+!$omp barrier
+  if (j .ne. 25 .or. i .ne. (k * 10 + 14)) l = .true.
+!$omp end parallel
+  if (l .or. j .ne. 25) call abort
+end
diff --git a/libgomp/testsuite/libgomp.fortran/sharing2.f90 b/libgomp/testsuite/libgomp.fortran/sharing2.f90
new file mode 100644
index 00000000000..266dd46fadb
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/sharing2.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+
+  use omp_lib
+  integer :: i, j, k, m, n
+  logical :: l
+  equivalence (i, m)
+  equivalence (j, n)
+  i = 4
+  j = 8
+  l = .false.
+!$omp parallel private (k) firstprivate (i) shared (j) num_threads (2) &
+!$omp& reduction (.or.:l)
+  l = l .or. i .ne. 4
+  l = l .or. j .ne. 8
+!$omp barrier
+  k = omp_get_thread_num ()
+  if (k .eq. 0) then
+    i = 14
+    j = 15
+  end if
+!$omp barrier
+  if (k .eq. 1) then
+    if (i .ne. 4 .or. j .ne. 15) l = .true.
+    i = 24
+    j = 25
+  end if
+!$omp barrier
+  if (j .ne. 25 .or. i .ne. (k * 10 + 14)) l = .true.
+!$omp end parallel
+  if (l) call abort
+  if (j .ne. 25) call abort
+end
diff --git a/libgomp/testsuite/libgomp.fortran/threadprivate1.f90 b/libgomp/testsuite/libgomp.fortran/threadprivate1.f90
new file mode 100644
index 00000000000..99a20185509
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/threadprivate1.f90
@@ -0,0 +1,19 @@
+! { dg-do run }
+! { dg-require-effective-target tls_runtime }
+
+module threadprivate1
+  double precision :: d
+!$omp threadprivate (d)
+end module threadprivate1
+
+!$ use omp_lib
+  use threadprivate1
+  logical :: l
+  l = .false.
+!$omp parallel num_threads (4) reduction (.or.:l)
+  d = omp_get_thread_num () + 6.5
+!$omp barrier
+  if (d .ne. omp_get_thread_num () + 6.5) l = .true.
+!$omp end parallel
+  if (l) call abort ()
+end
diff --git a/libgomp/testsuite/libgomp.fortran/threadprivate2.f90 b/libgomp/testsuite/libgomp.fortran/threadprivate2.f90
new file mode 100644
index 00000000000..f3a4af0fc13
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/threadprivate2.f90
@@ -0,0 +1,94 @@
+! { dg-do run }
+! { dg-require-effective-target tls_runtime }
+
+module threadprivate2
+  integer, dimension(:,:), allocatable :: foo
+!$omp threadprivate (foo)
+end module threadprivate2
+
+  use omp_lib
+  use threadprivate2
+
+  integer, dimension(:), pointer :: bar1
+  integer, dimension(2), target :: bar2
+  common /thrc/ bar1, bar2
+!$omp threadprivate (/thrc/)
+
+  integer, dimension(:), pointer, save :: bar3 => NULL()
+!$omp threadprivate (bar3)
+
+  logical :: l
+  type tt
+    integer :: a
+    integer :: b = 32
+  end type tt
+  type (tt), save :: baz
+!$omp threadprivate (baz)
+
+  l = .false.
+  call omp_set_dynamic (.false.)
+  call omp_set_num_threads (4)
+
+!$omp parallel num_threads (4) reduction (.or.:l)
+  l = allocated (foo)
+  allocate (foo (6 + omp_get_thread_num (), 3))
+  l = l.or..not.allocated (foo)
+  l = l.or.size (foo).ne.(18 + 3 * omp_get_thread_num ())
+  foo = omp_get_thread_num () + 1
+
+  bar2 = omp_get_thread_num ()
+  l = l.or.associated (bar3)
+  bar1 => bar2
+  l = l.or..not.associated (bar1)
+  l = l.or..not.associated (bar1, bar2)
+  l = l.or.any (bar1.ne.omp_get_thread_num ())
+  nullify (bar1)
+  l = l.or.associated (bar1)
+  allocate (bar3 (4))
+  l = l.or..not.associated (bar3)
+  bar3 = omp_get_thread_num () - 2
+
+  l = l.or.(baz%b.ne.32)
+  baz%a = omp_get_thread_num () * 2
+  baz%b = omp_get_thread_num () * 2 + 1
+!$omp end parallel
+
+  if (l) call abort
+  if (.not.allocated (foo)) call abort
+  if (size (foo).ne.18) call abort
+  if (any (foo.ne.1)) call abort
+
+  if (associated (bar1)) call abort
+  if (.not.associated (bar3)) call abort
+  if (any (bar3 .ne. -2)) call abort
+  deallocate (bar3)
+  if (associated (bar3)) call abort
+
+!$omp parallel num_threads (4) reduction (.or.:l)
+  l = l.or..not.allocated (foo)
+  l = l.or.size (foo).ne.(18 + 3 * omp_get_thread_num ())
+  l = l.or.any (foo.ne.(omp_get_thread_num () + 1))
+  if (omp_get_thread_num () .ne. 0) then
+    deallocate (foo)
+    l = l.or.allocated (foo)
+  end if
+
+  l = l.or.associated (bar1)
+  if (omp_get_thread_num () .ne. 0) then
+    l = l.or..not.associated (bar3)
+    l = l.or.any (bar3 .ne. omp_get_thread_num () - 2)
+    deallocate (bar3)
+  end if
+  l = l.or.associated (bar3)
+
+  l = l.or.(baz%a.ne.(omp_get_thread_num () * 2))
+  l = l.or.(baz%b.ne.(omp_get_thread_num () * 2 + 1))
+!$omp end parallel
+
+  if (l) call abort
+  if (.not.allocated (foo)) call abort
+  if (size (foo).ne.18) call abort
+  if (any (foo.ne.1)) call abort
+  deallocate (foo)
+  if (allocated (foo)) call abort
+end
diff --git a/libgomp/testsuite/libgomp.fortran/threadprivate3.f90 b/libgomp/testsuite/libgomp.fortran/threadprivate3.f90
new file mode 100644
index 00000000000..d20a6520a8a
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/threadprivate3.f90
@@ -0,0 +1,106 @@
+! { dg-do run }
+! { dg-require-effective-target tls_runtime }
+
+module threadprivate3
+  integer, dimension(:,:), pointer :: foo => NULL()
+!$omp threadprivate (foo)
+end module threadprivate3
+
+  use omp_lib
+  use threadprivate3
+
+  integer, dimension(:), pointer :: bar1
+  integer, dimension(2), target :: bar2, var
+  common /thrc/ bar1, bar2
+!$omp threadprivate (/thrc/)
+
+  integer, dimension(:), pointer, save :: bar3 => NULL()
+!$omp threadprivate (bar3)
+
+  logical :: l
+  type tt
+    integer :: a
+    integer :: b = 32
+  end type tt
+  type (tt), save :: baz
+!$omp threadprivate (baz)
+
+  l = .false.
+  call omp_set_dynamic (.false.)
+  call omp_set_num_threads (4)
+  var = 6
+
+!$omp parallel num_threads (4) reduction (.or.:l)
+  bar2 = omp_get_thread_num ()
+  l = associated (bar3)
+  bar1 => bar2
+  l = l.or..not.associated (bar1)
+  l = l.or..not.associated (bar1, bar2)
+  l = l.or.any (bar1.ne.omp_get_thread_num ())
+  nullify (bar1)
+  l = l.or.associated (bar1)
+  allocate (bar3 (4))
+  l = l.or..not.associated (bar3)
+  bar3 = omp_get_thread_num () - 2
+  if (omp_get_thread_num () .ne. 0) then
+    deallocate (bar3)
+    if (associated (bar3)) call abort
+  else
+    bar1 => var
+  end if
+  bar2 = omp_get_thread_num () * 6 + 130
+
+  l = l.or.(baz%b.ne.32)
+  baz%a = omp_get_thread_num () * 2
+  baz%b = omp_get_thread_num () * 2 + 1
+!$omp end parallel
+
+  if (l) call abort
+  if (.not.associated (bar1)) call abort
+  if (any (bar1.ne.6)) call abort
+  if (.not.associated (bar3)) call abort
+  if (any (bar3 .ne. -2)) call abort
+  deallocate (bar3)
+  if (associated (bar3)) call abort
+
+  allocate (bar3 (10))
+  bar3 = 17
+
+!$omp parallel copyin (bar1, bar2, bar3, baz) num_threads (4) &
+!$omp& reduction (.or.:l)
+  l = l.or..not.associated (bar1)
+  l = l.or.any (bar1.ne.6)
+  l = l.or.any (bar2.ne.130)
+  l = l.or..not.associated (bar3)
+  l = l.or.size (bar3).ne.10
+  l = l.or.any (bar3.ne.17)
+  allocate (bar1 (4))
+  bar1 = omp_get_thread_num ()
+  bar2 = omp_get_thread_num () + 8
+
+  l = l.or.(baz%a.ne.0)
+  l = l.or.(baz%b.ne.1)
+  baz%a = omp_get_thread_num () * 3 + 4
+  baz%b = omp_get_thread_num () * 3 + 5
+
+!$omp barrier
+  if (omp_get_thread_num () .eq. 0) then
+    deallocate (bar3)
+  end if
+  bar3 => bar2
+!$omp barrier
+
+  l = l.or..not.associated (bar1)
+  l = l.or..not.associated (bar3)
+  l = l.or.any (bar1.ne.omp_get_thread_num ())
+  l = l.or.size (bar1).ne.4
+  l = l.or.any (bar2.ne.omp_get_thread_num () + 8)
+  l = l.or.any (bar3.ne.omp_get_thread_num () + 8)
+  l = l.or.size (bar3).ne.2
+
+  l = l.or.(baz%a .ne. omp_get_thread_num () * 3 + 4)
+  l = l.or.(baz%b .ne. omp_get_thread_num () * 3 + 5)
+!$omp end parallel
+
+  if (l) call abort
+end
diff --git a/libgomp/testsuite/libgomp.fortran/vla1.f90 b/libgomp/testsuite/libgomp.fortran/vla1.f90
new file mode 100644
index 00000000000..c22165ee0a1
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/vla1.f90
@@ -0,0 +1,185 @@
+! { dg-do run }
+
+  call test
+contains
+  subroutine check (x, y, l)
+    integer :: x, y
+    logical :: l
+    l = l .or. x .ne. y
+  end subroutine check
+
+  subroutine foo (c, d, e, f, g, h, i, j, k, n)
+    use omp_lib
+    integer :: n
+    character (len = *) :: c
+    character (len = n) :: d
+    integer, dimension (2, 3:5, n) :: e
+    integer, dimension (2, 3:n, n) :: f
+    character (len = *), dimension (5, 3:n) :: g
+    character (len = n), dimension (5, 3:n) :: h
+    real, dimension (:, :, :) :: i
+    double precision, dimension (3:, 5:, 7:) :: j
+    integer, dimension (:, :, :) :: k
+    logical :: l
+    integer :: p, q, r
+    character (len = n) :: s
+    integer, dimension (2, 3:5, n) :: t
+    integer, dimension (2, 3:n, n) :: u
+    character (len = n), dimension (5, 3:n) :: v
+    character (len = 2 * n + 24) :: w
+    integer :: x
+    character (len = 1) :: y
+    s = 'PQRSTUV'
+    forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + p - q + 2 * r
+    forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - p + q - 2 * r
+    forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = '_+|/Oo_'
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = '///|||!'
+    l = .false.
+!$omp parallel default (none) firstprivate (c, d, e, f, g, h, i, j, k) &
+!$omp & firstprivate (s, t, u, v) reduction (.or.:l) num_threads (6) &
+!$omp private (p, q, r, w, x, y)
+    l = l .or. c .ne. 'abcdefghijkl'
+    l = l .or. d .ne. 'ABCDEFG'
+    l = l .or. s .ne. 'PQRSTUV'
+    do 100, p = 1, 2
+      do 100, q = 3, 7
+	do 100, r = 1, 7
+	  if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 + p + q + 2 * r
+	  l = l .or. f(p, q, r) .ne. 25 + p + q + 2 * r
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. '0123456789AB'
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. '9876543210ZY'
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. '0123456'
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. '9876543'
+	  if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + p - q + 2 * r
+	  l = l .or. u(p, q, r) .ne. 30 - p + q - 2 * r
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. '_+|/Oo_'
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. '///|||!'
+100 continue
+    do 101, p = 3, 5
+      do 101, q = 2, 6
+	do 101, r = 1, 7
+	  l = l .or. i(p - 2, q - 1, r) .ne. 7.5 * p * q * r
+	  l = l .or. j(p, q + 3, r + 6) .ne. 9.5 * p * q * r
+101 continue
+    do 102, p = 1, 5
+      do 102, q = 4, 6
+	l = l .or. k(p, 1, q - 3) .ne. 19 + p + 7 + 3 * q
+102 continue
+    x = omp_get_thread_num ()
+    w = ''
+    if (x .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0'
+    if (x .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1'
+    if (x .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2'
+    if (x .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3'
+    if (x .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4'
+    if (x .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
+    c = w(8:19)
+    d = w(1:7)
+    forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 * x + p + q + 2 * r
+    forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 * x + p + q + 2 * r
+    forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = w(8:19)
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = w(27:38)
+    forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = w(1:7)
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = w(20:26)
+    forall (p = 3:5, q = 2:6, r = 1:7) i(p - 2, q - 1, r) = (7.5 + x) * p * q * r
+    forall (p = 3:5, q = 2:6, r = 1:7) j(p, q + 3, r + 6) = (9.5 + x) * p * q * r
+    forall (p = 1:5, q = 7:7, r = 4:6) k(p, q - 6, r - 3) = 19 + x + p + q + 3 * r
+    s = w(20:26)
+    forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + x + p - q + 2 * r
+    forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - x - p + q - 2 * r
+    forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = w(1:7)
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = w(20:26)
+!$omp barrier
+    y = ''
+    if (x .eq. 0) y = '0'
+    if (x .eq. 1) y = '1'
+    if (x .eq. 2) y = '2'
+    if (x .eq. 3) y = '3'
+    if (x .eq. 4) y = '4'
+    if (x .eq. 5) y = '5'
+    l = l .or. w(7:7) .ne. y
+    l = l .or. w(19:19) .ne. y
+    l = l .or. w(26:26) .ne. y
+    l = l .or. w(38:38) .ne. y
+    l = l .or. c .ne. w(8:19)
+    l = l .or. d .ne. w(1:7)
+    l = l .or. s .ne. w(20:26)
+    do 103, p = 1, 2
+      do 103, q = 3, 7
+	do 103, r = 1, 7
+	  if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r
+	  l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19)
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38)
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7)
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26)
+	  if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r
+	  l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7)
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26)
+103 continue
+    do 104, p = 3, 5
+      do 104, q = 2, 6
+	do 104, r = 1, 7
+	  l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r
+	  l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r
+104 continue
+    do 105, p = 1, 5
+      do 105, q = 4, 6
+	l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
+105 continue
+    call check (size (e, 1), 2, l)
+    call check (size (e, 2), 3, l)
+    call check (size (e, 3), 7, l)
+    call check (size (e), 42, l)
+    call check (size (f, 1), 2, l)
+    call check (size (f, 2), 5, l)
+    call check (size (f, 3), 7, l)
+    call check (size (f), 70, l)
+    call check (size (g, 1), 5, l)
+    call check (size (g, 2), 5, l)
+    call check (size (g), 25, l)
+    call check (size (h, 1), 5, l)
+    call check (size (h, 2), 5, l)
+    call check (size (h), 25, l)
+    call check (size (i, 1), 3, l)
+    call check (size (i, 2), 5, l)
+    call check (size (i, 3), 7, l)
+    call check (size (i), 105, l)
+    call check (size (j, 1), 4, l)
+    call check (size (j, 2), 5, l)
+    call check (size (j, 3), 7, l)
+    call check (size (j), 140, l)
+    call check (size (k, 1), 5, l)
+    call check (size (k, 2), 1, l)
+    call check (size (k, 3), 3, l)
+    call check (size (k), 15, l)
+!$omp end parallel
+    if (l) call abort
+  end subroutine foo
+
+  subroutine test
+    character (len = 12) :: c
+    character (len = 7) :: d
+    integer, dimension (2, 3:5, 7) :: e
+    integer, dimension (2, 3:7, 7) :: f
+    character (len = 12), dimension (5, 3:7) :: g
+    character (len = 7), dimension (5, 3:7) :: h
+    real, dimension (3:5, 2:6, 1:7) :: i
+    double precision, dimension (3:6, 2:6, 1:7) :: j
+    integer, dimension (1:5, 7:7, 4:6) :: k
+    integer :: p, q, r
+    c = 'abcdefghijkl'
+    d = 'ABCDEFG'
+    forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 + p + q + 2 * r
+    forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 + p + q + 2 * r
+    forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = '0123456789AB'
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = '9876543210ZY'
+    forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = '0123456'
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = '9876543'
+    forall (p = 3:5, q = 2:6, r = 1:7) i(p, q, r) = 7.5 * p * q * r
+    forall (p = 3:6, q = 2:6, r = 1:7) j(p, q, r) = 9.5 * p * q * r
+    forall (p = 1:5, q = 7:7, r = 4:6) k(p, q, r) = 19 + p + q + 3 * r
+    call foo (c, d, e, f, g, h, i, j, k, 7)
+  end subroutine test
+end
diff --git a/libgomp/testsuite/libgomp.fortran/vla2.f90 b/libgomp/testsuite/libgomp.fortran/vla2.f90
new file mode 100644
index 00000000000..a9510fd385a
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/vla2.f90
@@ -0,0 +1,142 @@
+! { dg-do run }
+
+  call test
+contains
+  subroutine check (x, y, l)
+    integer :: x, y
+    logical :: l
+    l = l .or. x .ne. y
+  end subroutine check
+
+  subroutine foo (c, d, e, f, g, h, i, j, k, n)
+    use omp_lib
+    integer :: n
+    character (len = *) :: c
+    character (len = n) :: d
+    integer, dimension (2, 3:5, n) :: e
+    integer, dimension (2, 3:n, n) :: f
+    character (len = *), dimension (5, 3:n) :: g
+    character (len = n), dimension (5, 3:n) :: h
+    real, dimension (:, :, :) :: i
+    double precision, dimension (3:, 5:, 7:) :: j
+    integer, dimension (:, :, :) :: k
+    logical :: l
+    integer :: p, q, r
+    character (len = n) :: s
+    integer, dimension (2, 3:5, n) :: t
+    integer, dimension (2, 3:n, n) :: u
+    character (len = n), dimension (5, 3:n) :: v
+    character (len = 2 * n + 24) :: w
+    integer :: x
+    character (len = 1) :: y
+    l = .false.
+!$omp parallel default (none) private (c, d, e, f, g, h, i, j, k) &
+!$omp & private (s, t, u, v) reduction (.or.:l) num_threads (6) &
+!$omp private (p, q, r, w, x, y)
+    x = omp_get_thread_num ()
+    w = ''
+    if (x .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0'
+    if (x .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1'
+    if (x .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2'
+    if (x .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3'
+    if (x .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4'
+    if (x .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
+    c = w(8:19)
+    d = w(1:7)
+    forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 * x + p + q + 2 * r
+    forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 * x + p + q + 2 * r
+    forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = w(8:19)
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = w(27:38)
+    forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = w(1:7)
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = w(20:26)
+    forall (p = 3:5, q = 2:6, r = 1:7) i(p - 2, q - 1, r) = (7.5 + x) * p * q * r
+    forall (p = 3:5, q = 2:6, r = 1:7) j(p, q + 3, r + 6) = (9.5 + x) * p * q * r
+    forall (p = 1:5, q = 7:7, r = 4:6) k(p, q - 6, r - 3) = 19 + x + p + q + 3 * r
+    s = w(20:26)
+    forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + x + p - q + 2 * r
+    forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - x - p + q - 2 * r
+    forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = w(1:7)
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = w(20:26)
+!$omp barrier
+    y = ''
+    if (x .eq. 0) y = '0'
+    if (x .eq. 1) y = '1'
+    if (x .eq. 2) y = '2'
+    if (x .eq. 3) y = '3'
+    if (x .eq. 4) y = '4'
+    if (x .eq. 5) y = '5'
+    l = l .or. w(7:7) .ne. y
+    l = l .or. w(19:19) .ne. y
+    l = l .or. w(26:26) .ne. y
+    l = l .or. w(38:38) .ne. y
+    l = l .or. c .ne. w(8:19)
+    l = l .or. d .ne. w(1:7)
+    l = l .or. s .ne. w(20:26)
+    do 103, p = 1, 2
+      do 103, q = 3, 7
+	do 103, r = 1, 7
+	  if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r
+	  l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19)
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38)
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7)
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26)
+	  if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r
+	  l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7)
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26)
+103 continue
+    do 104, p = 3, 5
+      do 104, q = 2, 6
+	do 104, r = 1, 7
+	  l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r
+	  l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r
+104 continue
+    do 105, p = 1, 5
+      do 105, q = 4, 6
+	l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
+105 continue
+    call check (size (e, 1), 2, l)
+    call check (size (e, 2), 3, l)
+    call check (size (e, 3), 7, l)
+    call check (size (e), 42, l)
+    call check (size (f, 1), 2, l)
+    call check (size (f, 2), 5, l)
+    call check (size (f, 3), 7, l)
+    call check (size (f), 70, l)
+    call check (size (g, 1), 5, l)
+    call check (size (g, 2), 5, l)
+    call check (size (g), 25, l)
+    call check (size (h, 1), 5, l)
+    call check (size (h, 2), 5, l)
+    call check (size (h), 25, l)
+    call check (size (i, 1), 3, l)
+    call check (size (i, 2), 5, l)
+    call check (size (i, 3), 7, l)
+    call check (size (i), 105, l)
+    call check (size (j, 1), 4, l)
+    call check (size (j, 2), 5, l)
+    call check (size (j, 3), 7, l)
+    call check (size (j), 140, l)
+    call check (size (k, 1), 5, l)
+    call check (size (k, 2), 1, l)
+    call check (size (k, 3), 3, l)
+    call check (size (k), 15, l)
+!$omp end parallel
+    if (l) call abort
+  end subroutine foo
+
+  subroutine test
+    character (len = 12) :: c
+    character (len = 7) :: d
+    integer, dimension (2, 3:5, 7) :: e
+    integer, dimension (2, 3:7, 7) :: f
+    character (len = 12), dimension (5, 3:7) :: g
+    character (len = 7), dimension (5, 3:7) :: h
+    real, dimension (3:5, 2:6, 1:7) :: i
+    double precision, dimension (3:6, 2:6, 1:7) :: j
+    integer, dimension (1:5, 7:7, 4:6) :: k
+    integer :: p, q, r
+    call foo (c, d, e, f, g, h, i, j, k, 7)
+  end subroutine test
+end
diff --git a/libgomp/testsuite/libgomp.fortran/vla3.f90 b/libgomp/testsuite/libgomp.fortran/vla3.f90
new file mode 100644
index 00000000000..bfafc4f7d05
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/vla3.f90
@@ -0,0 +1,191 @@
+! { dg-do run }
+
+  call test
+contains
+  subroutine check (x, y, l)
+    integer :: x, y
+    logical :: l
+    l = l .or. x .ne. y
+  end subroutine check
+
+  subroutine foo (c, d, e, f, g, h, i, j, k, n)
+    use omp_lib
+    integer :: n
+    character (len = *) :: c
+    character (len = n) :: d
+    integer, dimension (2, 3:5, n) :: e
+    integer, dimension (2, 3:n, n) :: f
+    character (len = *), dimension (5, 3:n) :: g
+    character (len = n), dimension (5, 3:n) :: h
+    real, dimension (:, :, :) :: i
+    double precision, dimension (3:, 5:, 7:) :: j
+    integer, dimension (:, :, :) :: k
+    logical :: l
+    integer :: p, q, r
+    character (len = n) :: s
+    integer, dimension (2, 3:5, n) :: t
+    integer, dimension (2, 3:n, n) :: u
+    character (len = n), dimension (5, 3:n) :: v
+    character (len = 2 * n + 24) :: w
+    integer :: x, z
+    character (len = 1) :: y
+    s = 'PQRSTUV'
+    forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + p - q + 2 * r
+    forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - p + q - 2 * r
+    forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = '_+|/Oo_'
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = '///|||!'
+    l = .false.
+!$omp parallel default (none) shared (c, d, e, f, g, h, i, j, k) &
+!$omp & shared (s, t, u, v) reduction (.or.:l) num_threads (6) &
+!$omp private (p, q, r, w, x, y)
+    l = l .or. c .ne. 'abcdefghijkl'
+    l = l .or. d .ne. 'ABCDEFG'
+    l = l .or. s .ne. 'PQRSTUV'
+    do 100, p = 1, 2
+      do 100, q = 3, 7
+	do 100, r = 1, 7
+	  if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 + p + q + 2 * r
+	  l = l .or. f(p, q, r) .ne. 25 + p + q + 2 * r
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. '0123456789AB'
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. '9876543210ZY'
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. '0123456'
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. '9876543'
+	  if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + p - q + 2 * r
+	  l = l .or. u(p, q, r) .ne. 30 - p + q - 2 * r
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. '_+|/Oo_'
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. '///|||!'
+100 continue
+    do 101, p = 3, 5
+      do 101, q = 2, 6
+	do 101, r = 1, 7
+	  l = l .or. i(p - 2, q - 1, r) .ne. 7.5 * p * q * r
+	  l = l .or. j(p, q + 3, r + 6) .ne. 9.5 * p * q * r
+101 continue
+    do 102, p = 1, 5
+      do 102, q = 4, 6
+	l = l .or. k(p, 1, q - 3) .ne. 19 + p + 7 + 3 * q
+102 continue
+    do 110 z = 0, omp_get_num_threads () - 1
+!$omp barrier
+      x = omp_get_thread_num ()
+      w = ''
+      if (z .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0'
+      if (z .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1'
+      if (z .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2'
+      if (z .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3'
+      if (z .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4'
+      if (z .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
+      if (x .eq. z) then
+	c = w(8:19)
+	d = w(1:7)
+	forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 * x + p + q + 2 * r
+	forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 * x + p + q + 2 * r
+	forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = w(8:19)
+	forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = w(27:38)
+	forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = w(1:7)
+	forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = w(20:26)
+	forall (p = 3:5, q = 2:6, r = 1:7) i(p - 2, q - 1, r) = (7.5 + x) * p * q * r
+	forall (p = 3:5, q = 2:6, r = 1:7) j(p, q + 3, r + 6) = (9.5 + x) * p * q * r
+	forall (p = 1:5, q = 7:7, r = 4:6) k(p, q - 6, r - 3) = 19 + x + p + q + 3 * r
+	s = w(20:26)
+	forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + x + p - q + 2 * r
+	forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - x - p + q - 2 * r
+	forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = w(1:7)
+	forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = w(20:26)
+      end if
+!$omp barrier
+      x = z
+      y = ''
+      if (x .eq. 0) y = '0'
+      if (x .eq. 1) y = '1'
+      if (x .eq. 2) y = '2'
+      if (x .eq. 3) y = '3'
+      if (x .eq. 4) y = '4'
+      if (x .eq. 5) y = '5'
+      l = l .or. w(7:7) .ne. y
+      l = l .or. w(19:19) .ne. y
+      l = l .or. w(26:26) .ne. y
+      l = l .or. w(38:38) .ne. y
+      l = l .or. c .ne. w(8:19)
+      l = l .or. d .ne. w(1:7)
+      l = l .or. s .ne. w(20:26)
+      do 103, p = 1, 2
+	do 103, q = 3, 7
+	  do 103, r = 1, 7
+	    if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r
+	    l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r
+	    if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19)
+	    if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38)
+	    if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7)
+	    if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26)
+	    if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r
+	    l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r
+	    if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7)
+	    if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26)
+103   continue
+      do 104, p = 3, 5
+	do 104, q = 2, 6
+	  do 104, r = 1, 7
+	    l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r
+	    l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r
+104   continue
+      do 105, p = 1, 5
+	do 105, q = 4, 6
+	  l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
+105   continue
+110 continue
+    call check (size (e, 1), 2, l)
+    call check (size (e, 2), 3, l)
+    call check (size (e, 3), 7, l)
+    call check (size (e), 42, l)
+    call check (size (f, 1), 2, l)
+    call check (size (f, 2), 5, l)
+    call check (size (f, 3), 7, l)
+    call check (size (f), 70, l)
+    call check (size (g, 1), 5, l)
+    call check (size (g, 2), 5, l)
+    call check (size (g), 25, l)
+    call check (size (h, 1), 5, l)
+    call check (size (h, 2), 5, l)
+    call check (size (h), 25, l)
+    call check (size (i, 1), 3, l)
+    call check (size (i, 2), 5, l)
+    call check (size (i, 3), 7, l)
+    call check (size (i), 105, l)
+    call check (size (j, 1), 4, l)
+    call check (size (j, 2), 5, l)
+    call check (size (j, 3), 7, l)
+    call check (size (j), 140, l)
+    call check (size (k, 1), 5, l)
+    call check (size (k, 2), 1, l)
+    call check (size (k, 3), 3, l)
+    call check (size (k), 15, l)
+!$omp end parallel
+    if (l) call abort
+  end subroutine foo
+
+  subroutine test
+    character (len = 12) :: c
+    character (len = 7) :: d
+    integer, dimension (2, 3:5, 7) :: e
+    integer, dimension (2, 3:7, 7) :: f
+    character (len = 12), dimension (5, 3:7) :: g
+    character (len = 7), dimension (5, 3:7) :: h
+    real, dimension (3:5, 2:6, 1:7) :: i
+    double precision, dimension (3:6, 2:6, 1:7) :: j
+    integer, dimension (1:5, 7:7, 4:6) :: k
+    integer :: p, q, r
+    c = 'abcdefghijkl'
+    d = 'ABCDEFG'
+    forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 + p + q + 2 * r
+    forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 + p + q + 2 * r
+    forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = '0123456789AB'
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = '9876543210ZY'
+    forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = '0123456'
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = '9876543'
+    forall (p = 3:5, q = 2:6, r = 1:7) i(p, q, r) = 7.5 * p * q * r
+    forall (p = 3:6, q = 2:6, r = 1:7) j(p, q, r) = 9.5 * p * q * r
+    forall (p = 1:5, q = 7:7, r = 4:6) k(p, q, r) = 19 + p + q + 3 * r
+    call foo (c, d, e, f, g, h, i, j, k, 7)
+  end subroutine test
+end
diff --git a/libgomp/testsuite/libgomp.fortran/vla4.f90 b/libgomp/testsuite/libgomp.fortran/vla4.f90
new file mode 100644
index 00000000000..58caabc6248
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/vla4.f90
@@ -0,0 +1,228 @@
+! { dg-do run }
+
+  call test
+contains
+  subroutine check (x, y, l)
+    integer :: x, y
+    logical :: l
+    l = l .or. x .ne. y
+  end subroutine check
+
+  subroutine foo (c, d, e, f, g, h, i, j, k, n)
+    use omp_lib
+    integer :: n
+    character (len = *) :: c
+    character (len = n) :: d
+    integer, dimension (2, 3:5, n) :: e
+    integer, dimension (2, 3:n, n) :: f
+    character (len = *), dimension (5, 3:n) :: g
+    character (len = n), dimension (5, 3:n) :: h
+    real, dimension (:, :, :) :: i
+    double precision, dimension (3:, 5:, 7:) :: j
+    integer, dimension (:, :, :) :: k
+    logical :: l
+    integer :: p, q, r
+    character (len = n) :: s
+    integer, dimension (2, 3:5, n) :: t
+    integer, dimension (2, 3:n, n) :: u
+    character (len = n), dimension (5, 3:n) :: v
+    character (len = 2 * n + 24) :: w
+    integer :: x, z, z2
+    character (len = 1) :: y
+    s = 'PQRSTUV'
+    forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + p - q + 2 * r
+    forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - p + q - 2 * r
+    forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = '_+|/Oo_'
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = '///|||!'
+    l = .false.
+    call omp_set_dynamic (.false.)
+    call omp_set_num_threads (6)
+!$omp parallel do default (none) firstprivate (c, d, e, f, g, h, i, j, k) &
+!$omp & firstprivate (s, t, u, v) reduction (.or.:l) num_threads (6) &
+!$omp private (p, q, r, w, x, y) schedule (static) shared (z2) &
+!$omp lastprivate (c, d, e, f, g, h, i, j, k, s, t, u, v)
+    do 110 z = 0, omp_get_num_threads () - 1
+    if (omp_get_thread_num () .eq. 0) z2 = omp_get_num_threads ()
+    l = l .or. c .ne. 'abcdefghijkl'
+    l = l .or. d .ne. 'ABCDEFG'
+    l = l .or. s .ne. 'PQRSTUV'
+    do 100, p = 1, 2
+      do 100, q = 3, 7
+	do 100, r = 1, 7
+	  if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 + p + q + 2 * r
+	  l = l .or. f(p, q, r) .ne. 25 + p + q + 2 * r
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. '0123456789AB'
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. '9876543210ZY'
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. '0123456'
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. '9876543'
+	  if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + p - q + 2 * r
+	  l = l .or. u(p, q, r) .ne. 30 - p + q - 2 * r
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. '_+|/Oo_'
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. '///|||!'
+100 continue
+    do 101, p = 3, 5
+      do 101, q = 2, 6
+	do 101, r = 1, 7
+	  l = l .or. i(p - 2, q - 1, r) .ne. 7.5 * p * q * r
+	  l = l .or. j(p, q + 3, r + 6) .ne. 9.5 * p * q * r
+101 continue
+    do 102, p = 1, 5
+      do 102, q = 4, 6
+	l = l .or. k(p, 1, q - 3) .ne. 19 + p + 7 + 3 * q
+102 continue
+    x = omp_get_thread_num ()
+    w = ''
+    if (x .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0'
+    if (x .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1'
+    if (x .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2'
+    if (x .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3'
+    if (x .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4'
+    if (x .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
+    c = w(8:19)
+    d = w(1:7)
+    forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 * x + p + q + 2 * r
+    forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 * x + p + q + 2 * r
+    forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = w(8:19)
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = w(27:38)
+    forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = w(1:7)
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = w(20:26)
+    forall (p = 3:5, q = 2:6, r = 1:7) i(p - 2, q - 1, r) = (7.5 + x) * p * q * r
+    forall (p = 3:5, q = 2:6, r = 1:7) j(p, q + 3, r + 6) = (9.5 + x) * p * q * r
+    forall (p = 1:5, q = 7:7, r = 4:6) k(p, q - 6, r - 3) = 19 + x + p + q + 3 * r
+    s = w(20:26)
+    forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + x + p - q + 2 * r
+    forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - x - p + q - 2 * r
+    forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = w(1:7)
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = w(20:26)
+!$omp barrier
+    y = ''
+    if (x .eq. 0) y = '0'
+    if (x .eq. 1) y = '1'
+    if (x .eq. 2) y = '2'
+    if (x .eq. 3) y = '3'
+    if (x .eq. 4) y = '4'
+    if (x .eq. 5) y = '5'
+    l = l .or. w(7:7) .ne. y
+    l = l .or. w(19:19) .ne. y
+    l = l .or. w(26:26) .ne. y
+    l = l .or. w(38:38) .ne. y
+    l = l .or. c .ne. w(8:19)
+    l = l .or. d .ne. w(1:7)
+    l = l .or. s .ne. w(20:26)
+    do 103, p = 1, 2
+      do 103, q = 3, 7
+	do 103, r = 1, 7
+	  if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r
+	  l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19)
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38)
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7)
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26)
+	  if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r
+	  l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7)
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26)
+103 continue
+    do 104, p = 3, 5
+      do 104, q = 2, 6
+	do 104, r = 1, 7
+	  l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r
+	  l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r
+104 continue
+    do 105, p = 1, 5
+      do 105, q = 4, 6
+	l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
+105 continue
+    call check (size (e, 1), 2, l)
+    call check (size (e, 2), 3, l)
+    call check (size (e, 3), 7, l)
+    call check (size (e), 42, l)
+    call check (size (f, 1), 2, l)
+    call check (size (f, 2), 5, l)
+    call check (size (f, 3), 7, l)
+    call check (size (f), 70, l)
+    call check (size (g, 1), 5, l)
+    call check (size (g, 2), 5, l)
+    call check (size (g), 25, l)
+    call check (size (h, 1), 5, l)
+    call check (size (h, 2), 5, l)
+    call check (size (h), 25, l)
+    call check (size (i, 1), 3, l)
+    call check (size (i, 2), 5, l)
+    call check (size (i, 3), 7, l)
+    call check (size (i), 105, l)
+    call check (size (j, 1), 4, l)
+    call check (size (j, 2), 5, l)
+    call check (size (j, 3), 7, l)
+    call check (size (j), 140, l)
+    call check (size (k, 1), 5, l)
+    call check (size (k, 2), 1, l)
+    call check (size (k, 3), 3, l)
+    call check (size (k), 15, l)
+110 continue
+!$omp end parallel do
+    if (l) call abort
+    if (z2 == 6) then
+      x = 5
+      w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
+      y = '5'
+      l = l .or. w(7:7) .ne. y
+      l = l .or. w(19:19) .ne. y
+      l = l .or. w(26:26) .ne. y
+      l = l .or. w(38:38) .ne. y
+      l = l .or. c .ne. w(8:19)
+      l = l .or. d .ne. w(1:7)
+      l = l .or. s .ne. w(20:26)
+      do 113, p = 1, 2
+	do 113, q = 3, 7
+	  do 113, r = 1, 7
+	    if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r
+	    l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r
+	    if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19)
+	    if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38)
+	    if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7)
+	    if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26)
+	    if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r
+	    l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r
+	    if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7)
+	    if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26)
+113   continue
+      do 114, p = 3, 5
+	do 114, q = 2, 6
+	  do 114, r = 1, 7
+	    l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r
+	    l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r
+114   continue
+      do 115, p = 1, 5
+	do 115, q = 4, 6
+	  l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
+115   continue
+      if (l) call abort
+    end if
+  end subroutine foo
+
+  subroutine test
+    character (len = 12) :: c
+    character (len = 7) :: d
+    integer, dimension (2, 3:5, 7) :: e
+    integer, dimension (2, 3:7, 7) :: f
+    character (len = 12), dimension (5, 3:7) :: g
+    character (len = 7), dimension (5, 3:7) :: h
+    real, dimension (3:5, 2:6, 1:7) :: i
+    double precision, dimension (3:6, 2:6, 1:7) :: j
+    integer, dimension (1:5, 7:7, 4:6) :: k
+    integer :: p, q, r
+    c = 'abcdefghijkl'
+    d = 'ABCDEFG'
+    forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 + p + q + 2 * r
+    forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 + p + q + 2 * r
+    forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = '0123456789AB'
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = '9876543210ZY'
+    forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = '0123456'
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = '9876543'
+    forall (p = 3:5, q = 2:6, r = 1:7) i(p, q, r) = 7.5 * p * q * r
+    forall (p = 3:6, q = 2:6, r = 1:7) j(p, q, r) = 9.5 * p * q * r
+    forall (p = 1:5, q = 7:7, r = 4:6) k(p, q, r) = 19 + p + q + 3 * r
+    call foo (c, d, e, f, g, h, i, j, k, 7)
+  end subroutine test
+end
diff --git a/libgomp/testsuite/libgomp.fortran/vla5.f90 b/libgomp/testsuite/libgomp.fortran/vla5.f90
new file mode 100644
index 00000000000..5c889f9923a
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/vla5.f90
@@ -0,0 +1,200 @@
+! { dg-do run }
+
+  call test
+contains
+  subroutine check (x, y, l)
+    integer :: x, y
+    logical :: l
+    l = l .or. x .ne. y
+  end subroutine check
+
+  subroutine foo (c, d, e, f, g, h, i, j, k, n)
+    use omp_lib
+    integer :: n
+    character (len = *) :: c
+    character (len = n) :: d
+    integer, dimension (2, 3:5, n) :: e
+    integer, dimension (2, 3:n, n) :: f
+    character (len = *), dimension (5, 3:n) :: g
+    character (len = n), dimension (5, 3:n) :: h
+    real, dimension (:, :, :) :: i
+    double precision, dimension (3:, 5:, 7:) :: j
+    integer, dimension (:, :, :) :: k
+    logical :: l
+    integer :: p, q, r
+    character (len = n) :: s
+    integer, dimension (2, 3:5, n) :: t
+    integer, dimension (2, 3:n, n) :: u
+    character (len = n), dimension (5, 3:n) :: v
+    character (len = 2 * n + 24) :: w
+    integer :: x, z, z2
+    character (len = 1) :: y
+    s = 'PQRSTUV'
+    forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + p - q + 2 * r
+    forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - p + q - 2 * r
+    forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = '_+|/Oo_'
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = '///|||!'
+    l = .false.
+    call omp_set_dynamic (.false.)
+    call omp_set_num_threads (6)
+!$omp parallel do default (none) lastprivate (c, d, e, f, g, h, i, j, k) &
+!$omp & lastprivate (s, t, u, v) reduction (.or.:l) num_threads (6) &
+!$omp private (p, q, r, w, x, y) schedule (static) shared (z2)
+    do 110 z = 0, omp_get_num_threads () - 1
+    if (omp_get_thread_num () .eq. 0) z2 = omp_get_num_threads ()
+    x = omp_get_thread_num ()
+    w = ''
+    if (x .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0'
+    if (x .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1'
+    if (x .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2'
+    if (x .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3'
+    if (x .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4'
+    if (x .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
+    c = w(8:19)
+    d = w(1:7)
+    forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 * x + p + q + 2 * r
+    forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 * x + p + q + 2 * r
+    forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = w(8:19)
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = w(27:38)
+    forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = w(1:7)
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = w(20:26)
+    forall (p = 3:5, q = 2:6, r = 1:7) i(p - 2, q - 1, r) = (7.5 + x) * p * q * r
+    forall (p = 3:5, q = 2:6, r = 1:7) j(p, q + 3, r + 6) = (9.5 + x) * p * q * r
+    forall (p = 1:5, q = 7:7, r = 4:6) k(p, q - 6, r - 3) = 19 + x + p + q + 3 * r
+    s = w(20:26)
+    forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + x + p - q + 2 * r
+    forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - x - p + q - 2 * r
+    forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = w(1:7)
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = w(20:26)
+!$omp barrier
+    y = ''
+    if (x .eq. 0) y = '0'
+    if (x .eq. 1) y = '1'
+    if (x .eq. 2) y = '2'
+    if (x .eq. 3) y = '3'
+    if (x .eq. 4) y = '4'
+    if (x .eq. 5) y = '5'
+    l = l .or. w(7:7) .ne. y
+    l = l .or. w(19:19) .ne. y
+    l = l .or. w(26:26) .ne. y
+    l = l .or. w(38:38) .ne. y
+    l = l .or. c .ne. w(8:19)
+    l = l .or. d .ne. w(1:7)
+    l = l .or. s .ne. w(20:26)
+    do 103, p = 1, 2
+      do 103, q = 3, 7
+	do 103, r = 1, 7
+	  if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r
+	  l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19)
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38)
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7)
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26)
+	  if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r
+	  l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7)
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26)
+103 continue
+    do 104, p = 3, 5
+      do 104, q = 2, 6
+	do 104, r = 1, 7
+	  l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r
+	  l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r
+104 continue
+    do 105, p = 1, 5
+      do 105, q = 4, 6
+	l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
+105 continue
+    call check (size (e, 1), 2, l)
+    call check (size (e, 2), 3, l)
+    call check (size (e, 3), 7, l)
+    call check (size (e), 42, l)
+    call check (size (f, 1), 2, l)
+    call check (size (f, 2), 5, l)
+    call check (size (f, 3), 7, l)
+    call check (size (f), 70, l)
+    call check (size (g, 1), 5, l)
+    call check (size (g, 2), 5, l)
+    call check (size (g), 25, l)
+    call check (size (h, 1), 5, l)
+    call check (size (h, 2), 5, l)
+    call check (size (h), 25, l)
+    call check (size (i, 1), 3, l)
+    call check (size (i, 2), 5, l)
+    call check (size (i, 3), 7, l)
+    call check (size (i), 105, l)
+    call check (size (j, 1), 4, l)
+    call check (size (j, 2), 5, l)
+    call check (size (j, 3), 7, l)
+    call check (size (j), 140, l)
+    call check (size (k, 1), 5, l)
+    call check (size (k, 2), 1, l)
+    call check (size (k, 3), 3, l)
+    call check (size (k), 15, l)
+110 continue
+!$omp end parallel do
+    if (l) call abort
+    if (z2 == 6) then
+      x = 5
+      w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
+      y = '5'
+      l = l .or. w(7:7) .ne. y
+      l = l .or. w(19:19) .ne. y
+      l = l .or. w(26:26) .ne. y
+      l = l .or. w(38:38) .ne. y
+      l = l .or. c .ne. w(8:19)
+      l = l .or. d .ne. w(1:7)
+      l = l .or. s .ne. w(20:26)
+      do 113, p = 1, 2
+	do 113, q = 3, 7
+	  do 113, r = 1, 7
+	    if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r
+	    l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r
+	    if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19)
+	    if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38)
+	    if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7)
+	    if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26)
+	    if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r
+	    l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r
+	    if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7)
+	    if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26)
+113   continue
+      do 114, p = 3, 5
+	do 114, q = 2, 6
+	  do 114, r = 1, 7
+	    l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r
+	    l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r
+114   continue
+      do 115, p = 1, 5
+	do 115, q = 4, 6
+	  l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
+115   continue
+      if (l) call abort
+    end if
+  end subroutine foo
+
+  subroutine test
+    character (len = 12) :: c
+    character (len = 7) :: d
+    integer, dimension (2, 3:5, 7) :: e
+    integer, dimension (2, 3:7, 7) :: f
+    character (len = 12), dimension (5, 3:7) :: g
+    character (len = 7), dimension (5, 3:7) :: h
+    real, dimension (3:5, 2:6, 1:7) :: i
+    double precision, dimension (3:6, 2:6, 1:7) :: j
+    integer, dimension (1:5, 7:7, 4:6) :: k
+    integer :: p, q, r
+    c = 'abcdefghijkl'
+    d = 'ABCDEFG'
+    forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 + p + q + 2 * r
+    forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 + p + q + 2 * r
+    forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = '0123456789AB'
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = '9876543210ZY'
+    forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = '0123456'
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = '9876543'
+    forall (p = 3:5, q = 2:6, r = 1:7) i(p, q, r) = 7.5 * p * q * r
+    forall (p = 3:6, q = 2:6, r = 1:7) j(p, q, r) = 9.5 * p * q * r
+    forall (p = 1:5, q = 7:7, r = 4:6) k(p, q, r) = 19 + p + q + 3 * r
+    call foo (c, d, e, f, g, h, i, j, k, 7)
+  end subroutine test
+end
diff --git a/libgomp/testsuite/libgomp.fortran/vla6.f90 b/libgomp/testsuite/libgomp.fortran/vla6.f90
new file mode 100644
index 00000000000..bb9c4916d40
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/vla6.f90
@@ -0,0 +1,191 @@
+! { dg-do run }
+
+  call test
+contains
+  subroutine check (x, y, l)
+    integer :: x, y
+    logical :: l
+    l = l .or. x .ne. y
+  end subroutine check
+
+  subroutine foo (c, d, e, f, g, h, i, j, k, n)
+    use omp_lib
+    integer :: n
+    character (len = *) :: c
+    character (len = n) :: d
+    integer, dimension (2, 3:5, n) :: e
+    integer, dimension (2, 3:n, n) :: f
+    character (len = *), dimension (5, 3:n) :: g
+    character (len = n), dimension (5, 3:n) :: h
+    real, dimension (:, :, :) :: i
+    double precision, dimension (3:, 5:, 7:) :: j
+    integer, dimension (:, :, :) :: k
+    logical :: l
+    integer :: p, q, r
+    character (len = n) :: s
+    integer, dimension (2, 3:5, n) :: t
+    integer, dimension (2, 3:n, n) :: u
+    character (len = n), dimension (5, 3:n) :: v
+    character (len = 2 * n + 24) :: w
+    integer :: x, z
+    character (len = 1) :: y
+    l = .false.
+!$omp parallel default (none) private (c, d, e, f, g, h, i, j, k) &
+!$omp & private (s, t, u, v) reduction (.or.:l) num_threads (6) &
+!$omp private (p, q, r, w, x, y) shared (z)
+    x = omp_get_thread_num ()
+    w = ''
+    if (x .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0'
+    if (x .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1'
+    if (x .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2'
+    if (x .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3'
+    if (x .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4'
+    if (x .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
+    c = w(8:19)
+    d = w(1:7)
+    forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 * x + p + q + 2 * r
+    forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 * x + p + q + 2 * r
+    forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = w(8:19)
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = w(27:38)
+    forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = w(1:7)
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = w(20:26)
+    forall (p = 3:5, q = 2:6, r = 1:7) i(p - 2, q - 1, r) = (7.5 + x) * p * q * r
+    forall (p = 3:5, q = 2:6, r = 1:7) j(p, q + 3, r + 6) = (9.5 + x) * p * q * r
+    forall (p = 1:5, q = 7:7, r = 4:6) k(p, q - 6, r - 3) = 19 + x + p + q + 3 * r
+    s = w(20:26)
+    forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + x + p - q + 2 * r
+    forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - x - p + q - 2 * r
+    forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = w(1:7)
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = w(20:26)
+!$omp barrier
+    y = ''
+    if (x .eq. 0) y = '0'
+    if (x .eq. 1) y = '1'
+    if (x .eq. 2) y = '2'
+    if (x .eq. 3) y = '3'
+    if (x .eq. 4) y = '4'
+    if (x .eq. 5) y = '5'
+    l = l .or. w(7:7) .ne. y
+    l = l .or. w(19:19) .ne. y
+    l = l .or. w(26:26) .ne. y
+    l = l .or. w(38:38) .ne. y
+    l = l .or. c .ne. w(8:19)
+    l = l .or. d .ne. w(1:7)
+    l = l .or. s .ne. w(20:26)
+    do 103, p = 1, 2
+      do 103, q = 3, 7
+	do 103, r = 1, 7
+	  if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r
+	  l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19)
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38)
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7)
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26)
+	  if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r
+	  l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7)
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26)
+103 continue
+    do 104, p = 3, 5
+      do 104, q = 2, 6
+	do 104, r = 1, 7
+	  l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r
+	  l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r
+104 continue
+    do 105, p = 1, 5
+      do 105, q = 4, 6
+	l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
+105 continue
+    call check (size (e, 1), 2, l)
+    call check (size (e, 2), 3, l)
+    call check (size (e, 3), 7, l)
+    call check (size (e), 42, l)
+    call check (size (f, 1), 2, l)
+    call check (size (f, 2), 5, l)
+    call check (size (f, 3), 7, l)
+    call check (size (f), 70, l)
+    call check (size (g, 1), 5, l)
+    call check (size (g, 2), 5, l)
+    call check (size (g), 25, l)
+    call check (size (h, 1), 5, l)
+    call check (size (h, 2), 5, l)
+    call check (size (h), 25, l)
+    call check (size (i, 1), 3, l)
+    call check (size (i, 2), 5, l)
+    call check (size (i, 3), 7, l)
+    call check (size (i), 105, l)
+    call check (size (j, 1), 4, l)
+    call check (size (j, 2), 5, l)
+    call check (size (j, 3), 7, l)
+    call check (size (j), 140, l)
+    call check (size (k, 1), 5, l)
+    call check (size (k, 2), 1, l)
+    call check (size (k, 3), 3, l)
+    call check (size (k), 15, l)
+!$omp single
+    z = omp_get_thread_num ()
+!$omp end single copyprivate (c, d, e, f, g, h, i, j, k, s, t, u, v)
+    w = ''
+    x = z
+    if (x .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0'
+    if (x .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1'
+    if (x .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2'
+    if (x .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3'
+    if (x .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4'
+    if (x .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
+    y = ''
+    if (x .eq. 0) y = '0'
+    if (x .eq. 1) y = '1'
+    if (x .eq. 2) y = '2'
+    if (x .eq. 3) y = '3'
+    if (x .eq. 4) y = '4'
+    if (x .eq. 5) y = '5'
+    l = l .or. w(7:7) .ne. y
+    l = l .or. w(19:19) .ne. y
+    l = l .or. w(26:26) .ne. y
+    l = l .or. w(38:38) .ne. y
+    l = l .or. c .ne. w(8:19)
+    l = l .or. d .ne. w(1:7)
+    l = l .or. s .ne. w(20:26)
+    do 113, p = 1, 2
+      do 113, q = 3, 7
+	do 113, r = 1, 7
+	  if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r
+	  l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19)
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38)
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7)
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26)
+	  if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r
+	  l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7)
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26)
+113 continue
+    do 114, p = 3, 5
+      do 114, q = 2, 6
+	do 114, r = 1, 7
+	  l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r
+	  l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r
+114 continue
+    do 115, p = 1, 5
+      do 115, q = 4, 6
+	l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
+115 continue
+!$omp end parallel
+    if (l) call abort
+  end subroutine foo
+
+  subroutine test
+    character (len = 12) :: c
+    character (len = 7) :: d
+    integer, dimension (2, 3:5, 7) :: e
+    integer, dimension (2, 3:7, 7) :: f
+    character (len = 12), dimension (5, 3:7) :: g
+    character (len = 7), dimension (5, 3:7) :: h
+    real, dimension (3:5, 2:6, 1:7) :: i
+    double precision, dimension (3:6, 2:6, 1:7) :: j
+    integer, dimension (1:5, 7:7, 4:6) :: k
+    integer :: p, q, r
+    call foo (c, d, e, f, g, h, i, j, k, 7)
+  end subroutine test
+end
diff --git a/libgomp/testsuite/libgomp.fortran/vla7.f90 b/libgomp/testsuite/libgomp.fortran/vla7.f90
new file mode 100644
index 00000000000..29a6696443a
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/vla7.f90
@@ -0,0 +1,143 @@
+! { dg-do run }
+! { dg-options "-w" }
+
+  character (6) :: c, f2
+  character (6) :: d(2)
+  c = f1 (6)
+  if (c .ne. 'opqrst') call abort
+  c = f2 (6)
+  if (c .ne. '_/!!/_') call abort
+  d = f3 (6)
+  if (d(1) .ne. 'opqrst' .or. d(2) .ne. 'a') call abort
+  d = f4 (6)
+  if (d(1) .ne. 'Opqrst' .or. d(2) .ne. 'A') call abort
+contains
+  function f1 (n)
+    use omp_lib
+    character (n) :: f1
+    logical :: l
+    f1 = 'abcdef'
+    l = .false.
+!$omp parallel firstprivate (f1) reduction (.or.:l) num_threads (2)
+    l = f1 .ne. 'abcdef'
+    if (omp_get_thread_num () .eq. 0) f1 = 'ijklmn'
+    if (omp_get_thread_num () .eq. 1) f1 = 'IJKLMN'
+!$omp barrier
+    l = l .or. (omp_get_thread_num () .eq. 0 .and. f1 .ne. 'ijklmn')
+    l = l .or. (omp_get_thread_num () .eq. 1 .and. f1 .ne. 'IJKLMN')
+!$omp end parallel
+    f1 = 'zZzz_z'
+!$omp parallel shared (f1) reduction (.or.:l) num_threads (2)
+    l = l .or. f1 .ne. 'zZzz_z'
+!$omp barrier
+!$omp master
+    f1 = 'abc'
+!$omp end master
+!$omp barrier
+    l = l .or. f1 .ne. 'abc'
+!$omp barrier
+    if (omp_get_thread_num () .eq. 1) f1 = 'def'
+!$omp barrier
+    l = l .or. f1 .ne. 'def'
+!$omp end parallel
+    if (l) call abort
+    f1 = 'opqrst'
+  end function f1
+  function f3 (n)
+    use omp_lib
+    character (n), dimension (2) :: f3
+    logical :: l
+    f3 = 'abcdef'
+    l = .false.
+!$omp parallel firstprivate (f3) reduction (.or.:l) num_threads (2)
+    l = any (f3 .ne. 'abcdef')
+    if (omp_get_thread_num () .eq. 0) f3 = 'ijklmn'
+    if (omp_get_thread_num () .eq. 1) f3 = 'IJKLMN'
+!$omp barrier
+    l = l .or. (omp_get_thread_num () .eq. 0 .and. any (f3 .ne. 'ijklmn'))
+    l = l .or. (omp_get_thread_num () .eq. 1 .and. any (f3 .ne. 'IJKLMN'))
+!$omp end parallel
+    f3 = 'zZzz_z'
+!$omp parallel shared (f3) reduction (.or.:l) num_threads (2)
+    l = l .or. any (f3 .ne. 'zZzz_z')
+!$omp barrier
+!$omp master
+    f3 = 'abc'
+!$omp end master
+!$omp barrier
+    l = l .or. any (f3 .ne. 'abc')
+!$omp barrier
+    if (omp_get_thread_num () .eq. 1) f3 = 'def'
+!$omp barrier
+    l = l .or. any (f3 .ne. 'def')
+!$omp end parallel
+    if (l) call abort
+    f3(1) = 'opqrst'
+    f3(2) = 'a'
+  end function f3
+  function f4 (n)
+    use omp_lib
+    character (n), dimension (n - 4) :: f4
+    logical :: l
+    f4 = 'abcdef'
+    l = .false.
+!$omp parallel firstprivate (f4) reduction (.or.:l) num_threads (2)
+    l = any (f4 .ne. 'abcdef')
+    if (omp_get_thread_num () .eq. 0) f4 = 'ijklmn'
+    if (omp_get_thread_num () .eq. 1) f4 = 'IJKLMN'
+!$omp barrier
+    l = l .or. (omp_get_thread_num () .eq. 0 .and. any (f4 .ne. 'ijklmn'))
+    l = l .or. (omp_get_thread_num () .eq. 1 .and. any (f4 .ne. 'IJKLMN'))
+    l = l .or. size (f4) .ne. 2
+!$omp end parallel
+    f4 = 'zZzz_z'
+!$omp parallel shared (f4) reduction (.or.:l) num_threads (2)
+    l = l .or. any (f4 .ne. 'zZzz_z')
+!$omp barrier
+!$omp master
+    f4 = 'abc'
+!$omp end master
+!$omp barrier
+    l = l .or. any (f4 .ne. 'abc')
+!$omp barrier
+    if (omp_get_thread_num () .eq. 1) f4 = 'def'
+!$omp barrier
+    l = l .or. any (f4 .ne. 'def')
+    l = l .or. size (f4) .ne. 2
+!$omp end parallel
+    if (l) call abort
+    f4(1) = 'Opqrst'
+    f4(2) = 'A'
+  end function f4
+end
+function f2 (n)
+  use omp_lib
+  character (*) :: f2
+  logical :: l
+  f2 = 'abcdef'
+  l = .false.
+!$omp parallel firstprivate (f2) reduction (.or.:l) num_threads (2)
+  l = f2 .ne. 'abcdef'
+  if (omp_get_thread_num () .eq. 0) f2 = 'ijklmn'
+  if (omp_get_thread_num () .eq. 1) f2 = 'IJKLMN'
+!$omp barrier
+  l = l .or. (omp_get_thread_num () .eq. 0 .and. f2 .ne. 'ijklmn')
+  l = l .or. (omp_get_thread_num () .eq. 1 .and. f2 .ne. 'IJKLMN')
+!$omp end parallel
+  f2 = 'zZzz_z'
+!$omp parallel shared (f2) reduction (.or.:l) num_threads (2)
+  l = l .or. f2 .ne. 'zZzz_z'
+!$omp barrier
+!$omp master
+  f2 = 'abc'
+!$omp end master
+!$omp barrier
+  l = l .or. f2 .ne. 'abc'
+!$omp barrier
+  if (omp_get_thread_num () .eq. 1) f2 = 'def'
+!$omp barrier
+  l = l .or. f2 .ne. 'def'
+!$omp end parallel
+  if (l) call abort
+  f2 = '_/!!/_'
+end function f2
diff --git a/libgomp/testsuite/libgomp.fortran/workshare1.f90 b/libgomp/testsuite/libgomp.fortran/workshare1.f90
new file mode 100644
index 00000000000..a0e6ff919e5
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/workshare1.f90
@@ -0,0 +1,30 @@
+function foo ()
+  integer :: foo
+  logical :: foo_seen
+  common /foo_seen/ foo_seen
+  foo_seen = .true.
+  foo = 3
+end
+function bar ()
+  integer :: bar
+  logical :: bar_seen
+  common /bar_seen/ bar_seen
+  bar_seen = .true.
+  bar = 3
+end
+  integer :: a (10), b (10), foo, bar
+  logical :: foo_seen, bar_seen
+  common /foo_seen/ foo_seen
+  common /bar_seen/ bar_seen
+
+  foo_seen = .false.
+  bar_seen = .false.
+!$omp parallel workshare if (foo () .gt. 2) num_threads (bar () + 1)
+  a = 10
+  b = 20
+  a(1:5) = max (a(1:5), b(1:5))
+!$omp end parallel workshare
+  if (any (a(1:5) .ne. 20)) call abort
+  if (any (a(6:10) .ne. 10)) call abort
+  if (.not. foo_seen .or. .not. bar_seen) call abort
+end
author	jakub <jakub@138bc75d-0d04-0410-961f-82ee72b054a4>	2006-02-14 16:38:03 +0000
committer	jakub <jakub@138bc75d-0d04-0410-961f-82ee72b054a4>	2006-02-14 16:38:03 +0000
commit	764f11758d254e1dee25b04620786ef89ad6ccce (patch)
tree	869f129d646d69ab3554ebb97c0c1c603b0f77c0 /libgomp
parent	2244ee93d466d8af82d22ec3c4b6d2df60033cb1 (diff)
download	gcc-764f11758d254e1dee25b04620786ef89ad6ccce.tar.gz