aboutsummaryrefslogtreecommitdiffstats
path: root/meta/recipes-devtools/gcc/gcc-4.6.0/gcc-4_6-branch-backports/0380-2011-06-02-Steven-G.-Kargl-kargl-gcc.gnu.org.patch
blob: 9dcda3d9433625fdf7738d640b54ccbc632bd7ac (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
From 56d647438bd3a69b44b10fb4e2adaceb5d9fac49 Mon Sep 17 00:00:00 2001
From: kargl <kargl@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Thu, 2 Jun 2011 19:53:02 +0000
Subject: [PATCH] 2011-06-02  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/49265
	* decl.c (gfc_match_modproc):  Allow for a double colon in a module
	procedure statement.
	* parse.c ( decode_statement): Deal with whitespace around :: in
	gfc_match_modproc.

2011-06-02  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/49265
	* gfortran.dg/module_procedure_double_colon_1.f90: New test.
	* gfortran.dg/module_procedure_double_colon_2.f90: New test.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gcc-4_6-branch@174576 138bc75d-0d04-0410-961f-82ee72b054a4

index 80249b5..90693a4 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -7005,6 +7005,7 @@ gfc_match_modproc (void)
   char name[GFC_MAX_SYMBOL_LEN + 1];
   gfc_symbol *sym;
   match m;
+  locus old_locus;
   gfc_namespace *module_ns;
   gfc_interface *old_interface_head, *interface;
 
@@ -7033,10 +7034,23 @@ gfc_match_modproc (void)
      end up with a syntax error and need to recover.  */
   old_interface_head = gfc_current_interface_head ();
 
+  /* Check if the F2008 optional double colon appears.  */
+  gfc_gobble_whitespace ();
+  old_locus = gfc_current_locus;
+  if (gfc_match ("::") == MATCH_YES)
+    {
+      if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: double colon in "
+			 "MODULE PROCEDURE statement at %L", &old_locus)
+	  == FAILURE)
+	return MATCH_ERROR;
+    }
+  else
+    gfc_current_locus = old_locus;
+      
   for (;;)
     {
-      locus old_locus = gfc_current_locus;
       bool last = false;
+      old_locus = gfc_current_locus;
 
       m = gfc_match_name (name);
       if (m == MATCH_NO)
@@ -7048,6 +7062,7 @@ gfc_match_modproc (void)
 	 current namespace.  */
       if (gfc_match_eos () == MATCH_YES)
 	last = true;
+
       if (!last && gfc_match_char (',') != MATCH_YES)
 	goto syntax;
 
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 7b24cc4..1acd251 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -399,7 +399,7 @@ decode_statement (void)
       break;
 
     case 'm':
-      match ("module% procedure% ", gfc_match_modproc, ST_MODULE_PROC);
+      match ("module% procedure", gfc_match_modproc, ST_MODULE_PROC);
       match ("module", gfc_match_module, ST_MODULE);
       break;
 
new file mode 100644
index 0000000..200f0ff
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_procedure_double_colon_1.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+!
+! PR fortran/49265
+! Contributed by Erik Toussaint
+!
+module m1
+   implicit none
+   interface foo
+      module procedure::bar
+      module procedure ::bar_none
+      module procedure:: none_bar
+   end interface
+contains
+   subroutine bar
+   end subroutine
+   subroutine bar_none(i)
+     integer i
+   end subroutine
+   subroutine none_bar(x)
+     real x
+   end subroutine
+end module
+! { dg-final { cleanup-modules "m1" } }
diff --git a/gcc/testsuite/gfortran.dg/module_procedure_double_colon_2.f90 b/gcc/testsuite/gfortran.dg/module_procedure_double_colon_2.f90
new file mode 100644
index 0000000..9300215
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_procedure_double_colon_2.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+!
+! PR fortran/49265
+! Contributed by Erik Toussaint
+!
+module m1
+   implicit none
+   interface foo
+      module procedure::bar       ! { dg-error "double colon" }
+      module procedure ::bar_none ! { dg-error "double colon" }
+      module procedure:: none_bar ! { dg-error "double colon" }
+   end interface
+contains
+   subroutine bar
+   end subroutine
+   subroutine bar_none(i)
+     integer i
+   end subroutine
+   subroutine none_bar(x)
+     real x
+   end subroutine
+end module
+! { dg-final { cleanup-modules "m1" } }
-- 
1.7.0.4