From bdc818b4e449a38eec934102a01eb208b68e965b Mon Sep 17 00:00:00 2001 From: charlet Date: Tue, 6 Sep 2011 12:14:30 +0000 Subject: [PATCH] 2011-09-06 Thomas Quinot * s-os_lib.ads (Spawn): Minor documentation clarification, Success is True for a zero exit status. 2011-09-06 Ed Schonberg * sem_ch5.adb: Add message for common iterator error. 2011-09-06 Ed Schonberg * exp_ch3.adb (Build_Initialization_Call): If the target is a selected component discriminated by a current instance, replace the constraint with a reference to the target object, regardless of whether the context is an init_proc. 2011-09-06 Robert Dewar * exp_attr.adb: Descriptor_Size is never static. 2011-09-06 Robert Dewar * gnat_ugn.texi: Add documentation for LSLOC metric in gnatmetric 2011-09-06 Hristian Kirtchev * gnat_rm.texi: Clarify that attribute Descriptor_Size is non-static. 2011-09-06 Ed Schonberg * sem_res.adb (Resolve): An expression that is the body of an expression function does not freeze. 2011-09-06 Matthew Heaney * a-csquin.ads, a-cusyqu.adb, a-cbprqu.adb, a-cbsyqu.adb, a-cuprqu.adb: Changed copyright notice to indicate current year only. 2011-09-06 Vincent Celier * prj.adb: Minor spelling error fix in comment * sem_res.adb: Minor reformatting 2011-09-06 Pascal Obry * sysdep.c (winflush_nt): Removed as not needed anymore. (winflush_95): Likewise. (winflush_init): Likewise. (winflush_function): Likewise. (getc_immediate_common): Remove call to winflush_function. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@178591 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 53 ++++++++++++++++++++++++++++++++++ gcc/ada/a-cbprqu.adb | 2 +- gcc/ada/a-cbsyqu.adb | 2 +- gcc/ada/a-csquin.ads | 2 +- gcc/ada/a-cuprqu.adb | 2 +- gcc/ada/a-cusyqu.adb | 2 +- gcc/ada/exp_attr.adb | 3 +- gcc/ada/exp_ch3.adb | 29 ++++++++++--------- gcc/ada/gnat_rm.texi | 10 +++---- gcc/ada/gnat_ugn.texi | 18 +++++++++++- gcc/ada/s-os_lib.ads | 3 +- gcc/ada/sem_ch5.adb | 15 ++++++++++ gcc/ada/sem_res.adb | 11 ++++++- gcc/ada/sysdep.c | 80 ++------------------------------------------------- 14 files changed, 126 insertions(+), 106 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 02520df..682e500 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,56 @@ +2011-09-06 Thomas Quinot + + * s-os_lib.ads (Spawn): Minor documentation clarification, + Success is True for a zero exit status. + +2011-09-06 Ed Schonberg + + * sem_ch5.adb: Add message for common iterator error. + +2011-09-06 Ed Schonberg + + * exp_ch3.adb (Build_Initialization_Call): If the target is a + selected component discriminated by a current instance, replace + the constraint with a reference to the target object, regardless + of whether the context is an init_proc. + +2011-09-06 Robert Dewar + + * exp_attr.adb: Descriptor_Size is never static. + +2011-09-06 Robert Dewar + + * gnat_ugn.texi: Add documentation for LSLOC metric in gnatmetric + +2011-09-06 Hristian Kirtchev + + * gnat_rm.texi: Clarify that attribute Descriptor_Size is + non-static. + +2011-09-06 Ed Schonberg + + * sem_res.adb (Resolve): An expression that is the body of an + expression function does not freeze. + +2011-09-06 Matthew Heaney + + * a-csquin.ads, a-cusyqu.adb, a-cbprqu.adb, a-cbsyqu.adb, + a-cuprqu.adb: Changed copyright notice to indicate current + year only. + +2011-09-06 Vincent Celier + + * prj.adb: Minor spelling error fix in comment + * sem_res.adb: Minor reformatting + +2011-09-06 Pascal Obry + + * sysdep.c (winflush_nt): Removed as not needed anymore. + (winflush_95): Likewise. + (winflush_init): Likewise. + (winflush_function): Likewise. + (getc_immediate_common): Remove call to winflush_function. + 2011-09-06 Hristian Kirtchev * exp_attr.adb (Expand_N_Attribute_Reference): Rewrite the diff --git a/gcc/ada/a-cbprqu.adb b/gcc/ada/a-cbprqu.adb index ca04912..09a06b2 100644 --- a/gcc/ada/a-cbprqu.adb +++ b/gcc/ada/a-cbprqu.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 2011, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- diff --git a/gcc/ada/a-cbsyqu.adb b/gcc/ada/a-cbsyqu.adb index cb2cbc5..462d6f4 100644 --- a/gcc/ada/a-cbsyqu.adb +++ b/gcc/ada/a-cbsyqu.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 2011, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- diff --git a/gcc/ada/a-csquin.ads b/gcc/ada/a-csquin.ads index 4a544d4..2a4d0b3 100644 --- a/gcc/ada/a-csquin.ads +++ b/gcc/ada/a-csquin.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2004-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 2011, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- diff --git a/gcc/ada/a-cuprqu.adb b/gcc/ada/a-cuprqu.adb index c1da3ee..2d11a26 100644 --- a/gcc/ada/a-cuprqu.adb +++ b/gcc/ada/a-cuprqu.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 2011, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- diff --git a/gcc/ada/a-cusyqu.adb b/gcc/ada/a-cusyqu.adb index 6a8e0d8..7fc01cc 100644 --- a/gcc/ada/a-cusyqu.adb +++ b/gcc/ada/a-cusyqu.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 2011, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index c05385e..897844b 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -1814,11 +1814,12 @@ package body Exp_Attr is Apply_Universal_Integer_Attribute_Checks (N); -- For any other type, the descriptor size is 0 because there is no - -- actual descriptor. + -- actual descriptor, but the result is not formally static. else Rewrite (N, Make_Integer_Literal (Loc, 0)); Analyze (N); + Set_Is_Static_Expression (N, False); end if; --------------- diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 4b5b26f..fecbf5c 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -1563,7 +1563,21 @@ package body Exp_Ch3 is Discriminant_Constraint (Full_Type)); end; - if In_Init_Proc then + -- If the target has access discriminants, and is constrained by + -- an access to the enclosing construct, i.e. a current instance, + -- replace the reference to the type by a reference to the object. + + if Nkind (Arg) = N_Attribute_Reference + and then Is_Access_Type (Etype (Arg)) + and then Is_Entity_Name (Prefix (Arg)) + and then Is_Type (Entity (Prefix (Arg))) + then + Arg := + Make_Attribute_Reference (Loc, + Prefix => New_Copy (Prefix (Id_Ref)), + Attribute_Name => Name_Unrestricted_Access); + + elsif In_Init_Proc then -- Replace any possible references to the discriminant in the -- call to the record initialization procedure with references @@ -1574,19 +1588,6 @@ package body Exp_Ch3 is then Arg := New_Reference_To (Discriminal (Entity (Arg)), Loc); - -- Case of access discriminants. We replace the reference - -- to the type by a reference to the actual object - - elsif Nkind (Arg) = N_Attribute_Reference - and then Is_Access_Type (Etype (Arg)) - and then Is_Entity_Name (Prefix (Arg)) - and then Is_Type (Entity (Prefix (Arg))) - then - Arg := - Make_Attribute_Reference (Loc, - Prefix => New_Copy (Prefix (Id_Ref)), - Attribute_Name => Name_Unrestricted_Access); - -- Otherwise make a copy of the default expression. Note that -- we use the current Sloc for this, because we do not want the -- call to appear to be at the declaration point. Within the diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 4e74a32..666d251 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -5940,11 +5940,11 @@ as a @code{Pos} value (0 for @code{High_Order_First}, 1 for @cindex Dope vector @findex Descriptor_Size @noindent -Attribute @code{Descriptor_Size} returns the size in bits of the descriptor -allocated for a type. The result is non-zero only for unconstrained array -types and the returned value is of type universal integer. In GNAT, an array -descriptor contains bounds information and is located immediately before the -first element of the array. +Non-static attribute @code{Descriptor_Size} returns the size in bits of the +descriptor allocated for a type. The result is non-zero only for unconstrained +array types and the returned value is of type universal integer. In GNAT, an +array descriptor contains bounds information and is located immediately before +the first element of the array. @smallexample @c ada type Unconstr_Array is array (Positive range <>) of Boolean; diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 8d1597d..e177167 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -14235,7 +14235,23 @@ outermost unit and for each eligible local unit: @table @emph @item LSLOC (``Logical Source Lines Of Code'') -The total number of declarations and the total number of statements +The total number of declarations and the total number of statements. Note +that the definition of declarations is the one given in the reference +manual: + +@noindent +``Each of the following is defined to be a declaration: any basic_declaration; +an enumeration_literal_specification; a discriminant_specification; +a component_declaration; a loop_parameter_specification; a +parameter_specification; a subprogram_body; an entry_declaration; +an entry_index_specification; a choice_parameter_specification; +a generic_formal_parameter_declaration.'' + +This means for example that each enumeration literal adds one to the count, +as well as each subprogram parameter. + +Thus the results from this metric will be significantly greater than might +be expected from a naive view of counting semicolons. @item Maximal static nesting level of inner program units According to diff --git a/gcc/ada/s-os_lib.ads b/gcc/ada/s-os_lib.ads index 85e77eb..1c63e38 100755 --- a/gcc/ada/s-os_lib.ads +++ b/gcc/ada/s-os_lib.ads @@ -707,7 +707,8 @@ package System.OS_Lib is -- -- This function will always set Success to False under VxWorks and other -- similar operating systems which have no notion of the concept of - -- dynamically executable file. + -- dynamically executable file. Otherwise Success is set True if the exit + -- status of the spawned process is zero. function Spawn (Program_Name : String; diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 5b56a9d..be22377 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -2430,6 +2430,21 @@ package body Sem_Ch5 is Entity (Find_Aspect (Typ, Aspect_Iterator_Element))); else + -- For an iteration of the form IN, the name must denote an + -- iterator, typically the result of a call to Iterate. Give a + -- useful error message when the name is a container by itself. + + if Is_Entity_Name (Original_Node (Name (N))) + and then not Is_Iterator (Typ) + then + Error_Msg_N + ("name must be an iterator, not a container", Name (N)); + + Error_Msg_NE + ("\to iterate directly over a container, write `of &`", + Name (N), Original_Node (Name (N))); + end if; + -- The result type of Iterate function is the classwide type of -- the interface parent. We need the specific Cursor type defined -- in the container package. diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index d28db8f..9ce5282 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -2810,7 +2810,16 @@ package body Sem_Res is -- default expression mode (the Freeze_Expression routine tests this -- flag and only freezes static types if it is set). - Freeze_Expression (N); + -- AI05-177 (Ada2012): Expression functions do not freeze. Only + -- their use (in an expanded call) freezes. + + if Ekind (Current_Scope) /= E_Function + or else + Nkind (Original_Node (Unit_Declaration_Node (Current_Scope))) /= + N_Expression_Function + then + Freeze_Expression (N); + end if; -- Now we can do the expansion diff --git a/gcc/ada/sysdep.c b/gcc/ada/sysdep.c index af05a91..4d383fd 100644 --- a/gcc/ada/sysdep.c +++ b/gcc/ada/sysdep.c @@ -211,84 +211,10 @@ __gnat_ttyname (int filedes) return NULL; } -/* This function is needed to fix a bug under Win95/98. Under these platforms - doing : - ch1 = getch(); - ch2 = fgetc (stdin); - - will put the same character into ch1 and ch2. It seem that the character - read by getch() is not correctly removed from the buffer. Even a - fflush(stdin) does not fix the bug. This bug does not appear under Window - NT. So we have two version of this routine below one for 95/98 and one for - NT/2000 version of Windows. There is also a special routine (winflushinit) - that will be called only the first time to check which version of Windows - we are running running on to set the right routine to use. - - This problem occurs when using Text_IO.Get_Line after Text_IO.Get_Immediate - for example. - - Calling FlushConsoleInputBuffer just after getch() fix the bug under - 95/98. */ - -#ifdef RTX - -static void winflush_nt (void); - -/* winflush_function will do nothing since we only have problems with Windows - 95/98 which are not supported by RTX. */ - -static void (*winflush_function) (void) = winflush_nt; - -static void -winflush_nt (void) -{ - /* Does nothing as there is no problem under NT. */ -} - -#else /* !RTX */ - -static void winflush_init (void); - -static void winflush_95 (void); - -static void winflush_nt (void); +#ifndef RTX int __gnat_is_windows_xp (void); -/* winflusfunction is set first to the winflushinit function which will check - the OS version 95/98 or NT/2000 */ - -static void (*winflush_function) (void) = winflush_init; - -/* This function does the runtime check of the OS version and then sets - winflush_function to the appropriate function and then call it. */ - -static void -winflush_init (void) -{ - DWORD dwVersion = GetVersion(); - - if (dwVersion < 0x80000000) /* Windows NT/2000 */ - winflush_function = winflush_nt; - else /* Windows 95/98 */ - winflush_function = winflush_95; - - (*winflush_function)(); /* Perform the 'flush' */ - -} - -static void -winflush_95 (void) -{ - FlushConsoleInputBuffer (GetStdHandle (STD_INPUT_HANDLE)); -} - -static void -winflush_nt (void) -{ - /* Does nothing as there is no problem under NT. */ -} - int __gnat_is_windows_xp (void) { @@ -311,7 +237,7 @@ __gnat_is_windows_xp (void) return is_win_xp; } -#endif /* !RTX */ +#endif /* Get the bounds of the stack. The stack pointer is supposed to be initialized to BASE when a thread is created and the stack can be extended @@ -542,7 +468,6 @@ getc_immediate_common (FILE *stream, if (waiting) { *ch = getch (); - (*winflush_function) (); if (*ch == eot_ch) *end_of_file = 1; @@ -559,7 +484,6 @@ getc_immediate_common (FILE *stream, { *avail = 1; *ch = getch (); - (*winflush_function) (); if (*ch == eot_ch) *end_of_file = 1; -- 2.7.4