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

gcc/fortran/ChangeLog

+2006-02-09  Tobias Schlter  <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

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

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;
 

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;

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

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

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

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)

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;
 

gcc/testsuite/ChangeLog

+2006-02-09  Tobias Schlter  <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

gcc/testsuite/gfortran.dg/parens_1.f90

+! 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

gcc/testsuite/gfortran.dg/parens_2.f90

+! 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
+

gcc/testsuite/gfortran.dg/parens_3.f90

+! 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