From: Tobias Burnus <burnus@net-b.de>
Date: Tue, 23 Sep 2008 08:00:01 +0000 (+0200)
Subject: re PR fortran/37580 (Accepts "pointer(:) => target" without lower bound)
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=54799fcd030107ce920b4522b67987a9128f8c78;p=platform%2Fupstream%2Fgcc.git

re PR fortran/37580 (Accepts "pointer(:) => target" without lower bound)

2008-09-22  Tobias Burnus  <burnus@net-b.de>

        PR fortran/37580
        * expr.c (gfc_check_pointer_assign): Add checks for pointer
        remapping.

2008-09-22  Tobias Burnus  <burnus@net-b.de>

        PR fortran/37580
        * gfortran.dg/pointer_assign_5.f90: New test.
        * gfortran.dg/pointer_assign_6.f90: New test.

From-SVN: r140580
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index afadaeb..5d1ad31 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2008-09-23  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/37580
+	* expr.c (gfc_check_pointer_assign): Add checks for pointer
+	remapping.
+
 2008-09-22  Jerry DeLisle  <jvdelisle@gcc.gnu.org
 
 	PR fortran/37498
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index ba4be56..e15412a 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -2955,6 +2955,32 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
 
       if (ref->type == REF_COMPONENT && ref->u.c.component->attr.pointer)
 	pointer = 1;
+
+      if (ref->type == REF_ARRAY && ref->next == NULL)
+	{
+	  if (ref->u.ar.type == AR_FULL)
+	    break;
+
+	  if (ref->u.ar.type != AR_SECTION)
+	    {
+	      gfc_error ("Expected bounds specification for '%s' at %L",
+			 lvalue->symtree->n.sym->name, &lvalue->where);
+	      return FAILURE;
+	    }
+
+	  if (gfc_notify_std (GFC_STD_F2003,"Fortran 2003: Bounds "
+			      "specification for '%s' in pointer assignment "
+                              "at %L", lvalue->symtree->n.sym->name,
+			      &lvalue->where) == FAILURE)
+            return FAILURE;
+
+	  gfc_error ("Pointer bounds remapping at %L is not yet implemented "
+		     "in gfortran", &lvalue->where);
+	  /* TODO: See PR 29785. Add checks that all lbounds are specified and
+	     either never or always the upper-bound; strides shall not be
+	     present.  */
+	  return FAILURE;
+	}
     }
 
   if (check_intent_in && lvalue->symtree->n.sym->attr.intent == INTENT_IN)
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 7522131..4995cea 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2008-09-23  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/37580
+	* gfortran.dg/pointer_assign_5.f90: New test.
+	* gfortran.dg/pointer_assign_6.f90: New test.
+
 2008-09-22  David Daney  <ddaney@avtrex.com>
 
 	PR target/37593
diff --git a/gcc/testsuite/gfortran.dg/pointer_assign_5.f90 b/gcc/testsuite/gfortran.dg/pointer_assign_5.f90
new file mode 100644
index 0000000..03562ca
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_assign_5.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! PR fortran/37580
+!
+program test
+implicit none
+real, pointer :: ptr1(:), ptr2(:)
+ptr1(1) => ptr2 ! { dg-error "Expected bounds specification" }
+ptr1(1:) => ptr2 ! { dg-error "not yet implemented in gfortran" }
+end program test
diff --git a/gcc/testsuite/gfortran.dg/pointer_assign_6.f90 b/gcc/testsuite/gfortran.dg/pointer_assign_6.f90
new file mode 100644
index 0000000..0b4d8f5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_assign_6.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+! PR fortran/37580
+!
+program test
+implicit none
+real, pointer :: ptr1(:), ptr2(:)
+ptr1(1:) => ptr2 ! { dg-error "Fortran 2003: Bounds specification" }
+end program test