Mercurial > hg > CbC > CbC_gcc

comparison gcc/fortran/parse.c @ 145:1830386684a0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc-9.2.0
author anatofuz
date Thu, 13 Feb 2020 11:34:05 +0900
parents 84e7813d76e9
children
comparison
equal deleted inserted replaced
131:84e7813d76e9 145:1830386684a0
1 /* Main parser. 1 /* Main parser.
2 Copyright (C) 2000-2018 Free Software Foundation, Inc. 2 Copyright (C) 2000-2020 Free Software Foundation, Inc.
3 Contributed by Andy Vaught 3 Contributed by Andy Vaught
4 4
5 This file is part of GCC. 5 This file is part of GCC.
6 6
7 GCC is free software; you can redistribute it and/or modify it under 7 GCC is free software; you can redistribute it and/or modify it under
424 match (NULL, gfc_match_block, ST_BLOCK); 424 match (NULL, gfc_match_block, ST_BLOCK);
425 match (NULL, gfc_match_associate, ST_ASSOCIATE); 425 match (NULL, gfc_match_associate, ST_ASSOCIATE);
426 match (NULL, gfc_match_critical, ST_CRITICAL); 426 match (NULL, gfc_match_critical, ST_CRITICAL);
427 match (NULL, gfc_match_select, ST_SELECT_CASE); 427 match (NULL, gfc_match_select, ST_SELECT_CASE);
428 match (NULL, gfc_match_select_type, ST_SELECT_TYPE); 428 match (NULL, gfc_match_select_type, ST_SELECT_TYPE);
429 match (NULL, gfc_match_select_rank, ST_SELECT_RANK);
429 430
430 /* General statement matching: Instead of testing every possible 431 /* General statement matching: Instead of testing every possible
431 statement, we eliminate most possibilities by peeking at the 432 statement, we eliminate most possibilities by peeking at the
432 first character. */ 433 first character. */
433 434
544 return st; 545 return st;
545 match ("protected", gfc_match_protected, ST_ATTR_DECL); 546 match ("protected", gfc_match_protected, ST_ATTR_DECL);
546 break; 547 break;
547 548
548 case 'r': 549 case 'r':
550 match ("rank", gfc_match_rank_is, ST_RANK);
549 match ("read", gfc_match_read, ST_READ); 551 match ("read", gfc_match_read, ST_READ);
550 match ("return", gfc_match_return, ST_RETURN); 552 match ("return", gfc_match_return, ST_RETURN);
551 match ("rewind", gfc_match_rewind, ST_REWIND); 553 match ("rewind", gfc_match_rewind, ST_REWIND);
552 break; 554 break;
553 555
585 match ("write", gfc_match_write, ST_WRITE); 587 match ("write", gfc_match_write, ST_WRITE);
586 break; 588 break;
587 } 589 }
588 590
589 /* All else has failed, so give up. See if any of the matchers has 591 /* All else has failed, so give up. See if any of the matchers has
590 stored an error message of some sort. */ 592 stored an error message of some sort. Suppress the "Unclassifiable
591 593 statement" if a previous error message was emitted, e.g., by
594 gfc_error_now (). */
592 if (!gfc_error_check ()) 595 if (!gfc_error_check ())
593 gfc_error_now ("Unclassifiable statement at %C"); 596 {
597 int ecnt;
598 gfc_get_errors (NULL, &ecnt);
599 if (ecnt <= 0)
600 gfc_error_now ("Unclassifiable statement at %C");
601 }
594 602
595 reject_statement (); 603 reject_statement ();
596 604
597 gfc_error_recovery (); 605 gfc_error_recovery ();
598 606
599 return ST_NONE; 607 return ST_NONE;
600 } 608 }
601 609
602 /* Like match and if spec_only, goto do_spec_only without actually 610 /* Like match and if spec_only, goto do_spec_only without actually
603 matching. */ 611 matching. */
612 /* If the directive matched but the clauses failed, do not start
613 matching the next directive in the same switch statement. */
604 #define matcha(keyword, subr, st) \ 614 #define matcha(keyword, subr, st) \
605 do { \ 615 do { \
616 match m2; \
606 if (spec_only && gfc_match (keyword) == MATCH_YES) \ 617 if (spec_only && gfc_match (keyword) == MATCH_YES) \
607 goto do_spec_only; \ 618 goto do_spec_only; \
608 else if (match_word (keyword, subr, &old_locus) \ 619 else if ((m2 = match_word (keyword, subr, &old_locus)) \
609 == MATCH_YES) \ 620 == MATCH_YES) \
610 return st; \ 621 return st; \
622 else if (m2 == MATCH_ERROR) \
623 goto error_handling; \
611 else \ 624 else \
612 undo_new_statement (); \ 625 undo_new_statement (); \
613 } while (0) 626 } while (0)
614 627
615 static gfc_statement 628 static gfc_statement
659 case 'd': 672 case 'd':
660 matcha ("data", gfc_match_oacc_data, ST_OACC_DATA); 673 matcha ("data", gfc_match_oacc_data, ST_OACC_DATA);
661 match ("declare", gfc_match_oacc_declare, ST_OACC_DECLARE); 674 match ("declare", gfc_match_oacc_declare, ST_OACC_DECLARE);
662 break; 675 break;
663 case 'e': 676 case 'e':
664 matcha ("end atomic", gfc_match_omp_eos, ST_OACC_END_ATOMIC); 677 matcha ("end atomic", gfc_match_omp_eos_error, ST_OACC_END_ATOMIC);
665 matcha ("end data", gfc_match_omp_eos, ST_OACC_END_DATA); 678 matcha ("end data", gfc_match_omp_eos_error, ST_OACC_END_DATA);
666 matcha ("end host_data", gfc_match_omp_eos, ST_OACC_END_HOST_DATA); 679 matcha ("end host_data", gfc_match_omp_eos_error, ST_OACC_END_HOST_DATA);
667 matcha ("end kernels loop", gfc_match_omp_eos, ST_OACC_END_KERNELS_LOOP); 680 matcha ("end kernels loop", gfc_match_omp_eos_error, ST_OACC_END_KERNELS_LOOP);
668 matcha ("end kernels", gfc_match_omp_eos, ST_OACC_END_KERNELS); 681 matcha ("end kernels", gfc_match_omp_eos_error, ST_OACC_END_KERNELS);
669 matcha ("end loop", gfc_match_omp_eos, ST_OACC_END_LOOP); 682 matcha ("end loop", gfc_match_omp_eos_error, ST_OACC_END_LOOP);
670 matcha ("end parallel loop", gfc_match_omp_eos, 683 matcha ("end parallel loop", gfc_match_omp_eos_error,
671 ST_OACC_END_PARALLEL_LOOP); 684 ST_OACC_END_PARALLEL_LOOP);
672 matcha ("end parallel", gfc_match_omp_eos, ST_OACC_END_PARALLEL); 685 matcha ("end parallel", gfc_match_omp_eos_error, ST_OACC_END_PARALLEL);
686 matcha ("end serial loop", gfc_match_omp_eos_error,
687 ST_OACC_END_SERIAL_LOOP);
688 matcha ("end serial", gfc_match_omp_eos_error, ST_OACC_END_SERIAL);
673 matcha ("enter data", gfc_match_oacc_enter_data, ST_OACC_ENTER_DATA); 689 matcha ("enter data", gfc_match_oacc_enter_data, ST_OACC_ENTER_DATA);
674 matcha ("exit data", gfc_match_oacc_exit_data, ST_OACC_EXIT_DATA); 690 matcha ("exit data", gfc_match_oacc_exit_data, ST_OACC_EXIT_DATA);
675 break; 691 break;
676 case 'h': 692 case 'h':
677 matcha ("host_data", gfc_match_oacc_host_data, ST_OACC_HOST_DATA); 693 matcha ("host_data", gfc_match_oacc_host_data, ST_OACC_HOST_DATA);
690 matcha ("loop", gfc_match_oacc_loop, ST_OACC_LOOP); 706 matcha ("loop", gfc_match_oacc_loop, ST_OACC_LOOP);
691 break; 707 break;
692 case 'r': 708 case 'r':
693 match ("routine", gfc_match_oacc_routine, ST_OACC_ROUTINE); 709 match ("routine", gfc_match_oacc_routine, ST_OACC_ROUTINE);
694 break; 710 break;
711 case 's':
712 matcha ("serial loop", gfc_match_oacc_serial_loop, ST_OACC_SERIAL_LOOP);
713 matcha ("serial", gfc_match_oacc_serial, ST_OACC_SERIAL);
714 break;
695 case 'u': 715 case 'u':
696 matcha ("update", gfc_match_oacc_update, ST_OACC_UPDATE); 716 matcha ("update", gfc_match_oacc_update, ST_OACC_UPDATE);
697 break; 717 break;
698 case 'w': 718 case 'w':
699 matcha ("wait", gfc_match_oacc_wait, ST_OACC_WAIT); 719 matcha ("wait", gfc_match_oacc_wait, ST_OACC_WAIT);
701 } 721 }
702 722
703 /* Directive not found or stored an error message. 723 /* Directive not found or stored an error message.
704 Check and give up. */ 724 Check and give up. */
705 725
726 error_handling:
706 if (gfc_error_check () == 0) 727 if (gfc_error_check () == 0)
707 gfc_error_now ("Unclassifiable OpenACC directive at %C"); 728 gfc_error_now ("Unclassifiable OpenACC directive at %C");
708 729
709 reject_statement (); 730 reject_statement ();
710 731
722 743
723 /* Like match, but set a flag simd_matched if keyword matched 744 /* Like match, but set a flag simd_matched if keyword matched
724 and if spec_only, goto do_spec_only without actually matching. */ 745 and if spec_only, goto do_spec_only without actually matching. */
725 #define matchs(keyword, subr, st) \ 746 #define matchs(keyword, subr, st) \
726 do { \ 747 do { \
748 match m2; \
727 if (spec_only && gfc_match (keyword) == MATCH_YES) \ 749 if (spec_only && gfc_match (keyword) == MATCH_YES) \
728 goto do_spec_only; \ 750 goto do_spec_only; \
729 if (match_word_omp_simd (keyword, subr, &old_locus, \ 751 if ((m2 = match_word_omp_simd (keyword, subr, &old_locus, \
730 &simd_matched) == MATCH_YES) \ 752 &simd_matched)) == MATCH_YES) \
731 { \ 753 { \
732 ret = st; \ 754 ret = st; \
733 goto finish; \ 755 goto finish; \
734 } \ 756 } \
757 else if (m2 == MATCH_ERROR) \
758 goto error_handling; \
735 else \ 759 else \
736 undo_new_statement (); \ 760 undo_new_statement (); \
737 } while (0) 761 } while (0)
738 762
739 /* Like match, but don't match anything if not -fopenmp 763 /* Like match, but don't match anything if not -fopenmp
740 and if spec_only, goto do_spec_only without actually matching. */ 764 and if spec_only, goto do_spec_only without actually matching. */
765 /* If the directive matched but the clauses failed, do not start
766 matching the next directive in the same switch statement. */
741 #define matcho(keyword, subr, st) \ 767 #define matcho(keyword, subr, st) \
742 do { \ 768 do { \
769 match m2; \
743 if (!flag_openmp) \ 770 if (!flag_openmp) \
744 ; \ 771 ; \
745 else if (spec_only && gfc_match (keyword) == MATCH_YES) \ 772 else if (spec_only && gfc_match (keyword) == MATCH_YES) \
746 goto do_spec_only; \ 773 goto do_spec_only; \
747 else if (match_word (keyword, subr, &old_locus) \ 774 else if ((m2 = match_word (keyword, subr, &old_locus)) \
748 == MATCH_YES) \ 775 == MATCH_YES) \
749 { \ 776 { \
750 ret = st; \ 777 ret = st; \
751 goto finish; \ 778 goto finish; \
752 } \ 779 } \
780 else if (m2 == MATCH_ERROR) \
781 goto error_handling; \
753 else \ 782 else \
754 undo_new_statement (); \ 783 undo_new_statement (); \
755 } while (0) 784 } while (0)
756 785
757 /* Like match, but set a flag simd_matched if keyword matched. */ 786 /* Like match, but set a flag simd_matched if keyword matched. */
758 #define matchds(keyword, subr, st) \ 787 #define matchds(keyword, subr, st) \
759 do { \ 788 do { \
760 if (match_word_omp_simd (keyword, subr, &old_locus, \ 789 match m2; \
761 &simd_matched) == MATCH_YES) \ 790 if ((m2 = match_word_omp_simd (keyword, subr, &old_locus, \
791 &simd_matched)) == MATCH_YES) \
762 { \ 792 { \
763 ret = st; \ 793 ret = st; \
764 goto finish; \ 794 goto finish; \
765 } \ 795 } \
796 else if (m2 == MATCH_ERROR) \
797 goto error_handling; \
766 else \ 798 else \
767 undo_new_statement (); \ 799 undo_new_statement (); \
768 } while (0) 800 } while (0)
769 801
770 /* Like match, but don't match anything if not -fopenmp. */ 802 /* Like match, but don't match anything if not -fopenmp. */
771 #define matchdo(keyword, subr, st) \ 803 #define matchdo(keyword, subr, st) \
772 do { \ 804 do { \
805 match m2; \
773 if (!flag_openmp) \ 806 if (!flag_openmp) \
774 ; \ 807 ; \
775 else if (match_word (keyword, subr, &old_locus) \ 808 else if ((m2 = match_word (keyword, subr, &old_locus)) \
776 == MATCH_YES) \ 809 == MATCH_YES) \
777 { \ 810 { \
778 ret = st; \ 811 ret = st; \
779 goto finish; \ 812 goto finish; \
780 } \ 813 } \
814 else if (m2 == MATCH_ERROR) \
815 goto error_handling; \
781 else \ 816 else \
782 undo_new_statement (); \ 817 undo_new_statement (); \
783 } while (0) 818 } while (0)
784 819
785 static gfc_statement 820 static gfc_statement
868 matcho ("distribute", gfc_match_omp_distribute, ST_OMP_DISTRIBUTE); 903 matcho ("distribute", gfc_match_omp_distribute, ST_OMP_DISTRIBUTE);
869 matchs ("do simd", gfc_match_omp_do_simd, ST_OMP_DO_SIMD); 904 matchs ("do simd", gfc_match_omp_do_simd, ST_OMP_DO_SIMD);
870 matcho ("do", gfc_match_omp_do, ST_OMP_DO); 905 matcho ("do", gfc_match_omp_do, ST_OMP_DO);
871 break; 906 break;
872 case 'e': 907 case 'e':
873 matcho ("end atomic", gfc_match_omp_eos, ST_OMP_END_ATOMIC); 908 matcho ("end atomic", gfc_match_omp_eos_error, ST_OMP_END_ATOMIC);
874 matcho ("end critical", gfc_match_omp_end_critical, ST_OMP_END_CRITICAL); 909 matcho ("end critical", gfc_match_omp_end_critical, ST_OMP_END_CRITICAL);
875 matchs ("end distribute parallel do simd", gfc_match_omp_eos, 910 matchs ("end distribute parallel do simd", gfc_match_omp_eos_error,
876 ST_OMP_END_DISTRIBUTE_PARALLEL_DO_SIMD); 911 ST_OMP_END_DISTRIBUTE_PARALLEL_DO_SIMD);
877 matcho ("end distribute parallel do", gfc_match_omp_eos, 912 matcho ("end distribute parallel do", gfc_match_omp_eos_error,
878 ST_OMP_END_DISTRIBUTE_PARALLEL_DO); 913 ST_OMP_END_DISTRIBUTE_PARALLEL_DO);
879 matchs ("end distribute simd", gfc_match_omp_eos, 914 matchs ("end distribute simd", gfc_match_omp_eos_error,
880 ST_OMP_END_DISTRIBUTE_SIMD); 915 ST_OMP_END_DISTRIBUTE_SIMD);
881 matcho ("end distribute", gfc_match_omp_eos, ST_OMP_END_DISTRIBUTE); 916 matcho ("end distribute", gfc_match_omp_eos_error, ST_OMP_END_DISTRIBUTE);
882 matchs ("end do simd", gfc_match_omp_end_nowait, ST_OMP_END_DO_SIMD); 917 matchs ("end do simd", gfc_match_omp_end_nowait, ST_OMP_END_DO_SIMD);
883 matcho ("end do", gfc_match_omp_end_nowait, ST_OMP_END_DO); 918 matcho ("end do", gfc_match_omp_end_nowait, ST_OMP_END_DO);
884 matchs ("end simd", gfc_match_omp_eos, ST_OMP_END_SIMD); 919 matchs ("end simd", gfc_match_omp_eos_error, ST_OMP_END_SIMD);
885 matcho ("end master", gfc_match_omp_eos, ST_OMP_END_MASTER); 920 matcho ("end master", gfc_match_omp_eos_error, ST_OMP_END_MASTER);
886 matchs ("end ordered", gfc_match_omp_eos, ST_OMP_END_ORDERED); 921 matchs ("end ordered", gfc_match_omp_eos_error, ST_OMP_END_ORDERED);
887 matchs ("end parallel do simd", gfc_match_omp_eos, 922 matchs ("end parallel do simd", gfc_match_omp_eos_error,
888 ST_OMP_END_PARALLEL_DO_SIMD); 923 ST_OMP_END_PARALLEL_DO_SIMD);
889 matcho ("end parallel do", gfc_match_omp_eos, ST_OMP_END_PARALLEL_DO); 924 matcho ("end parallel do", gfc_match_omp_eos_error, ST_OMP_END_PARALLEL_DO);
890 matcho ("end parallel sections", gfc_match_omp_eos, 925 matcho ("end parallel sections", gfc_match_omp_eos_error,
891 ST_OMP_END_PARALLEL_SECTIONS); 926 ST_OMP_END_PARALLEL_SECTIONS);
892 matcho ("end parallel workshare", gfc_match_omp_eos, 927 matcho ("end parallel workshare", gfc_match_omp_eos_error,
893 ST_OMP_END_PARALLEL_WORKSHARE); 928 ST_OMP_END_PARALLEL_WORKSHARE);
894 matcho ("end parallel", gfc_match_omp_eos, ST_OMP_END_PARALLEL); 929 matcho ("end parallel", gfc_match_omp_eos_error, ST_OMP_END_PARALLEL);
895 matcho ("end sections", gfc_match_omp_end_nowait, ST_OMP_END_SECTIONS); 930 matcho ("end sections", gfc_match_omp_end_nowait, ST_OMP_END_SECTIONS);
896 matcho ("end single", gfc_match_omp_end_single, ST_OMP_END_SINGLE); 931 matcho ("end single", gfc_match_omp_end_single, ST_OMP_END_SINGLE);
897 matcho ("end target data", gfc_match_omp_eos, ST_OMP_END_TARGET_DATA); 932 matcho ("end target data", gfc_match_omp_eos_error, ST_OMP_END_TARGET_DATA);
898 matchs ("end target parallel do simd", gfc_match_omp_eos, 933 matchs ("end target parallel do simd", gfc_match_omp_eos_error,
899 ST_OMP_END_TARGET_PARALLEL_DO_SIMD); 934 ST_OMP_END_TARGET_PARALLEL_DO_SIMD);
900 matcho ("end target parallel do", gfc_match_omp_eos, 935 matcho ("end target parallel do", gfc_match_omp_eos_error,
901 ST_OMP_END_TARGET_PARALLEL_DO); 936 ST_OMP_END_TARGET_PARALLEL_DO);
902 matcho ("end target parallel", gfc_match_omp_eos, 937 matcho ("end target parallel", gfc_match_omp_eos_error,
903 ST_OMP_END_TARGET_PARALLEL); 938 ST_OMP_END_TARGET_PARALLEL);
904 matchs ("end target simd", gfc_match_omp_eos, ST_OMP_END_TARGET_SIMD); 939 matchs ("end target simd", gfc_match_omp_eos_error, ST_OMP_END_TARGET_SIMD);
905 matchs ("end target teams distribute parallel do simd", 940 matchs ("end target teams distribute parallel do simd",
906 gfc_match_omp_eos, 941 gfc_match_omp_eos_error,
907 ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD); 942 ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD);
908 matcho ("end target teams distribute parallel do", gfc_match_omp_eos, 943 matcho ("end target teams distribute parallel do", gfc_match_omp_eos_error,
909 ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO); 944 ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO);
910 matchs ("end target teams distribute simd", gfc_match_omp_eos, 945 matchs ("end target teams distribute simd", gfc_match_omp_eos_error,
911 ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_SIMD); 946 ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_SIMD);
912 matcho ("end target teams distribute", gfc_match_omp_eos, 947 matcho ("end target teams distribute", gfc_match_omp_eos_error,
913 ST_OMP_END_TARGET_TEAMS_DISTRIBUTE); 948 ST_OMP_END_TARGET_TEAMS_DISTRIBUTE);
914 matcho ("end target teams", gfc_match_omp_eos, ST_OMP_END_TARGET_TEAMS); 949 matcho ("end target teams", gfc_match_omp_eos_error, ST_OMP_END_TARGET_TEAMS);
915 matcho ("end target", gfc_match_omp_eos, ST_OMP_END_TARGET); 950 matcho ("end target", gfc_match_omp_eos_error, ST_OMP_END_TARGET);
916 matcho ("end taskgroup", gfc_match_omp_eos, ST_OMP_END_TASKGROUP); 951 matcho ("end taskgroup", gfc_match_omp_eos_error, ST_OMP_END_TASKGROUP);
917 matchs ("end taskloop simd", gfc_match_omp_eos, 952 matchs ("end taskloop simd", gfc_match_omp_eos_error,
918 ST_OMP_END_TASKLOOP_SIMD); 953 ST_OMP_END_TASKLOOP_SIMD);
919 matcho ("end taskloop", gfc_match_omp_eos, ST_OMP_END_TASKLOOP); 954 matcho ("end taskloop", gfc_match_omp_eos_error, ST_OMP_END_TASKLOOP);
920 matcho ("end task", gfc_match_omp_eos, ST_OMP_END_TASK); 955 matcho ("end task", gfc_match_omp_eos_error, ST_OMP_END_TASK);
921 matchs ("end teams distribute parallel do simd", gfc_match_omp_eos, 956 matchs ("end teams distribute parallel do simd", gfc_match_omp_eos_error,
922 ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD); 957 ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD);
923 matcho ("end teams distribute parallel do", gfc_match_omp_eos, 958 matcho ("end teams distribute parallel do", gfc_match_omp_eos_error,
924 ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO); 959 ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO);
925 matchs ("end teams distribute simd", gfc_match_omp_eos, 960 matchs ("end teams distribute simd", gfc_match_omp_eos_error,
926 ST_OMP_END_TEAMS_DISTRIBUTE_SIMD); 961 ST_OMP_END_TEAMS_DISTRIBUTE_SIMD);
927 matcho ("end teams distribute", gfc_match_omp_eos, 962 matcho ("end teams distribute", gfc_match_omp_eos_error,
928 ST_OMP_END_TEAMS_DISTRIBUTE); 963 ST_OMP_END_TEAMS_DISTRIBUTE);
929 matcho ("end teams", gfc_match_omp_eos, ST_OMP_END_TEAMS); 964 matcho ("end teams", gfc_match_omp_eos_error, ST_OMP_END_TEAMS);
930 matcho ("end workshare", gfc_match_omp_end_nowait, 965 matcho ("end workshare", gfc_match_omp_end_nowait,
931 ST_OMP_END_WORKSHARE); 966 ST_OMP_END_WORKSHARE);
932 break; 967 break;
933 case 'f': 968 case 'f':
934 matcho ("flush", gfc_match_omp_flush, ST_OMP_FLUSH); 969 matcho ("flush", gfc_match_omp_flush, ST_OMP_FLUSH);
958 ST_OMP_PARALLEL_WORKSHARE); 993 ST_OMP_PARALLEL_WORKSHARE);
959 matcho ("parallel", gfc_match_omp_parallel, ST_OMP_PARALLEL); 994 matcho ("parallel", gfc_match_omp_parallel, ST_OMP_PARALLEL);
960 break; 995 break;
961 case 's': 996 case 's':
962 matcho ("sections", gfc_match_omp_sections, ST_OMP_SECTIONS); 997 matcho ("sections", gfc_match_omp_sections, ST_OMP_SECTIONS);
963 matcho ("section", gfc_match_omp_eos, ST_OMP_SECTION); 998 matcho ("section", gfc_match_omp_eos_error, ST_OMP_SECTION);
964 matcho ("single", gfc_match_omp_single, ST_OMP_SINGLE); 999 matcho ("single", gfc_match_omp_single, ST_OMP_SINGLE);
965 break; 1000 break;
966 case 't': 1001 case 't':
967 matcho ("target data", gfc_match_omp_target_data, ST_OMP_TARGET_DATA); 1002 matcho ("target data", gfc_match_omp_target_data, ST_OMP_TARGET_DATA);
968 matcho ("target enter data", gfc_match_omp_target_enter_data, 1003 matcho ("target enter data", gfc_match_omp_target_enter_data,
1020 /* All else has failed, so give up. See if any of the matchers has 1055 /* All else has failed, so give up. See if any of the matchers has
1021 stored an error message of some sort. Don't error out if 1056 stored an error message of some sort. Don't error out if
1022 not -fopenmp and simd_matched is false, i.e. if a directive other 1057 not -fopenmp and simd_matched is false, i.e. if a directive other
1023 than one marked with match has been seen. */ 1058 than one marked with match has been seen. */
1024 1059
1060 error_handling:
1025 if (flag_openmp || simd_matched) 1061 if (flag_openmp || simd_matched)
1026 { 1062 {
1027 if (!gfc_error_check ()) 1063 if (!gfc_error_check ())
1028 gfc_error_now ("Unclassifiable OpenMP directive at %C"); 1064 gfc_error_now ("Unclassifiable OpenMP directive at %C");
1029 } 1065 }
1070 gfc_clear_warning (); /* Clear any pending warnings. */ 1106 gfc_clear_warning (); /* Clear any pending warnings. */
1071 old_locus = gfc_current_locus; 1107 old_locus = gfc_current_locus;
1072 1108
1073 match ("attributes", gfc_match_gcc_attributes, ST_ATTR_DECL); 1109 match ("attributes", gfc_match_gcc_attributes, ST_ATTR_DECL);
1074 match ("unroll", gfc_match_gcc_unroll, ST_NONE); 1110 match ("unroll", gfc_match_gcc_unroll, ST_NONE);
1111 match ("builtin", gfc_match_gcc_builtin, ST_NONE);
1112 match ("ivdep", gfc_match_gcc_ivdep, ST_NONE);
1113 match ("vector", gfc_match_gcc_vector, ST_NONE);
1114 match ("novector", gfc_match_gcc_novector, ST_NONE);
1075 1115
1076 /* All else has failed, so give up. See if any of the matchers has 1116 /* All else has failed, so give up. See if any of the matchers has
1077 stored an error message of some sort. */ 1117 stored an error message of some sort. */
1078 1118
1079 if (!gfc_error_check ()) 1119 if (!gfc_error_check ())
1080 gfc_error_now ("Unclassifiable GCC directive at %C"); 1120 {
1121 if (pedantic)
1122 gfc_error_now ("Unclassifiable GCC directive at %C");
1123 else
1124 gfc_warning_now (0, "Unclassifiable GCC directive at %C, ignored");
1125 }
1081 1126
1082 reject_statement (); 1127 reject_statement ();
1083 1128
1084 gfc_error_recovery (); 1129 gfc_error_recovery ();
1085 1130
1520 /* Statements that mark other executable statements. */ 1565 /* Statements that mark other executable statements. */
1521 1566
1522 #define case_exec_markers case ST_DO: case ST_FORALL_BLOCK: \ 1567 #define case_exec_markers case ST_DO: case ST_FORALL_BLOCK: \
1523 case ST_IF_BLOCK: case ST_BLOCK: case ST_ASSOCIATE: \ 1568 case ST_IF_BLOCK: case ST_BLOCK: case ST_ASSOCIATE: \
1524 case ST_WHERE_BLOCK: case ST_SELECT_CASE: case ST_SELECT_TYPE: \ 1569 case ST_WHERE_BLOCK: case ST_SELECT_CASE: case ST_SELECT_TYPE: \
1525 case ST_OMP_PARALLEL: \ 1570 case ST_SELECT_RANK: case ST_OMP_PARALLEL: \
1526 case ST_OMP_PARALLEL_SECTIONS: case ST_OMP_SECTIONS: case ST_OMP_ORDERED: \ 1571 case ST_OMP_PARALLEL_SECTIONS: case ST_OMP_SECTIONS: case ST_OMP_ORDERED: \
1527 case ST_OMP_CRITICAL: case ST_OMP_MASTER: case ST_OMP_SINGLE: \ 1572 case ST_OMP_CRITICAL: case ST_OMP_MASTER: case ST_OMP_SINGLE: \
1528 case ST_OMP_DO: case ST_OMP_PARALLEL_DO: case ST_OMP_ATOMIC: \ 1573 case ST_OMP_DO: case ST_OMP_PARALLEL_DO: case ST_OMP_ATOMIC: \
1529 case ST_OMP_WORKSHARE: case ST_OMP_PARALLEL_WORKSHARE: \ 1574 case ST_OMP_WORKSHARE: case ST_OMP_PARALLEL_WORKSHARE: \
1530 case ST_OMP_TASK: case ST_OMP_TASKGROUP: case ST_OMP_SIMD: \ 1575 case ST_OMP_TASK: case ST_OMP_TASKGROUP: case ST_OMP_SIMD: \
1543 case ST_OMP_TARGET_PARALLEL_DO: case ST_OMP_TARGET_PARALLEL_DO_SIMD: \ 1588 case ST_OMP_TARGET_PARALLEL_DO: case ST_OMP_TARGET_PARALLEL_DO_SIMD: \
1544 case ST_OMP_TARGET_SIMD: case ST_OMP_TASKLOOP: case ST_OMP_TASKLOOP_SIMD: \ 1589 case ST_OMP_TARGET_SIMD: case ST_OMP_TASKLOOP: case ST_OMP_TASKLOOP_SIMD: \
1545 case ST_CRITICAL: \ 1590 case ST_CRITICAL: \
1546 case ST_OACC_PARALLEL_LOOP: case ST_OACC_PARALLEL: case ST_OACC_KERNELS: \ 1591 case ST_OACC_PARALLEL_LOOP: case ST_OACC_PARALLEL: case ST_OACC_KERNELS: \
1547 case ST_OACC_DATA: case ST_OACC_HOST_DATA: case ST_OACC_LOOP: \ 1592 case ST_OACC_DATA: case ST_OACC_HOST_DATA: case ST_OACC_LOOP: \
1548 case ST_OACC_KERNELS_LOOP: case ST_OACC_ATOMIC 1593 case ST_OACC_KERNELS_LOOP: case ST_OACC_SERIAL_LOOP: case ST_OACC_SERIAL: \
1594 case ST_OACC_ATOMIC
1549 1595
1550 /* Declaration statements */ 1596 /* Declaration statements */
1551 1597
1552 #define case_decl case ST_ATTR_DECL: case ST_COMMON: case ST_DATA_DECL: \ 1598 #define case_decl case ST_ATTR_DECL: case ST_COMMON: case ST_DATA_DECL: \
1553 case ST_EQUIVALENCE: case ST_NAMELIST: case ST_STATEMENT_FUNCTION: \ 1599 case ST_EQUIVALENCE: case ST_NAMELIST: case ST_STATEMENT_FUNCTION: \
2060 p = "SELECT CASE"; 2106 p = "SELECT CASE";
2061 break; 2107 break;
2062 case ST_SELECT_TYPE: 2108 case ST_SELECT_TYPE:
2063 p = "SELECT TYPE"; 2109 p = "SELECT TYPE";
2064 break; 2110 break;
2111 case ST_SELECT_RANK:
2112 p = "SELECT RANK";
2113 break;
2065 case ST_TYPE_IS: 2114 case ST_TYPE_IS:
2066 p = "TYPE IS"; 2115 p = "TYPE IS";
2067 break; 2116 break;
2068 case ST_CLASS_IS: 2117 case ST_CLASS_IS:
2069 p = "CLASS IS"; 2118 p = "CLASS IS";
2070 break; 2119 break;
2120 case ST_RANK:
2121 p = "RANK";
2122 break;
2071 case ST_SEQUENCE: 2123 case ST_SEQUENCE:
2072 p = "SEQUENCE"; 2124 p = "SEQUENCE";
2073 break; 2125 break;
2074 case ST_SIMPLE_IF: 2126 case ST_SIMPLE_IF:
2075 p = _("simple IF"); 2127 p = _("simple IF");
2110 case ST_OACC_KERNELS_LOOP: 2162 case ST_OACC_KERNELS_LOOP:
2111 p = "!$ACC KERNELS LOOP"; 2163 p = "!$ACC KERNELS LOOP";
2112 break; 2164 break;
2113 case ST_OACC_END_KERNELS_LOOP: 2165 case ST_OACC_END_KERNELS_LOOP:
2114 p = "!$ACC END KERNELS LOOP"; 2166 p = "!$ACC END KERNELS LOOP";
2167 break;
2168 case ST_OACC_SERIAL_LOOP:
2169 p = "!$ACC SERIAL LOOP";
2170 break;
2171 case ST_OACC_END_SERIAL_LOOP:
2172 p = "!$ACC END SERIAL LOOP";
2173 break;
2174 case ST_OACC_SERIAL:
2175 p = "!$ACC SERIAL";
2176 break;
2177 case ST_OACC_END_SERIAL:
2178 p = "!$ACC END SERIAL";
2115 break; 2179 break;
2116 case ST_OACC_DATA: 2180 case ST_OACC_DATA:
2117 p = "!$ACC DATA"; 2181 p = "!$ACC DATA";
2118 break; 2182 break;
2119 case ST_OACC_END_DATA: 2183 case ST_OACC_END_DATA:
3737 gfc_ascii_statement (st)); 3801 gfc_ascii_statement (st));
3738 reject_statement (); 3802 reject_statement ();
3739 break; 3803 break;
3740 } 3804 }
3741 3805
3742 /* If we find a statement that can not be followed by an IMPLICIT statement 3806 /* If we find a statement that cannot be followed by an IMPLICIT statement
3743 (and thus we can expect to see none any further), type the function result 3807 (and thus we can expect to see none any further), type the function result
3744 if it has not yet been typed. Be careful not to give the END statement 3808 if it has not yet been typed. Be careful not to give the END statement
3745 to verify_st_order! */ 3809 to verify_st_order! */
3746 if (!function_result_typed && st != ST_GET_FCN_CHARACTERISTICS) 3810 if (!function_result_typed && st != ST_GET_FCN_CHARACTERISTICS)
3747 { 3811 {
4162 "CASE at %C"); 4226 "CASE at %C");
4163 4227
4164 reject_statement (); 4228 reject_statement ();
4165 } 4229 }
4166 4230
4167 /* At this point, we're got a nonempty select block. */ 4231 /* At this point, we've got a nonempty select block. */
4168 cp = new_level (cp); 4232 cp = new_level (cp);
4169 *cp = new_st; 4233 *cp = new_st;
4170 4234
4171 accept_statement (st); 4235 accept_statement (st);
4172 4236
4246 "following SELECT TYPE at %C"); 4310 "following SELECT TYPE at %C");
4247 4311
4248 reject_statement (); 4312 reject_statement ();
4249 } 4313 }
4250 4314
4251 /* At this point, we're got a nonempty select block. */ 4315 /* At this point, we've got a nonempty select block. */
4252 cp = new_level (cp); 4316 cp = new_level (cp);
4253 *cp = new_st; 4317 *cp = new_st;
4254 4318
4255 accept_statement (st); 4319 accept_statement (st);
4256 4320
4262 case ST_NONE: 4326 case ST_NONE:
4263 unexpected_eof (); 4327 unexpected_eof ();
4264 4328
4265 case ST_TYPE_IS: 4329 case ST_TYPE_IS:
4266 case ST_CLASS_IS: 4330 case ST_CLASS_IS:
4331 cp = new_level (gfc_state_stack->head);
4332 *cp = new_st;
4333 gfc_clear_new_st ();
4334
4335 accept_statement (st);
4336 /* Fall through */
4337
4338 case ST_END_SELECT:
4339 break;
4340
4341 /* Can't have an executable statement because of
4342 parse_executable(). */
4343 default:
4344 unexpected_statement (st);
4345 break;
4346 }
4347 }
4348 while (st != ST_END_SELECT);
4349
4350 done:
4351 pop_state ();
4352 accept_statement (st);
4353 gfc_current_ns = gfc_current_ns->parent;
4354 select_type_pop ();
4355 }
4356
4357
4358 /* Parse a SELECT RANK construct. */
4359
4360 static void
4361 parse_select_rank_block (void)
4362 {
4363 gfc_statement st;
4364 gfc_code *cp;
4365 gfc_state_data s;
4366
4367 gfc_current_ns = new_st.ext.block.ns;
4368 accept_statement (ST_SELECT_RANK);
4369
4370 cp = gfc_state_stack->tail;
4371 push_state (&s, COMP_SELECT_RANK, gfc_new_block);
4372
4373 /* Make sure that the next statement is a RANK IS or RANK DEFAULT. */
4374 for (;;)
4375 {
4376 st = next_statement ();
4377 if (st == ST_NONE)
4378 unexpected_eof ();
4379 if (st == ST_END_SELECT)
4380 /* Empty SELECT CASE is OK. */
4381 goto done;
4382 if (st == ST_RANK)
4383 break;
4384
4385 gfc_error ("Expected RANK or RANK DEFAULT "
4386 "following SELECT RANK at %C");
4387
4388 reject_statement ();
4389 }
4390
4391 /* At this point, we've got a nonempty select block. */
4392 cp = new_level (cp);
4393 *cp = new_st;
4394
4395 accept_statement (st);
4396
4397 do
4398 {
4399 st = parse_executable (ST_NONE);
4400 switch (st)
4401 {
4402 case ST_NONE:
4403 unexpected_eof ();
4404
4405 case ST_RANK:
4267 cp = new_level (gfc_state_stack->head); 4406 cp = new_level (gfc_state_stack->head);
4268 *cp = new_st; 4407 *cp = new_st;
4269 gfc_clear_new_st (); 4408 gfc_clear_new_st ();
4270 4409
4271 accept_statement (st); 4410 accept_statement (st);
4534 Still, sometimes it helps to have it right now -- especially 4673 Still, sometimes it helps to have it right now -- especially
4535 for parsing component references on the associate-name 4674 for parsing component references on the associate-name
4536 in case of association to a derived-type. */ 4675 in case of association to a derived-type. */
4537 sym->ts = a->target->ts; 4676 sym->ts = a->target->ts;
4538 4677
4539 /* Check if the target expression is array valued. This can not always 4678 /* Check if the target expression is array valued. This cannot always
4540 be done by looking at target.rank, because that might not have been 4679 be done by looking at target.rank, because that might not have been
4541 set yet. Therefore traverse the chain of refs, looking for the last 4680 set yet. Therefore traverse the chain of refs, looking for the last
4542 array ref and evaluate that. */ 4681 array ref and evaluate that. */
4543 array_ref = NULL; 4682 array_ref = NULL;
4544 for (ref = a->target->ref; ref; ref = ref->next) 4683 for (ref = a->target->ref; ref; ref = ref->next)
4560 ++rank; 4699 ++rank;
4561 } 4700 }
4562 else 4701 else
4563 rank = a->target->rank; 4702 rank = a->target->rank;
4564 /* When the rank is greater than zero then sym will be an array. */ 4703 /* When the rank is greater than zero then sym will be an array. */
4565 if (sym->ts.type == BT_CLASS) 4704 if (sym->ts.type == BT_CLASS && CLASS_DATA (sym))
4566 { 4705 {
4567 if ((!CLASS_DATA (sym)->as && rank != 0) 4706 if ((!CLASS_DATA (sym)->as && rank != 0)
4568 || (CLASS_DATA (sym)->as 4707 || (CLASS_DATA (sym)->as
4569 && CLASS_DATA (sym)->as->rank != rank)) 4708 && CLASS_DATA (sym)->as->rank != rank))
4570 { 4709 {
4663 if (directive_unroll != -1) 4802 if (directive_unroll != -1)
4664 { 4803 {
4665 new_st.ext.iterator->unroll = directive_unroll; 4804 new_st.ext.iterator->unroll = directive_unroll;
4666 directive_unroll = -1; 4805 directive_unroll = -1;
4667 } 4806 }
4807 if (directive_ivdep)
4808 {
4809 new_st.ext.iterator->ivdep = directive_ivdep;
4810 directive_ivdep = false;
4811 }
4812 if (directive_vector)
4813 {
4814 new_st.ext.iterator->vector = directive_vector;
4815 directive_vector = false;
4816 }
4817 if (directive_novector)
4818 {
4819 new_st.ext.iterator->novector = directive_novector;
4820 directive_novector = false;
4821 }
4668 } 4822 }
4669 else 4823 else
4670 stree = NULL; 4824 stree = NULL;
4671 4825
4672 accept_statement (ST_DO); 4826 accept_statement (ST_DO);
4929 acc_end_st = ST_OACC_END_PARALLEL; 5083 acc_end_st = ST_OACC_END_PARALLEL;
4930 break; 5084 break;
4931 case ST_OACC_KERNELS: 5085 case ST_OACC_KERNELS:
4932 acc_end_st = ST_OACC_END_KERNELS; 5086 acc_end_st = ST_OACC_END_KERNELS;
4933 break; 5087 break;
5088 case ST_OACC_SERIAL:
5089 acc_end_st = ST_OACC_END_SERIAL;
5090 break;
4934 case ST_OACC_DATA: 5091 case ST_OACC_DATA:
4935 acc_end_st = ST_OACC_END_DATA; 5092 acc_end_st = ST_OACC_END_DATA;
4936 break; 5093 break;
4937 case ST_OACC_HOST_DATA: 5094 case ST_OACC_HOST_DATA:
4938 acc_end_st = ST_OACC_END_HOST_DATA; 5095 acc_end_st = ST_OACC_END_HOST_DATA;
4960 gfc_commit_symbols (); 5117 gfc_commit_symbols ();
4961 gfc_warning_check (); 5118 gfc_warning_check ();
4962 pop_state (); 5119 pop_state ();
4963 } 5120 }
4964 5121
4965 /* Parse the statements of OpenACC loop/parallel loop/kernels loop. */ 5122 /* Parse the statements of OpenACC 'loop', or combined compute 'loop'. */
4966 5123
4967 static gfc_statement 5124 static gfc_statement
4968 parse_oacc_loop (gfc_statement acc_st) 5125 parse_oacc_loop (gfc_statement acc_st)
4969 { 5126 {
4970 gfc_statement st; 5127 gfc_statement st;
5013 st = next_statement (); 5170 st = next_statement ();
5014 if (st == ST_OACC_END_LOOP) 5171 if (st == ST_OACC_END_LOOP)
5015 gfc_warning (0, "Redundant !$ACC END LOOP at %C"); 5172 gfc_warning (0, "Redundant !$ACC END LOOP at %C");
5016 if ((acc_st == ST_OACC_PARALLEL_LOOP && st == ST_OACC_END_PARALLEL_LOOP) || 5173 if ((acc_st == ST_OACC_PARALLEL_LOOP && st == ST_OACC_END_PARALLEL_LOOP) ||
5017 (acc_st == ST_OACC_KERNELS_LOOP && st == ST_OACC_END_KERNELS_LOOP) || 5174 (acc_st == ST_OACC_KERNELS_LOOP && st == ST_OACC_END_KERNELS_LOOP) ||
5175 (acc_st == ST_OACC_SERIAL_LOOP && st == ST_OACC_END_SERIAL_LOOP) ||
5018 (acc_st == ST_OACC_LOOP && st == ST_OACC_END_LOOP)) 5176 (acc_st == ST_OACC_LOOP && st == ST_OACC_END_LOOP))
5019 { 5177 {
5020 gcc_assert (new_st.op == EXEC_NOP); 5178 gcc_assert (new_st.op == EXEC_NOP);
5021 gfc_clear_new_st (); 5179 gfc_clear_new_st ();
5022 gfc_commit_symbols (); 5180 gfc_commit_symbols ();
5070 case ST_OMP_TARGET: 5228 case ST_OMP_TARGET:
5071 omp_end_st = ST_OMP_END_TARGET; 5229 omp_end_st = ST_OMP_END_TARGET;
5072 break; 5230 break;
5073 case ST_OMP_TARGET_DATA: 5231 case ST_OMP_TARGET_DATA:
5074 omp_end_st = ST_OMP_END_TARGET_DATA; 5232 omp_end_st = ST_OMP_END_TARGET_DATA;
5233 break;
5234 case ST_OMP_TARGET_PARALLEL:
5235 omp_end_st = ST_OMP_END_TARGET_PARALLEL;
5075 break; 5236 break;
5076 case ST_OMP_TARGET_TEAMS: 5237 case ST_OMP_TARGET_TEAMS:
5077 omp_end_st = ST_OMP_END_TARGET_TEAMS; 5238 omp_end_st = ST_OMP_END_TARGET_TEAMS;
5078 break; 5239 break;
5079 case ST_OMP_TARGET_TEAMS_DISTRIBUTE: 5240 case ST_OMP_TARGET_TEAMS_DISTRIBUTE:
5328 5489
5329 case ST_SELECT_TYPE: 5490 case ST_SELECT_TYPE:
5330 parse_select_type_block (); 5491 parse_select_type_block ();
5331 break; 5492 break;
5332 5493
5494 case ST_SELECT_RANK:
5495 parse_select_rank_block ();
5496 break;
5497
5333 case ST_DO: 5498 case ST_DO:
5334 parse_do_block (); 5499 parse_do_block ();
5335 if (check_do_closure () == 1) 5500 if (check_do_closure () == 1)
5336 return ST_IMPLIED_ENDDO; 5501 return ST_IMPLIED_ENDDO;
5337 break; 5502 break;
5348 parse_forall_block (); 5513 parse_forall_block ();
5349 break; 5514 break;
5350 5515
5351 case ST_OACC_PARALLEL_LOOP: 5516 case ST_OACC_PARALLEL_LOOP:
5352 case ST_OACC_KERNELS_LOOP: 5517 case ST_OACC_KERNELS_LOOP:
5518 case ST_OACC_SERIAL_LOOP:
5353 case ST_OACC_LOOP: 5519 case ST_OACC_LOOP:
5354 st = parse_oacc_loop (st); 5520 st = parse_oacc_loop (st);
5355 if (st == ST_IMPLIED_ENDDO) 5521 if (st == ST_IMPLIED_ENDDO)
5356 return st; 5522 return st;
5357 continue; 5523 continue;
5358 5524
5359 case ST_OACC_PARALLEL: 5525 case ST_OACC_PARALLEL:
5360 case ST_OACC_KERNELS: 5526 case ST_OACC_KERNELS:
5527 case ST_OACC_SERIAL:
5361 case ST_OACC_DATA: 5528 case ST_OACC_DATA:
5362 case ST_OACC_HOST_DATA: 5529 case ST_OACC_HOST_DATA:
5363 parse_oacc_structured_block (st); 5530 parse_oacc_structured_block (st);
5364 break; 5531 break;
5365 5532
5394 case ST_OMP_PARALLEL_DO: 5561 case ST_OMP_PARALLEL_DO:
5395 case ST_OMP_PARALLEL_DO_SIMD: 5562 case ST_OMP_PARALLEL_DO_SIMD:
5396 case ST_OMP_SIMD: 5563 case ST_OMP_SIMD:
5397 case ST_OMP_TARGET_PARALLEL_DO: 5564 case ST_OMP_TARGET_PARALLEL_DO:
5398 case ST_OMP_TARGET_PARALLEL_DO_SIMD: 5565 case ST_OMP_TARGET_PARALLEL_DO_SIMD:
5566 case ST_OMP_TARGET_SIMD:
5399 case ST_OMP_TARGET_TEAMS_DISTRIBUTE: 5567 case ST_OMP_TARGET_TEAMS_DISTRIBUTE:
5400 case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: 5568 case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
5401 case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: 5569 case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
5402 case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: 5570 case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
5403 case ST_OMP_TASKLOOP: 5571 case ST_OMP_TASKLOOP:
5422 default: 5590 default:
5423 return st; 5591 return st;
5424 } 5592 }
5425 5593
5426 if (directive_unroll != -1) 5594 if (directive_unroll != -1)
5427 gfc_error ("%<GCC unroll%> directive does not commence a loop at %C"); 5595 gfc_error ("%<GCC unroll%> directive not at the start of a loop at %C");
5596
5597 if (directive_ivdep)
5598 gfc_error ("%<GCC ivdep%> directive not at the start of a loop at %C");
5599
5600 if (directive_vector)
5601 gfc_error ("%<GCC vector%> directive not at the start of a loop at %C");
5602
5603 if (directive_novector)
5604 gfc_error ("%<GCC novector%> "
5605 "directive not at the start of a loop at %C");
5428 5606
5429 st = next_statement (); 5607 st = next_statement ();
5430 } 5608 }
5431 } 5609 }
5432 5610
5661 parse_progunit (gfc_statement st) 5839 parse_progunit (gfc_statement st)
5662 { 5840 {
5663 gfc_state_data *p; 5841 gfc_state_data *p;
5664 int n; 5842 int n;
5665 5843
5844 gfc_adjust_builtins ();
5845
5666 if (gfc_new_block 5846 if (gfc_new_block
5667 && gfc_new_block->abr_modproc_decl 5847 && gfc_new_block->abr_modproc_decl
5668 && gfc_new_block->attr.function) 5848 && gfc_new_block->attr.function)
5669 get_modproc_result (); 5849 get_modproc_result ();
5670 5850
5828 blank_locus = gfc_current_locus; 6008 blank_locus = gfc_current_locus;
5829 } 6009 }
5830 } 6010 }
5831 else 6011 else
5832 { 6012 {
5833 s = gfc_get_gsymbol (gfc_new_block->name); 6013 s = gfc_get_gsymbol (gfc_new_block->name, false);
5834 if (s->defined 6014 if (s->defined
5835 || (s->type != GSYM_UNKNOWN && s->type != GSYM_BLOCK_DATA)) 6015 || (s->type != GSYM_UNKNOWN && s->type != GSYM_BLOCK_DATA))
5836 gfc_global_used (s, &gfc_new_block->declared_at); 6016 gfc_global_used (s, &gfc_new_block->declared_at);
5837 else 6017 else
5838 { 6018 {
5863 static void 6043 static void
5864 set_syms_host_assoc (gfc_symbol *sym) 6044 set_syms_host_assoc (gfc_symbol *sym)
5865 { 6045 {
5866 gfc_component *c; 6046 gfc_component *c;
5867 const char dot[2] = "."; 6047 const char dot[2] = ".";
5868 char parent1[GFC_MAX_SYMBOL_LEN + 1]; 6048 /* Symbols take the form module.submodule_ or module.name_. */
5869 char parent2[GFC_MAX_SYMBOL_LEN + 1]; 6049 char parent1[2 * GFC_MAX_SYMBOL_LEN + 2];
6050 char parent2[2 * GFC_MAX_SYMBOL_LEN + 2];
5870 6051
5871 if (sym == NULL) 6052 if (sym == NULL)
5872 return; 6053 return;
5873 6054
5874 if (sym->attr.module_procedure) 6055 if (sym->attr.module_procedure)
5910 { 6091 {
5911 gfc_statement st; 6092 gfc_statement st;
5912 gfc_gsymbol *s; 6093 gfc_gsymbol *s;
5913 bool error; 6094 bool error;
5914 6095
5915 s = gfc_get_gsymbol (gfc_new_block->name); 6096 s = gfc_get_gsymbol (gfc_new_block->name, false);
5916 if (s->defined || (s->type != GSYM_UNKNOWN && s->type != GSYM_MODULE)) 6097 if (s->defined || (s->type != GSYM_UNKNOWN && s->type != GSYM_MODULE))
5917 gfc_global_used (s, &gfc_new_block->declared_at); 6098 gfc_global_used (s, &gfc_new_block->declared_at);
5918 else 6099 else
5919 { 6100 {
5920 s->type = GSYM_MODULE; 6101 s->type = GSYM_MODULE;
5974 6155
5975 /* Only in Fortran 2003: For procedures with a binding label also the Fortran 6156 /* Only in Fortran 2003: For procedures with a binding label also the Fortran
5976 name is a global identifier. */ 6157 name is a global identifier. */
5977 if (!gfc_new_block->binding_label || gfc_notification_std (GFC_STD_F2008)) 6158 if (!gfc_new_block->binding_label || gfc_notification_std (GFC_STD_F2008))
5978 { 6159 {
5979 s = gfc_get_gsymbol (gfc_new_block->name); 6160 s = gfc_get_gsymbol (gfc_new_block->name, false);
5980 6161
5981 if (s->defined 6162 if (s->defined
5982 || (s->type != GSYM_UNKNOWN 6163 || (s->type != GSYM_UNKNOWN
5983 && s->type != (sub ? GSYM_SUBROUTINE : GSYM_FUNCTION))) 6164 && s->type != (sub ? GSYM_SUBROUTINE : GSYM_FUNCTION)))
5984 { 6165 {
5999 /* Don't add the symbol multiple times. */ 6180 /* Don't add the symbol multiple times. */
6000 if (gfc_new_block->binding_label 6181 if (gfc_new_block->binding_label
6001 && (!gfc_notification_std (GFC_STD_F2008) 6182 && (!gfc_notification_std (GFC_STD_F2008)
6002 || strcmp (gfc_new_block->name, gfc_new_block->binding_label) != 0)) 6183 || strcmp (gfc_new_block->name, gfc_new_block->binding_label) != 0))
6003 { 6184 {
6004 s = gfc_get_gsymbol (gfc_new_block->binding_label); 6185 s = gfc_get_gsymbol (gfc_new_block->binding_label, true);
6005 6186
6006 if (s->defined 6187 if (s->defined
6007 || (s->type != GSYM_UNKNOWN 6188 || (s->type != GSYM_UNKNOWN
6008 && s->type != (sub ? GSYM_SUBROUTINE : GSYM_FUNCTION))) 6189 && s->type != (sub ? GSYM_SUBROUTINE : GSYM_FUNCTION)))
6009 { 6190 {
6031 { 6212 {
6032 gfc_gsymbol *s; 6213 gfc_gsymbol *s;
6033 6214
6034 if (gfc_new_block == NULL) 6215 if (gfc_new_block == NULL)
6035 return; 6216 return;
6036 s = gfc_get_gsymbol (gfc_new_block->name); 6217 s = gfc_get_gsymbol (gfc_new_block->name, false);
6037 6218
6038 if (s->defined || (s->type != GSYM_UNKNOWN && s->type != GSYM_PROGRAM)) 6219 if (s->defined || (s->type != GSYM_UNKNOWN && s->type != GSYM_PROGRAM))
6039 gfc_global_used (s, &gfc_new_block->declared_at); 6220 gfc_global_used (s, &gfc_new_block->declared_at);
6040 else 6221 else
6041 { 6222 {
6267 6448
6268 /* Dump the parse tree if requested. */ 6449 /* Dump the parse tree if requested. */
6269 if (flag_dump_fortran_original) 6450 if (flag_dump_fortran_original)
6270 gfc_dump_parse_tree (gfc_current_ns, stdout); 6451 gfc_dump_parse_tree (gfc_current_ns, stdout);
6271 6452
6272 if (flag_c_prototypes)
6273 gfc_dump_c_prototypes (gfc_current_ns, stdout);
6274
6275 gfc_get_errors (NULL, &errors); 6453 gfc_get_errors (NULL, &errors);
6276 if (s.state == COMP_MODULE || s.state == COMP_SUBMODULE) 6454 if (s.state == COMP_MODULE || s.state == COMP_SUBMODULE)
6277 { 6455 {
6278 gfc_dump_module (s.sym->name, errors_before == errors); 6456 gfc_dump_module (s.sym->name, errors_before == errors);
6279 gfc_current_ns->derived_types = gfc_derived_types; 6457 gfc_current_ns->derived_types = gfc_derived_types;
6310 goto loop; 6488 goto loop;
6311 6489
6312 done: 6490 done:
6313 /* Do the resolution. */ 6491 /* Do the resolution. */
6314 resolve_all_program_units (gfc_global_ns_list); 6492 resolve_all_program_units (gfc_global_ns_list);
6493
6494
6495 /* Fixup for external procedures. */
6496 for (gfc_current_ns = gfc_global_ns_list; gfc_current_ns;
6497 gfc_current_ns = gfc_current_ns->sibling)
6498 gfc_check_externals (gfc_current_ns);
6315 6499
6316 /* Do the parse tree dump. */ 6500 /* Do the parse tree dump. */
6317 gfc_current_ns = flag_dump_fortran_original ? gfc_global_ns_list : NULL; 6501 gfc_current_ns = flag_dump_fortran_original ? gfc_global_ns_list : NULL;
6318 6502
6319 for (; gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling) 6503 for (; gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling)
6322 { 6506 {
6323 gfc_dump_parse_tree (gfc_current_ns, stdout); 6507 gfc_dump_parse_tree (gfc_current_ns, stdout);
6324 fputs ("------------------------------------------\n\n", stdout); 6508 fputs ("------------------------------------------\n\n", stdout);
6325 } 6509 }
6326 6510
6511 /* Dump C prototypes. */
6512 if (flag_c_prototypes || flag_c_prototypes_external)
6513 {
6514 fprintf (stdout,
6515 "#include <stddef.h>\n"
6516 "#ifdef __cplusplus\n"
6517 "#include <complex>\n"
6518 "#define __GFORTRAN_FLOAT_COMPLEX std::complex<float>\n"
6519 "#define __GFORTRAN_DOUBLE_COMPLEX std::complex<double>\n"
6520 "#define __GFORTRAN_LONG_DOUBLE_COMPLEX std::complex<long double>\n"
6521 "extern \"C\" {\n"
6522 "#else\n"
6523 "#define __GFORTRAN_FLOAT_COMPLEX float _Complex\n"
6524 "#define __GFORTRAN_DOUBLE_COMPLEX double _Complex\n"
6525 "#define __GFORTRAN_LONG_DOUBLE_COMPLEX long double _Complex\n"
6526 "#endif\n\n");
6527 }
6528
6529 /* First dump BIND(C) prototypes. */
6530 if (flag_c_prototypes)
6531 {
6532 for (gfc_current_ns = gfc_global_ns_list; gfc_current_ns;
6533 gfc_current_ns = gfc_current_ns->sibling)
6534 gfc_dump_c_prototypes (gfc_current_ns, stdout);
6535 }
6536
6537 /* Dump external prototypes. */
6538 if (flag_c_prototypes_external)
6539 gfc_dump_external_c_prototypes (stdout);
6540
6541 if (flag_c_prototypes || flag_c_prototypes_external)
6542 fprintf (stdout, "\n#ifdef __cplusplus\n}\n#endif\n");
6543
6327 /* Do the translation. */ 6544 /* Do the translation. */
6328 translate_all_program_units (gfc_global_ns_list); 6545 translate_all_program_units (gfc_global_ns_list);
6546
6547 /* Dump the global symbol ist. We only do this here because part
6548 of it is generated after mangling the identifiers in
6549 trans-decl.c. */
6550
6551 if (flag_dump_fortran_global)
6552 gfc_dump_global_symbols (stdout);
6329 6553
6330 gfc_end_source_files (); 6554 gfc_end_source_files ();
6331 return true; 6555 return true;
6332 6556
6333 duplicate_main: 6557 duplicate_main:
6348 { 6572 {
6349 case EXEC_OACC_PARALLEL_LOOP: 6573 case EXEC_OACC_PARALLEL_LOOP:
6350 case EXEC_OACC_PARALLEL: 6574 case EXEC_OACC_PARALLEL:
6351 case EXEC_OACC_KERNELS_LOOP: 6575 case EXEC_OACC_KERNELS_LOOP:
6352 case EXEC_OACC_KERNELS: 6576 case EXEC_OACC_KERNELS:
6577 case EXEC_OACC_SERIAL_LOOP:
6578 case EXEC_OACC_SERIAL:
6353 case EXEC_OACC_DATA: 6579 case EXEC_OACC_DATA:
6354 case EXEC_OACC_HOST_DATA: 6580 case EXEC_OACC_HOST_DATA:
6355 case EXEC_OACC_LOOP: 6581 case EXEC_OACC_LOOP:
6356 case EXEC_OACC_UPDATE: 6582 case EXEC_OACC_UPDATE:
6357 case EXEC_OACC_WAIT: 6583 case EXEC_OACC_WAIT: