PR fortran/82934,83318 -- Enforce F2008:C631

Message ID 20171209011328.GA42376@troutmask.apl.washington.edu
State New
Headers show
Series
  • PR fortran/82934,83318 -- Enforce F2008:C631
Related show

Commit Message

Steve Kargl Dec. 9, 2017, 1:13 a.m.
The attached patch enforces F2008:C631, which of course is

/* F2008:C631 (R626) A type-param-value in a type-spec shall be an
   asterisk if and only if each allocate-object is a dummy argument
   for which the corresponding type parameter is assumed.  */

Regression tested on x86_64-*-freebsd.

2017-12-08  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/82934
	PR fortran/83318
	* match.c (gfc_match_allocate): Enforce F2008:C631.

2017-12-08  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/82934
	PR fortran/83318
	* gfortran.dg/allocate_assumed_charlen_2.f90: new test.

-- 
Steve

Comments

Thomas Koenig Dec. 9, 2017, 8:59 a.m. | #1
Hi Steve,

> The attached patch enforces F2008:C631, which of course is

> 

> /* F2008:C631 (R626) A type-param-value in a type-spec shall be an

>     asterisk if and only if each allocate-object is a dummy argument

>     for which the corresponding type parameter is assumed.  */

> 

> Regression tested on x86_64-*-freebsd.



Looks good, OK for trunk.

Thanks for the patch!

Regards

	Thomas
Paul Richard Thomas Dec. 9, 2017, 9:09 a.m. | #2
Hi Steve,

This is good for trunk with one proviso:

This should mutate from:
-  /* TODO understand why this error does not appear but, instead,
-     the derived type is caught as a variable in primary.c.  */
-  if (gfc_spec_list_type (type_param_spec_list, NULL) != SPEC_EXPLICIT)
     {
-      gfc_error ("The type parameter spec list in the type-spec at "
- "%L cannot contain ASSUMED or DEFERRED parameters",
- &old_locus);
-      goto cleanup;

to (ignoring lhs white space and tabs):
   if (type_param_spec_list
       && gfc_spec_list_type (type_param_spec_list, NULL) == SPEC_DEFERRED)
      {
         gfc_error ("The type parameter spec list in the type-spec at "
                        %L cannot contain DEFERRED parameters", &old_locus);
         goto cleanup;
      }

which retains the appropriate error for PDTs.

Cheers

Paul


On 9 December 2017 at 01:13, Steve Kargl
<sgk@troutmask.apl.washington.edu> wrote:
> The attached patch enforces F2008:C631, which of course is

>

> /* F2008:C631 (R626) A type-param-value in a type-spec shall be an

>    asterisk if and only if each allocate-object is a dummy argument

>    for which the corresponding type parameter is assumed.  */

>

> Regression tested on x86_64-*-freebsd.

>

> 2017-12-08  Steven G. Kargl  <kargl@gcc.gnu.org>

>

>         PR fortran/82934

>         PR fortran/83318

>         * match.c (gfc_match_allocate): Enforce F2008:C631.

>

> 2017-12-08  Steven G. Kargl  <kargl@gcc.gnu.org>

>

>         PR fortran/82934

>         PR fortran/83318

>         * gfortran.dg/allocate_assumed_charlen_2.f90: new test.

>

> --

> Steve




-- 
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein
Steve Kargl Dec. 9, 2017, 4:21 p.m. | #3
On Sat, Dec 09, 2017 at 09:09:14AM +0000, Paul Richard Thomas wrote:
> 

> This is good for trunk with one proviso:

> 

> This should mutate from:

> -  /* TODO understand why this error does not appear but, instead,

> -     the derived type is caught as a variable in primary.c.  */

> -  if (gfc_spec_list_type (type_param_spec_list, NULL) != SPEC_EXPLICIT)

>      {

> -      gfc_error ("The type parameter spec list in the type-spec at "

> - "%L cannot contain ASSUMED or DEFERRED parameters",

> - &old_locus);

> -      goto cleanup;

> 

> to (ignoring lhs white space and tabs):

>    if (type_param_spec_list

>        && gfc_spec_list_type (type_param_spec_list, NULL) == SPEC_DEFERRED)

>       {

>          gfc_error ("The type parameter spec list in the type-spec at "

>                         %L cannot contain DEFERRED parameters", &old_locus);

>          goto cleanup;

>       }

> 

> which retains the appropriate error for PDTs.

> 


OK.  Do you have a test that triggers this error
sitting in your next round of PDT changes?  My
regression testing did not bulk at the removal
of the code.

BTW, is this code correct?

bool
gfc_insert_parameter_exprs (gfc_expr *e, gfc_actual_arglist *param_list)
{
  gfc_actual_arglist *old_param_spec_list = type_param_spec_list;
  type_param_spec_list = param_list;
  return gfc_traverse_expr (e, NULL, &insert_parameter_exprs, 1);
  type_param_spec_list = NULL;
  type_param_spec_list = old_param_spec_list;
}

The last 2 line are never reached?

-- 
Steve
Paul Richard Thomas Dec. 9, 2017, 4:46 p.m. | #4
Hi Steve,

I can generate such a test but it will have to wait until I have
finished doing all my Christmas cards :-)

As for the dead code, that is not what is intended and might explain
some difficulties that I have had with the code in decl.c.

Cheers

Paul


On 9 December 2017 at 16:21, Steve Kargl
<sgk@troutmask.apl.washington.edu> wrote:
> On Sat, Dec 09, 2017 at 09:09:14AM +0000, Paul Richard Thomas wrote:

>>

>> This is good for trunk with one proviso:

>>

>> This should mutate from:

>> -  /* TODO understand why this error does not appear but, instead,

>> -     the derived type is caught as a variable in primary.c.  */

>> -  if (gfc_spec_list_type (type_param_spec_list, NULL) != SPEC_EXPLICIT)

>>      {

>> -      gfc_error ("The type parameter spec list in the type-spec at "

>> - "%L cannot contain ASSUMED or DEFERRED parameters",

>> - &old_locus);

>> -      goto cleanup;

>>

>> to (ignoring lhs white space and tabs):

>>    if (type_param_spec_list

>>        && gfc_spec_list_type (type_param_spec_list, NULL) == SPEC_DEFERRED)

>>       {

>>          gfc_error ("The type parameter spec list in the type-spec at "

>>                         %L cannot contain DEFERRED parameters", &old_locus);

>>          goto cleanup;

>>       }

>>

>> which retains the appropriate error for PDTs.

>>

>

> OK.  Do you have a test that triggers this error

> sitting in your next round of PDT changes?  My

> regression testing did not bulk at the removal

> of the code.

>

> BTW, is this code correct?

>

> bool

> gfc_insert_parameter_exprs (gfc_expr *e, gfc_actual_arglist *param_list)

> {

>   gfc_actual_arglist *old_param_spec_list = type_param_spec_list;

>   type_param_spec_list = param_list;

>   return gfc_traverse_expr (e, NULL, &insert_parameter_exprs, 1);

>   type_param_spec_list = NULL;

>   type_param_spec_list = old_param_spec_list;

> }

>

> The last 2 line are never reached?

>

> --

> Steve




-- 
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein
Steve Kargl Dec. 9, 2017, 7:55 p.m. | #5
On Fri, Dec 08, 2017 at 05:13:28PM -0800, Steve Kargl wrote:
> The attached patch enforces F2008:C631, which of course is

> 

> /* F2008:C631 (R626) A type-param-value in a type-spec shall be an

>    asterisk if and only if each allocate-object is a dummy argument

>    for which the corresponding type parameter is assumed.  */

> 

> Regression tested on x86_64-*-freebsd.

> 

> 2017-12-08  Steven G. Kargl  <kargl@gcc.gnu.org>

> 

> 	PR fortran/82934

> 	PR fortran/83318

> 	* match.c (gfc_match_allocate): Enforce F2008:C631.

> 

> 2017-12-08  Steven G. Kargl  <kargl@gcc.gnu.org>

> 

> 	PR fortran/82934

> 	PR fortran/83318

> 	* gfortran.dg/allocate_assumed_charlen_2.f90: new test.

> 


The final version of the patch that I committed is attached.

-- 
Steve
Index: gcc/fortran/match.c
===================================================================
--- gcc/fortran/match.c	(revision 255517)
+++ gcc/fortran/match.c	(working copy)
@@ -3960,9 +3960,9 @@ gfc_match_allocate (void)
   gfc_typespec ts;
   gfc_symbol *sym;
   match m;
-  locus old_locus, deferred_locus;
+  locus old_locus, deferred_locus, assumed_locus;
   bool saw_stat, saw_errmsg, saw_source, saw_mold, saw_deferred, b1, b2, b3;
-  bool saw_unlimited = false;
+  bool saw_unlimited = false, saw_assumed = false;
 
   head = tail = NULL;
   stat = errmsg = source = mold = tmp = NULL;
@@ -3993,6 +3993,9 @@ gfc_match_allocate (void)
     }
   else
     {
+      /* Needed for the F2008:C631 check below. */
+      assumed_locus = gfc_current_locus;
+
       if (gfc_match (" :: ") == MATCH_YES)
 	{
 	  if (!gfc_notify_std (GFC_STD_F2003, "typespec in ALLOCATE at %L",
@@ -4007,15 +4010,19 @@ gfc_match_allocate (void)
 	    }
 
 	  if (ts.type == BT_CHARACTER)
-	    ts.u.cl->length_from_typespec = true;
+	    {
+	      if (!ts.u.cl->length)
+		saw_assumed = true;
+	      else
+		ts.u.cl->length_from_typespec = true;
+	    }
 
-	  /* TODO understand why this error does not appear but, instead,
-	     the derived type is caught as a variable in primary.c.  */
-	  if (gfc_spec_list_type (type_param_spec_list, NULL) != SPEC_EXPLICIT)
+	  if (type_param_spec_list
+	      && gfc_spec_list_type (type_param_spec_list, NULL)
+		 == SPEC_DEFERRED)
 	    {
 	      gfc_error ("The type parameter spec list in the type-spec at "
-			 "%L cannot contain ASSUMED or DEFERRED parameters",
-			 &old_locus);
+			 "%L cannot contain DEFERRED parameters", &old_locus);
 	      goto cleanup;
 	    }
 	}
@@ -4054,6 +4061,19 @@ gfc_match_allocate (void)
 
       if (impure)
 	gfc_unset_implicit_pure (NULL);
+
+      /* F2008:C631 (R626) A type-param-value in a type-spec shall be an
+	 asterisk if and only if each allocate-object is a dummy argument
+	 for which the corresponding type parameter is assumed.  */
+      if (saw_assumed
+	  && (tail->expr->ts.deferred
+	      || tail->expr->ts.u.cl->length
+	      || tail->expr->symtree->n.sym->attr.dummy == 0))
+	{
+	  gfc_error ("Incompatible allocate-object at %C for CHARACTER "
+		     "type-spec at %L", &assumed_locus);
+	  goto cleanup;
+	}
 
       if (tail->expr->ts.deferred)
 	{
Index: gcc/testsuite/gfortran.dg/allocate_assumed_charlen_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/allocate_assumed_charlen_2.f90	(nonexistent)
+++ gcc/testsuite/gfortran.dg/allocate_assumed_charlen_2.f90	(working copy)
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! PR fortran/82934
+! PR fortran/83318
+program a
+ character(len=42), allocatable :: f
+ character(len=22), allocatable :: ff
+ call alloc(f, ff)
+ if (len(f) .ne. 42) call abort
+ if (len(ff) .ne. 22) call abort
+contains
+ subroutine alloc( a, b )
+  character(len=*), allocatable  :: a
+  character(len=22), allocatable :: b
+  character(len=:), allocatable :: c
+  character, allocatable :: d
+  allocate(character(len=*)::a,b) ! { dg-error "Incompatible allocate-object" }
+  allocate(character(len=*)::c)   ! { dg-error "Incompatible allocate-object" }
+  allocate(character(len=*)::d)   ! { dg-error "Incompatible allocate-object" }
+ end subroutine
+end program a
Paul Richard Thomas Dec. 10, 2017, 5:18 p.m. | #6
Hi Steve,

I see that the implementation of the standard is slightly more
complicated than I thought.

  type :: t(a,b)
    integer, kind :: a
    integer, len :: b
    integer(a) :: v(b)
  end type t

  type(t(4,:)), allocatable :: z1
  type(t(4,10)), allocatable :: z2

  allocate (t(4, :) :: z1) ! { dg-error "cannot contain DEFERRED parameters" }
  allocate (t(4, *) :: z2) ! This should give an error because it isn't a dummy.

  call foo (z1, z2, z2)

contains
  subroutine foo (arg1, arg2, arg3)
    type(t(4,:)), allocatable :: arg1
    type(t(4,*)), allocatable :: arg2
    type(t(4,10)), allocatable :: arg3

    allocate (t(4, :) :: arg1) ! { dg-error "cannot contain DEFERRED
parameters" }
    allocate (t(4, *) :: arg2) ! This needs to be handled correctly at
runtime but is legal.
    allocate (t(4, *) :: arg2) ! This should give an error because the
dummy parameter is not assumed.
  end subroutine

end

I'll hit this next weekend because I am away all this week.

Regards

Paul


On 9 December 2017 at 19:55, Steve Kargl
<sgk@troutmask.apl.washington.edu> wrote:
> On Fri, Dec 08, 2017 at 05:13:28PM -0800, Steve Kargl wrote:

>> The attached patch enforces F2008:C631, which of course is

>>

>> /* F2008:C631 (R626) A type-param-value in a type-spec shall be an

>>    asterisk if and only if each allocate-object is a dummy argument

>>    for which the corresponding type parameter is assumed.  */

>>

>> Regression tested on x86_64-*-freebsd.

>>

>> 2017-12-08  Steven G. Kargl  <kargl@gcc.gnu.org>

>>

>>       PR fortran/82934

>>       PR fortran/83318

>>       * match.c (gfc_match_allocate): Enforce F2008:C631.

>>

>> 2017-12-08  Steven G. Kargl  <kargl@gcc.gnu.org>

>>

>>       PR fortran/82934

>>       PR fortran/83318

>>       * gfortran.dg/allocate_assumed_charlen_2.f90: new test.

>>

>

> The final version of the patch that I committed is attached.

>

> --

> Steve




-- 
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein
Steve Kargl Dec. 10, 2017, 5:48 p.m. | #7
On Sun, Dec 10, 2017 at 05:18:53PM +0000, Paul Richard Thomas wrote:
> Hi Steve,

> 

> I see that the implementation of the standard is slightly more

> complicated than I thought.


I haven't played with PDT, yet.  My patch only deals with
assumed length character.  See below for a question.

>   type :: t(a,b)

>     integer, kind :: a

>     integer, len :: b

>     integer(a) :: v(b)

>   end type t

> 

>   type(t(4,:)), allocatable :: z1

>   type(t(4,10)), allocatable :: z2

> 

>   allocate (t(4, :) :: z1) ! { dg-error "cannot contain DEFERRED parameters" }

>   allocate (t(4, *) :: z2) ! This should give an error because it isn't a dummy.

> 

>   call foo (z1, z2, z2)

> 

> contains

>   subroutine foo (arg1, arg2, arg3)

>     type(t(4,:)), allocatable :: arg1

>     type(t(4,*)), allocatable :: arg2

>     type(t(4,10)), allocatable :: arg3

> 

>     allocate (t(4, :) :: arg1) ! { dg-error "cannot contain DEFERRED

> parameters" }

>     allocate (t(4, *) :: arg2) ! This needs to be handled correctly at

> runtime but is legal.

>     allocate (t(4, *) :: arg2) ! This should give an error because the


Did you mean arg3 here?

> dummy parameter is not assumed.

>   end subroutine

> 

> end

> 

> I'll hit this next weekend because I am away all this week.

> 


-- 
steve
Paul Richard Thomas Dec. 10, 2017, 6:11 p.m. | #8
Yes - thanks

Paul

On 10 December 2017 at 17:48, Steve Kargl
<sgk@troutmask.apl.washington.edu> wrote:
> On Sun, Dec 10, 2017 at 05:18:53PM +0000, Paul Richard Thomas wrote:

>> Hi Steve,

>>

>> I see that the implementation of the standard is slightly more

>> complicated than I thought.

>

> I haven't played with PDT, yet.  My patch only deals with

> assumed length character.  See below for a question.

>

>>   type :: t(a,b)

>>     integer, kind :: a

>>     integer, len :: b

>>     integer(a) :: v(b)

>>   end type t

>>

>>   type(t(4,:)), allocatable :: z1

>>   type(t(4,10)), allocatable :: z2

>>

>>   allocate (t(4, :) :: z1) ! { dg-error "cannot contain DEFERRED parameters" }

>>   allocate (t(4, *) :: z2) ! This should give an error because it isn't a dummy.

>>

>>   call foo (z1, z2, z2)

>>

>> contains

>>   subroutine foo (arg1, arg2, arg3)

>>     type(t(4,:)), allocatable :: arg1

>>     type(t(4,*)), allocatable :: arg2

>>     type(t(4,10)), allocatable :: arg3

>>

>>     allocate (t(4, :) :: arg1) ! { dg-error "cannot contain DEFERRED

>> parameters" }

>>     allocate (t(4, *) :: arg2) ! This needs to be handled correctly at

>> runtime but is legal.

>>     allocate (t(4, *) :: arg2) ! This should give an error because the

>

> Did you mean arg3 here?

>

>> dummy parameter is not assumed.

>>   end subroutine

>>

>> end

>>

>> I'll hit this next weekend because I am away all this week.

>>

>

> --

> steve




-- 
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein

Patch

Index: gcc/fortran/match.c
===================================================================
--- gcc/fortran/match.c	(revision 255517)
+++ gcc/fortran/match.c	(working copy)
@@ -3960,9 +3960,9 @@  gfc_match_allocate (void)
   gfc_typespec ts;
   gfc_symbol *sym;
   match m;
-  locus old_locus, deferred_locus;
+  locus old_locus, deferred_locus, assumed_locus;
   bool saw_stat, saw_errmsg, saw_source, saw_mold, saw_deferred, b1, b2, b3;
-  bool saw_unlimited = false;
+  bool saw_unlimited = false, saw_assumed = false;
 
   head = tail = NULL;
   stat = errmsg = source = mold = tmp = NULL;
@@ -3993,6 +3993,9 @@  gfc_match_allocate (void)
     }
   else
     {
+      /* Needed for the F2008:C631 check below. */
+      assumed_locus = gfc_current_locus;
+
       if (gfc_match (" :: ") == MATCH_YES)
 	{
 	  if (!gfc_notify_std (GFC_STD_F2003, "typespec in ALLOCATE at %L",
@@ -4007,16 +4010,11 @@  gfc_match_allocate (void)
 	    }
 
 	  if (ts.type == BT_CHARACTER)
-	    ts.u.cl->length_from_typespec = true;
-
-	  /* TODO understand why this error does not appear but, instead,
-	     the derived type is caught as a variable in primary.c.  */
-	  if (gfc_spec_list_type (type_param_spec_list, NULL) != SPEC_EXPLICIT)
 	    {
-	      gfc_error ("The type parameter spec list in the type-spec at "
-			 "%L cannot contain ASSUMED or DEFERRED parameters",
-			 &old_locus);
-	      goto cleanup;
+	      if (!ts.u.cl->length)
+		saw_assumed = true;
+	      else
+		ts.u.cl->length_from_typespec = true;
 	    }
 	}
       else
@@ -4054,6 +4052,17 @@  gfc_match_allocate (void)
 
       if (impure)
 	gfc_unset_implicit_pure (NULL);
+
+      /* F2008:C631 (R626) A type-param-value in a type-spec shall be an
+	 asterisk if and only if each allocate-object is a dummy argument
+	 for which the corresponding type parameter is assumed.  */
+      if (saw_assumed
+	  && (tail->expr->ts.deferred || tail->expr->ts.u.cl->length))
+	{
+	  gfc_error ("Incompatible allocate-object at %C for CHARACTER "
+		     "type-spec at %L", &assumed_locus);
+	  goto cleanup;
+	}
 
       if (tail->expr->ts.deferred)
 	{
Index: gcc/testsuite/gfortran.dg/allocate_assumed_charlen_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/allocate_assumed_charlen_2.f90	(nonexistent)
+++ gcc/testsuite/gfortran.dg/allocate_assumed_charlen_2.f90	(working copy)
@@ -0,0 +1,20 @@ 
+! { dg-do compile }
+! PR fortran/82934
+! PR fortran/83318
+program a
+ character(len=42), allocatable :: f
+ character(len=22), allocatable :: ff
+ call alloc(f, ff)
+ if (len(f) .ne. 42) call abort
+ if (len(ff) .ne. 22) call abort
+contains
+ subroutine alloc( a, b )
+  character(len=*), allocatable  :: a
+  character(len=22), allocatable :: b
+  character(len=:), allocatable :: c
+  character, allocatable :: d
+  allocate(character(len=*)::a,b) ! { dg-error "Incompatible allocate-object" }
+  allocate(character(len=*)::c)   ! { dg-error "Incompatible allocate-object" }
+  allocate(character(len=*)::d)   ! { dg-error "Incompatible allocate-object" }
+ end subroutine
+end program a