OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2011-08-01  Geert Bosch  <bosch@adacore.com>

	* par-ch3.adb (P_Discrete_Choice_List): Improve error message for extra
	"," in choice list.

2011-08-01  Thomas Quinot  <quinot@adacore.com>

	* exp_ch11.adb (Expand_N_Raise_Statement): Mark N_Raise_xxx_Error for
	explicit raise of a predefined exception as Comes_From_Source if the
	original N_Raise_Statement comes from source.

2011-08-01  Robert Dewar  <dewar@adacore.com>

	* sinfo.ads: Add comment.
	* sem_ch6.adb: Minor reformatting.

2011-08-01  Robert Dewar  <dewar@adacore.com>

	* freeze.adb (Freeze_Entity): Refine check for bad component size
	clause to avoid rejecting confirming clause when atomic/aliased present.

2011-08-01  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch8.adb (Find_Direct_Name, Analyze_Expanded_Name): use Is_LHS to
	better determine whether an entity reference is a write.
	* sem_util.adb (Is_LHS): refine predicate to handle assignment to a
	subcomponent.
	* lib-xref.adb (Output_References): Do no suppress a read reference at
	the same location as an immediately preceeding modify-reference, to
	handle properly in-out actuals.

2011-08-01  Tristan Gingold  <gingold@adacore.com>

	* env.c (__gnat_setenv) [VMS]: Refine previous change.

2011-08-01  Quentin Ochem  <ochem@adacore.com>

	* i-cstrin.adb (New_String): Changed implementation, now uses only the
	heap to compute the result.

From-SVN: r177029
This commit is contained in:
Arnaud Charlet 2011-08-01 15:23:32 +02:00
parent c7f0d2c0c5
commit 84df40f768
11 changed files with 161 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
gcc/ada/ChangeLog
View File

@ -1,3 +1,43 @@
2011-08-01 Geert Bosch <bosch@adacore.com>
* par-ch3.adb (P_Discrete_Choice_List): Improve error message for extra
"," in choice list.
2011-08-01 Thomas Quinot <quinot@adacore.com>
* exp_ch11.adb (Expand_N_Raise_Statement): Mark N_Raise_xxx_Error for
explicit raise of a predefined exception as Comes_From_Source if the
original N_Raise_Statement comes from source.
2011-08-01 Robert Dewar <dewar@adacore.com>
* sinfo.ads: Add comment.
* sem_ch6.adb: Minor reformatting.
2011-08-01 Robert Dewar <dewar@adacore.com>
* freeze.adb (Freeze_Entity): Refine check for bad component size
clause to avoid rejecting confirming clause when atomic/aliased present.
2011-08-01 Ed Schonberg <schonberg@adacore.com>
* sem_ch8.adb (Find_Direct_Name, Analyze_Expanded_Name): use Is_LHS to
better determine whether an entity reference is a write.
* sem_util.adb (Is_LHS): refine predicate to handle assignment to a
subcomponent.
* lib-xref.adb (Output_References): Do no suppress a read reference at
the same location as an immediately preceeding modify-reference, to
handle properly in-out actuals.
2011-08-01 Tristan Gingold <gingold@adacore.com>
* env.c (__gnat_setenv) [VMS]: Refine previous change.
2011-08-01 Quentin Ochem <ochem@adacore.com>
* i-cstrin.adb (New_String): Changed implementation, now uses only the
heap to compute the result.
2011-08-01 Robert Dewar <dewar@adacore.com>
* atree.ads: Minor reformatting.

5
gcc/ada/env.c
View File

@ -50,7 +50,6 @@ extern "C" {
#include <time.h>
#ifdef VMS
#include <unixio.h>
#include <vms/descrip.h>
#endif
#if defined (__MINGW32__)
@ -74,6 +73,10 @@ extern char** ppGlobalEnviron;
#include <crt_externs.h>
#endif
#ifdef VMS
#include <vms/descrip.h>
#endif
#include "env.h"
void

27
gcc/ada/exp_ch11.adb
View File

@ -1439,6 +1439,7 @@ package body Exp_Ch11 is
E : Entity_Id;
Str : String_Id;
H : Node_Id;
Src : Boolean;
begin
-- Processing for locally handled exception (exclude reraise case)
@ -1510,12 +1511,12 @@ package body Exp_Ch11 is
return;
end if;
-- Remaining processing is for the case where no string expression
-- is present.
-- Remaining processing is for the case where no string expression is
-- present.
-- Don't expand a raise statement that does not come from source
-- if we have already had configurable run-time violations, since
-- most likely it will be junk cascaded nonsense.
-- Don't expand a raise statement that does not come from source if we
-- have already had configurable run-time violations, since most likely
-- it will be junk cascaded nonsense.
if Configurable_Run_Time_Violations > 0
and then not Comes_From_Source (N)
@ -1526,27 +1527,29 @@ package body Exp_Ch11 is
-- Convert explicit raise of Program_Error, Constraint_Error, and
-- Storage_Error into the corresponding raise (in High_Integrity_Mode
-- all other raises will get normal expansion and be disallowed,
-- but this is also faster in all modes).
-- but this is also faster in all modes). Propagate Comes_From_Source
-- flag to the new node.
if Present (Name (N)) and then Nkind (Name (N)) = N_Identifier then
Src := Comes_From_Source (N);
if Entity (Name (N)) = Standard_Constraint_Error then
Rewrite (N,
Make_Raise_Constraint_Error (Loc,
Reason => CE_Explicit_Raise));
Make_Raise_Constraint_Error (Loc, Reason => CE_Explicit_Raise));
Set_Comes_From_Source (N, Src);
Analyze (N);
return;
elsif Entity (Name (N)) = Standard_Program_Error then
Rewrite (N,
Make_Raise_Program_Error (Loc,
Reason => PE_Explicit_Raise));
Make_Raise_Program_Error (Loc, Reason => PE_Explicit_Raise));
Set_Comes_From_Source (N, Src);
Analyze (N);
return;
elsif Entity (Name (N)) = Standard_Storage_Error then
Rewrite (N,
Make_Raise_Storage_Error (Loc,
Reason => SE_Explicit_Raise));
Make_Raise_Storage_Error (Loc, Reason => SE_Explicit_Raise));
Set_Comes_From_Source (N, Src);
Analyze (N);
return;
end if;

24
gcc/ada/freeze.adb
View File

@ -3447,12 +3447,28 @@ package body Freeze is
-- Start of processing for Alias_Atomic_Check
begin
-- Case where component size has no effect
-- Case where component size has no effect. First
-- check for object size of component type known
-- and a multiple of the storage unit size.
if Known_Static_Esize (Ctyp)
and then Known_Static_RM_Size (Ctyp)
and then Esize (Ctyp) = RM_Size (Ctyp)
and then Esize (Ctyp) mod 8 = 0
and then Esize (Ctyp) mod System_Storage_Unit = 0
-- OK in both packing case and component size case
-- if RM size is known and static and the same as
-- the object size.
and then
((Known_Static_RM_Size (Ctyp)
and then Esize (Ctyp) = RM_Size (Ctyp))
-- Or if we have an explicit component size
-- clause and the component size and object size
-- are equal.
or else
(Has_Component_Size_Clause (E)
and then Component_Size (E) = Esize (Ctyp)))
then
null;

20
gcc/ada/i-cstrin.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2010, 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- --
@ -139,8 +139,24 @@ package body Interfaces.C.Strings is
----------------
function New_String (Str : String) return chars_ptr is
-- It's important that this subprogram uses directly the heap to compute
-- the result, and doesn't copy the string on the stack, otherwise its
-- use is limited when used from tasks on large strings.
Result : constant chars_ptr := Memory_Alloc (Str'Length + 1);
Result_Array : char_array (1 .. Str'Length + 1);
for Result_Array'Address use To_Address (Result);
pragma Import (Ada, Result_Array);
Count : size_t;
begin
return New_Char_Array (To_C (Str));
To_C
(Item => Str,
Target => Result_Array,
Count => Count,
Append_Nul => True);
return Result;
end New_String;
----------

13
gcc/ada/lib-xref.adb
View File

@ -1377,6 +1377,9 @@ package body Lib.Xref is
Ctyp : Character;
-- Entity type character
Prevt : Character;
-- reference kind of previous reference
Tref : Entity_Id;
-- Type reference
@ -1519,6 +1522,7 @@ package body Lib.Xref is
Curdef := No_Location;
Curru := No_Unit;
Crloc := No_Location;
Prevt := 'm';
-- Loop to output references
@ -2193,12 +2197,17 @@ package body Lib.Xref is
Crloc := No_Location;
end if;
-- Output the reference
-- Output the reference if it is not as the same location
-- as the previous one, or it is a read-reference that
-- indicates that the entity is an in-out actual in a call.
if XE.Loc /= No_Location
and then XE.Loc /= Crloc
and then
(XE.Loc /= Crloc
or else (Prevt = 'm' and then XE.Typ = 'r'))
then
Crloc := XE.Loc;
Prevt := XE.Typ;
-- Start continuation if line full, else blank

16
gcc/ada/par-ch3.adb
View File

@ -3714,13 +3714,23 @@ package body Ch3 is
end if;
if Token = Tok_Comma then
Error_Msg_SC -- CODEFIX
(""","" should be ""'|""");
Scan; -- past comma
if Token = Tok_Vertical_Bar then
Error_Msg_SP -- CODEFIX
("|extra "","" ignored");
Scan; -- past |
else
Error_Msg_SP -- CODEFIX
(""","" should be ""'|""");
end if;
else
exit when Token /= Tok_Vertical_Bar;
Scan; -- past |
end if;
Scan; -- past | or comma
end loop;
return Choices;

8
gcc/ada/sem_ch6.adb
View File

@ -1072,12 +1072,13 @@ package body Sem_Ch6 is
procedure Analyze_Parameterized_Expression (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
LocX : constant Source_Ptr := Sloc (Expression (N));
Def_Id : constant Entity_Id := Defining_Entity (Specification (N));
Prev : constant Entity_Id := Current_Entity_In_Scope (Def_Id);
Def_Id : constant Entity_Id := Defining_Entity (Specification (N));
New_Body : Node_Id;
Prev : constant Entity_Id := Current_Entity_In_Scope (Def_Id);
-- If the expression is a completion, Prev is the entity whose
-- declaration is completed.
New_Body : Node_Id;
begin
-- This is one of the occasions on which we transform the tree during
-- semantic analysis. Transform the parameterized expression into an
@ -1096,7 +1097,6 @@ package body Sem_Ch6 is
if Present (Prev)
and then Ekind (Prev) = E_Generic_Function
then
-- If the expression completes a generic subprogram, we must create
-- a separate node for the body, because at instantiation the
-- original node of the generic copy must be a generic subprogram

20
gcc/ada/sem_ch8.adb
View File

@ -4574,10 +4574,21 @@ package body Sem_Ch8 is
--
-- The Is_Actual_Parameter routine takes care of one of these
-- cases but there are others probably ???
--
-- If the entity is the LHS of an assignment, and is a variable
-- (rather than a package prefix), we can mark it as a
-- modification right away, to avoid duplicate references.
else
if not Is_Actual_Parameter then
Generate_Reference (E, N);
if Is_LHS (N)
and then Ekind (E) /= E_Package
and then Ekind (E) /= E_Generic_Package
then
Generate_Reference (E, N, 'm');
else
Generate_Reference (E, N);
end if;
end if;
Check_Nested_Access (E);
@ -4980,7 +4991,12 @@ package body Sem_Ch8 is
Set_Entity (N, Id);
else
Set_Entity_Or_Discriminal (N, Id);
Generate_Reference (Id, N);
if Is_LHS (N) then
Generate_Reference (Id, N, 'm');
else
Generate_Reference (Id, N);
end if;
end if;
if Is_Type (Id) then

13
gcc/ada/sem_util.adb
View File

@ -6663,8 +6663,17 @@ package body Sem_Util is
function Is_LHS (N : Node_Id) return Boolean is
P : constant Node_Id := Parent (N);
begin
return Nkind (P) = N_Assignment_Statement
and then Name (P) = N;
if Nkind (P) = N_Assignment_Statement then
return Name (P) = N;
elsif
Nkind_In (P, N_Indexed_Component, N_Selected_Component, N_Slice)
then
return N = Prefix (P) and then Is_LHS (P);
else
return False;
end if;
end Is_LHS;
----------------------------

7
gcc/ada/sinfo.ads
View File

@ -7449,6 +7449,13 @@ package Sinfo is
-- N_Has_Etype, N_Has_Chars
-- Note: of course N_Error does not really have Etype or Chars fields,
-- and any attempt to access these fields in N_Error will cause an
-- error, but historically this always has been positioned so that an
-- "in N_Has_Chars" or "in N_Has_Etype" test yields true for N_Error.
-- Most likely this makes coding easier somewhere but still seems
-- undesirable. To be investigated some time ???
N_Error,
-- N_Entity, N_Has_Etype, N_Has_Chars