[multiple changes]

2010-10-22  Thomas Quinot  <quinot@adacore.com>

	* sem_ch3.adb (Complete_Private_Subtype): The full view of the subtype
	may already have a rep item chain inherited from the full view of the
	base type, so do not overwrite it when propagating rep items from the
	partial view of the subtype.
	* sem_ch3.adb: Minor code reorganization.  Minor reformatting.

2010-10-22  Sergey Rybin  <rybin@adacore.com>

	* gnat_ugn.texi (gnatmetric): Remove description of debug option.

2010-10-22  Tristan Gingold  <gingold@adacore.com>

	* adaint.c (__gnat_number_of_cpus): Add implementation for VMS.

2010-10-22  Ed Schonberg  <schonberg@adacore.com>

	* par-ch5.adb: Set properly starting sloc of loop parameter.

From-SVN: r165818

5 files changed, 82 insertions, 13 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 2d8f3cb..ca316fd 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,23 @@
+2010-10-22  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_ch3.adb (Complete_Private_Subtype): The full view of the subtype
+	may already have a rep item chain inherited from the full view of the
+	base type, so do not overwrite it when propagating rep items from the
+	partial view of the subtype.
+	* sem_ch3.adb: Minor code reorganization.  Minor reformatting.
+
+2010-10-22  Sergey Rybin  <rybin@adacore.com>
+
+	* gnat_ugn.texi (gnatmetric): Remove description of debug option.
+
+2010-10-22  Tristan Gingold  <gingold@adacore.com>
+
+	* adaint.c (__gnat_number_of_cpus): Add implementation for VMS.
+
+2010-10-22  Ed Schonberg  <schonberg@adacore.com>
+
+	* par-ch5.adb: Set properly starting sloc of loop parameter.
+
 2010-10-22  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_util.adb (May_Be_Lvalue): An actual in a function call can be an
diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c
index 3f4654f..b3e2e0ce 100644
--- a/gcc/ada/adaint.c
+++ b/gcc/ada/adaint.c
@@ -188,6 +188,9 @@ struct vstring
   char string[NAM$C_MAXRSS+1];
 };
 
+#define SYI$_ACTIVECPU_CNT 0x111e
+extern int LIB$GETSYI (int *, unsigned int *);
+
 #else
 #include <utime.h>
 #endif
@@ -2394,6 +2397,15 @@ __gnat_number_of_cpus (void)
   SYSTEM_INFO sysinfo;
   GetSystemInfo (&sysinfo);
   cores = (int) sysinfo.dwNumberOfProcessors;
+
+#elif defined (VMS)
+  int code = SYI$_ACTIVECPU_CNT;
+  unsigned int res;
+  int status;
+
+  status = LIB$GETSYI (&code, &res);
+  if ((status & 1) != 0)
+    cores = res;
 #endif
 
   return cores;
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index d4c76d5..bc68838 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -14553,12 +14553,6 @@ Verbose mode;
 @command{gnatmetric} generates version information and then
 a trace of sources being processed.
 
-@item ^-dv^/DEBUG_OUTPUT^
-@cindex @option{^-dv^/DEBUG_OUTPUT^} (@code{gnatmetric})
-Debug mode;
-@command{gnatmetric} generates various messages useful to understand what
-happens during the metrics computation
-
 @item ^-q^/QUIET^
 @cindex @option{^-q^/QUIET^} (@code{gnatmetric})
 Quiet mode.
diff --git a/gcc/ada/par-ch5.adb b/gcc/ada/par-ch5.adb
index 400b3e1..489707e 100644
--- a/gcc/ada/par-ch5.adb
+++ b/gcc/ada/par-ch5.adb
@@ -1711,11 +1711,19 @@ package body Ch5 is
       --  during analysis of the loop parameter specification.
 
       if Token = Tok_Of or else Token = Tok_Colon then
+
+         if Ada_Version < Ada_2012 then
+            Error_Msg_SC ("iterator is an Ada2012 feature");
+         end if;
+
          return P_Iterator_Specification (ID_Node);
       end if;
 
+      --  The span of the Loop_Parameter_Specification starts at the
+      --  defining identifier.
+
       Loop_Param_Specification_Node :=
-        New_Node (N_Loop_Parameter_Specification, Token_Ptr);
+        New_Node (N_Loop_Parameter_Specification, Sloc (ID_Node));
       Set_Defining_Identifier (Loop_Param_Specification_Node, ID_Node);
 
       if Token = Tok_Left_Paren then
@@ -1753,7 +1761,7 @@ package body Ch5 is
       Node1 : Node_Id;
 
    begin
-      Node1 :=  New_Node (N_Iterator_Specification, Token_Ptr);
+      Node1 :=  New_Node (N_Iterator_Specification, Sloc (Def_Id));
       Set_Defining_Identifier (Node1, Def_Id);
 
       if Token = Tok_Colon then
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 8b1398c..0c82011 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -9914,12 +9914,47 @@ package body Sem_Ch3 is
          end if;
       end if;
 
-      --  Copy rep item chain, and also setting of Has_Predicates from
-      --  private subtype to full subtype, since we will need these on the
-      --  full subtype to create the predicate function.
+      --  Link rep item chain, and also setting of Has_Predicates from private
+      --  subtype to full subtype, since we will need these on the full subtype
+      --  to create the predicate function. Note that the full subtype may
+      --  already have rep items, inherited from the full view of the base
+      --  type, so we must be sure not to overwrite these entries.
 
-      Set_First_Rep_Item (Full, First_Rep_Item (Priv));
-      Set_Has_Predicates (Full, Has_Predicates (Priv));
+      declare
+         Item      : Node_Id;
+         Next_Item : Node_Id;
+
+      begin
+         Item := First_Rep_Item (Full);
+
+         --  If no existing rep items on full type, we can just link directly
+         --  to the list of items on the private type.
+
+         if No (Item) then
+            Set_First_Rep_Item (Full, First_Rep_Item (Priv));
+
+         --  Else search to end of items currently linked to the full subtype
+
+         else
+            loop
+               Next_Item := Next_Rep_Item (Item);
+               exit when No (Next_Item);
+               Item := Next_Item;
+            end loop;
+
+            --  And link the private type items at the end of the chain
+
+            Set_Next_Rep_Item (Item, First_Rep_Item (Priv));
+         end if;
+      end;
+
+      --  Make sure Has_Predicates is set on full type if it is set on the
+      --  private type. Note that it may already be set on the full type and
+      --  if so, we don't want to unset it.
+
+      if Has_Predicates (Priv) then
+         Set_Has_Predicates (Full);
+      end if;
    end Complete_Private_Subtype;
 
    ----------------------------