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

login
register
mail settings
Submitter Tobias Burnus
Date Dec. 14, 2010, 4:13 p.m.
Message ID <4D0797A5.80404@net-b.de>
Download mbox | patch
Permalink /patch/75505/
State New
Headers show

Comments

Tobias Burnus - Dec. 14, 2010, 4:13 p.m.
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
Steve Kargl - Dec. 14, 2010, 5:02 p.m.
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.

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