re PR fortran/27122 (binary operator functions should require intent(in))

2006-04-21 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/27122
	* resolve.c (resolve_function): Remove general restriction on auto
	character length function interfaces.
	(gfc_resolve_uops): Check restrictions on defined operator
	procedures.
	(resolve_types): Call the check for defined operators.

	PR fortran/27113
	* trans-array.c (gfc_trans_array_constructor_subarray): Remove
	redundant gfc_todo_error.
	(get_array_ctor_var_strlen): Remove typo in enum.

2006-04-21 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/27122
	* gfortran.dg/defined_operators_1.f90: New test.
	* gfortran.dg/assumed_charlen_function_1.f90: Add new error and
	remove old ones associated, incorrectly, with Note 5.46.

	PR fortran/27113
	* gfortran.dg/character_array_constructor_1.f90: New test.

From-SVN: r113133

gcc/fortran/ChangeLog

@@ -1,3 +1,17 @@
+2006-04-21 Paul Thomas <pault@gcc.gnu.org>
+
+	PR fortran/27122
+	* resolve.c (resolve_function): Remove general restriction on auto
+	character length function interfaces.
+	(gfc_resolve_uops): Check restrictions on defined operator
+	procedures.
+	(resolve_types): Call the check for defined operators.
+
+	PR fortran/27113
+	* trans-array.c (gfc_trans_array_constructor_subarray): Remove
+	redundant gfc_todo_error.
+	(get_array_ctor_var_strlen): Remove typo in enum.
+
 2006-04-18  Bernhard Fischer  <aldot@gcc.gnu.org>
 
 	* parse.c (next_free): Use consistent error string between

gcc/fortran/resolve.c

@@ -1237,28 +1237,16 @@ resolve_function (gfc_expr * expr)
   need_full_assumed_size--;
 
   if (sym && sym->ts.type == BT_CHARACTER
-	  && sym->ts.cl && sym->ts.cl->length == NULL)
+	&& sym->ts.cl
+	&& sym->ts.cl->length == NULL
+	&& !sym->attr.dummy
+	&& !sym->attr.contained)
     {
-      if (sym->attr.if_source == IFSRC_IFBODY)
-	{
-	  /* This follows from a slightly odd requirement at 5.1.1.5 in the
-	     standard that allows assumed character length functions to be
-	     declared in interfaces but not used.  Picking up the symbol here,
-	     rather than resolve_symbol, accomplishes that.  */
-	  gfc_error ("Function '%s' can be declared in an interface to "
-		     "return CHARACTER(*) but cannot be used at %L",
-		     sym->name, &expr->where);
-	  return FAILURE;
-	}
-
       /* Internal procedures are taken care of in resolve_contained_fntype.  */
-      if (!sym->attr.dummy && !sym->attr.contained)
-	{
-	  gfc_error ("Function '%s' is declared CHARACTER(*) and cannot "
-		     "be used at %L since it is not a dummy argument",
-		     sym->name, &expr->where);
-	  return FAILURE;
-	}
+      gfc_error ("Function '%s' is declared CHARACTER(*) and cannot "
+		 "be used at %L since it is not a dummy argument",
+		 sym->name, &expr->where);
+      return FAILURE;
     }
 
 /* See if function is already resolved.  */
@@ -6105,6 +6093,68 @@ resolve_fntype (gfc_namespace * ns)
       }
 }
 
+/* 12.3.2.1.1 Defined operators.  */
+
+static void
+gfc_resolve_uops(gfc_symtree *symtree)
+{
+  gfc_interface *itr;
+  gfc_symbol *sym;
+  gfc_formal_arglist *formal;
+
+  if (symtree == NULL) 
+    return; 
+ 
+  gfc_resolve_uops (symtree->left);
+  gfc_resolve_uops (symtree->right);
+
+  for (itr = symtree->n.uop->operator; itr; itr = itr->next)
+    {
+      sym = itr->sym;
+      if (!sym->attr.function)
+	gfc_error("User operator procedure '%s' at %L must be a FUNCTION",
+		  sym->name, &sym->declared_at);
+
+      if (sym->ts.type == BT_CHARACTER
+	    && !(sym->ts.cl && sym->ts.cl->length)
+	    && !(sym->result && sym->result->ts.cl && sym->result->ts.cl->length))
+	gfc_error("User operator procedure '%s' at %L cannot be assumed character "
+		  "length", sym->name, &sym->declared_at);
+
+      formal = sym->formal;
+      if (!formal || !formal->sym)
+	{
+	  gfc_error("User operator procedure '%s' at %L must have at least "
+		    "one argument", sym->name, &sym->declared_at);
+	  continue;
+	}
+
+      if (formal->sym->attr.intent != INTENT_IN)
+	gfc_error ("First argument of operator interface at %L must be "
+		   "INTENT(IN)", &sym->declared_at);
+
+      if (formal->sym->attr.optional)
+	gfc_error ("First argument of operator interface at %L cannot be "
+		   "optional", &sym->declared_at);
+
+      formal = formal->next;
+      if (!formal || !formal->sym)
+	continue;
+
+      if (formal->sym->attr.intent != INTENT_IN)
+	gfc_error ("Second argument of operator interface at %L must be "
+		   "INTENT(IN)", &sym->declared_at);
+
+      if (formal->sym->attr.optional)
+	gfc_error ("Second argument of operator interface at %L cannot be "
+		   "optional", &sym->declared_at);
+
+      if (formal->next)
+	gfc_error ("Operator interface at %L must have, at most, two "
+		   "arguments", &sym->declared_at);
+    }
+}
+
 
 /* Examine all of the expressions associated with a program unit,
    assign types to all intermediate expressions, make sure that all
@@ -6164,6 +6214,9 @@ resolve_types (gfc_namespace * ns)
   /* Warn about unused labels.  */
   if (gfc_option.warn_unused_labels)
     warn_unused_label (ns->st_labels);
+
+  gfc_resolve_uops (ns->uop_root);
+    
 }
 
 

gcc/fortran/trans-array.c

@@ -1035,9 +1035,6 @@ gfc_trans_array_constructor_subarray (stmtblock_t * pblock,
   gfc_copy_loopinfo_to_se (&se, &loop);
   se.ss = ss;
 
-  if (expr->ts.type == BT_CHARACTER)
-    gfc_todo_error ("character arrays in constructors");
-
   gfc_trans_array_ctor_element (&body, desc, *poffset, &se, expr);
   gcc_assert (se.ss == gfc_ss_terminator);
 
@@ -1311,7 +1308,7 @@ get_array_ctor_var_strlen (gfc_expr * expr, tree * len)
 	  /* Array references don't change the string length.  */
 	  break;
 
-	case COMPONENT_REF:
+	case REF_COMPONENT:
 	  /* Use the length of the component.  */
 	  ts = &ref->u.c.component->ts;
 	  break;

gcc/testsuite/ChangeLog

@@ -1,3 +1,13 @@
+2006-04-21 Paul Thomas <pault@gcc.gnu.org>
+
+	PR fortran/27122
+	* gfortran.dg/defined_operators_1.f90: New test.
+	* gfortran.dg/assumed_charlen_function_1.f90: Add new error and
+	remove old ones associated, incorrectly, with Note 5.46.
+
+	PR fortran/27113
+	* gfortran.dg/character_array_constructor_1.f90: New test.
+
 2006-04-20  Jakub Jelinek  <jakub@redhat.com>
 
 	* gcc.dg/20060419-1.c: New test.

gcc/testsuite/gfortran.dg/assumed_charlen_function_1.f90

@@ -17,7 +17,7 @@ END MODULE M1
 
 MODULE  INTEGER_SETS
  INTERFACE  OPERATOR  (.IN.)
-  FUNCTION ELEMENT(X,A)
+  FUNCTION ELEMENT(X,A) ! { dg-error "cannot be assumed character length" }
      USE M1
      CHARACTER(LEN=*)      :: ELEMENT
      INTEGER, INTENT(IN)   ::  X
@@ -59,7 +59,6 @@ function not_OK (ch)
   not_OK = ch
 end function not_OK
 
-  use INTEGER_SETS
   use m1
 
   character(4) :: answer
@@ -74,11 +73,8 @@ end function not_OK
     end function ext
   end interface
 
-  answer = i.IN.z   ! { dg-error "cannot be used|Operands of user operator" }
-  answer = ext (2)  ! { dg-error "but cannot be used" }
-
   answer = not_OK ("unOK") ! { dg-error "since it is not a dummy" }
 
 END
 
-! { dg-final { cleanup-modules "M1 INTEGER_SETS" } }
+! { dg-final { cleanup-modules "M1" } }

gcc/testsuite/gfortran.dg/character_array_constructor_1.f90

@@ -0,0 +1,47 @@
+! { dg-do run }
+! Tests the fix for PR27113, in which character structure
+! components would produce the TODO compilation error "complex
+! character array constructors".
+!
+! Test based on part of tonto-2.2;
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+  type BASIS_TYPE
+    character(len=8) :: label
+  end type
+
+  type(BASIS_TYPE), dimension(:), pointer :: ptr
+  character(8), dimension(2) :: carray
+
+  allocate (ptr(2))
+  ptr(1)%label = "Label 1"
+  ptr(2)%label = "Label 2"
+
+! This is the original bug
+  call read_library_data_((/ptr%label/))
+
+  carray(1) = "Label 3"
+  carray(2) = "Label 4"
+
+! Mix a character array with the character component of a derived type pointer array.
+  call read_library_data_((/carray, ptr%label/))
+
+! Finally, add a constant (character(8)).
+  call read_library_data_((/carray, ptr%label, "Label 5 "/))
+
+contains
+
+  subroutine read_library_data_ (chr)
+    character(*), dimension(:) :: chr
+    character(len = len(chr)) :: tmp
+    if (size(chr,1) == 2) then
+      if (any (chr .ne. (/"Label 1", "Label 2"/))) call abort ()
+    elseif (size(chr,1) == 4) then
+      if (any (chr .ne. (/"Label 3", "Label 4","Label 1", "Label 2"/))) call abort ()
+    elseif (size(chr,1) == 5) then
+      if (any (chr .ne. (/"Label 3", "Label 4","Label 1", "Label 2", "Label 5"/))) &
+          call abort ()
+    end if
+  end subroutine read_library_data_
+
+end

gcc/testsuite/gfortran.dg/defined_operators_1.f90

@@ -0,0 +1,56 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+! Tests the fix for PR27122, in which the requirements of 12.3.2.1.1
+! for defined operators were not enforced.
+! 
+! Based on PR test by Thomas Koenig  <tkoenig@gcc.gnu.org>
+!
+module mymod
+  interface operator (.foo.)
+     module procedure foo_0 ! { dg-error "must have at least one argument" }
+     module procedure foo_1 ! { dg-error "must be INTENT" }
+     module procedure foo_2 ! { dg-error "cannot be optional" }
+     module procedure foo_3 ! { dg-error "must have, at most, two arguments" }
+     module procedure foo_1_OK
+     module procedure foo_2_OK
+     function foo_chr (chr) ! { dg-error "cannot be assumed character length" }
+       character(*) :: foo_chr
+       character(*), intent(in) :: chr
+     end function foo_chr
+     subroutine bad_foo (chr) ! { dg-error "must be a FUNCTION" }
+       character(*), intent(in) :: chr
+     end subroutine bad_foo
+  end interface
+contains
+  function foo_0 ()
+    integer :: foo_1
+    foo_0 = 1
+  end function foo_0
+  function foo_1 (a)
+    integer :: foo_1
+    integer :: a
+    foo_1 = 1
+  end function foo_1
+  function foo_1_OK (a)
+    integer :: foo_1_OK
+    integer, intent (in) :: a
+    foo_1_OK = 1
+  end function foo_1_OK
+  function foo_2 (a, b)
+    integer :: foo_2
+    integer, intent(in) :: a
+    integer, intent(in), optional :: b
+    foo_2 = 2 * a + b
+  end function foo_2
+  function foo_2_OK (a, b)
+    real :: foo_2_OK
+    real, intent(in) :: a
+    real, intent(in) :: b
+    foo_2_OK = 2.0 * a + b
+  end function foo_2_OK
+  function foo_3 (a, b, c)
+    integer :: foo_3
+    integer, intent(in) :: a, b, c
+    foo_3 = a + 3 * b - c
+  end function foo_3
+end module mymod