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

[multiple changes] 

2015-05-27  Robert Dewar  <dewar@adacore.com>

	* sem_aux.adb: Minor rewording.

2015-05-27  Bob Duff  <duff@adacore.com>

	* exp_prag.adb (Expand_Pragma_Abort_Defer): Make
	pragma Abort_Defer do nothing if Abort_Allowed is False.

2015-05-27  Arnaud Charlet  <charlet@adacore.com>

	* exp_ch9.adb, sem_util.adb, sem_util.ads, s-stposu.adb, s-spsufi.ads,
	sem_elab.ads, g-comlin.ads, errout.ads, exp_ch6.adb, sem_ch4.adb,
	opt.ads, s-bignum.adb, output.ads, sem_ch13.adb, erroutc.ads,
	sem_disp.ads, exp_ch3.adb: Minor fixes of duplicate words in comments.

2015-05-27  Doug Rupp  <rupp@adacore.com>

	* adaint.c (__gnat_tmp_name) [vxworks]: Robustify and use for rtp as
	well as kernel.

2015-05-27  Pierre-Marie de Rodat  <derodat@adacore.com>

	* par_sco.adb (Process_Decision): Store sloc to
	condition/pragmas SCOs associations into a temporary table before
	moving them to the SCO_Raw_Hash_Table so that we can back them
	out just like we do for SCO entries that are simple decisions
	in an expression context.

From-SVN: r223754
This commit is contained in:
Arnaud Charlet 2015-05-27 15:26:16 +02:00
parent 99206968a8
commit 50ef946c45
22 changed files with 166 additions and 73 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
gcc/ada/ChangeLog
View File

@ -1,3 +1,32 @@
2015-05-27 Robert Dewar <dewar@adacore.com>
* sem_aux.adb: Minor rewording.
2015-05-27 Bob Duff <duff@adacore.com>
* exp_prag.adb (Expand_Pragma_Abort_Defer): Make
pragma Abort_Defer do nothing if Abort_Allowed is False.
2015-05-27 Arnaud Charlet <charlet@adacore.com>
* exp_ch9.adb, sem_util.adb, sem_util.ads, s-stposu.adb, s-spsufi.ads,
sem_elab.ads, g-comlin.ads, errout.ads, exp_ch6.adb, sem_ch4.adb,
opt.ads, s-bignum.adb, output.ads, sem_ch13.adb, erroutc.ads,
sem_disp.ads, exp_ch3.adb: Minor fixes of duplicate words in comments.
2015-05-27 Doug Rupp <rupp@adacore.com>
* adaint.c (__gnat_tmp_name) [vxworks]: Robustify and use for rtp as
well as kernel.
2015-05-27 Pierre-Marie de Rodat <derodat@adacore.com>
* par_sco.adb (Process_Decision): Store sloc to
condition/pragmas SCOs associations into a temporary table before
moving them to the SCO_Raw_Hash_Table so that we can back them
out just like we do for SCO entries that are simple decisions
in an expression context.
2015-05-27 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Process_Formals): A non-private formal type that

34
gcc/ada/adaint.c
View File

@ -1170,23 +1170,37 @@ __gnat_tmp_name (char *tmp_filename)
sprintf (tmp_filename, "%s/gnat-XXXXXX", tmpdir);
close (mkstemp(tmp_filename));
#elif defined (__vxworks) && !(defined (__RTP__) || defined (VTHREADS))
int index;
char * pos;
ushort_t t;
#elif defined (__vxworks) && !defined (VTHREADS)
int index;
char *pos;
char *savepos;
static ushort_t seed = 0; /* used to generate unique name */
/* generate unique name */
/* Generate a unique name. */
strcpy (tmp_filename, "tmp");
/* fill up the name buffer from the last position */
index = 5;
pos = tmp_filename + strlen (tmp_filename) + index;
savepos = pos = tmp_filename + strlen (tmp_filename) + index;
*pos = '\0';
seed++;
for (t = seed; 0 <= --index; t >>= 3)
*--pos = '0' + (t & 07);
while (1)
{
FILE *f;
ushort_t t;
/* Fill up the name buffer from the last position. */
seed++;
for (t = seed; 0 <= --index; t >>= 3)
*--pos = '0' + (t & 07);
/* Check to see if its unique, if not bump the seed and try again. */
f = fopen (tmp_filename, "r");
if (f == NULL)
break;
fclose (f);
pos = savepos;
index = 5;
}
#else
tmpnam (tmp_filename);
#endif

2
gcc/ada/errout.ads
View File

@ -837,7 +837,7 @@ package Errout is
-- pragma, or the null string if no reason is given. Config is True for the
-- configuration pragma case (where there is no requirement for a matching
-- OFF pragma). Used is set True to disable the check that the warning
-- actually has has the effect of suppressing a warning.
-- actually has the effect of suppressing a warning.
procedure Set_Specific_Warning_On
(Loc : Source_Ptr;

4
gcc/ada/erroutc.ads
View File

@ -552,7 +552,7 @@ package Erroutc is
-- pragma, or the null string if no reason is given. Config is True for the
-- configuration pragma case (where there is no requirement for a matching
-- OFF pragma). Used is set True to disable the check that the warning
-- actually has has the effect of suppressing a warning.
-- actually has the effect of suppressing a warning.
procedure Set_Specific_Warning_On
(Loc : Source_Ptr;
@ -580,7 +580,7 @@ package Erroutc is
-- which generates a warning range for the whole source file). This routine
-- only deals with the general ON/OFF case, not specific warnings. The
-- returned result is No_String if warnings are not suppressed. If warnings
-- are suppressed for the given location, then then corresponding Reason
-- are suppressed for the given location, then corresponding Reason
-- parameter from the pragma is returned (or the null string if no Reason
-- parameter was present).

2
gcc/ada/exp_ch3.adb
View File

@ -5177,7 +5177,7 @@ package body Exp_Ch3 is
and then not Is_Value_Type (Typ)
then
-- Do not initialize the components if No_Default_Initialization
-- applies as the the actual restriction check will occur later
-- applies as the actual restriction check will occur later
-- when the object is frozen as it is not known yet whether the
-- object is imported or not.

2
gcc/ada/exp_ch6.adb
View File

@ -8992,7 +8992,7 @@ package body Exp_Ch6 is
Freeze_Expression (Ptr_Typ_Freeze_Ref);
end;
-- If the the object is a return object of an enclosing build-in-place
-- If the object is a return object of an enclosing build-in-place
-- function, then the implicit build-in-place parameters of the
-- enclosing function are simply passed along to the called function.
-- (Unfortunately, this won't cover the case of extension aggregates

4
gcc/ada/exp_ch9.adb
View File

@ -4284,7 +4284,7 @@ package body Exp_Ch9 is
Append (Unprot_Call, Stmts);
end if;
-- Historical note: Previously, call the the cleanup was inserted
-- Historical note: Previously, call to the cleanup was inserted
-- here. This is now done by Build_Protected_Subprogram_Call_Cleanup,
-- which is also shared by the 'not Exc_Safe' path.
@ -12153,7 +12153,7 @@ package body Exp_Ch9 is
-- 3) Ada 2005 (AI-345): When T.E is a dispatching procedure call, there
-- is no delay and the triggering statements are executed. We first
-- determine the kind of of the triggering call and then execute a
-- determine the kind of the triggering call and then execute a
-- synchronized operation or a direct call.
-- declare

68
gcc/ada/exp_prag.adb
View File

@ -251,41 +251,51 @@ package body Exp_Prag is
-- end;
procedure Expand_Pragma_Abort_Defer (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
Stm : Node_Id;
Stms : List_Id;
HSS : Node_Id;
Blk : constant Entity_Id :=
New_Internal_Entity (E_Block, Current_Scope, Sloc (N), 'B');
AUD : constant Entity_Id := RTE (RE_Abort_Undefer_Direct);
begin
Stms := New_List (Build_Runtime_Call (Loc, RE_Abort_Defer));
loop
Stm := Remove_Next (N);
exit when No (Stm);
Append (Stm, Stms);
end loop;
-- Abort_Defer has no useful effect if Abort's are not allowed
HSS :=
Make_Handled_Sequence_Of_Statements (Loc,
Statements => Stms,
At_End_Proc => New_Occurrence_Of (AUD, Loc));
if not Abort_Allowed then
return;
end if;
-- Present the Abort_Undefer_Direct function to the backend so that it
-- can inline the call to the function.
-- Normal case where abort is possible
Add_Inlined_Body (AUD, N);
declare
Loc : constant Source_Ptr := Sloc (N);
Stm : Node_Id;
Stms : List_Id;
HSS : Node_Id;
Blk : constant Entity_Id :=
New_Internal_Entity (E_Block, Current_Scope, Sloc (N), 'B');
AUD : constant Entity_Id := RTE (RE_Abort_Undefer_Direct);
Rewrite (N,
Make_Block_Statement (Loc,
Handled_Statement_Sequence => HSS));
begin
Stms := New_List (Build_Runtime_Call (Loc, RE_Abort_Defer));
loop
Stm := Remove_Next (N);
exit when No (Stm);
Append (Stm, Stms);
end loop;
Set_Scope (Blk, Current_Scope);
Set_Etype (Blk, Standard_Void_Type);
Set_Identifier (N, New_Occurrence_Of (Blk, Sloc (N)));
Expand_At_End_Handler (HSS, Blk);
Analyze (N);
HSS :=
Make_Handled_Sequence_Of_Statements (Loc,
Statements => Stms,
At_End_Proc => New_Occurrence_Of (AUD, Loc));
-- Present the Abort_Undefer_Direct function to the backend so that
-- it can inline the call to the function.
Add_Inlined_Body (AUD, N);
Rewrite (N,
Make_Block_Statement (Loc, Handled_Statement_Sequence => HSS));
Set_Scope (Blk, Current_Scope);
Set_Etype (Blk, Standard_Void_Type);
Set_Identifier (N, New_Occurrence_Of (Blk, Sloc (N)));
Expand_At_End_Handler (HSS, Blk);
Analyze (N);
end;
end Expand_Pragma_Abort_Defer;
--------------------------

4
gcc/ada/g-comlin.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1999-2014, AdaCore --
-- Copyright (C) 1999-2015, AdaCore --
-- --
-- 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- --
@ -502,7 +502,7 @@ package GNAT.Command_Line is
-- Expansion of command line arguments --
-----------------------------------------
-- These subprograms take care of of expanding globbing patterns on the
-- These subprograms take care of expanding globbing patterns on the
-- command line. On Unix, such expansion is done by the shell before your
-- application is called. But on Windows you must do this expansion
-- yourself.

2
gcc/ada/opt.ads
View File

@ -2144,7 +2144,7 @@ package Opt is
---------------------------
-- The following array would more reasonably be located in Err_Vars or
-- Errour, but but we put them here to deal with licensing issues (we need
-- Errour, but we put them here to deal with licensing issues (we need
-- this to have the GPL exception licensing, since these variables and
-- subprograms are accessed from units with this licensing).

4
gcc/ada/output.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2015, 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- --
@ -60,7 +60,7 @@ package Output is
-- Sets subsequent output to call procedure P. If P is null, then the call
-- cancels the effect of a previous call, reverting the output to standard
-- error or standard output depending on the mode at the time of previous
-- call. Any exception generated by by calls to P is simply propagated to
-- call. Any exception generated by calls to P is simply propagated to
-- the caller of the routine causing the write operation.
procedure Cancel_Special_Output;

48
gcc/ada/par_sco.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2009-2014, Free Software Foundation, Inc. --
-- Copyright (C) 2009-2015, 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- --
@ -495,6 +495,32 @@ package body Par_SCO is
-- table. We use it for backing out a simple decision in an expression
-- context that contains only NOT operators.
Mark_Hash : Nat;
-- Likewise for the putative SCO_Raw_Hash_Table entries: see below
type Hash_Entry is record
Sloc : Source_Ptr;
SCO_Index : Nat;
end record;
-- We must register all conditions/pragmas in SCO_Raw_Hash_Table.
-- However we cannot register them in the same time we are adding the
-- corresponding SCO entries to the raw table since we may discard them
-- later on. So instead we put all putative conditions into Hash_Entries
-- (see below) and register them once we are sure we keep them.
--
-- This data structure holds the conditions/pragmas to register in
-- SCO_Raw_Hash_Table.
package Hash_Entries is new Table.Table (
Table_Component_Type => Hash_Entry,
Table_Index_Type => Nat,
Table_Low_Bound => 1,
Table_Initial => 10,
Table_Increment => 10,
Table_Name => "Hash_Entries");
-- Hold temporarily (i.e. free'd before returning) the Hash_Entry before
-- they are registered in SCO_Raw_Hash_Table.
X_Not_Decision : Boolean;
-- This flag keeps track of whether a decision sequence in the SCO table
-- contains only NOT operators, and is for an expression context (T=X).
@ -581,7 +607,7 @@ package body Par_SCO is
To => No_Location,
Last => False);
SCO_Raw_Hash_Table.Set (Sloc (N), SCO_Raw_Table.Last);
Hash_Entries.Append ((Sloc (N), SCO_Raw_Table.Last));
Output_Decision_Operand (L);
Output_Decision_Operand (Right_Opnd (N));
@ -608,7 +634,7 @@ package body Par_SCO is
From => FSloc,
To => LSloc,
Last => False);
SCO_Raw_Hash_Table.Set (FSloc, SCO_Raw_Table.Last);
Hash_Entries.Append ((FSloc, SCO_Raw_Table.Last));
end Output_Element;
-------------------
@ -684,7 +710,7 @@ package body Par_SCO is
-- pragma, enter a hash table entry now.
if T = 'a' then
SCO_Raw_Hash_Table.Set (Loc, SCO_Raw_Table.Last);
Hash_Entries.Append ((Loc, SCO_Raw_Table.Last));
end if;
end Output_Header;
@ -736,6 +762,7 @@ package body Par_SCO is
X_Not_Decision := T = 'X' and then Nkind (N) = N_Op_Not;
Mark := SCO_Raw_Table.Last;
Mark_Hash := Hash_Entries.Last;
Output_Header (T);
-- Output the decision
@ -748,6 +775,7 @@ package body Par_SCO is
if X_Not_Decision then
SCO_Raw_Table.Set_Last (Mark);
Hash_Entries.Set_Last (Mark_Hash);
-- Otherwise, set Last in last table entry to mark end
@ -800,6 +828,8 @@ package body Par_SCO is
return;
end if;
Hash_Entries.Init;
-- See if we have simple decision at outer level and if so then
-- generate the decision entry for this simple decision. A simple
-- decision is a boolean expression (which is not a logical operator
@ -817,6 +847,16 @@ package body Par_SCO is
end if;
Traverse (N);
-- Now we have the definitive set of SCO entries, register them in the
-- corresponding hash table.
for I in 1 .. Hash_Entries.Last loop
SCO_Raw_Hash_Table.Set
(Hash_Entries.Table (I).Sloc,
Hash_Entries.Table (I).SCO_Index);
end loop;
Hash_Entries.Free;
end Process_Decisions;
-----------

4
gcc/ada/s-bignum.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2012-2013, Free Software Foundation, Inc. --
-- Copyright (C) 2012-2015, 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- --
@ -881,7 +881,7 @@ package body System.Bignums is
-- D3 (continued). Now test if qhat >= b or v2*qhat > (rhat,uj+2):
-- if so, decrease qhat by 1, increase rhat by v1, and repeat this
-- test if rhat < b. [The test on v2 determines at at high speed
-- test if rhat < b. [The test on v2 determines at high speed
-- most of the cases in which the trial value qhat is one too
-- large, and eliminates all cases where qhat is two too large.]

4
gcc/ada/s-spsufi.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2011-2013, Free Software Foundation, Inc. --
-- Copyright (C) 2011-2015, 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- --
@ -41,7 +41,7 @@ package System.Storage_Pools.Subpools.Finalization is
procedure Finalize_And_Deallocate (Subpool : in out Subpool_Handle);
-- This routine performs the following actions:
-- 1) Finalize all objects chained on the subpool's master
-- 2) Remove the the subpool from the owner's list of subpools
-- 2) Remove the subpool from the owner's list of subpools
-- 3) Deallocate the doubly linked list node associated with the subpool
-- 4) Call Deallocate_Subpool

4
gcc/ada/s-stposu.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2011-2014, Free Software Foundation, Inc. --
-- Copyright (C) 2011-2015, 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- --
@ -541,7 +541,7 @@ package body System.Storage_Pools.Subpools is
-- Perform the following actions:
-- 1) Finalize all objects chained on the subpool's master
-- 2) Remove the the subpool from the owner's list of subpools
-- 2) Remove the subpool from the owner's list of subpools
-- 3) Deallocate the doubly linked list node associated with the
-- subpool.
-- 4) Call Deallocate_Subpool

6
gcc/ada/sem_aux.adb
View File

@ -249,9 +249,9 @@ package body Sem_Aux is
-- Call may be on a private type with unknown discriminants, in which
-- case Ent is Empty, and as per the spec, we return Empty in this case.
-- Historical note: The revious assertion that Ent is a discriminant
-- was overly cautious and prevented application of this function in
-- SPARK applications.
-- Historical note: The assertion in previous versions that Ent is a
-- discriminant was overly cautious and prevented convenient application
-- of this function in the gnatprove context.
return Ent;
end First_Discriminant;

6
gcc/ada/sem_ch13.adb
View File

@ -6496,7 +6496,7 @@ package body Sem_Ch13 is
return;
end if;
-- We know we have a first subtype, now possibly go the the anonymous
-- We know we have a first subtype, now possibly go the anonymous
-- base type to determine whether Rectype is a record extension.
Recdef := Type_Definition (Declaration_Node (Base_Type (Rectype)));
@ -8661,7 +8661,7 @@ package body Sem_Ch13 is
SId : constant Entity_Id :=
Make_Defining_Identifier (Loc,
Chars => New_External_Name (Chars (Typ), "Predicate"));
-- The entity for the the function spec
-- The entity for the function spec
SIdB : constant Entity_Id :=
Make_Defining_Identifier (Loc,
@ -8744,7 +8744,7 @@ package body Sem_Ch13 is
SId : constant Entity_Id :=
Make_Defining_Identifier (Loc,
Chars => New_External_Name (Chars (Typ), "PredicateM"));
-- The entity for the the function spec
-- The entity for the function spec
SIdB : constant Entity_Id :=
Make_Defining_Identifier (Loc,

2
gcc/ada/sem_ch4.adb
View File

@ -3880,7 +3880,7 @@ package body Sem_Ch4 is
-- for some X => (if P then Q [else True])
-- any value for X that makes P False results in the if expression being
-- trivially True, and so also results in the the quantified expression
-- trivially True, and so also results in the quantified expression
-- being trivially True.
if Warn_On_Suspicious_Contract

2
gcc/ada/sem_disp.ads
View File

@ -50,7 +50,7 @@ package Sem_Disp is
-- Empty we are in the overriding case. If the tagged type associated with
-- Subp is a concurrent type (case that occurs when the type is declared in
-- a generic because the analysis of generics disables generation of the
-- corresponding record) then this routine does does not add Subp to the
-- corresponding record) then this routine does not add Subp to the
-- list of primitive operations but leaves Subp decorated as dispatching
-- operation to enable checks associated with the Object.Operation notation

4
gcc/ada/sem_elab.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1997-2014, Free Software Foundation, Inc. --
-- Copyright (C) 1997-2015, 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- --
@ -51,7 +51,7 @@ package Sem_Elab is
-- In addition, in SPARK mode, we are checking for a variable reference in
-- another package, which requires an explicit Elaborate_All pragma.
-- The only references that we need to look at at the outer level are
-- The only references that we need to look at the outer level are
-- references that occur in elaboration code. There are two cases. The
-- reference can be at the outer level of elaboration code, or it can
-- be within another unit, e.g. the elaboration code of a subprogram.

2
gcc/ada/sem_util.adb
View File

@ -16300,7 +16300,7 @@ package body Sem_Util is
function Policy_In_Effect (Policy : Name_Id) return Name_Id is
function Policy_In_List (List : Node_Id) return Name_Id;
-- Determine the the mode of a policy in a N_Pragma list
-- Determine the mode of a policy in a N_Pragma list
--------------------
-- Policy_In_List --

2
gcc/ada/sem_util.ads
View File

@ -455,7 +455,7 @@ package Sem_Util is
-- 2012 stand-alone object of an anonymous access type, then return the
-- static accesssibility level of the object. In that case, the dynamic
-- accessibility level of the object may take on values in a range. The low
-- bound of of that range is returned by Type_Access_Level; this function
-- bound of that range is returned by Type_Access_Level; this function
-- yields the high bound of that range. Also differs from Type_Access_Level
-- in the case of a descendant of a generic formal type (returns Int'Last
-- instead of 0).