|| (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)
--- /dev/null
+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" }