re PR fortran/16404 (should reject invalid code with -pedantic -std=f95 ? (x8))

2005-10-01  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/16404
	PR fortran/20835
	PR fortran/20890
	PR fortran/20899
	PR fortran/20900
	PR fortran/20901
	PR fortran/20902
	* gfortran.h: Prototype for gfc_add_in_equivalence.
	* match.c (gfc_match_equivalence): Make a structure component
	an explicit,rather than a syntax, error in an equivalence
	group.  Call gfc_add_in_equivalence to add the constraints
	imposed in check_conflict.
	* resolve.c (resolve_symbol): Add constraints: No public
	structures with private-type components and no public
	procedures with private-type dummy arguments.
	(resolve_equivalence_derived): Add constraint that prevents
	a structure equivalence member from having a default
	initializer.
	(sequence_type): New static function to determine whether an
	object is default numeric, default character, non-default
	or mixed sequence. Add corresponding enum typespec.
	(resolve_equivalence): Add constraints to equivalence groups
	or their members: No more than one initialized member and
	that different types are not equivalenced for std=f95.  All
	the simple constraints have been moved to check_conflict.
	* symbol.c (check_conflict): Simple equivalence constraints
	added, including those removed from resolve_symbol.
	(gfc_add_in_equivalence): New function to interface calls
	match_equivalence to check_conflict.

2005-10-01  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/16404
	PR fortran/20835
	PR fortran/20890
	PR fortran/20899
	PR fortran/20900
	PR fortran/20901
	PR fortran/20902
	gfortran.dg/equiv_constraint_1.f90: New test.
	gfortran.dg/equiv_constraint_2.f90: New test.
	gfortran.dg/equiv_constraint_3.f90: New test.
	gfortran.dg/equiv_constraint_4.f90: New test.
	gfortran.dg/equiv_constraint_5.f90: New test.
	gfortran.dg/equiv_constraint_6.f90: New test.
	gfortran.dg/equiv_constraint_7.f90: New test.
	gfortran.dg/equiv_constraint_8.f90: New test.
	gfortran.dg/private_type_1.f90: New test.
	gfortran.dg/private_type_2.f90: New test.
	gfortran.dg/g77/980628-2.f, 980628-3.f, 980628-9.f,
	980628-10.f: Assert std=gnu to permit mixing of
	types in equivalence statements.

From-SVN: r104850

gcc/fortran/ChangeLog

+2005-10-01  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/16404
+	PR fortran/20835
+	PR fortran/20890
+	PR fortran/20899
+	PR fortran/20900
+	PR fortran/20901
+	PR fortran/20902
+	* gfortran.h: Prototype for gfc_add_in_equivalence.
+	* match.c (gfc_match_equivalence): Make a structure component
+	an explicit,rather than a syntax, error in an equivalence
+	group.  Call gfc_add_in_equivalence to add the constraints
+	imposed in check_conflict.
+	* resolve.c (resolve_symbol): Add constraints: No public
+	structures with private-type components and no public
+	procedures with private-type dummy arguments.
+	(resolve_equivalence_derived): Add constraint that prevents
+	a structure equivalence member from having a default
+	initializer.
+	(sequence_type): New static function to determine whether an
+	object is default numeric, default character, non-default
+	or mixed sequence. Add corresponding enum typespec.
+	(resolve_equivalence): Add constraints to equivalence groups
+	or their members: No more than one initialized member and
+	that different types are not equivalenced for std=f95.  All
+	the simple constraints have been moved to check_conflict.
+	* symbol.c (check_conflict): Simple equivalence constraints
+	added, including those removed from resolve_symbol.
+	(gfc_add_in_equivalence): New function to interface calls
+	match_equivalence to check_conflict.
+
 2005-09-27  Jakub Jelinek  <jakub@redhat.com>
 
 	PR fortran/18518

gcc/fortran/gfortran.h

@@ -1639,6 +1639,7 @@ try gfc_add_dummy (symbol_attribute *, const char *, locus *);
 try gfc_add_generic (symbol_attribute *, const char *, locus *);
 try gfc_add_common (symbol_attribute *, locus *);
 try gfc_add_in_common (symbol_attribute *, const char *, locus *);
+try gfc_add_in_equivalence (symbol_attribute *, const char *, locus *);
 try gfc_add_data (symbol_attribute *, const char *, locus *);
 try gfc_add_in_namelist (symbol_attribute *, const char *, locus *);
 try gfc_add_sequence (symbol_attribute *, const char *, locus *);

gcc/fortran/match.c

@@ -2622,6 +2622,13 @@ gfc_match_equivalence (void)
 	  if (m == MATCH_NO)
 	    goto syntax;
 
+	  if (gfc_match_char ('%') == MATCH_YES)
+	    {
+	      gfc_error ("Derived type component %C is not a "
+			 "permitted EQUIVALENCE member");
+	      goto cleanup;
+	    }
+
 	  for (ref = set->expr->ref; ref; ref = ref->next)
 	    if (ref->type == REF_ARRAY && ref->u.ar.type == AR_SECTION)
 	      {
@@ -2631,14 +2638,18 @@ gfc_match_equivalence (void)
 		goto cleanup;
 	      }
 
-	  if (set->expr->symtree->n.sym->attr.in_common)
+	  sym = set->expr->symtree->n.sym;
+
+	  if (gfc_add_in_equivalence (&sym->attr, sym->name, NULL)
+		== FAILURE)
+	    goto cleanup;
+
+	  if (sym->attr.in_common)
 	    {
 	      common_flag = TRUE;
-	      common_head = set->expr->symtree->n.sym->common_head;
+	      common_head = sym->common_head;
 	    }
 
-	  set->expr->symtree->n.sym->attr.in_equivalence = 1;
-
 	  if (gfc_match_char (')') == MATCH_YES)
 	    break;
 	  if (gfc_match_char (',') != MATCH_YES)

gcc/fortran/symbol.c

@@ -262,7 +262,8 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
     *in_common = "COMMON", *result = "RESULT", *in_namelist = "NAMELIST",
     *public = "PUBLIC", *optional = "OPTIONAL", *entry = "ENTRY",
     *function = "FUNCTION", *subroutine = "SUBROUTINE",
-    *dimension = "DIMENSION";
+    *dimension = "DIMENSION", *in_equivalence = "EQUIVALENCE",
+    *use_assoc = "USE ASSOCIATED";
 
   const char *a1, *a2;
 
@@ -323,6 +324,15 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
   conf (in_common, result);
   conf (dummy, result);
 
+  conf (in_equivalence, use_assoc);
+  conf (in_equivalence, dummy);
+  conf (in_equivalence, target);
+  conf (in_equivalence, pointer);
+  conf (in_equivalence, function);
+  conf (in_equivalence, result);
+  conf (in_equivalence, entry);
+  conf (in_equivalence, allocatable);
+
   conf (in_namelist, pointer);
   conf (in_namelist, allocatable);
 
@@ -726,6 +736,21 @@ gfc_add_in_common (symbol_attribute * attr, const char *name, locus * where)
   return gfc_add_flavor (attr, FL_VARIABLE, name, where);
 }
 
+try
+gfc_add_in_equivalence (symbol_attribute * attr, const char *name, locus * where)
+{
+
+  /* Duplicate attribute already checked for.  */
+  attr->in_equivalence = 1;
+  if (check_conflict (attr, name, where) == FAILURE)
+    return FAILURE;
+
+  if (attr->flavor == FL_VARIABLE)
+    return SUCCESS;
+
+  return gfc_add_flavor (attr, FL_VARIABLE, name, where);
+}
+
 
 try
 gfc_add_data (symbol_attribute *attr, const char *name, locus *where)

gcc/testsuite/ChangeLog

+2005-10-01  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/16404
+	PR fortran/20835
+	PR fortran/20890
+	PR fortran/20899
+	PR fortran/20900
+	PR fortran/20901
+	PR fortran/20902
+	gfortran.dg/equiv_constraint_1.f90: New test.
+	gfortran.dg/equiv_constraint_2.f90: New test.
+	gfortran.dg/equiv_constraint_3.f90: New test.
+	gfortran.dg/equiv_constraint_4.f90: New test.
+	gfortran.dg/equiv_constraint_5.f90: New test.
+	gfortran.dg/equiv_constraint_6.f90: New test.
+	gfortran.dg/equiv_constraint_7.f90: New test.
+	gfortran.dg/equiv_constraint_8.f90: New test.
+	gfortran.dg/private_type_1.f90: New test.
+	gfortran.dg/private_type_2.f90: New test.
+	gfortran.dg/g77/980628-2.f, 980628-3.f, 980628-9.f,
+	980628-10.f: Assert std=gnu to permit mixing of
+	types in equivalence statements.
+
 2005-09-30  Janne Blomqvist <jblomqvi@cc.hut.fi>
 
 	PR 24112

gcc/testsuite/gfortran.dg/equiv_constraint_1.f90

+! { dg-do compile }
+! { dg-options "-std=f95" }
+! PR20901 - F95 constrains mixing of types in equivalence.
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+ character(len=4) :: a
+ integer :: i
+ equivalence(a,i) ! { dg-error "in default CHARACTER EQUIVALENCE statement at" }
+ END
+
+

gcc/testsuite/gfortran.dg/equiv_constraint_2.f90

+! { dg-do compile }
+! { dg-options "-std=f95" }
+!
+! PR20901 - Checks resolution of types in EQUIVALENCE statement when
+! f95 standard is imposed.
+!
+! Contributed by Paul Thomas <pault@gcc.gnu.org>
+!
+  type   :: numeric_type
+    sequence
+    integer  :: i
+    real     :: x
+    real*8   :: d
+    complex  :: z
+    logical  :: l
+  end type numeric_type
+
+  type (numeric_type) :: my_num, thy_num
+
+  type   :: numeric_type2
+    sequence
+    integer  :: i
+    real     :: x
+    real*8   :: d
+    complex  :: z
+    logical  :: l
+  end type numeric_type2
+
+  type (numeric_type2) :: his_num
+
+  type       :: char_type
+    sequence
+    character*4 :: ch
+    character*4 :: cha (6)
+  end type char_type
+
+  type (char_type) ::  my_char
+
+  type       :: mixed_type
+    sequence
+    integer*4 :: i(4)
+    character*4 :: cha (6)
+  end type mixed_type
+
+  type (mixed_type) ::  my_mixed, thy_mixed
+
+  character(len=4) :: ch
+  integer :: num
+  integer*8 :: non_def
+  complex*16 :: my_z, thy_z
+
+! Permitted: character with character sequence
+!            numeric with numeric sequence
+!            numeric sequence with numeric sequence
+!            non-default of same type
+!            mixed sequences of same type
+  equivalence (ch, my_char)
+  equivalence (num, my_num)
+  equivalence (my_num, his_num, thy_num)
+  equivalence (my_z, thy_z)
+  equivalence (my_mixed, thy_mixed)
+
+! Not permitted by the standard - OK with -std=gnu
+  equivalence (my_mixed, my_num) ! { dg-error "with mixed components in EQUIVALENCE" }
+  equivalence (my_z, num) ! { dg-error "Non-default type object or sequence" }
+  equivalence (my_char, my_num) ! { dg-error "in default CHARACTER EQUIVALENCE" }
+  equivalence (ch, my_num) ! { dg-error "in default CHARACTER EQUIVALENCE" }
+  equivalence (my_num, ch) ! { dg-error "in default NUMERIC EQUIVALENCE" }
+  equivalence (num, my_char) ! { dg-error "in default NUMERIC EQUIVALENCE" }
+  equivalence (my_char, num) ! { dg-error "in default CHARACTER EQUIVALENCE" }
+  equivalence (non_def, ch) ! { dg-error "Non-default type object or sequence" }
+  equivalence (my_z, ch) ! { dg-error "Non-default type object or sequence" }
+  equivalence (my_z, num) ! { dg-error "Non-default type object or sequence" }
+ END

gcc/testsuite/gfortran.dg/equiv_constraint_3.f90

+! { dg-do compile }
+! PR20900 - USE associated variables cannot be equivalenced.
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+MODULE TEST
+ INTEGER :: I
+END MODULE
+! note 11.7
+USE TEST, ONLY : K=>I
+INTEGER :: L
+EQUIVALENCE(K,L) ! { dg-error "conflicts with USE ASSOCIATED attribute" }
+END
+
+

gcc/testsuite/gfortran.dg/equiv_constraint_4.f90

+! { dg-do run }
+! { dg-options "-O0" }
+! PR20901 - check that derived/numeric equivalence works with std!=f95.
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+TYPE data_type
+ SEQUENCE
+ INTEGER :: I
+END TYPE data_type
+INTEGER :: J = 7
+TYPE(data_type) :: dd
+EQUIVALENCE(dd,J)
+if (dd%i.ne.7) call abort ()
+END
+
+
+

gcc/testsuite/gfortran.dg/equiv_constraint_5.f90

+! { dg-do compile }
+! { dg-options "-O0" }
+! PR20902 - Structure with default initializer cannot be equivalence memeber.
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+TYPE T1
+ sequence
+ integer :: i=1
+END TYPE T1
+TYPE T2
+ sequence
+ integer :: i      ! drop original initializer to pick up error below.
+END TYPE T2
+TYPE(T1) :: a1
+TYPE(T2) :: a2
+EQUIVALENCE(a1,a2) ! { dg-error "initializer cannot be an EQUIVALENCE" }
+write(6,*) a1,a2
+END
+

gcc/testsuite/gfortran.dg/equiv_constraint_6.f90

+! { dg-do compile }
+! PR16404 test 3 and PR20835 - Target cannot be equivalence object.
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+  REAL :: A
+  REAL, TARGET :: B
+  EQUIVALENCE(A,B) ! { dg-error "conflicts with TARGET attribute" }
+END
+

gcc/testsuite/gfortran.dg/equiv_constraint_7.f90

+! { dg-do compile }
+! { dg-options "-O0" }
+! PR20890 - Equivalence cannot contain more than one initialized variables.
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+ BLOCK DATA
+  INTEGER :: I=1,J=2
+  EQUIVALENCE(I,J)  ! { dg-error "cannot both be in the EQUIVALENCE" }
+ END BLOCK DATA
+ END

gcc/testsuite/gfortran.dg/equiv_constraint_8.f90

+! { dg-do compile }
+! { dg-options "-O0" }
+! PR20899 - Common block variables cannot be equivalenced in a pure procedure.
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+common /z/ i
+contains
+pure integer function test(j)
+  integer, intent(in) :: j
+  common /z/ i
+  integer :: k
+  equivalence(i,k) ! { dg-error "EQUIVALENCE object in the pure" }
+  k=1 ! { dg-error "in PURE procedure at" }
+  test=i*j
+end function test
+end
+

gcc/testsuite/gfortran.dg/g77/980628-10.f

 c { dg-do run }
+c { dg-options "-std=gnu" }
 * g77 0.5.23 and previous had bugs involving too little space
 * allocated for EQUIVALENCE and COMMON areas needing initial
 * padding to meet alignment requirements of the system.

gcc/testsuite/gfortran.dg/g77/980628-2.f

 c { dg-do run }
+c { dg-options "-std=gnu" }
 * g77 0.5.23 and previous had bugs involving too little space
 * allocated for EQUIVALENCE and COMMON areas needing initial
 * padding to meet alignment requirements of the system.

gcc/testsuite/gfortran.dg/g77/980628-3.f

 c { dg-do run }
+c { dg-options "-std=gnu" }
+c
 * g77 0.5.23 and previous had bugs involving too little space
 * allocated for EQUIVALENCE and COMMON areas needing initial
 * padding to meet alignment requirements of the system.

gcc/testsuite/gfortran.dg/g77/980628-9.f

 c { dg-do run }
+c { dg-options "-std=gnu" }
 * g77 0.5.23 and previous had bugs involving too little space
 * allocated for EQUIVALENCE and COMMON areas needing initial
 * padding to meet alignment requirements of the system.

gcc/testsuite/gfortran.dg/private_type_1.f90

+! { dg-do compile }
+! PR21986 - test based on original example.
+! A public subroutine must not have private-type, dummy arguments.
+! Contributed by Paul Thomas <pault@gcc.gnu.org>
+module modboom
+  implicit none
+  private
+  public:: dummysub ! { dg-error "PRIVATE type and cannot be a dummy argument" }
+  type:: intwrapper
+    integer n
+  end type intwrapper
+contains
+  subroutine dummysub(size, arg_array)
+   type(intwrapper) :: size
+   real, dimension(size%n) :: arg_array
+   real :: local_array(4)
+  end subroutine dummysub
+end module modboom
+

gcc/testsuite/gfortran.dg/private_type_2.f90

+! { dg-do compile }
+! PR16404 test 6 - A public type cannot have private-type components.
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+MODULE TEST
+  PRIVATE
+  TYPE :: info_type
+   INTEGER :: value
+  END TYPE info_type
+  TYPE :: all_type! { dg-error "PRIVATE type and cannot be a component" }
+    TYPE(info_type) :: info
+  END TYPE
+  public  all_type
+END MODULE
+END
+