From patchwork Tue Aug 14 09:33:26 2012 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Subject: [Fortran] PR40881 - Add two F95 obsolescence warnings Date: Mon, 13 Aug 2012 23:33:26 -0000 From: Tobias Burnus X-Patchwork-Id: 177196 Message-Id: <502A1B66.80302@net-b.de> To: Mikael Morin Cc: gcc patches , gfortran On 08/09/2012 02:13 PM, Mikael Morin wrote: > On 08/08/2012 19:12, Tobias Burnus wrote: >> With this patch, I think the only unimplemented obsolescence warning is for >> "(8) Fixed form source -- see B.2.7." >> >> For the latter, I would like to see a possibility to silence that >> warning, given that there is substantial code around, which is in fixed >> form but otherwise a completely valid and obsolescent-free code. > We could silence it with explicit -ffixed-form. That won't work. The driver ("gfortran") automatically adds the flag when compiling ".f" files. Thus, from within the compile ("f951") those are indistinguishable. Besides, many Makefiles have the same compiler flags for fixed and free form as (most) compilers automatically choose the right source form based on the file extension. > Regarding the general design, I'm not sure it makes sense to distinguish between ST_LABEL_DO_TARGET and ST_LABEL_ENDDO_TARGET. I concur. I changed it and also added a comment to gfortran.h. >> @@ -3825,8 +3828,11 @@ parse_executable (gfc_statement st) >> case ST_NONE: >> unexpected_eof (); >> >> - case ST_FORMAT: >> case ST_DATA: >> + gfc_notify_std (GFC_STD_F95_OBS, "DATA statement at %C after the " >> + "first executable statement"); >> + /* Fall through. */ >> + case ST_FORMAT: >> case ST_ENTRY: >> case_executable: >> accept_statement (st); > This diagnostic is more appropriate in verify_st_order (which needs to > be called then). I disagree. Initially, I thought that verify_st_order is the right place - and discovered then that it doesn't get called after the first executable statement. Thus, I added it to parse_executable. Given that DATA is the only statement, which can also occur in the execution section and that its validity depends on the compile flags, it also would need a special handling in verify_st_order. Calling verify_st_order from parse_executable only for ST_DATA is kind of pointless while calling it always, leads to quite some overhead, requires that one keeps track of the previous state (which is required by verify_st_order but otherwise not needed in the execution section). Thus, I really prefer the current solution. >> case ST_LABEL_TARGET: >> + case ST_LABEL_ENDDO_TARGET: >> if (lp->referenced == ST_LABEL_FORMAT) >> gfc_error ("Label %d at %C already referenced as a format label", >> labelno); >> else >> lp->defined = ST_LABEL_TARGET; > I think it should be `lp->defined = type;' here. I think the current code is okay due to the required ordering, e.g. the termination label for a DO block has to come after the DO block. But I concur that using "= type" is cleaner. Thus, I removed ST_LABEL_ENDDO_TARGET, use "=type" and added a comment, but I didn't do the verify_st_order change. Build and regested on x86-64-linux. OK for the trunk? Tobias 2012-08-14 Tobias Burnus PR fortran/40881 * error.c (gfc_notify_std): Reset cur_error_buffer->flag flag when the error/warning has been printed. * gfortran.h (gfc_sl_type): Add ST_LABEL_DO_TARGET. * match.c (gfc_match_do): Use ST_LABEL_DO_TARGET. * parse.c (check_statement_label): Use ST_LABEL_DO_TARGET. (parse_executable): Add obsolescence check for DATA. * resolve.c (resolve_branch): Handle ST_LABEL_DO_TARGET. * symbol.c (gfc_define_st_label, gfc_reference_st_label): Add obsolescence diagnostics. * trans-stmt.c (gfc_trans_label_assign): Handle ST_LABEL_DO_TARGET. 2012-08-14 Tobias Burnus PR fortran/40881 * gfortran.dg/data_constraints_3.f90: New. * gfortran.dg/data_constraints_1.f90: Update dg-warning. * gfortran.dg/pr37243.f: Ditto. * gfortran.dg/g77/19990826-3.f: Ditto. * gfortran.dg/g77/20020307-1.f : Ditto. * gfortran.dg/g77/980310-3.f: Ditto. diff --git a/gcc/fortran/error.c b/gcc/fortran/error.c index 7e968db..dde6a0f 100644 --- a/gcc/fortran/error.c +++ b/gcc/fortran/error.c @@ -875,6 +875,7 @@ gfc_notify_std (int std, const char *gmsgid, ...) warnings++; else gfc_increment_error_count(); + cur_error_buffer->flag = 0; } return (warning && !warnings_are_errors) ? SUCCESS : FAILURE; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index b6e2975..0e2130f 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -144,9 +144,11 @@ typedef enum { AR_FULL = 1, AR_ELEMENT, AR_SECTION, AR_UNKNOWN } ar_type; -/* Statement label types. */ +/* Statement label types. ST_LABEL_DO_TARGET is used for obsolescent warnings + related to shared DO terminations and DO targets which are neither END DO + nor CONTINUE; otherwise it is identical to ST_LABEL_TARGET. */ typedef enum -{ ST_LABEL_UNKNOWN = 1, ST_LABEL_TARGET, +{ ST_LABEL_UNKNOWN = 1, ST_LABEL_TARGET, ST_LABEL_DO_TARGET, ST_LABEL_BAD_TARGET, ST_LABEL_FORMAT } gfc_sl_type; diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 737d6a3..5ab07e5 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -2400,7 +2400,7 @@ gfc_match_do (void) goto concurr_cleanup; if (label != NULL - && gfc_reference_st_label (label, ST_LABEL_TARGET) == FAILURE) + && gfc_reference_st_label (label, ST_LABEL_DO_TARGET) == FAILURE) goto concurr_cleanup; new_st.label1 = label; @@ -2454,7 +2454,7 @@ concurr_cleanup: done: if (label != NULL - && gfc_reference_st_label (label, ST_LABEL_TARGET) == FAILURE) + && gfc_reference_st_label (label, ST_LABEL_DO_TARGET) == FAILURE) goto cleanup; new_st.label1 = label; diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index ecda163..44b1900 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -1168,7 +1168,10 @@ check_statement_label (gfc_statement st) case ST_END_ASSOCIATE: case_executable: case_exec_markers: - type = ST_LABEL_TARGET; + if (st == ST_ENDDO || st == ST_CONTINUE) + type = ST_LABEL_DO_TARGET; + else + type = ST_LABEL_TARGET; break; case ST_FORMAT: @@ -3825,8 +3828,12 @@ parse_executable (gfc_statement st) case ST_NONE: unexpected_eof (); - case ST_FORMAT: case ST_DATA: + gfc_notify_std (GFC_STD_F95_OBS, "DATA statement at %C after the " + "first executable statement"); + /* Fall through. */ + + case ST_FORMAT: case ST_ENTRY: case_executable: accept_statement (st); diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index c5810b2..9b8033d 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -8767,7 +8767,7 @@ resolve_branch (gfc_st_label *label, gfc_code *code) return; } - if (label->defined != ST_LABEL_TARGET) + if (label->defined != ST_LABEL_TARGET && label->defined != ST_LABEL_DO_TARGET) { gfc_error ("Statement at %L is not a valid branch target statement " "for the branch statement at %L", &label->where, &code->loc); diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 455e6c9..5a1e5ad 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -2204,7 +2204,8 @@ gfc_define_st_label (gfc_st_label *lp, gfc_sl_type type, locus *label_locus) switch (type) { case ST_LABEL_FORMAT: - if (lp->referenced == ST_LABEL_TARGET) + if (lp->referenced == ST_LABEL_TARGET + || lp->referenced == ST_LABEL_DO_TARGET) gfc_error ("Label %d at %C already referenced as branch target", labelno); else @@ -2213,12 +2214,18 @@ gfc_define_st_label (gfc_st_label *lp, gfc_sl_type type, locus *label_locus) break; case ST_LABEL_TARGET: + case ST_LABEL_DO_TARGET: if (lp->referenced == ST_LABEL_FORMAT) gfc_error ("Label %d at %C already referenced as a format label", labelno); else - lp->defined = ST_LABEL_TARGET; + lp->defined = type; + if (lp->referenced == ST_LABEL_DO_TARGET && type != ST_LABEL_DO_TARGET + && gfc_notify_std (GFC_STD_F95_OBS, "DO termination statement " + "which is not END DO or CONTINUE with label " + "%d at %C", labelno) == FAILURE) + return; break; default: @@ -2254,14 +2261,16 @@ gfc_reference_st_label (gfc_st_label *lp, gfc_sl_type type) lp->where = gfc_current_locus; } - if (label_type == ST_LABEL_FORMAT && type == ST_LABEL_TARGET) + if (label_type == ST_LABEL_FORMAT + && (type == ST_LABEL_TARGET || type == ST_LABEL_DO_TARGET)) { gfc_error ("Label %d at %C previously used as a FORMAT label", labelno); rc = FAILURE; goto done; } - if ((label_type == ST_LABEL_TARGET || label_type == ST_LABEL_BAD_TARGET) + if ((label_type == ST_LABEL_TARGET || label_type == ST_LABEL_DO_TARGET + || label_type == ST_LABEL_BAD_TARGET) && type == ST_LABEL_FORMAT) { gfc_error ("Label %d at %C previously used as branch target", labelno); @@ -2269,7 +2278,13 @@ gfc_reference_st_label (gfc_st_label *lp, gfc_sl_type type) goto done; } - lp->referenced = type; + if (lp->referenced == ST_LABEL_DO_TARGET && type == ST_LABEL_DO_TARGET + && gfc_notify_std (GFC_STD_F95_OBS, "Shared DO termination label %d " + "at %C", labelno) == FAILURE) + return FAILURE; + + if (lp->referenced != ST_LABEL_DO_TARGET) + lp->referenced = type; rc = SUCCESS; done: diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 323fca3..7ece492 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -109,7 +109,8 @@ gfc_trans_label_assign (gfc_code * code) label_tree = gfc_get_label_decl (code->label1); - if (code->label1->defined == ST_LABEL_TARGET) + if (code->label1->defined == ST_LABEL_TARGET + || code->label1->defined == ST_LABEL_DO_TARGET) { label_tree = gfc_build_addr_expr (pvoid_type_node, label_tree); len_tree = integer_minus_one_node; diff --git a/gcc/testsuite/gfortran.dg/data_constraints_1.f90 b/gcc/testsuite/gfortran.dg/data_constraints_1.f90 index 5f11ffd..bfedcd4 100644 --- a/gcc/testsuite/gfortran.dg/data_constraints_1.f90 +++ b/gcc/testsuite/gfortran.dg/data_constraints_1.f90 @@ -16,7 +16,7 @@ contains function foo (m) result (bar) integer p (m), bar integer, allocatable :: l(:) - allocate (l(1)) +! allocate (l(1)) data l /42/ ! { dg-error "conflicts with ALLOCATABLE" } data p(1) /1/ ! { dg-error "non-constant array in DATA" } data q /1/ ! { dg-error "Host associated variable" } diff --git a/gcc/testsuite/gfortran.dg/g77/19990826-3.f b/gcc/testsuite/gfortran.dg/g77/19990826-3.f index dba24be..374c553 100644 --- a/gcc/testsuite/gfortran.dg/g77/19990826-3.f +++ b/gcc/testsuite/gfortran.dg/g77/19990826-3.f @@ -64,7 +64,7 @@ C IF(M2.LT.64)INDE=5 IF(M2.LT.32)INDE=4 DO 3 NUN =3,INUN - DO 3 NDE=3,INDE + DO 3 NDE=3,INDE ! { dg-warning "Obsolescent feature: Shared DO termination" } N10=2**NUN N20=2**NDE NDIF=(N10-N20) diff --git a/gcc/testsuite/gfortran.dg/g77/20020307-1.f b/gcc/testsuite/gfortran.dg/g77/20020307-1.f index 730c14d..7358543 100644 --- a/gcc/testsuite/gfortran.dg/g77/20020307-1.f +++ b/gcc/testsuite/gfortran.dg/g77/20020307-1.f @@ -6,7 +6,7 @@ c { dg-do compile } DIMENSION BNORM(MAXVEC),BINV(MAXVEC),WT(MAXVEC),W0(MAXVEC) DIMENSION C1(MAXVEC),C2(MAXVEC),R1(MAXVEC),R2(MAXVEC) DO 200 ILAT=1,2**IDIM - DO 200 I1=1,IDIM + DO 200 I1=1,IDIM ! { dg-warning "Obsolescent feature: Shared DO termination" } DO 220 I2=1,IDIM CALL INTACT(ILAT,I1,I1,W1) 220 CONTINUE diff --git a/gcc/testsuite/gfortran.dg/g77/980310-3.f b/gcc/testsuite/gfortran.dg/g77/980310-3.f index 5656023..098e22c 100644 --- a/gcc/testsuite/gfortran.dg/g77/980310-3.f +++ b/gcc/testsuite/gfortran.dg/g77/980310-3.f @@ -128,7 +128,7 @@ c compute right side vector in resulting linear equations c basl = dlog10(2.0d0) do 240 i = low,igh - do 240 j = low,igh + do 240 j = low,igh ! { dg-warning "Obsolescent feature: Shared DO termination" } tb = b(i,j) ta = a(i,j) if (ta .eq. 0.0d0) go to 220 @@ -242,7 +242,7 @@ c ir = wk(i,1) fi = 2.0d0**ir if (i .lt. low) fi = 1.0d0 - do 400 j =low,n + do 400 j =low,n ! { dg-warning "Obsolescent feature: Shared DO termination" } jc = cscale(j) fj = 2.0d0**jc if (j .le. igh) go to 390 diff --git a/gcc/testsuite/gfortran.dg/pr37243.f b/gcc/testsuite/gfortran.dg/pr37243.f index 0a606ad..f5dda43 100644 --- a/gcc/testsuite/gfortran.dg/pr37243.f +++ b/gcc/testsuite/gfortran.dg/pr37243.f @@ -13,10 +13,10 @@ DO 160 I = 1,M DUMI = ZERO DO 100 K = 1,N - 100 DUMI = DUMI+V(K,I)*V(K,I) + 100 DUMI = DUMI+V(K,I)*V(K,I) ! { dg-warning "Obsolescent feature: DO termination statement which is not END DO or CONTINUE" } DUMI = ONE/ SQRT(DUMI) DO 120 K = 1,N - 120 V(K,I) = V(K,I)*DUMI + 120 V(K,I) = V(K,I)*DUMI ! { dg-warning "Obsolescent feature: DO termination statement which is not END DO or CONTINUE" } IF (I .EQ. M) GO TO 160 I1 = I+1 DO 140 J = I1,M @@ -34,15 +34,15 @@ 220 J = J+1 IF (J .GT. N) GO TO 320 DO 240 K = 1,N - 240 V(K,I) = ZERO + 240 V(K,I) = ZERO ! { dg-warning "Obsolescent feature: DO termination statement which is not END DO or CONTINUE" } CALL DAXPY(N,DUM,V(1,I),1,V(1,I),1) 260 CONTINUE DUMI = ZERO DO 280 K = 1,N - 280 DUMI = DUMI+V(K,I)*V(K,I) + 280 DUMI = DUMI+V(K,I)*V(K,I) ! { dg-warning "Obsolescent feature: DO termination statement which is not END DO or CONTINUE" } IF ( ABS(DUMI) .LT. TOL) GO TO 220 DO 300 K = 1,N - 300 V(K,I) = V(K,I)*DUMI + 300 V(K,I) = V(K,I)*DUMI ! { dg-warning "Obsolescent feature: DO termination statement which is not END DO or CONTINUE" } GO TO 200 320 END program main