Commit a043e735 by Arnaud Charlet

[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
parent 229db351
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
......
......@@ -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;
......
......@@ -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.
......
......@@ -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
......
......@@ -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;
----------------------------
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment