public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
* [Patch, Fortran, F08] PR45290: pointer initialization
@ 2010-08-16 21:42 Janus Weil
  2010-08-17  6:38 ` Jerry DeLisle
  2010-08-17  7:52 ` Tobias Burnus
  0 siblings, 2 replies; 13+ messages in thread
From: Janus Weil @ 2010-08-16 21:42 UTC (permalink / raw)
  To: gfortran, gcc-patches

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

Hi all,

here is a patch which implements the new pointer initialization
capabilities of F08. While in F03 all pointers had to be initialized
to NULL(), F08 allows non-NULL initialization values for data pointers
as well as procedure pointers. The patch contains some parsing bits in
decl.c, a couple of diagnostic checks in resolve.c and check.c and a
small hunk in trans-expr.c which handles the translation to the middle
end.

I hope everything should work as advertised. Regtesting was successful
on x86_64-unknown-linux-gnu (except for the continuing failure of
array_memcpy_3.f90, cf. PR45266).

Ok for trunk?

Btw: While the most obvious benefit of this patch of course is the
availability of pointer initialization as a useful feature in itself
(and another YES in the F08 compatibility table), my actual motivation
for implementing this was the fact that it will enable me to improve
the OOP implementation by making the vtabs statically initialized,
instead of having to initialize all the PPCs dynamically at run time
(and making sure this happens before the vtab is used). This is what I
will work on next, after the pointer init patch has landed ...

Cheers,
Janus



2010-08-16  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/45290
	* decl.c (add_init_expr_to_sym): Defer checking of proc pointer init.
	(match_pointer_init): New function to match F08 pointer initialization.
	(variable_decl,match_procedure_decl,match_ppc_decl): Use
	'match_pointer_init'.
	* expr.c (gfc_check_assign_symbol): Extra checks for pointer
	initialization.
	* primary.c (gfc_variable_attr): Handle SAVE attribute.
	* resolve.c (resolve_structure_cons): Add new argument and do pointer
	initialization checks.
	(gfc_resolve_expr): Modified call to 'resolve_structure_cons'.
	(resolve_values): Call 'resolve_structure_cons' directly with init arg.
	* trans-expr.c (gfc_conv_initializer): Implement non-NULL pointer
	initialization.


2010-08-16  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/45290
	* gfortran.dg/proc_ptr_comp_3.f90: Modified.
	* gfortran.dg/pointer_init_2.f90: New.
	* gfortran.dg/pointer_init_3.f90: New.
	* gfortran.dg/pointer_init_4.f90: New.

[-- Attachment #2: pr45290.diff --]
[-- Type: application/octet-stream, Size: 8924 bytes --]

Index: gcc/testsuite/gfortran.dg/proc_ptr_comp_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/proc_ptr_comp_3.f90	(revision 163281)
+++ gcc/testsuite/gfortran.dg/proc_ptr_comp_3.f90	(working copy)
@@ -22,7 +22,6 @@ type :: t
   procedure(), pointer, nopass ptr4              ! { dg-error "Expected '::'" }
   procedure(), pointer, nopass, pointer :: ptr5  ! { dg-error "Duplicate" }
   procedure, pointer, nopass :: ptr6             ! { dg-error "Syntax error" }
-  procedure(), pointer, nopass :: ptr7 => ptr2   ! { dg-error "requires a NULL" }
   procedure(), nopass :: ptr8                    ! { dg-error "POINTER attribute is required" }
   procedure(pp), pointer, nopass :: ptr9         ! { dg-error "declared in a later PROCEDURE statement" }
   procedure(aaargh), pointer, nopass :: ptr10    ! { dg-error "must be explicit" }
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c	(revision 163281)
+++ gcc/fortran/trans-expr.c	(working copy)
@@ -3982,7 +3982,17 @@ gfc_conv_initializer (gfc_expr * expr, gfc_typespe
 	return gfc_conv_array_initializer (type, expr);
     }
   else if (pointer)
-    return fold_convert (type, null_pointer_node);
+    {
+      if (!expr || expr->expr_type == EXPR_NULL)
+	return fold_convert (type, null_pointer_node);
+      else
+	{
+	  gfc_init_se (&se, NULL);
+	  se.want_pointer = 1;
+	  gfc_conv_expr (&se, expr);
+	  return se.expr;
+	}
+    }
   else
     {
       switch (ts->type)
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(revision 163281)
+++ gcc/fortran/decl.c	(working copy)
@@ -1312,9 +1312,10 @@ add_init_expr_to_sym (const char *name, gfc_expr *
 	}
 
       /* Check if the assignment can happen. This has to be put off
-	 until later for a derived type variable.  */
+	 until later for derived type variables and procedure pointers.  */
       if (sym->ts.type != BT_DERIVED && init->ts.type != BT_DERIVED
 	  && sym->ts.type != BT_CLASS && init->ts.type != BT_CLASS
+	  && !sym->attr.proc_pointer 
 	  && gfc_check_assign_symbol (sym, init) == FAILURE)
 	return FAILURE;
 
@@ -1652,6 +1653,48 @@ gfc_match_null (gfc_expr **result)
 }
 
 
+/* Match the initialization expr for a data pointer or procedure pointer.  */
+
+static match
+match_pointer_init (gfc_expr **init, int procptr)
+{
+  match m;
+
+  if (gfc_pure (NULL) && gfc_state_stack->state != COMP_DERIVED)
+    {
+      gfc_error ("Initialization of pointer at %C is not allowed in "
+		 "a PURE procedure");
+      return MATCH_ERROR;
+    }
+
+  /* Match NULL() initilization.  */
+  m = gfc_match_null (init);
+  if (m != MATCH_NO)
+    return m;
+
+  /* Match non-NULL initialization.  */
+  gfc_matching_procptr_assignment = procptr;
+  m = gfc_match_rvalue (init);
+  gfc_matching_procptr_assignment = 0;
+  if (m == MATCH_ERROR)
+    return MATCH_ERROR;
+  else if (m == MATCH_NO)
+    {
+      gfc_error ("Error in pointer initialization at %C");
+      return MATCH_ERROR;
+    }
+
+  if (!procptr)
+    gfc_resolve_expr (*init);
+  
+  if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: non-NULL pointer "
+		      "initialization at %C") == FAILURE)
+    return MATCH_ERROR;
+
+  return MATCH_YES;
+}
+
+
 /* Match a variable name with an optional initializer.  When this
    subroutine is called, a variable is expected to be parsed next.
    Depending on what is happening at the moment, updates either the
@@ -1899,23 +1942,9 @@ variable_decl (int elem)
 	      goto cleanup;
 	    }
 
-	  m = gfc_match_null (&initializer);
-	  if (m == MATCH_NO)
-	    {
-	      gfc_error ("Pointer initialization requires a NULL() at %C");
-	      m = MATCH_ERROR;
-	    }
-
-	  if (gfc_pure (NULL) && gfc_state_stack->state != COMP_DERIVED)
-	    {
-	      gfc_error ("Initialization of pointer at %C is not allowed in "
-			 "a PURE procedure");
-	      m = MATCH_ERROR;
-	    }
-
+	  m = match_pointer_init (&initializer, 0);
 	  if (m != MATCH_YES)
 	    goto cleanup;
-
 	}
       else if (gfc_match_char ('=') == MATCH_YES)
 	{
@@ -4675,20 +4704,7 @@ match_procedure_decl (void)
 	      goto cleanup;
 	    }
 
-	  m = gfc_match_null (&initializer);
-	  if (m == MATCH_NO)
-	    {
-	      gfc_error ("Pointer initialization requires a NULL() at %C");
-	      m = MATCH_ERROR;
-	    }
-
-	  if (gfc_pure (NULL))
-	    {
-	      gfc_error ("Initialization of pointer at %C is not allowed in "
-			 "a PURE procedure");
-	      m = MATCH_ERROR;
-	    }
-
+	  m = match_pointer_init (&initializer, 1);
 	  if (m != MATCH_YES)
 	    goto cleanup;
 
@@ -4815,18 +4831,7 @@ match_ppc_decl (void)
 
       if (gfc_match (" =>") == MATCH_YES)
 	{
-	  m = gfc_match_null (&initializer);
-	  if (m == MATCH_NO)
-	    {
-	      gfc_error ("Pointer initialization requires a NULL() at %C");
-	      m = MATCH_ERROR;
-	    }
-	  if (gfc_pure (NULL))
-	    {
-	      gfc_error ("Initialization of pointer at %C is not allowed in "
-			 "a PURE procedure");
-	      m = MATCH_ERROR;
-	    }
+	  m = match_pointer_init (&initializer, 1);
 	  if (m != MATCH_YES)
 	    {
 	      gfc_free_expr (initializer);
Index: gcc/fortran/expr.c
===================================================================
--- gcc/fortran/expr.c	(revision 163281)
+++ gcc/fortran/expr.c	(working copy)
@@ -3552,7 +3552,28 @@ gfc_check_assign_symbol (gfc_symbol *sym, gfc_expr
 
   gfc_free (lvalue.symtree);
 
-  return r;
+  if (r == FAILURE)
+    return r;
+  
+  if (sym->attr.pointer && rvalue->expr_type != EXPR_NULL)
+    {
+      /* F08:C461. Additional checks for pointer initialization.  */
+      symbol_attribute attr;
+      attr = gfc_expr_attr (rvalue);
+      if (attr.allocatable)
+	{
+	  gfc_error ("Pointer initialization target at %C "
+	             "must not be ALLOCATABLE ");
+	  return FAILURE;
+	}
+      if (!attr.save)
+	{
+	  gfc_error ("Pointer initialization target at %C must be SAVE");
+	  return FAILURE;
+	}
+    }
+
+  return SUCCESS;
 }
 
 
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 163281)
+++ gcc/fortran/resolve.c	(working copy)
@@ -833,10 +833,11 @@ resolve_contained_functions (gfc_namespace *ns)
 
 
 /* Resolve all of the elements of a structure constructor and make sure that
-   the types are correct.  */
+   the types are correct. The 'init' flag indicates that the given
+   constructor is an initializer.  */
 
 static gfc_try
-resolve_structure_cons (gfc_expr *expr)
+resolve_structure_cons (gfc_expr *expr, int init)
 {
   gfc_constructor *cons;
   gfc_component *comp;
@@ -896,7 +897,8 @@ static gfc_try
 
       /* If we don't have the right type, try to convert it.  */
 
-      if (!gfc_compare_types (&cons->expr->ts, &comp->ts))
+      if (!comp->attr.proc_pointer &&
+	  !gfc_compare_types (&cons->expr->ts, &comp->ts))
 	{
 	  t = FAILURE;
 	  if (strcmp (comp->name, "$extends") == 0)
@@ -1005,6 +1007,23 @@ static gfc_try
 		     "a TARGET", &cons->expr->where, comp->name);
 	}
 
+      if (init)
+	{
+	  /* F08:C461. Additional checks for pointer initialization.  */
+	  if (a.allocatable)
+	    {
+	      t = FAILURE;
+	      gfc_error ("Pointer initialization target at %L "
+			"must not be ALLOCATABLE ", &cons->expr->where);
+	    }
+	  if (!a.save)
+	    {
+	      t = FAILURE;
+	      gfc_error ("Pointer initialization target at %L must be SAVE",
+			&cons->expr->where);
+	    }
+	}
+
       /* F2003, C1272 (3).  */
       if (gfc_pure (NULL) && cons->expr->expr_type == EXPR_VARIABLE
 	  && (gfc_impure_variable (cons->expr->symtree->n.sym)
@@ -1015,6 +1034,7 @@ static gfc_try
 		     "pointer component '%s' at %L in PURE procedure",
 		     comp->name, &cons->expr->where);
 	}
+
     }
 
   return t;
@@ -5977,7 +5997,7 @@ gfc_resolve_expr (gfc_expr *e)
       if (t == FAILURE)
 	break;
 
-      t = resolve_structure_cons (e);
+      t = resolve_structure_cons (e, 0);
       if (t == FAILURE)
 	break;
 
@@ -8956,10 +8976,17 @@ resolve_code (gfc_code *code, gfc_namespace *ns)
 static void
 resolve_values (gfc_symbol *sym)
 {
+  gfc_try t;
+
   if (sym->value == NULL)
     return;
 
-  if (gfc_resolve_expr (sym->value) == FAILURE)
+  if (sym->value->expr_type == EXPR_STRUCTURE)
+    t= resolve_structure_cons (sym->value, 1);
+  else 
+    t = gfc_resolve_expr (sym->value);
+
+  if (t == FAILURE)
     return;
 
   gfc_check_assign_symbol (sym, sym->value);
Index: gcc/fortran/primary.c
===================================================================
--- gcc/fortran/primary.c	(revision 163281)
+++ gcc/fortran/primary.c	(working copy)
@@ -2088,6 +2088,7 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *t
   attr.pointer = pointer;
   attr.allocatable = allocatable;
   attr.target = target;
+  attr.save = sym->attr.save;
 
   return attr;
 }

[-- Attachment #3: pointer_init_2.f90 --]
[-- Type: application/octet-stream, Size: 1253 bytes --]

! { dg-do compile }
!
! PR 45290: [F08] pointer initialization
!
! Contributed by Janus Weil <janus@gcc.gnu.org>


implicit none

real, target, save :: r
integer, target, save, dimension(1:3) :: v

integer, save :: i
integer, target :: j
integer, target, save, allocatable :: a


integer, pointer :: dp0 => 13  ! { dg-error "Error in pointer initialization" }
integer, pointer :: dp1 => r   ! { dg-error "Different types in pointer assignment" }
integer, pointer :: dp2 => v   ! { dg-error "Different ranks in pointer assignment" }
integer, pointer :: dp3 => i   ! { dg-error "is neither TARGET nor POINTER" }
integer, pointer :: dp4 => j   ! { dg-error "must be SAVE" }
integer, pointer :: dp5 => a   ! { dg-error "must not be ALLOCATABLE" }

type :: t
  integer, pointer :: dpc0 => 13  ! { dg-error "Error in pointer initialization" }
  integer, pointer :: dpc1 => r   ! { dg-error "is REAL but should be INTEGER" }
  integer, pointer :: dpc2 => v   ! { dg-error "rank of the element.*does not match" }
  integer, pointer :: dpc3 => i   ! { dg-error "must have the TARGET attribute" }
  integer, pointer :: dpc4 => j   ! { dg-error "must be SAVE" }
  integer, pointer :: dpc5 => a   ! { dg-error "must not be ALLOCATABLE" }
end type

type(t) ::u

end

[-- Attachment #4: pointer_init_3.f90 --]
[-- Type: application/octet-stream, Size: 530 bytes --]

! { dg-do run }
!
! PR 45290: [F08] pointer initialization
!
! Contributed by Janus Weil <janus@gcc.gnu.org>

implicit none

integer,target :: i0 = 2
integer,target,dimension(1:3) :: vec = 1

type :: t
  integer, pointer :: dpc => i0
  integer :: i = 0
end type

type (t), save, target :: u

integer, pointer :: dp => i0
integer, pointer :: dp2 => vec(2)
integer, pointer :: dp3 => u%i

dp = 5
if (i0/=5) call abort()

u%dpc = 6
if (i0/=6) call abort()

dp2 = 3
if (vec(2)/=3) call abort()

dp3 = 4
if (u%i/=4) call abort()

end 

[-- Attachment #5: pointer_init_4.f90 --]
[-- Type: application/octet-stream, Size: 525 bytes --]

! { dg-do run }
!
! PR 45290: [F08] pointer initialization
!
! Contributed by Janus Weil <janus@gcc.gnu.org>

module m

implicit none

contains

  integer function f1()
    f1 = 42
  end function

  integer function f2()
    f2 = 43
  end function

end module


program test_ptr_init

use m
implicit none

procedure(f1), pointer :: pp => f1

type :: t
  procedure(f2), pointer, nopass :: ppc => f2
end type

type (t) :: u

if (pp()/=42) call abort()
if (u%ppc()/=43) call abort()

end

! { dg-final { cleanup-modules "m" } }

^ permalink raw reply	[flat|nested] 13+ messages in thread
* Re: [Patch, Fortran, F08] PR45290: pointer initialization
@ 2010-08-18  8:26 Tobias Burnus
  2010-08-18 13:19 ` Janus Weil
  0 siblings, 1 reply; 13+ messages in thread
From: Tobias Burnus @ 2010-08-18  8:26 UTC (permalink / raw)
  To: Janus Weil, gcc-patches, fortran

Janus Weil wrote:
> Tobias Burnus wrote:
> > - ? ?integer(c_int), dimension(:), pointer :: int_ptr
> > - ? ?my_c_ptr = c_loc(int_ptr(0))
> >
> > Well, as written is is invalid - but change it to
> >
> > - ? ?integer(c_int), dimension(:), pointer :: int_ptr
> > ALLOCATE(int_ptr(0:10))
> > - ? ?my_c_ptr = c_loc(int_ptr(0))
> >
> > Then it is valid.
>
> ... which means that a through check for validity is
> very hard to do at compile time, since it depends on
> the run-time value, right?

Yes, like most pointer-initialization problems, most cannot
be detected at compile time and some only with quite some
effort. However, for compiling,
  my_c_ptr = c_loc(int_ptr(0))
it should be enough to decide whether (based on that line and
the function/variable declarations) it could be valid - and
if so, one accepts the code. In the example, one could track
whether "int_ptr" is ever pointer associated or allocated
before using it; I think NAG's f95 does some of these checks,
though I found a bug where v5.1 refuses to compile a perfectly
valid code because the check misses a valid method to make
the (in that case) allocatable allocated.


> Well, ok. I guess that is one way to look at it. However, if I apply
> the same logic to your earlier pointer-init example ...
>
> module m
>  integer, target, save  :: t1
>  integer, pointer :: p1 => t1
>  integer, pointer :: p3 => p1
> end module m
>
> ... then I'd say this is valid, too. p1 itself is a pointer, but the
> thing that it points to is a target (namely t1). Therefore "p3 => p1"
> is valid, since the object on the RHS has the TARGET attribute. Can we
> agree on that?

Over night I came to the same conclusion. But I think it is only valid if
the pointer on the RHS is pointer-associated (note: after "p => NULL()",
"p" is unassociated) - otherwise the status of the pointer is undefined
or unassociated and no TARGET exists.

But maybe one should ask for a second standard interpretation at j3 or
c.l.f to make sure we interprete it correctly. As this thread shows, it
is very easy to get on the wrong track.

Tobias

^ permalink raw reply	[flat|nested] 13+ messages in thread
* Re: [Patch, Fortran, F08] PR45290: pointer initialization
@ 2010-08-18 13:30 Tobias Burnus
  2010-08-18 22:46 ` Janus Weil
  0 siblings, 1 reply; 13+ messages in thread
From: Tobias Burnus @ 2010-08-18 13:30 UTC (permalink / raw)
  To: Janus Weil, gcc-patches, fortran

Janus Weil wrote at http://gcc.gnu.org/ml/fortran/2010-08/msg00222.html:
> > Yes, like most pointer-initialization problems, most cannot
> > be detected at compile time and some only with quite some
> > effort. [...]
> Ok. I'm certainly not very keen on implementing this right now

Well, I was not suggesting it to you to implement it ;-)

> Anyway, would it be ok if I commit the bulk changes needed for
> pointer init now (i.e. version #2 of the patch as posted
> yesterday), and take care of the remaining problems afterwards?

I assume, you mean: pr45290_v2.diff of
http://gcc.gnu.org/ml/fortran/2010-08/msg00203.html

That patch is OK.

> The remaining problems being:
>
> (2) Making global variables in a program SAVE_IMPLICIT.
> If I do that (analogously to module variables), then I get a couple of
> regressions, e.g.: [...]
> It seems that SAVE_IMPLICIT messes up automatic deallocation ...

You could insert code in resolve_symbol of the kind
  /* Despite implicit SAVE, free and finallize allocatables of
     the main program.  */
  if (sym->attr.save == SAVE_IMPLICIT && sym->attr.allocatable
      && sym->ns->proc_name->attr.is_main_program)
    sym->attr.save = SAVE_NONE


> (1) Initializing to a pointer:
>
> module m
>  implicit none
>  integer, target, save  :: t1
>  integer, pointer :: p1 => t
>  integer, pointer :: p2 => p1    ! ICE
> end module m

When you fix this, please check (in the test case) that "p2"
is indeed associated with "t" and not with "p1".

Additionally, I think one should reject it if the RHS is not
initialized or if it is NULL initialized as in both cases there
cannot be any target on the RHS. (Check also the case LHS == RHS
[invalid] and RHS being an array with non-vector array designator.

Maybe start with the doing the right checks in decl.c - maybe the
ICE disappears then automatically.

Tobias

^ permalink raw reply	[flat|nested] 13+ messages in thread
end of thread, other threads:[~2010-08-18 22:35 UTC | newest]

Thread overview: 13+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2010-08-16 21:42 [Patch, Fortran, F08] PR45290: pointer initialization Janus Weil
2010-08-17  6:38 ` Jerry DeLisle
2010-08-17  7:52 ` Tobias Burnus
2010-08-17 15:05   ` Janus Weil
2010-08-17 21:14     ` Tobias Burnus
2010-08-17 21:48       ` Janus Weil
2010-08-17 22:47         ` Janus Weil
2010-08-17 23:05         ` Tobias Burnus
2010-08-18  7:44           ` Janus Weil
2010-08-18  8:26 Tobias Burnus
2010-08-18 13:19 ` Janus Weil
2010-08-18 13:30 Tobias Burnus
2010-08-18 22:46 ` Janus Weil

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).