diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc index 5a46658651a..feb454ea5b3 100644 --- a/gcc/fortran/decl.cc +++ b/gcc/fortran/decl.cc @@ -9795,6 +9795,15 @@ gfc_match_save (void) if (m == MATCH_NO) goto syntax; + /* F2023:C1108: A SAVE statement in a BLOCK construct shall contain a + saved-entity-list that does not specify a common-block-name. */ + if (gfc_current_state () == COMP_BLOCK) + { + gfc_error ("SAVE of COMMON block %qs at %C is not allowed " + "in a BLOCK construct", n); + return MATCH_ERROR; + } + c = gfc_get_common (n, 0); c->saved = 1; diff --git a/gcc/fortran/trans-common.cc b/gcc/fortran/trans-common.cc index 70b45174f84..2db50da20dd 100644 --- a/gcc/fortran/trans-common.cc +++ b/gcc/fortran/trans-common.cc @@ -1218,7 +1218,7 @@ translate_common (gfc_common_head *common, gfc_symbol *var_list) align = 1; saw_equiv = false; - if (var_list->attr.omp_allocate) + if (var_list && var_list->attr.omp_allocate) gfc_error ("Sorry, !$OMP allocate for COMMON block variable %qs at %L " "not supported", common->name, &common->where); diff --git a/gcc/testsuite/gfortran.dg/common_30.f90 b/gcc/testsuite/gfortran.dg/common_30.f90 new file mode 100644 index 00000000000..77a86348f4a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/common_30.f90 @@ -0,0 +1,10 @@ +! { dg-do compile } +! PR fortran/119199 +! +! One cannot SAVE an undefined COMMON block +! +! Contributed by David Binderman + +program main + save /argmnt1/ ! { dg-error "does not exist" } +end diff --git a/gcc/testsuite/gfortran.dg/common_31.f90 b/gcc/testsuite/gfortran.dg/common_31.f90 new file mode 100644 index 00000000000..b60f46d7d5a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/common_31.f90 @@ -0,0 +1,15 @@ +! { dg-do compile } +! PR fortran/119199 - reject SAVE of a COMMON in a BLOCK construct +! +! F2023:C1108: A SAVE statement in a BLOCK construct shall contain a +! saved-entity-list that does not specify a common-block-name. +! +! Contributed by David Binderman + +program main + real r + common /argmnt2/ r + block + save /argmnt2/ ! { dg-error "not allowed in a BLOCK construct" } + end block +end