aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/fortran/ChangeLog15
-rw-r--r--gcc/fortran/dump-parse-tree.c3
-rw-r--r--gcc/fortran/expr.c1
-rw-r--r--gcc/fortran/gfortran.h2
-rw-r--r--gcc/fortran/match.c1
-rw-r--r--gcc/fortran/matchexp.c28
-rw-r--r--gcc/fortran/module.c1
-rw-r--r--gcc/fortran/resolve.c5
-rw-r--r--gcc/fortran/trans-expr.c1
-rw-r--r--gcc/testsuite/ChangeLog8
-rw-r--r--gcc/testsuite/gfortran.dg/parens_1.f908
-rw-r--r--gcc/testsuite/gfortran.dg/parens_2.f9011
-rw-r--r--gcc/testsuite/gfortran.dg/parens_3.f9048
13 files changed, 129 insertions, 3 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ae80278..d175cc4 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,18 @@
+2006-02-09 Tobias Schlü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
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index ef5c88a..6e2f55f 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 92a7dc0..c72281c 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 31d5a4e..46141b6 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 f726224..a78cd02 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 a306c95..e4bf44e 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 8f1ab73..8af0c6d 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 3e1c005..f8234bf 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 2529fb7..d64dabe 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 bd7b36f..bf3e0b8 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/parens_1.f90 b/gcc/testsuite/gfortran.dg/parens_1.f90
new file mode 100644
index 0000000..91ced3b
--- /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 0000000..bc2acd8
--- /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 0000000..47bb75e
--- /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
generated by cgit v1.1 at 2024-10-04 04:11:09 +0000