]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
2010-10-22 Thomas Quinot <quinot@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 22 Oct 2010 10:26:01 +0000 (10:26 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 22 Oct 2010 10:26:01 +0000 (10:26 +0000)
* 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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@165818 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/ada/ChangeLog
gcc/ada/adaint.c
gcc/ada/gnat_ugn.texi
gcc/ada/par-ch5.adb
gcc/ada/sem_ch3.adb

index 2d8f3cbbc085ff0986866f3048a07e2395009641..ca316fdb8ba310d4c57b485830572dce821081ef 100644 (file)
@@ -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
index 3f4654f7a2ac59db698c945b8fda8cf0660d3621..b3e2e0ce648707f6e8d0f68907e3c0a8677d7d2a 100644 (file)
@@ -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;
index d4c76d5c07f64fda39db447cbfe84551a48f41c9..bc688383ab1e9261f0e8ffa2ac2d53ded4af0716 100644 (file)
@@ -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.
index 400b3e1deb59df93b477e617758e269566aa3da5..489707ece970c140c7aed6494bb37886b07cdfdc 100644 (file)
@@ -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
index 8b1398c25a6ea138676d5a6bc534769f24b43489..0c8201182e9ebb61c3530af066e0ae2826e71d49 100644 (file)
@@ -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;
 
    ----------------------------