From: Tobias Schlüter Date: Fri, 10 Feb 2006 00:10:47 +0000 (+0100) Subject: re PR fortran/14771 (frontend doesn't record parentheses) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=2414e1d655249938cc53becd63d8fb95db65bbfe;p=gcc.git re PR fortran/14771 (frontend doesn't record parentheses) fortran/ 2006-02-09 Tobias Schlueter PR fortran/14771 * gfortran.h (gfc_intrinsic_op): Add INTRINSIC_PARENTHESES. * dump-parse-tree (gfc_show_expr): Handle INTRINSIC_PARENTHESES. * expr.c (simplify_intrinsic_op): Treat INTRINSIC_PARENTHESES as if it were INTRINSIC_UPLUS. * resolve.c (resolve_operator): Handle INTRINSIC_PARENTHESES. * match.c (intrinsic_operators): Add INTRINSIC_PARENTHESES. * matchexp.c (match_primary): Record parentheses surrounding numeric expressions. * module.c (intrinsics): Add INTRINSIC_PARENTHESES for module dumping. * trans-expr.c (gfc_conv_expr_op): Handle INTRINSIC_PARENTHESES. testsuite/ 2006-02-09 Tobias Schlueter Paul Thomas PR fortran/14771 * gfortran.dg/parens_1.f90: New. * gfortran.dg/parens_2.f90: New. * gfortran.dg/parens_3.f90: New. From-SVN: r110819 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ae80278d962..d175cc4ad33 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,18 @@ +2006-02-09 Tobias Schlüter + + PR fortran/14771 + * gfortran.h (gfc_intrinsic_op): Add INTRINSIC_PARENTHESES. + * dump-parse-tree (gfc_show_expr): Handle INTRINSIC_PARENTHESES. + * expr.c (simplify_intrinsic_op): Treat INTRINSIC_PARENTHESES as + if it were INTRINSIC_UPLUS. + * resolve.c (resolve_operator): Handle INTRINSIC_PARENTHESES. + * match.c (intrinsic_operators): Add INTRINSIC_PARENTHESES. + * matchexp.c (match_primary): Record parentheses surrounding + numeric expressions. + * module.c (intrinsics): Add INTRINSIC_PARENTHESES for module + dumping. + * trans-expr.c (gfc_conv_expr_op): Handle INTRINSIC_PARENTHESES. + 2006-02-09 Paul Thomas PR fortran/26038 diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index ef5c88a94b4..6e2f55f5d7f 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -478,6 +478,9 @@ gfc_show_expr (gfc_expr * p) case INTRINSIC_NOT: gfc_status ("NOT "); break; + case INTRINSIC_PARENTHESES: + gfc_status ("parens"); + break; default: gfc_internal_error diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 92a7dc02792..c72281c6758 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -782,6 +782,7 @@ simplify_intrinsic_op (gfc_expr * p, int type) switch (p->value.op.operator) { case INTRINSIC_UPLUS: + case INTRINSIC_PARENTHESES: result = gfc_uplus (op1); break; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 31d5a4eca0e..46141b6184a 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -182,7 +182,7 @@ typedef enum INTRINSIC_AND, INTRINSIC_OR, INTRINSIC_EQV, INTRINSIC_NEQV, INTRINSIC_EQ, INTRINSIC_NE, INTRINSIC_GT, INTRINSIC_GE, INTRINSIC_LT, INTRINSIC_LE, INTRINSIC_NOT, INTRINSIC_USER, - INTRINSIC_ASSIGN, + INTRINSIC_ASSIGN, INTRINSIC_PARENTHESES, GFC_INTRINSIC_END /* Sentinel */ } gfc_intrinsic_op; diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index f726224a74b..a78cd028ea4 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -58,6 +58,7 @@ mstring intrinsic_operators[] = { minit (".gt.", INTRINSIC_GT), minit (">", INTRINSIC_GT), minit (".not.", INTRINSIC_NOT), + minit ("parens", INTRINSIC_PARENTHESES), minit (NULL, INTRINSIC_NONE) }; diff --git a/gcc/fortran/matchexp.c b/gcc/fortran/matchexp.c index a306c953653..e4bf44e4b61 100644 --- a/gcc/fortran/matchexp.c +++ b/gcc/fortran/matchexp.c @@ -128,6 +128,8 @@ static match match_primary (gfc_expr ** result) { match m; + gfc_expr *e; + locus where; m = gfc_match_literal_constant (result, 0); if (m != MATCH_NO) @@ -141,11 +143,13 @@ match_primary (gfc_expr ** result) if (m != MATCH_NO) return m; - /* Match an expression in parenthesis. */ + /* Match an expression in parentheses. */ + where = gfc_current_locus; + if (gfc_match_char ('(') != MATCH_YES) return MATCH_NO; - m = gfc_match_expr (result); + m = gfc_match_expr (&e); if (m == MATCH_NO) goto syntax; if (m == MATCH_ERROR) @@ -155,6 +159,26 @@ match_primary (gfc_expr ** result) if (m == MATCH_NO) gfc_error ("Expected a right parenthesis in expression at %C"); + /* Now we have the expression inside the parentheses, build the + expression pointing to it. By 7.1.7.2 the integrity of + parentheses is only conserved in numerical calculations, so we + don't bother to keep the parentheses otherwise. */ + if(!gfc_numeric_ts(&e->ts)) + *result = e; + else + { + gfc_expr *e2 = gfc_get_expr(); + + e2->expr_type = EXPR_OP; + e2->ts = e->ts; + e2->rank = e->rank; + e2->where = where; + e2->value.op.operator = INTRINSIC_PARENTHESES; + e2->value.op.op1 = e; + e2->value.op.op2 = NULL; + *result = e2; + } + if (m != MATCH_YES) { gfc_free_expr (*result); diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 8f1ab7301f4..8af0c6d964f 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -2455,6 +2455,7 @@ static const mstring intrinsics[] = minit ("LT", INTRINSIC_LT), minit ("LE", INTRINSIC_LE), minit ("NOT", INTRINSIC_NOT), + minit ("PARENTHESES", INTRINSIC_PARENTHESES), minit (NULL, -1) }; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 3e1c005f4e6..f8234bf4bc9 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1692,6 +1692,7 @@ resolve_operator (gfc_expr * e) case INTRINSIC_NOT: case INTRINSIC_UPLUS: case INTRINSIC_UMINUS: + case INTRINSIC_PARENTHESES: if (gfc_resolve_expr (e->value.op.op1) == FAILURE) return FAILURE; break; @@ -1835,6 +1836,9 @@ resolve_operator (gfc_expr * e) goto bad_op; + case INTRINSIC_PARENTHESES: + break; + default: gfc_internal_error ("resolve_operator(): Bad intrinsic"); } @@ -1911,6 +1915,7 @@ resolve_operator (gfc_expr * e) case INTRINSIC_NOT: case INTRINSIC_UPLUS: case INTRINSIC_UMINUS: + case INTRINSIC_PARENTHESES: e->rank = op1->rank; if (e->shape == NULL) diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 2529fb7c6d2..d64dabe491f 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -925,6 +925,7 @@ gfc_conv_expr_op (gfc_se * se, gfc_expr * expr) switch (expr->value.op.operator) { case INTRINSIC_UPLUS: + case INTRINSIC_PARENTHESES: gfc_conv_expr (se, expr->value.op.op1); return; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index bd7b36f0fd9..bf3e0b817e3 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2006-02-09 Tobias Schlüter + Paul Thomas + + PR fortran/14771 + * gfortran.dg/parens_1.f90: New. + * gfortran.dg/parens_2.f90: New. + * gfortran.dg/parens_3.f90: New. + 2006-02-09 Paul Thomas PR fortran/26038 diff --git a/gcc/testsuite/gfortran.dg/parens_1.f90 b/gcc/testsuite/gfortran.dg/parens_1.f90 new file mode 100644 index 00000000000..91ced3b6da0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/parens_1.f90 @@ -0,0 +1,8 @@ +! PR 20894 +! { dg-do compile } +! Originally contributed by Joost VandeVondele +INTEGER, POINTER :: I,J +INTEGER :: K +ALLOCATE(I) +J=>(I) ! { dg-error "Pointer assignment target is neither TARGET nor POINTER" } +END diff --git a/gcc/testsuite/gfortran.dg/parens_2.f90 b/gcc/testsuite/gfortran.dg/parens_2.f90 new file mode 100644 index 00000000000..bc2acd8e71d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/parens_2.f90 @@ -0,0 +1,11 @@ +! PR 25048 +! { dg-do compile } +! Originally contributed by Joost VandeVondele +INTEGER, POINTER :: I +CALL S1((I)) ! { dg-error "Actual argument for .i. must be a pointer" } +CONTAINS + SUBROUTINE S1(I) + INTEGER, POINTER ::I + END SUBROUTINE S1 +END + diff --git a/gcc/testsuite/gfortran.dg/parens_3.f90 b/gcc/testsuite/gfortran.dg/parens_3.f90 new file mode 100644 index 00000000000..47bb75e401d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/parens_3.f90 @@ -0,0 +1,48 @@ +! PR 14771 +! { dg-do run } +! Originally contributed by Walt Brainerd, modified for the testsuite + PROGRAM fc107 + +! Submitted by Walt Brainerd, The Fortran Company +! GNU Fortran 95 (GCC 4.1.0 20050322 (experimental)) +! Windows XP + +! Return value should be 3 + + INTEGER I, J, M(2), N(2) + integer, pointer :: k + integer, target :: l + INTEGER TRYME + + interface + FUNCTION TRYyou(RTNME,HITME) + INTEGER RTNME(2),HITME(2), tryyou(2) + END function tryyou + end interface + + m = 7 + l = 5 + I = 3 + k => l + + j = tryme((i),i) + if (j .ne. 3) call abort () + + j = tryme((k),k) + if (j .ne. 5) call abort () + + n = tryyou((m),m) + if (any(n .ne. 7)) call abort () + END + + INTEGER FUNCTION TRYME(RTNME,HITME) + INTEGER RTNME,HITME + HITME = 999 + TRYME = RTNME + END + + FUNCTION TRYyou(RTNME,HITME) + INTEGER RTNME(2),HITME(2), tryyou(2) + HITME = 999 + TRYyou = RTNME + END