From: burnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Sun, 23 Dec 2007 18:17:08 +0000 (+0000)
Subject: 2007-12-23  Tobias Burnus  <burnus@net-b.de>
X-Git-Tag: upstream/4.9.2~44401
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=407c9b8065621fef4502342c7ccf774271f9feb6;p=platform%2Fupstream%2Flinaro-gcc.git

2007-12-23  Tobias Burnus  <burnus@net-b.de>

        PR fortran/34421
        * resolve.c (resolve_entries): Add standard error for functions
        returning characters with different length.

2007-12-23  Tobias Burnus  <burnus@net-b.de>

        PR fortran/34421
        * gfortran.dg/entry_17.f90: New.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@131150 138bc75d-0d04-0410-961f-82ee72b054a4
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 6e99243..9db44b2 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2007-12-23  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34421
+	* resolve.c (resolve_entries): Add standard error for functions
+	returning characters with different length.
+
 2007-12-23  Daniel Franke  <franke.daniel@gmail.com>
 
 	PR fortran/34536 
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 6289d5d..8fc679d 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -488,11 +488,28 @@ resolve_entries (gfc_namespace *ns)
 	      || (el->sym->result->attr.pointer
 		  != ns->entries->sym->result->attr.pointer))
 	    break;
-
 	  else if (as && fas && gfc_compare_array_spec (as, fas) == 0)
-	    gfc_error ("Procedure %s at %L has entries with mismatched "
+	    gfc_error ("Function %s at %L has entries with mismatched "
 		       "array specifications", ns->entries->sym->name,
 		       &ns->entries->sym->declared_at);
+	  /* The characteristics need to match and thus both need to have
+	     the same string length, i.e. both len=*, or both len=4.
+	     Having both len=<variable> is also possible, but difficult to
+	     check at compile time.  */
+	  else if (ts->type == BT_CHARACTER && ts->cl && fts->cl
+		   && (((ts->cl->length && !fts->cl->length)
+			||(!ts->cl->length && fts->cl->length))
+		       || (ts->cl->length
+			   && ts->cl->length->expr_type
+			      != fts->cl->length->expr_type)
+		       || (ts->cl->length
+			   && ts->cl->length->expr_type == EXPR_CONSTANT
+		           && mpz_cmp (ts->cl->length->value.integer,
+				       fts->cl->length->value.integer) != 0)))
+	    gfc_notify_std (GFC_STD_GNU, "Extension: Function %s at %L with "
+			    "entries returning variables of different "
+			    "string lengths", ns->entries->sym->name,
+			    &ns->entries->sym->declared_at);
 	}
 
       if (el == NULL)
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 4b540f0..9f5aa26 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2007-12-23  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34421
+	* gfortran.dg/entry_17.f90: New.
+
 2007-12-23  Daniel Franke  <franke.daniel@gmail.com>
 
 	PR fortran/34536
diff --git a/gcc/testsuite/gfortran.dg/entry_17.f90 b/gcc/testsuite/gfortran.dg/entry_17.f90
new file mode 100644
index 0000000..d466266
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/entry_17.f90
@@ -0,0 +1,55 @@
+function test1(n)
+  integer  :: n
+  character(n) :: test1
+  character(n) :: bar1
+  test1 = ""
+  return
+entry bar1()
+  bar1 = ""
+end function test1
+
+function test2()
+  character(1) :: test2
+  character(1) :: bar2
+  test2 = ""
+  return
+entry bar2()
+  bar2 = ""
+end function test2
+
+function test3() ! { dg-warning "is obsolescent" }
+  character(*) :: test3
+  character(*) :: bar3 ! { dg-warning "is obsolescent" }
+  test3 = ""
+  return
+entry bar3()
+  bar3 = ""
+end function test3 ! { dg-warning "is obsolescent" }
+
+function test4(n) ! { dg-error "returning variables of different string lengths" }
+  integer  :: n
+  character(n) :: test4
+  character(*) :: bar4 ! { dg-warning "is obsolescent" }
+  test4 = ""
+  return
+entry bar4()
+  bar4 = ""
+end function test4
+
+function test5() ! { dg-error "returning variables of different string lengths" }
+  character(1) :: test5
+  character(2) :: bar5
+  test5 = ""
+  return
+entry bar5()
+  bar5 = ""
+end function test5
+
+function test6() ! { dg-warning "is obsolescent|returning variables of different string lengths" }
+  character(*) :: test6
+  character(2) :: bar6
+  test6 = ""
+  return
+entry bar6()
+  bar6 = ""
+end function test6 ! { dg-warning "is obsolescent" }