diff mbox

[Fortran] PR 46937 - fix function annotation for derived types with pointer component

Message ID 4D0797A5.80404@net-b.de
State New
Headers show

Commit Message

Tobias Burnus Dec. 14, 2010, 4:13 p.m. UTC 
gfortran 4.6 annotates functions to tell the middle end that certain 
arguments are not modified.

Well, the previous patch was too eager by forgetting about pointer 
components of derived types, as the PR shows. This patch adds a check 
for  (proc-)pointer components and also takes care of BT_CLASS.

Build and currently regtesting on x86-64-linux.
OK for the trunk?

Tobias

Comments

Steve Kargl Dec. 14, 2010, 5:02 p.m. UTC | #1 
On Tue, Dec 14, 2010 at 05:13:25PM +0100, Tobias Burnus wrote:
> gfortran 4.6 annotates functions to tell the middle end that certain 
> arguments are not modified.
> 
> Well, the previous patch was too eager by forgetting about pointer 
> components of derived types, as the PR shows. This patch adds a check 
> for  (proc-)pointer components and also takes care of BT_CLASS.
> 
> Build and currently regtesting on x86-64-linux.
> OK for the trunk?
> 

OK.
diff mbox

Patch

2010-12-14  Tobias Burnus  <burnus@net-b.de>

	PR fortran/46937
	* trans-types.c (create_fn_spec): "."-annotate derived types
	with (proc-)pointer components.

2010-12-14  Tobias Burnus  <burnus@net-b.de>

	PR fortran/46937
	* gfortran.dg/pointer_intent_4.f90: New.

diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 561261f..1de7e1e 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -2325,7 +2325,13 @@  create_fn_spec (gfc_symbol *sym, tree fntype)
     if (spec_len < sizeof (spec))
       {
 	if (!f->sym || f->sym->attr.pointer || f->sym->attr.target
-	    || f->sym->attr.external || f->sym->attr.cray_pointer)
+	    || f->sym->attr.external || f->sym->attr.cray_pointer
+	    || (f->sym->ts.type == BT_DERIVED
+		&& (f->sym->ts.u.derived->attr.proc_pointer_comp
+		    || f->sym->ts.u.derived->attr.pointer_comp))
+	    || (f->sym->ts.type == BT_CLASS
+		&& (CLASS_DATA (f->sym)->ts.u.derived->attr.proc_pointer_comp
+		    || CLASS_DATA (f->sym)->ts.u.derived->attr.pointer_comp)))
 	  spec[spec_len++] = '.';
 	else if (f->sym->attr.intent == INTENT_IN)
 	  spec[spec_len++] = 'r';
diff --git a/gcc/testsuite/gfortran.dg/pointer_intent_4.f90 b/gcc/testsuite/gfortran.dg/pointer_intent_4.f90
new file mode 100644
index 0000000..862edff
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_intent_4.f90
@@ -0,0 +1,30 @@ 
+! { dg-do run }
+! { dg-options "-fno-inline" }
+!
+! PR fortran/46937
+!
+! Check that a non-pointer INTENT(IN) dummy
+! with pointer component is properly treated
+!
+program test
+ type myT
+   integer, pointer :: point
+ end type myT
+ type(myT) :: t2
+ allocate(t2%point)
+ t2%point = 42
+ call nonpointer(t2)
+ if(t2%point /= 7) call abort()
+ t2%point = 42
+ call nonpointer2(t2)
+ if(t2%point /= 66) call abort()
+contains
+  subroutine nonpointer(t)
+     type(myT), intent(in) :: t
+     t%point = 7
+  end subroutine nonpointer
+  subroutine nonpointer2(t)
+     class(myT), intent(in) :: t
+     t%point = 66
+  end subroutine nonpointer2
+end program