public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
* [4.8, Fortran, Patch] PR 48820 - Support TYPE(*) of TS29113
@ 2012-03-02 11:28 Tobias Burnus
  2012-03-03  7:41 ` Paul Richard Thomas
  0 siblings, 1 reply; 6+ messages in thread
From: Tobias Burnus @ 2012-03-02 11:28 UTC (permalink / raw)
  To: gcc patches FOR, gfortran

[-- Attachment #1: Type: text/plain, Size: 2178 bytes --]

TYPE(*) is Fortran's equivalent to C's "void *buffer". It may only be 
used for dummy arguments and essentially might only either be passed on, 
or appear in PRESENT, LBOUND/UBOUND/SHAPE/SIZE/IS_CONTIGUOUS - and most 
useful: in C_LOC.


Note: For scalar TYPE(*) and for assumed-size dummies, only the address 
is passed on. But for dimension(:) and TS29113's new (but unimplemented) 
dimension(..) an array descriptor is passed. In that case, one might 
recover the type from the array descriptor - at least for intrinsic types.


TYPE(*) is useful for, e.g., MPI (and used in the MPI v3 draft spec): 
There, one simply takes an argument of any type and transfers some bytes 
from it - without needing to know the type. TYPE(*) avoids to create 
hundreds of useless explicit interfaces for all kind of data types (and 
missing derived types that way) - or TS29113 avoids the alternative: Not 
using explicit interfaces (causing argument checking issues and prevents 
the use of BIND(C).)


See PR (or first test case) for a usage example. For a pure Fortran use, 
one could imagine:

subroutine send(buf, size)
   use iso_c_binding, only: c_signed_char, c_size_t
   type(*) :: buf(*)
   integer(c_size_t) :: size
   integer(c_signed_char) :: ibuf(size)
   call c_f_pointer (c_loc(buf), ibuf, shape=[size])
   ! ... use ibuf ...
end

[This example currently fails as "c_loc(buf)" is rejected. Several 
BIND(C) restrictions were removed in F2008 and especially in TS29113, 
but gfortran has not yet removed them.]


For more details, see:

* TS 29113 draft: ftp://ftp.nag.co.uk/sc22wg5/N1901-N1950/N1904.pdf
(Status: Went as PDTR through one round of voting by the ISO members, 
was updated at the last J3 meeting and is now the subject of a one-month 
WG5 ballot that ends on 19 March 2012. The schedule is that it will then 
be forwarded to SC22, which initiates a DTS ballot such that the final 
version will be published in September by ISO.)

* MPIv3 draft (of 2011-12-15):
https://svn.mpi-forum.org/trac/mpi-forum-web/attachment/ticket/229/mpi-report-F2008-2011-12-15-changeonlyplustickets_majorpages.pdf

Build and regtested on x86-64-linux.
OK for the 4.8 trunk?

Tobias

[-- Attachment #2: assumed-type.diff --]
[-- Type: text/x-patch, Size: 24815 bytes --]

2012-03-02  Tobias Burnus  <burnus@net-b.de>

	PR fortran/48820
	* decl.c (gfc_match_decl_type_spec): Support type(*).
	(gfc_verify_c_interop): Allow type(*).
	* dump-parse-tree.c (show_typespec): Handle type(*).
	* expr.c (gfc_copy_expr): Ditto.
	* interface.c (compare_type_rank, compare_parameter,
	compare_actual_formal, gfc_procedure_use): Ditto.
	* libgfortran.h (bt): Add BT_ASSUMED.
	* misc.c (gfc_basic_typename, gfc_typename): Handle type(*).
	* module.c (bt_types): Ditto.
	* resolve.c (assumed_type_expr_allowed): New static variable.
	(resolve_actual_arglist, resolve_variable, resolve_symbol):
	Handle type(*). 
	* trans-expr.c (gfc_conv_procedure_call): Ditto.
	* trans-types.c (gfc_typenode_for_spec, gfc_get_dtype): Ditto.

2012-03-02  Tobias Burnus  <burnus@net-b.de>

	PR fortran/48820
	* gfortran.dg/assumed_type_1.f90: New.
	* gfortran.dg/assumed_type_2.f90: New.
	* gfortran.dg/assumed_type_3.f90: New.
	* gfortran.dg/assumed_type_4.f90: New.

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 43c558a..bdb8c39 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -2600,9 +2600,31 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag)
     }
 
 
-  m = gfc_match (" type ( %n", name);
+  m = gfc_match (" type (");
   matched_type = (m == MATCH_YES);
-  
+  if (matched_type)
+    {
+      gfc_gobble_whitespace ();
+      if (gfc_peek_ascii_char () == '*')
+	{
+	  if ((m = gfc_match ("*)")) != MATCH_YES)
+	    return m;
+	  if (gfc_current_state () == COMP_DERIVED)
+	    {
+	      gfc_error ("Assumed type at %C is not allowed for components");
+	      return MATCH_ERROR;
+	    }
+	  if (gfc_notify_std (GFC_STD_F2008_TS, "TS 29113: Assumed type "
+			  "at %C") == FAILURE)
+	    return MATCH_ERROR;
+	  ts->type = BT_ASSUMED;
+	  return MATCH_YES;
+	}
+
+      m = gfc_match ("%n", name);
+      matched_type = (m == MATCH_YES);
+    }
+
   if ((matched_type && strcmp ("integer", name) == 0)
       || (!matched_type && gfc_match (" integer") == MATCH_YES))
     {
@@ -3854,9 +3876,9 @@ gfc_verify_c_interop (gfc_typespec *ts)
 	   ? SUCCESS : FAILURE;
   else if (ts->type == BT_CLASS)
     return FAILURE;
-  else if (ts->is_c_interop != 1)
+  else if (ts->is_c_interop != 1 && ts->type != BT_ASSUMED)
     return FAILURE;
-  
+
   return SUCCESS;
 }
 
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index c715b30..7f1d28f 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -94,6 +94,12 @@ show_indent (void)
 static void
 show_typespec (gfc_typespec *ts)
 {
+  if (ts->type == BT_ASSUMED)
+    {
+      fputs ("(TYPE(*))", dumpfile);
+      return;
+    }
+
   fprintf (dumpfile, "(%s ", gfc_basic_typename (ts->type));
 
   switch (ts->type)
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 129ece3..1521318 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -336,6 +336,7 @@ gfc_copy_expr (gfc_expr *p)
 	case BT_LOGICAL:
 	case BT_DERIVED:
 	case BT_CLASS:
+	case BT_ASSUMED:
 	  break;		/* Already done.  */
 
 	case BT_PROCEDURE:
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index e1f0cb6..ada9ea1 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -514,7 +514,8 @@ compare_type_rank (gfc_symbol *s1, gfc_symbol *s2)
   if (r1 != r2)
     return 0;			/* Ranks differ.  */
 
-  return gfc_compare_types (&s1->ts, &s2->ts);
+  return gfc_compare_types (&s1->ts, &s2->ts)
+	 || s1->ts.type == BT_ASSUMED || s2->ts.type == BT_ASSUMED; 
 }
 
 
@@ -1695,6 +1696,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
 
   if ((actual->expr_type != EXPR_NULL || actual->ts.type != BT_UNKNOWN)
       && actual->ts.type != BT_HOLLERITH
+      && formal->ts.type != BT_ASSUMED
       && !gfc_compare_types (&formal->ts, &actual->ts)
       && !(formal->ts.type == BT_DERIVED && actual->ts.type == BT_CLASS
 	   && gfc_compare_derived_types (formal->ts.u.derived, 
@@ -2271,6 +2273,27 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 			      is_elemental, where))
 	return 0;
 
+      /* TS 29113, 6.3p2.  */
+      if (f->sym->ts.type == BT_ASSUMED
+	  && (a->expr->ts.type == BT_DERIVED
+	      || (a->expr->ts.type == BT_CLASS && CLASS_DATA (a->expr))))
+	{
+	  gfc_namespace *f2k_derived;
+
+	  f2k_derived = a->expr->ts.type == BT_DERIVED
+			? a->expr->ts.u.derived->f2k_derived
+			: CLASS_DATA (a->expr)->ts.u.derived->f2k_derived;
+
+	  if (f2k_derived
+	      && (f2k_derived->finalizers || f2k_derived->tb_sym_root))
+	    {
+	      gfc_error ("Actual argument at %L to assumed-type dummy is of "
+			 "derived type with type-bound or FINAL procedures",
+			 &a->expr->where);
+	      return FAILURE;
+	    }
+	}
+
       /* Special case for character arguments.  For allocatable, pointer
 	 and assumed-shape dummies, the string length needs to match
 	 exactly.  */
@@ -2882,7 +2905,6 @@ check_intents (gfc_formal_arglist *f, gfc_actual_arglist *a)
 void
 gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where)
 {
-
   /* Warn about calls with an implicit interface.  Special case
      for calling a ISO_C_BINDING becase c_loc and c_funloc
      are pseudo-unknown.  Additionally, warn about procedures not
@@ -2935,6 +2957,16 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where)
 	      break;
 	    }
 
+	  /* TS 29113, 6.2.  */
+	  if (a->expr && a->expr->ts.type == BT_ASSUMED
+	      && sym->intmod_sym_id != ISOCBINDING_LOC)
+	    {
+	      gfc_error ("Assumed-type argument %s at %L requires an explicit "
+			 "interface", a->expr->symtree->n.sym->name,
+			 &a->expr->where);
+	      break;
+	    }
+
 	  /* F2008, C1303 and C1304.  */
 	  if (a->expr
 	      && (a->expr->ts.type == BT_DERIVED || a->expr->ts.type == BT_CLASS)
diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h
index 3f36fe8..62afc21 100644
--- a/gcc/fortran/libgfortran.h
+++ b/gcc/fortran/libgfortran.h
@@ -129,6 +129,7 @@ libgfortran_stat_codes;
    used in the run-time library for IO.  */
 typedef enum
 { BT_UNKNOWN = 0, BT_INTEGER, BT_LOGICAL, BT_REAL, BT_COMPLEX,
-  BT_DERIVED, BT_CHARACTER, BT_CLASS, BT_PROCEDURE, BT_HOLLERITH, BT_VOID
+  BT_DERIVED, BT_CHARACTER, BT_CLASS, BT_PROCEDURE, BT_HOLLERITH, BT_VOID,
+  BT_ASSUMED
 }
 bt;
diff --git a/gcc/fortran/misc.c b/gcc/fortran/misc.c
index 05aef9f..012364a 100644
--- a/gcc/fortran/misc.c
+++ b/gcc/fortran/misc.c
@@ -107,6 +107,9 @@ gfc_basic_typename (bt type)
     case BT_UNKNOWN:
       p = "UNKNOWN";
       break;
+    case BT_ASSUMED:
+      p = "TYPE(*)";
+      break;
     default:
       gfc_internal_error ("gfc_basic_typename(): Undefined type");
     }
@@ -157,6 +160,9 @@ gfc_typename (gfc_typespec *ts)
       sprintf (buffer, "CLASS(%s)",
 	       ts->u.derived->components->ts.u.derived->name);
       break;
+    case BT_ASSUMED:
+      sprintf (buffer, "TYPE(*)");
+      break;
     case BT_PROCEDURE:
       strcpy (buffer, "PROCEDURE");
       break;
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 5e0f26e..36ef4f8 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -2244,6 +2244,7 @@ static const mstring bt_types[] = {
     minit ("PROCEDURE", BT_PROCEDURE),
     minit ("UNKNOWN", BT_UNKNOWN),
     minit ("VOID", BT_VOID),
+    minit ("ASSUMED", BT_ASSUMED),
     minit (NULL, -1)
 };
 
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 4dcf9b1..4104924 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -63,6 +63,8 @@ static code_stack *cs_base = NULL;
 static int forall_flag;
 static int do_concurrent_flag;
 
+static bool assumed_type_expr_allowed = false;
+
 /* Nonzero if we're inside a OpenMP WORKSHARE or PARALLEL WORKSHARE block.  */
 
 static int omp_workshare_flag;
@@ -1597,6 +1599,8 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype,
   gfc_expr *e;
   int save_need_full_assumed_size;
 
+  assumed_type_expr_allowed = true;
+
   for (; arg; arg = arg->next)
     {
       e = arg->expr;
@@ -1829,6 +1833,7 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype,
           return FAILURE;
         }
     }
+  assumed_type_expr_allowed = true;
 
   return SUCCESS;
 }
@@ -5057,6 +5062,24 @@ resolve_variable (gfc_expr *e)
     return FAILURE;
   sym = e->symtree->n.sym;
 
+  /* TS 29113, 407b.  */
+  if (e->ts.type == BT_ASSUMED && !assumed_type_expr_allowed)
+    {
+      gfc_error ("Invalid expression with assumed-type variable %s at %L",
+		 sym->name, &e->where);
+      return FAILURE;
+    }
+
+  /* TS 29113, 407b.  */
+  if (e->ts.type == BT_ASSUMED && e->ref
+      && !(e->ref->type == REF_ARRAY && e->ref->u.ar.type == AR_FULL
+           && e->ref->next == NULL))
+    {
+      gfc_error ("Assumed-type variable %s with designator at %L",
+                 sym->name, &e->ref->u.ar.where);
+      return FAILURE;
+    }
+
   /* If this is an associate-name, it may be parsed with an array reference
      in error even though the target is scalar.  Fail directly in this case.  */
   if (sym->assoc && !sym->attr.dimension && e->ref && e->ref->type == REF_ARRAY)
@@ -12435,6 +12459,31 @@ resolve_symbol (gfc_symbol *sym)
 	}
     }
 
+  if (sym->ts.type == BT_ASSUMED)
+    { 
+      /* TS 29113, C407a.  */
+      if (!sym->attr.dummy)
+	{
+	  gfc_error ("Assumed type of variable %s at %L is only permitted "
+		     "for dummy variables", sym->name, &sym->declared_at);
+	  return;
+	}
+      if (sym->attr.allocatable || sym->attr.codimension
+	  || sym->attr.pointer || sym->attr.value)
+    	{
+	  gfc_error ("Assumed-type variable %s at %L may not have the "
+		     "ALLOCATABLE, CODIMENSION, POINTER or VALUE attribute",
+		     sym->name, &sym->declared_at);
+	  return;
+	}
+      if (sym->attr.dimension && sym->as->type == AS_EXPLICIT)
+	{
+	  gfc_error ("Assumed-type variable %s at %L shall not be an "
+		     "explicit-shape array", sym->name, &sym->declared_at);
+	  return;
+	}
+    }
+
   /* If the symbol is marked as bind(c), verify it's type and kind.  Do not
      do this for something that was implicitly typed because that is handled
      in gfc_set_default_type.  Handle dummy arguments and procedure
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 3552da3..d69399c 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -3619,7 +3619,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 			&& CLASS_DATA (e)->attr.dimension)
 		    gfc_conv_class_to_class (&parmse, e, fsym->ts, false);
 
-		  if (fsym && fsym->ts.type == BT_DERIVED
+		  if (fsym && (fsym->ts.type == BT_DERIVED
+			       || fsym->ts.type == BT_ASSUMED)
 		      && e->ts.type == BT_CLASS
 		      && !CLASS_DATA (e)->attr.dimension
 		      && !CLASS_DATA (e)->attr.codimension)
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 2579e23..6ff1d33 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -1118,6 +1118,7 @@ gfc_typenode_for_spec (gfc_typespec * spec)
         }
       break;
     case BT_VOID:
+    case BT_ASSUMED:
       /* This is for the second arg to c_f_pointer and c_f_procpointer
          of the iso_c_binding module, to accept any ptr type.  */
       basetype = ptr_type_node;
@@ -1416,6 +1417,10 @@ gfc_get_dtype (tree type)
       n = BT_CHARACTER;
       break;
 
+    case POINTER_TYPE:
+      n = BT_ASSUMED;
+      break;
+
     default:
       /* TODO: Don't do dtype for temporary descriptorless arrays.  */
       /* We can strange array types for temporary arrays.  */
--- /dev/null	2012-03-02 07:37:33.883806634 +0100
+++ gcc/gcc/testsuite/gfortran.dg/assumed_type_1.f90	2012-03-01 10:13:39.000000000 +0100
@@ -0,0 +1,57 @@
+! { dg-do compile }
+!
+! PR fortran/48820
+!
+! Test TYPE(*)
+!
+! Based on a contributed test case by Walter Spector
+!
+module mpi_interface
+  implicit none
+
+  interface mpi_send
+    subroutine MPI_Send (buf, count, datatype, dest, tag, comm, ierr)
+      type(*), intent(in) :: buf(:)
+      integer, intent(in) :: count
+      integer, intent(in) :: datatype
+      integer, intent(in) :: dest
+      integer, intent(in) :: tag
+      integer, intent(in) :: comm
+      integer, intent(out):: ierr
+    end subroutine
+  end interface
+
+  interface mpi_send2
+    subroutine MPI_Send2 (buf, count, datatype, dest, tag, comm, ierr)
+      type(*), intent(in) :: buf(*)
+      integer, intent(in) :: count
+      integer, intent(in) :: datatype
+      integer, intent(in) :: dest
+      integer, intent(in) :: tag
+      integer, intent(in) :: comm
+      integer, intent(out):: ierr
+    end subroutine
+  end interface
+
+end module
+
+use mpi_interface
+  real :: a(3)
+  integer :: b(3)
+  call foo(a)
+  call foo(b)
+  call foo(a(1:2))
+  call foo(b(1:2))
+  call MPI_Send(a, 1, 1,1,1,j,i)
+  call MPI_Send(b, 1, 1,1,1,j,i)
+  call MPI_Send2(a, 1, 1,1,1,j,i)
+  call MPI_Send2(b, 1, 1,1,1,j,i)
+contains
+    subroutine foo(x)
+    type(*):: x(*)
+    call MPI_Send(x, 1, 1,1,1,j,i)
+    call MPI_Send2(x, 1, 1,1,1,j,i)
+  end
+end
+
+! { dg-final { cleanup-modules "mpi_interface" } }
--- /dev/null	2012-03-02 07:37:33.883806634 +0100
+++ gcc/gcc/testsuite/gfortran.dg/assumed_type_2.f90	2012-03-02 11:28:22.000000000 +0100
@@ -0,0 +1,181 @@
+! { dg-do run }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/48820
+!
+! Test TYPE(*)
+!
+
+module mod
+  use iso_c_binding, only: c_loc, c_ptr, c_bool
+  implicit none
+  interface my_c_loc
+    function my_c_loc1(x) bind(C)
+      import c_ptr
+      type(*) :: x
+      type(c_ptr) :: my_c_loc1
+    end function
+    function my_c_loc2(x) bind(C)
+      import c_ptr
+      type(*) :: x(*)
+      type(c_ptr) :: my_c_loc2
+    end function
+  end interface my_c_loc
+contains
+  subroutine sub_scalar (arg1, presnt)
+     type(*), target, optional :: arg1
+     logical :: presnt
+     type(c_ptr) :: cpt
+     if (presnt .neqv. present (arg1)) call abort ()
+     cpt = c_loc (arg1)
+  end subroutine sub_scalar
+
+  subroutine sub_array_shape (arg2, lbounds, ubounds)
+     type(*), target :: arg2(:,:)
+     type(c_ptr) :: cpt
+     integer :: lbounds(2), ubounds(2)
+     if (any (lbound(arg2) /= lbounds)) call abort ()
+     if (any (ubound(arg2) /= ubounds)) call abort ()
+     if (any (shape(arg2) /= ubounds-lbounds+1)) call abort ()
+     if (size(arg2) /= product (ubounds-lbounds+1)) call abort ()
+     if (rank (arg2) /= 2) call abort ()
+!     if (.not. is_continuous (arg2)) call abort () !<< Not yet implemented
+!     cpt = c_loc (arg2) ! << FIXME: Valid since TS29113
+     call sub_array_assumed (arg2)
+  end subroutine sub_array_shape
+
+  subroutine sub_array_assumed (arg3)
+     type(*), target :: arg3(*)
+     type(c_ptr) :: cpt
+     cpt = c_loc (arg3)
+  end subroutine sub_array_assumed
+end module
+
+use mod
+use iso_c_binding, only: c_int, c_null_ptr
+implicit none
+type t1
+  integer :: a
+end type t1
+type :: t2
+  sequence
+  integer :: b
+end type t2
+type, bind(C) :: t3
+  integer(c_int) :: c
+end type t3
+
+integer            :: scalar_int
+real, allocatable  :: scalar_real_alloc
+character, pointer :: scalar_char_ptr
+
+integer            :: array_int(3)
+real, allocatable  :: array_real_alloc(:,:)
+character, pointer :: array_char_ptr(:,:)
+
+type(t1)              :: scalar_t1
+type(t2), allocatable :: scalar_t2_alloc
+type(t3), pointer     :: scalar_t3_ptr
+
+type(t1)              :: array_t1(4)
+type(t2), allocatable :: array_t2_alloc(:,:)
+type(t3), pointer     :: array_t3_ptr(:,:)
+
+class(t1), allocatable :: scalar_class_t1_alloc
+class(t1), pointer     :: scalar_class_t1_ptr
+
+class(t1), allocatable :: array_class_t1_alloc(:,:)
+class(t1), pointer     :: array_class_t1_ptr(:,:)
+
+scalar_char_ptr => null()
+scalar_t3_ptr => null()
+
+call sub_scalar (presnt=.false.)
+call sub_scalar (scalar_real_alloc, .false.)
+call sub_scalar (scalar_char_ptr, .false.)
+call sub_scalar (null (), .false.)
+call sub_scalar (scalar_t2_alloc, .false.)
+call sub_scalar (scalar_t3_ptr, .false.)
+
+allocate (scalar_real_alloc, scalar_char_ptr, scalar_t3_ptr)
+allocate (scalar_class_t1_alloc, scalar_class_t1_ptr, scalar_t2_alloc)
+allocate (array_real_alloc(3:5,2:4), array_char_ptr(-2:2,2))
+allocate (array_t2_alloc(3:5,2:4), array_t3_ptr(-2:2,2))
+allocate (array_class_t1_alloc(3,3), array_class_t1_ptr(4,4))
+
+call sub_scalar (scalar_int, .true.)
+call sub_scalar (scalar_real_alloc, .true.)
+call sub_scalar (scalar_char_ptr, .true.)
+call sub_scalar (array_int(2), .true.)
+call sub_scalar (array_real_alloc(3,2), .true.)
+call sub_scalar (array_char_ptr(0,1), .true.)
+call sub_scalar (scalar_t1, .true.)
+call sub_scalar (scalar_t2_alloc, .true.)
+call sub_scalar (scalar_t3_ptr, .true.)
+call sub_scalar (array_t1(2), .true.)
+call sub_scalar (array_t2_alloc(3,2), .true.)
+call sub_scalar (array_t3_ptr(0,1), .true.)
+call sub_scalar (array_class_t1_alloc(2,1), .true.)
+call sub_scalar (array_class_t1_ptr(3,3), .true.)
+
+call sub_array_assumed (array_int)
+call sub_array_assumed (array_real_alloc)
+call sub_array_assumed (array_char_ptr)
+call sub_array_assumed (array_t1)
+call sub_array_assumed (array_t2_alloc)
+call sub_array_assumed (array_t3_ptr)
+call sub_array_assumed (array_class_t1_alloc)
+call sub_array_assumed (array_class_t1_ptr)
+
+call sub_array_shape (array_real_alloc, [1,1], shape(array_real_alloc))
+call sub_array_shape (array_char_ptr, [1,1], shape(array_char_ptr))
+call sub_array_shape (array_t2_alloc, [1,1], shape(array_t2_alloc))
+call sub_array_shape (array_t3_ptr, [1,1], shape(array_t3_ptr))
+call sub_array_shape (array_class_t1_alloc, [1,1], shape(array_class_t1_alloc))
+call sub_array_shape (array_class_t1_ptr, [1,1], shape(array_class_t1_ptr))
+
+deallocate (scalar_char_ptr, scalar_class_t1_ptr, array_char_ptr)
+deallocate (array_class_t1_ptr, array_t3_ptr)
+
+end
+
+! { dg-final { cleanup-modules "mod" } }
+
+! { dg-final { scan-tree-dump-times "sub_scalar .0B,"  2 "original" } }
+! { dg-final { scan-tree-dump-times "sub_scalar .scalar_real_alloc," 2 "original" } }
+! { dg-final { scan-tree-dump-times "sub_scalar .scalar_char_ptr," 2 "original" } }
+! { dg-final { scan-tree-dump-times "sub_scalar .scalar_t2_alloc," 2 "original" } }
+! { dg-final { scan-tree-dump-times "sub_scalar .scalar_t3_ptr" 2 "original" } }
+
+! { dg-final { scan-tree-dump-times "sub_scalar .&scalar_int," 1 "original" } }
+! { dg-final { scan-tree-dump-times "sub_scalar .&scalar_t1," 1 "original" } }
+! { dg-final { scan-tree-dump-times "sub_scalar .&array_int.1.," 1 "original" } }
+! { dg-final { scan-tree-dump-times "sub_scalar .&scalar_t1," 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "sub_scalar .&\\(.\\(real.kind=4..0:. . restrict\\) array_real_alloc.data" 1 "original" } }
+! { dg-final { scan-tree-dump-times "sub_scalar .&\\(.\\(character.kind=1..0:..1:1. .\\) array_char_ptr.data" 1 "original" } }
+! { dg-final { scan-tree-dump-times "sub_scalar .&\\(.\\(struct t2.0:. . restrict\\) array_t2_alloc.data" 1 "original" } }
+! { dg-final { scan-tree-dump-times "sub_scalar .&\\(.\\(struct t3.0:. .\\) array_t3_ptr.data" 1 "original" } }
+! { dg-final { scan-tree-dump-times "sub_scalar .\\(struct t1 .\\) array_class_t1_alloc._data.data" 1 "original" } }
+! { dg-final { scan-tree-dump-times "sub_scalar .\\(struct t1 .\\) array_class_t1_ptr._data.dat" 1 "original" } }a
+
+! { dg-final { scan-tree-dump-times "sub_array_assumed \\(D" 2 "original" } }
+! { dg-final { scan-tree-dump-times " = _gfortran_internal_pack \\(&parm" 1 "original" } }
+! { dg-final { scan-tree-dump-times "sub_array_assumed \\(&array_int\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(real\\(kind=4\\).0:. . restrict\\) array_real_alloc.data" 1 "original" } }
+! { dg-final { scan-tree-dump-times " = _gfortran_internal_pack \\(&array_char_ptr\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "\\.data = \\(void .\\) &array_t1.0.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(struct t1.0:. .\\) parm" 1 "original" } }
+! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(struct t2.0:. . restrict\\) array_t2_alloc.data\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(struct t3.0:. .\\) array_t3_ptr.data\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(struct t1.0:. . restrict\\) array_class_t1_alloc._data.data\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(struct t1.0:. .\\) array_class_t1_ptr._data.data\\);" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "sub_array_shape \\(&array_real_alloc," 1 "original" } }
+! { dg-final { scan-tree-dump-times "sub_array_shape \\(&array_char_ptr," 1 "original" } }
+! { dg-final { scan-tree-dump-times "sub_array_shape \\(&array_t2_alloc," 1 "original" } }
+! { dg-final { scan-tree-dump-times "sub_array_shape \\(&array_t3_ptr," 1 "original" } }
+! { dg-final { scan-tree-dump-times "sub_array_shape \\(&array_class_t1_alloc._data," 1 "original" } }
+! { dg-final { scan-tree-dump-times "sub_array_shape \\(&array_class_t1_ptr._data," 1 "original" } }
+
+! { dg-final { cleanup-tree-dump "original" } }
--- /dev/null	2012-03-02 07:37:33.883806634 +0100
+++ gcc/gcc/testsuite/gfortran.dg/assumed_type_3.f90	2012-03-02 00:51:48.000000000 +0100
@@ -0,0 +1,119 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+!
+! PR fortran/48820
+!
+! Test TYPE(*)
+
+subroutine one(a) ! { dg-error "may not have the ALLOCATABLE, CODIMENSION, POINTER or VALUE attribute" }
+  type(*), value :: a
+end subroutine one
+
+subroutine two(a) ! { dg-error "may not have the ALLOCATABLE, CODIMENSION, POINTER or VALUE attribute" }
+  type(*), pointer :: a
+end subroutine two
+
+subroutine three(a) ! { dg-error "may not have the ALLOCATABLE, CODIMENSION, POINTER or VALUE attribute" }
+  type(*), allocatable :: a
+end subroutine three
+
+subroutine four(a) ! { dg-error "may not have the ALLOCATABLE, CODIMENSION, POINTER or VALUE attribute" }
+  type(*)  :: a[*]
+end subroutine four
+
+subroutine five(a) ! { dg-error "shall not be an explicit-shape array" }
+  type(*) :: a(3)
+end subroutine five
+
+subroutine six()
+  type(*) :: nodum ! { dg-error "is only permitted for dummy variables" }
+end subroutine six
+
+subroutine seven(y)
+ type(*) :: y(:)
+ call a7(y(3:5)) ! { dg-error "Assumed-type variable y with designator" }
+contains
+ subroutine a7(x)
+   type(*) :: x(*)
+ end subroutine a7
+end subroutine seven
+
+subroutine eight()
+  type t
+    type(*) :: x ! { dg-error "is not allowed for components" }
+  end type t
+end subroutine eight
+
+subroutine nine()
+  interface one
+    subroutine okay(x)
+      type(*) :: x
+    end subroutine okay
+    subroutine okay2(x)
+      type(*) :: x(*)
+    end subroutine okay2
+    subroutine okay2(x,y)
+      integer :: x
+      type(*) :: y
+    end subroutine okay2
+  end interface
+  interface two
+    subroutine okok1(x)
+      type(*) :: x
+    end subroutine okok1
+    subroutine okok2(x)
+      integer :: x(*)
+    end subroutine okok2
+  end interface
+  interface three
+    subroutine ambig1(x)
+      type(*) :: x
+    end subroutine ambig1
+    subroutine ambig2(x)
+      integer :: x
+    end subroutine ambig2 ! { dg-error "Ambiguous interfaces 'ambig2' and 'ambig1' in generic interface 'three'" }
+  end interface
+end subroutine nine
+
+subroutine ten()
+ interface
+   subroutine bar()
+   end subroutine
+ end interface
+ type t
+ contains
+   procedure, nopass :: proc => bar
+ end type
+ type(t) :: xx
+ call sub(xx) ! { dg-error "is of derived type with type-bound or FINAL procedures" }
+contains
+  subroutine sub(a)
+    type(*) :: a
+  end subroutine sub
+end subroutine ten
+
+subroutine eleven(x)
+  external bar
+  type(*) :: x
+  call bar(x) ! { dg-error "Assumed-type argument x at .1. requires an explicit interface" }
+end subroutine eleven
+
+subroutine twelf(x)
+  type(*) :: x
+  call bar(x)
+contains
+  subroutine bar(x)
+    integer :: x ! { dg-error "Type mismatch in argument" }
+  end subroutine bar
+end subroutine twelf
+
+subroutine thirteen(x, y)
+  type(*) :: x
+  integer :: y(:)
+  print *, ubound(y, dim=x) ! { dg-error "must be INTEGER" }
+end subroutine thirteen
+
+subroutine fourteen(x)
+  type(*) :: x
+  x = x ! { dg-error "Invalid expression with assumed-type variable" }
+end subroutine fourteen
--- /dev/null	2012-03-02 07:37:33.883806634 +0100
+++ gcc/gcc/testsuite/gfortran.dg/assumed_type_4.f90	2012-03-02 00:53:21.000000000 +0100
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-options "-std=f2008" }
+!
+! PR fortran/48820
+!
+! Test TYPE(*)
+
+subroutine one(a) ! { dg-error "TS 29113: Assumed type" }
+  type(*)  :: a
+end subroutine one

^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: [4.8, Fortran, Patch] PR 48820 - Support TYPE(*) of TS29113
  2012-03-02 11:28 [4.8, Fortran, Patch] PR 48820 - Support TYPE(*) of TS29113 Tobias Burnus
@ 2012-03-03  7:41 ` Paul Richard Thomas
  2012-03-03 10:13   ` Tobias Burnus
  2014-12-03  0:21   ` Tom de Vries
  0 siblings, 2 replies; 6+ messages in thread
From: Paul Richard Thomas @ 2012-03-03  7:41 UTC (permalink / raw)
  To: Tobias Burnus; +Cc: gcc patches FOR, gfortran

Dear Tobias,

This is certainly OK for 4.8.

I have a couple of remarks:
(i) The DTYPE_TYPE_MASK is 0x38 so that we saturated it a long time
since!  At the moment it does not cause any problems because of the
extremely limited use of the dtype 'type'.  Whilst the array
descriptor revamp will eliminate such worries, we should be mindful of
this; and
(ii) By making such substantial use of scan-tree-dump-times in the
dg-run test case, you are potentially building in instability against
future development, I suppose?  Are the runtime tests not sufficient?

Thanks for this early upgrade!

Paul

On Fri, Mar 2, 2012 at 12:28 PM, Tobias Burnus <burnus@net-b.de> wrote:
> TYPE(*) is Fortran's equivalent to C's "void *buffer". It may only be used
> for dummy arguments and essentially might only either be passed on, or
> appear in PRESENT, LBOUND/UBOUND/SHAPE/SIZE/IS_CONTIGUOUS - and most useful:
> in C_LOC.
>
>
> Note: For scalar TYPE(*) and for assumed-size dummies, only the address is
> passed on. But for dimension(:) and TS29113's new (but unimplemented)
> dimension(..) an array descriptor is passed. In that case, one might recover
> the type from the array descriptor - at least for intrinsic types.
>
>
> TYPE(*) is useful for, e.g., MPI (and used in the MPI v3 draft spec): There,
> one simply takes an argument of any type and transfers some bytes from it -
> without needing to know the type. TYPE(*) avoids to create hundreds of
> useless explicit interfaces for all kind of data types (and missing derived
> types that way) - or TS29113 avoids the alternative: Not using explicit
> interfaces (causing argument checking issues and prevents the use of
> BIND(C).)
>
>
> See PR (or first test case) for a usage example. For a pure Fortran use, one
> could imagine:
>
> subroutine send(buf, size)
>  use iso_c_binding, only: c_signed_char, c_size_t
>  type(*) :: buf(*)
>  integer(c_size_t) :: size
>  integer(c_signed_char) :: ibuf(size)
>  call c_f_pointer (c_loc(buf), ibuf, shape=[size])
>  ! ... use ibuf ...
> end
>
> [This example currently fails as "c_loc(buf)" is rejected. Several BIND(C)
> restrictions were removed in F2008 and especially in TS29113, but gfortran
> has not yet removed them.]
>
>
> For more details, see:
>
> * TS 29113 draft: ftp://ftp.nag.co.uk/sc22wg5/N1901-N1950/N1904.pdf
> (Status: Went as PDTR through one round of voting by the ISO members, was
> updated at the last J3 meeting and is now the subject of a one-month WG5
> ballot that ends on 19 March 2012. The schedule is that it will then be
> forwarded to SC22, which initiates a DTS ballot such that the final version
> will be published in September by ISO.)
>
> * MPIv3 draft (of 2011-12-15):
> https://svn.mpi-forum.org/trac/mpi-forum-web/attachment/ticket/229/mpi-report-F2008-2011-12-15-changeonlyplustickets_majorpages.pdf
>
> Build and regtested on x86-64-linux.
> OK for the 4.8 trunk?
>
> Tobias



-- 
The knack of flying is learning how to throw yourself at the ground and miss.
       --Hitchhikers Guide to the Galaxy

^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: [4.8, Fortran, Patch] PR 48820 - Support TYPE(*) of TS29113
  2012-03-03  7:41 ` Paul Richard Thomas
@ 2012-03-03 10:13   ` Tobias Burnus
  2012-03-03 14:17     ` Tobias Burnus
  2014-12-03  0:21   ` Tom de Vries
  1 sibling, 1 reply; 6+ messages in thread
From: Tobias Burnus @ 2012-03-03 10:13 UTC (permalink / raw)
  To: Paul Richard Thomas; +Cc: gcc patches, gfortran

Dear Paul,

thanks for the review.

Paul Richard Thomas wrote:
> I have a couple of remarks:
> (i) The DTYPE_TYPE_MASK is 0x38 so that we saturated it a long time
> since!  At the moment it does not cause any problems because of the
> extremely limited use of the dtype 'type'.  Whilst the array
> descriptor revamp will eliminate such worries, we should be mindful of
> this; and

Thanks for the reminder. I kind of expected such an issue - and decided 
not to worry about it.

> (ii) By making such substantial use of scan-tree-dump-times in the
> dg-run test case, you are potentially building in instability against
> future development, I suppose?  Are the runtime tests not sufficient?

In principle, run-time tests are sufficient. But they rely on C tests - 
or at least on a working C_LOC. However, one currently cannot use 
C_LOC() on assumed-shape variables nor BIND(C) for assumed-shape 
dummies. [Which is allowed in TS29113.]  Besides, the C program needs 
then to make use of gfortran's array descriptor to really check.

I tried a bit, but it gets rather complicated so that at some point, I 
gave up, deleted the traces of the C code and surrendered. I checked the 
argument manually and added them to the scan-tree-dump-times. I tried 
carefully to use them such that they should work on all targets. 
However, if the array descriptor will change, they might break. However, 
the work to fix them once or twice might be less than writing a run-time 
test.

Tobias

^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: [4.8, Fortran, Patch] PR 48820 - Support TYPE(*) of TS29113
  2012-03-03 10:13   ` Tobias Burnus
@ 2012-03-03 14:17     ` Tobias Burnus
  2012-03-03 18:56       ` Tobias Burnus
  0 siblings, 1 reply; 6+ messages in thread
From: Tobias Burnus @ 2012-03-03 14:17 UTC (permalink / raw)
  To: fortran; +Cc: gcc patches

[-- Attachment #1: Type: text/plain, Size: 558 bytes --]

Tobias Burnus wrote:
> thanks for the review.
>
> Paul Richard Thomas wrote:
> [...]

Something is odd. The test case didn't regtest, but I could swear that 
it did so yesterday.

_1.f90: That was correctly failing because one cannot pass an 
assumed-size array to an assumed-shape array.

_4.f90: Somehow, the line has changed.

_3.f90: Besides some more obvious issues, there is:

"fourteen" is really odd: Depending on the position of that subroutine 
in file, I get an error or not. I think one should try to better 
understand why that happens.

Tobias

[-- Attachment #2: commit.diff --]
[-- Type: text/x-patch, Size: 2991 bytes --]

Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog	(Revision 184855)
+++ gcc/testsuite/ChangeLog	(Arbeitskopie)
@@ -1,6 +1,13 @@
 2012-03-03  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/48820
+	* gfortran.dg/assumed_type_1.f90: Correct dg-error.
+	* gfortran.dg/assumed_type_3.f90: Correct dg-error.
+	* gfortran.dg/assumed_type_4.f90: Correct dg-error.
+
+2012-03-03  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/48820
 	* gfortran.dg/assumed_type_1.f90: New.
 	* gfortran.dg/assumed_type_2.f90: New.
 	* gfortran.dg/assumed_type_3.f90: New.
Index: gcc/testsuite/gfortran.dg/assumed_type_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/assumed_type_1.f90	(Revision 184855)
+++ gcc/testsuite/gfortran.dg/assumed_type_1.f90	(Arbeitskopie)
@@ -49,7 +49,6 @@ use mpi_interface
 contains
     subroutine foo(x)
     type(*):: x(*)
-    call MPI_Send(x, 1, 1,1,1,j,i)
     call MPI_Send2(x, 1, 1,1,1,j,i)
   end
 end
Index: gcc/testsuite/gfortran.dg/assumed_type_4.f90
===================================================================
--- gcc/testsuite/gfortran.dg/assumed_type_4.f90	(Revision 184855)
+++ gcc/testsuite/gfortran.dg/assumed_type_4.f90	(Arbeitskopie)
@@ -5,6 +5,6 @@
 !
 ! Test TYPE(*)
 
-subroutine one(a) ! { dg-error "TS 29113: Assumed type" }
-  type(*)  :: a
+subroutine one(a)
+  type(*)  :: a ! { dg-error "TS 29113: Assumed type" }
 end subroutine one
Index: gcc/testsuite/gfortran.dg/assumed_type_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/assumed_type_3.f90	(Revision 184855)
+++ gcc/testsuite/gfortran.dg/assumed_type_3.f90	(Arbeitskopie)
@@ -5,6 +5,11 @@
 !
 ! Test TYPE(*)
 
+subroutine fourteen(x)
+  type(*) :: x
+  x = x ! { dg-error "Invalid expression with assumed-type variable" }
+end subroutine fourteen
+
 subroutine one(a) ! { dg-error "may not have the ALLOCATABLE, CODIMENSION, POINTER or VALUE attribute" }
   type(*), value :: a
 end subroutine one
@@ -52,10 +57,10 @@ subroutine nine()
     subroutine okay2(x)
       type(*) :: x(*)
     end subroutine okay2
-    subroutine okay2(x,y)
+    subroutine okay3(x,y)
       integer :: x
       type(*) :: y
-    end subroutine okay2
+    end subroutine okay3
   end interface
   interface two
     subroutine okok1(x)
@@ -100,10 +105,10 @@ end subroutine eleven
 
 subroutine twelf(x)
   type(*) :: x
-  call bar(x)
+  call bar(x) ! { dg-error "Type mismatch in argument" }
 contains
   subroutine bar(x)
-    integer :: x ! { dg-error "Type mismatch in argument" }
+    integer :: x
   end subroutine bar
 end subroutine twelf
 
@@ -113,7 +118,4 @@ subroutine thirteen(x, y)
   print *, ubound(y, dim=x) ! { dg-error "must be INTEGER" }
 end subroutine thirteen
 
-subroutine fourteen(x)
-  type(*) :: x
-  x = x ! { dg-error "Invalid expression with assumed-type variable" }
-end subroutine fourteen
+

^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: [4.8, Fortran, Patch] PR 48820 - Support TYPE(*) of TS29113
  2012-03-03 14:17     ` Tobias Burnus
@ 2012-03-03 18:56       ` Tobias Burnus
  0 siblings, 0 replies; 6+ messages in thread
From: Tobias Burnus @ 2012-03-03 18:56 UTC (permalink / raw)
  To: fortran; +Cc: gcc patches

[-- Attachment #1: Type: text/plain, Size: 478 bytes --]

Tobias Burnus wrote:
> _3.f90: [...]
> "fourteen" is really odd: Depending on the position of that subroutine 
> in file, I get an error or not. I think one should try to better 
> understand why that happens.

I found it with the help of Paul. The problem was that I set instead of 
re-set the variable at the end of resolve_actual_arglist. Now, it works.

Committed the attached patch as Rev. 184863 after a fresh rebuild and 
regtesting.

Tobias

PS: Sorry for the glitches.

[-- Attachment #2: commit.diff --]
[-- Type: text/x-patch, Size: 2343 bytes --]

Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(Revision 184861)
+++ gcc/fortran/resolve.c	(Arbeitskopie)
@@ -1833,7 +1833,7 @@ resolve_actual_arglist (gfc_actual_arglist *arg, p
           return FAILURE;
         }
     }
-  assumed_type_expr_allowed = true;
+  assumed_type_expr_allowed = false;
 
   return SUCCESS;
 }
Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog	(Revision 184861)
+++ gcc/fortran/ChangeLog	(Arbeitskopie)
@@ -1,5 +1,11 @@
 2012-03-03  Tobias Burnus  <burnus@net-b.de>
 
+	PR fortran/48820
+	* resolve.c (resolve_actual_arglist): Properly reset
+	assumed_type_expr_allowed.
+
+2012-03-03  Tobias Burnus  <burnus@net-b.de>
+
 	* lang.opt (Wc-binding-type): New flag.
 	* options.c (gfc_init_options, gfc_handle_option): Handle it.
 	* invoke.texi (Wc-binding-type): Document it.
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog	(Revision 184861)
+++ gcc/testsuite/ChangeLog	(Arbeitskopie)
@@ -1,5 +1,10 @@
 2012-03-03  Tobias Burnus  <burnus@net-b.de>
 
+	PR fortran/48820
+	* gfortran.dg/assumed_type_3.f90: Undo previous commit.
+
+2012-03-03  Tobias Burnus  <burnus@net-b.de>
+
 	* gfortran.dg/bind_c_dts_4.f03: Add dg-options -Wc-binding-type.
 	* gfortran.dg/bind_c_implicit_vars.f03: Ditto.
 	* gfortran.dg/bind_c_usage_8.f03: Ditto.
Index: gcc/testsuite/gfortran.dg/assumed_type_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/assumed_type_3.f90	(Revision 184861)
+++ gcc/testsuite/gfortran.dg/assumed_type_3.f90	(Arbeitskopie)
@@ -5,11 +5,6 @@
 !
 ! Test TYPE(*)
 
-subroutine fourteen(x)
-  type(*) :: x
-  x = x ! { dg-error "Invalid expression with assumed-type variable" }
-end subroutine fourteen
-
 subroutine one(a) ! { dg-error "may not have the ALLOCATABLE, CODIMENSION, POINTER or VALUE attribute" }
   type(*), value :: a
 end subroutine one
@@ -118,4 +113,7 @@ subroutine thirteen(x, y)
   print *, ubound(y, dim=x) ! { dg-error "must be INTEGER" }
 end subroutine thirteen
 
-
+subroutine fourteen(x)
+  type(*) :: x
+  x = x ! { dg-error "Invalid expression with assumed-type variable" }
+end subroutine fourteen

^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: [4.8, Fortran, Patch] PR 48820 - Support TYPE(*) of TS29113
  2012-03-03  7:41 ` Paul Richard Thomas
  2012-03-03 10:13   ` Tobias Burnus
@ 2014-12-03  0:21   ` Tom de Vries
  1 sibling, 0 replies; 6+ messages in thread
From: Tom de Vries @ 2014-12-03  0:21 UTC (permalink / raw)
  To: Paul Richard Thomas, Tobias Burnus; +Cc: gcc patches FOR, gfortran

On 03/03/12 08:41, Paul Richard Thomas wrote:
> Dear Tobias,
> 
> This is certainly OK for 4.8.
> 
> I have a couple of remarks:
> (i) The DTYPE_TYPE_MASK is 0x38 so that we saturated it a long time
> since!  At the moment it does not cause any problems because of the
> extremely limited use of the dtype 'type'.

Hi,

AFAIU, you're saying here that since there are very few uses of the type part of
dtype, it's not a problem.

But at the moment, BT_ASSUMED with value 11 bleeds into the size part of dtype.

In gfc_get_dtype_rank_type, we just set the type directly without applying the mask:
...
  i = rank | (n << GFC_DTYPE_TYPE_SHIFT);
...

In fact, the mask seems completely unused.

>  Whilst the array
> descriptor revamp will eliminate such worries, we should be mindful of
> this; and

I think that if we have a mask that we're not respecting, we need to clearly
document at the definiton how that's done and why that's not a problem. And
ideally, add some asserts to detect when we break that allowed usage pattern.

Thanks,
- Tom

^ permalink raw reply	[flat|nested] 6+ messages in thread

end of thread, other threads:[~2014-12-03  0:21 UTC | newest]

Thread overview: 6+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2012-03-02 11:28 [4.8, Fortran, Patch] PR 48820 - Support TYPE(*) of TS29113 Tobias Burnus
2012-03-03  7:41 ` Paul Richard Thomas
2012-03-03 10:13   ` Tobias Burnus
2012-03-03 14:17     ` Tobias Burnus
2012-03-03 18:56       ` Tobias Burnus
2014-12-03  0:21   ` Tom de Vries

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).