re PR fortran/14771 (frontend doesn't record parentheses)

fortran/
2006-02-09  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>

        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  <tobias.schlueter@physik.uni-muenchen.de>
        Paul Thomas  <pault@gcc.gnu.org>

        PR fortran/14771
        * gfortran.dg/parens_1.f90: New.
        * gfortran.dg/parens_2.f90: New.
        * gfortran.dg/parens_3.f90: New.

From-SVN: r110819
This commit is contained in:
Tobias Schlüter 2006-02-10 01:10:47 +01:00
parent a286e145de
commit 2414e1d655
13 changed files with 129 additions and 3 deletions

View File

@ -1,3 +1,18 @@
2006-02-09 Tobias Schl<68>üter <tobias.schlueter@physik.uni-muenchen.de>
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 <pault@gcc.gnu.org>
PR fortran/26038

View File

@ -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

View File

@ -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;

View File

@ -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;

View File

@ -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)
};

View File

@ -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);

View File

@ -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)
};

View File

@ -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)

View File

@ -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;

View File

@ -1,3 +1,11 @@
2006-02-09 Tobias Schlüter <tobias.schlueter@physik.uni-muenchen.de>
Paul Thomas <pault@gcc.gnu.org>
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 <pault@gcc.gnu.org>
PR fortran/26038

View File

@ -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

View File

@ -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

View File

@ -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