git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

[multiple changes] 

2012-03-19  Yannick Moy  <moy@adacore.com>

	* sem_ch6.adb: Minor code clean up.

2012-03-19  Vincent Celier  <celier@adacore.com>

	* make.adb (Scan_Make_Arg): Make sure all significant -m switches
	on the command line are counted.

2012-03-19  Robert Dewar  <dewar@adacore.com>

	* sem_elab.adb (Generate_Elab_Warnings): Fix spec, fix attribute
	reference case

2012-03-19  Robert Dewar  <dewar@adacore.com>

	* par-ch4.adb (Check_Bad_Exp): New procedure

2012-03-19  Robert Dewar  <dewar@adacore.com>

	* exp_attr.adb, sem_attr.adb, sem_attr.ads, snames.ads-tmpl: Add
	initial framework for Valid_Scalars attribute.

2012-03-19  Robert Dewar  <dewar@adacore.com>

	* scng.adb (Scan): Recognize incorrect preprocessor directive

2012-03-19  Robert Dewar  <dewar@adacore.com>

	* atree.adb (Allocate_Initialize_Node): Use Num_Extension_Nodes
	* atree.ads (Num_Extension_Nodes): New variable
	* debug.adb: New debug flag -gnatd.N
	* gnat1drv.adb (Adjust_Global_Switches): Adjust
	Num_Extension_Nodes if -gnatd.N set

2012-03-19  Eric Botcazou  <ebotcazou@adacore.com>

	* einfo.ads: Minor update to First_Rep_Item and Has_Gigi_Rep_Item
	descriptions.

2012-03-19  Robert Dewar  <dewar@adacore.com>

	* opt.ads: Remove HLO_Active flag.
	* sem.adb: Remove call of high level optimizer.
	* sem.ads (New_Nodes_OK): Removed.
	* sem_ch10.adb: Remove references to New_Nodes_OK.
	* switch-c.adb: Remove handling of -gnatH switch.

From-SVN: r185528
This commit is contained in:
Arnaud Charlet 2012-03-19 17:41:25 +01:00
parent 119e3be6ca
commit 2a1f6a1f90
20 changed files with 261 additions and 78 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
gcc/ada/ChangeLog
View File

@ -1,3 +1,51 @@
2012-03-19 Yannick Moy <moy@adacore.com>
* sem_ch6.adb: Minor code clean up.
2012-03-19 Vincent Celier <celier@adacore.com>
* make.adb (Scan_Make_Arg): Make sure all significant -m switches
on the command line are counted.
2012-03-19 Robert Dewar <dewar@adacore.com>
* sem_elab.adb (Generate_Elab_Warnings): Fix spec, fix attribute
reference case
2012-03-19 Robert Dewar <dewar@adacore.com>
* par-ch4.adb (Check_Bad_Exp): New procedure
2012-03-19 Robert Dewar <dewar@adacore.com>
* exp_attr.adb, sem_attr.adb, sem_attr.ads, snames.ads-tmpl: Add
initial framework for Valid_Scalars attribute.
2012-03-19 Robert Dewar <dewar@adacore.com>
* scng.adb (Scan): Recognize incorrect preprocessor directive
2012-03-19 Robert Dewar <dewar@adacore.com>
* atree.adb (Allocate_Initialize_Node): Use Num_Extension_Nodes
* atree.ads (Num_Extension_Nodes): New variable
* debug.adb: New debug flag -gnatd.N
* gnat1drv.adb (Adjust_Global_Switches): Adjust
Num_Extension_Nodes if -gnatd.N set
2012-03-19 Eric Botcazou <ebotcazou@adacore.com>
* einfo.ads: Minor update to First_Rep_Item and Has_Gigi_Rep_Item
descriptions.
2012-03-19 Robert Dewar <dewar@adacore.com>
* opt.ads: Remove HLO_Active flag.
* sem.adb: Remove call of high level optimizer.
* sem.ads (New_Nodes_OK): Removed.
* sem_ch10.adb: Remove references to New_Nodes_OK.
* switch-c.adb: Remove handling of -gnatH switch.
2012-03-19 Yannick Moy <moy@adacore.com>
* sem_ch6.adb (Check_Subprogram_Contract): Do not emit warnings

6
gcc/ada/atree.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, 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- --
@ -516,11 +516,11 @@ package body Atree is
if With_Extension then
if Present (Src) and then Has_Extension (Src) then
for J in 1 .. 4 loop
for J in 1 .. Num_Extension_Nodes loop
Nodes.Append (Nodes.Table (Src + Node_Id (J)));
end loop;
else
for J in 1 .. 4 loop
for J in 1 .. Num_Extension_Nodes loop
Nodes.Append (Default_Node_Extension);
end loop;
end if;

13
gcc/ada/atree.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, 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- --
@ -65,6 +65,17 @@ package Atree is
-- syntax tree format. Subsequent processing in the front end traverses the
-- tree, transforming it in various ways and adding semantic information.
----------------------
-- Size of Entities --
----------------------
-- Currently entities are composed of 5 sequentially allocated 32-byte
-- nodes, considered as a single record. The following definition gives
-- the number of extension nodes.
Num_Extension_Nodes : Int := 4;
-- This value is increased by one if debug flag -gnatd.N is set
----------------------------------------
-- Definitions of Fields in Tree Node --
----------------------------------------

6
gcc/ada/debug.adb
View File

@ -131,7 +131,7 @@ package body Debug is
-- d.K Alfa detection only mode for gnat2why
-- d.L Depend on back end for limited types in conditional expressions
-- d.M
-- d.N
-- d.N Add node to all entities
-- d.O Dump internal SCO tables
-- d.P Previous (non-optimized) handling of length comparisons
-- d.Q
@ -629,6 +629,10 @@ package body Debug is
-- case expansion, leaving it up to the back end to handle conditional
-- expressions correctly.
-- d.N Enlarge entities by one node (but don't attempt to use this extra
-- node for storage of any flags or fields). This can be used to do
-- experiments on the impact of increasing entity sizes.
-- d.O Dump internal SCO tables. Before outputting the SCO information to
-- the ALI file, the internal SCO tables (SCO_Table/SCO_Unit_Table)
-- are dumped for debugging purposes.

5
gcc/ada/einfo.ads
View File

@ -1277,11 +1277,13 @@ package Einfo is
-- reflect the specified information. However, there are some items that
-- are only reflected in the chain. These include:
--
-- Alignment attribute definition clause
-- Machine_Attribute pragma
-- Link_Alias pragma
-- Linker_Section pragma
-- Linker_Constructor pragma
-- Linker_Destructor pragma
-- Weak_External pragma
-- Thread_Local_Storage pragma
--
-- If any of these items are present, then the flag Has_Gigi_Rep_Item is
-- set, indicating that Gigi should search the chain.
@ -1530,6 +1532,7 @@ package Einfo is
-- Linker_Constructor pragma
-- Linker_Destructor pragma
-- Weak_External pragma
-- Thread_Local_Storage pragma
--
-- If this flag is set, then Gigi should scan the rep item chain to
-- process any of these items that appear. At least one such item will

9
gcc/ada/exp_attr.adb
View File

@ -5368,6 +5368,15 @@ package body Exp_Attr is
Validity_Checks_On := Save_Validity_Checks_On;
end Valid;
-------------------
-- Valid_Scalars --
-------------------
when Attribute_Valid_Scalars => Valid_Scalars : declare
begin
raise Program_Error;
end Valid_Scalars;
-----------
-- Value --
-----------

6
gcc/ada/gnat1drv.adb
View File

@ -289,6 +289,12 @@ procedure Gnat1drv is
Ttypes.Target_Strict_Alignment := True;
end if;
-- Increase size of allocated entities if debug flag -gnatd.N is set
if Debug_Flag_Dot_NN then
Atree.Num_Extension_Nodes := Atree.Num_Extension_Nodes + 1;
end if;
-- Disable static allocation of dispatch tables if -gnatd.t or if layout
-- is enabled. The front end's layout phase currently treats types that
-- have discriminant-dependent arrays as not being static even when a

10
gcc/ada/make.adb
View File

@ -7423,6 +7423,16 @@ package body Make is
Add_Switch (Argv, Program_Args, And_Save => And_Save);
-- Make sure that all significant switches -m on the command line
-- are counted.
if Argv'Length > 2
and then Argv (1 .. 2) = "-m"
and then Argv /= "-mieee"
then
N_M_Switch := N_M_Switch + 1;
end if;
-- Handle non-default compiler, binder, linker, and handle --RTS switch
elsif Argv'Length > 2 and then Argv (1 .. 2) = "--" then

4
gcc/ada/opt.ads
View File

@ -666,10 +666,6 @@ package Opt is
-- Heap size for memory allocations. Valid values are 32 and 64. Only
-- available on VMS.
HLO_Active : Boolean := False;
-- GNAT
-- True if High Level Optimizer is activated (-gnatH switch)
Identifier_Character_Set : Character;
-- GNAT
-- This variable indicates the character set to be used for identifiers.

21
gcc/ada/par-ch4.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, 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- --
@ -81,6 +81,9 @@ package body Ch4 is
-- Called to place complaint about bad range attribute at the given
-- source location. Terminates by raising Error_Resync.
procedure Check_Bad_Exp;
-- Called after scanning a**b, posts error if ** detected
procedure P_Membership_Test (N : Node_Id);
-- N is the node for a N_In or N_Not_In node whose right operand has not
-- yet been processed. It is called just after scanning out the IN keyword.
@ -107,6 +110,20 @@ package body Ch4 is
Resync_Expression;
end Bad_Range_Attribute;
-------------------
-- Check_Bad_Exp --
-------------------
procedure Check_Bad_Exp is
begin
if Token = Tok_Double_Asterisk then
Error_Msg_SC ("parenthesization required for '*'*");
Scan; -- past **
Discard_Junk_Node (P_Primary);
Check_Bad_Exp;
end if;
end Check_Bad_Exp;
--------------------------
-- 4.1 Name (also 6.4) --
--------------------------
@ -1933,6 +1950,7 @@ package body Ch4 is
Scan; -- past **
Set_Left_Opnd (Node2, Node1);
Set_Right_Opnd (Node2, P_Primary);
Check_Bad_Exp;
Node1 := Node2;
end if;
@ -2320,6 +2338,7 @@ package body Ch4 is
Scan; -- past **
Set_Left_Opnd (Node2, Node1);
Set_Right_Opnd (Node2, P_Primary);
Check_Bad_Exp;
return Node2;
else
return Node1;

67
gcc/ada/scng.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, 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- --
@ -2242,6 +2242,71 @@ package body Scng is
Scan_Ptr := Scan_Ptr + 1;
return;
-- Check for something looking like a preprocessor directive
elsif Source (Scan_Ptr) = '#'
and then (Source (Scan_Ptr + 1 .. Scan_Ptr + 2) = "if"
or else
Source (Scan_Ptr + 1 .. Scan_Ptr + 5) = "elsif"
or else
Source (Scan_Ptr + 1 .. Scan_Ptr + 4) = "else"
or else
Source (Scan_Ptr + 1 .. Scan_Ptr + 3) = "end")
then
Error_Msg_S
("preprocessor directive ignored, preprocessor not active");
-- Skip to end of line
loop
if Source (Scan_Ptr) in Graphic_Character
or else
Source (Scan_Ptr) = HT
then
Scan_Ptr := Scan_Ptr + 1;
-- Done if line terminator or EOF
elsif Source (Scan_Ptr) in Line_Terminator
or else
Source (Scan_Ptr) = EOF
then
exit;
-- If we have a wide character, we have to scan it out,
-- because it might be a legitimate line terminator
elsif Start_Of_Wide_Character then
declare
Wptr : constant Source_Ptr := Scan_Ptr;
Code : Char_Code;
Err : Boolean;
begin
Scan_Wide (Source, Scan_Ptr, Code, Err);
-- If not well formed wide character, then just skip
-- past it and ignore it.
if Err then
Scan_Ptr := Wptr + 1;
-- If UTF_32 terminator, terminate comment scan
elsif Is_UTF_32_Line_Terminator (UTF_32 (Code)) then
Scan_Ptr := Wptr;
exit;
end if;
end;
-- Else keep going (don't worry about bad comment chars
-- in this context, we just want to find the end of line.
else
Scan_Ptr := Scan_Ptr + 1;
end if;
end loop;
-- Otherwise, this is an illegal character
else

15
gcc/ada/sem.adb
View File

@ -30,7 +30,6 @@ with Elists; use Elists;
with Errout; use Errout;
with Expander; use Expander;
with Fname; use Fname;
with HLO; use HLO;
with Lib; use Lib;
with Lib.Load; use Lib.Load;
with Nlists; use Nlists;
@ -1367,7 +1366,6 @@ package body Sem is
S_Global_Dis_Names : constant Boolean := Global_Discard_Names;
S_In_Spec_Expr : constant Boolean := In_Spec_Expression;
S_Inside_A_Generic : constant Boolean := Inside_A_Generic;
S_New_Nodes_OK : constant Int := New_Nodes_OK;
S_Outer_Gen_Scope : constant Entity_Id := Outer_Generic_Scope;
Generic_Main : constant Boolean :=
@ -1386,8 +1384,7 @@ package body Sem is
-- and we need to restore these saved values at the end.
procedure Do_Analyze;
-- Procedure to analyze the compilation unit. This is called more than
-- once when the high level optimizer is activated.
-- Procedure to analyze the compilation unit
----------------
-- Do_Analyze --
@ -1491,15 +1488,6 @@ package body Sem is
if not Analyzed (Comp_Unit) then
Initialize_Version (Current_Sem_Unit);
if HLO_Active then
Expander_Mode_Save_And_Set (False);
New_Nodes_OK := 1;
Do_Analyze;
Reset_Analyzed_Flags (Comp_Unit);
Expander_Mode_Restore;
High_Level_Optimize (Comp_Unit);
New_Nodes_OK := 0;
end if;
-- Do analysis, and then append the compilation unit onto the
-- Comp_Unit_List, if appropriate. This is done after analysis,
@ -1547,7 +1535,6 @@ package body Sem is
GNAT_Mode := S_GNAT_Mode;
In_Spec_Expression := S_In_Spec_Expr;
Inside_A_Generic := S_Inside_A_Generic;
New_Nodes_OK := S_New_Nodes_OK;
Outer_Generic_Scope := S_Outer_Gen_Scope;
Restore_Opt_Config_Switches (Save_Config_Switches);

4
gcc/ada/sem.ads
View File

@ -209,10 +209,6 @@ with Types; use Types;
package Sem is
New_Nodes_OK : Int := 1;
-- Temporary flag for use in checking out HLO. Set non-zero if it is
-- OK to generate new nodes.
-----------------------------
-- Semantic Analysis Flags --
-----------------------------

12
gcc/ada/sem_attr.adb
View File

@ -5196,6 +5196,15 @@ package body Sem_Attr is
Set_Etype (N, Standard_Boolean);
-------------------
-- Valid_Scalars --
-------------------
when Attribute_Valid_Scalars =>
Check_E0;
Check_Type;
-- More stuff TBD ???
-----------
-- Value --
-----------
@ -6034,7 +6043,7 @@ package body Sem_Attr is
return;
-- No other cases are foldable (they certainly aren't static, and at
-- the moment we don't try to fold any cases other than these three).
-- the moment we don't try to fold any cases other than the ones above).
else
Check_Expressions;
@ -8145,6 +8154,7 @@ package body Sem_Attr is
Attribute_Universal_Literal_String |
Attribute_Unrestricted_Access |
Attribute_Valid |
Attribute_Valid_Scalars |
Attribute_Value |
Attribute_Wchar_T_Size |
Attribute_Wide_Value |

9
gcc/ada/sem_attr.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, 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- --
@ -549,6 +549,13 @@ package Sem_Attr is
-- Natural'Size is typically 31, the value of Natural'VADS_Size is 32.
-- For all other types, Size and VADS_Size yield the same value.
-------------------
-- Valid_Scalars --
-------------------
Attribute_Valid_Scalars => True,
-- Typ'Valid_Scalars applies to ???
----------------
-- Value_Size --
----------------

10
gcc/ada/sem_ch10.adb
View File

@ -2977,7 +2977,6 @@ package body Sem_Ch10 is
-- Start of processing for Expand_With_Clause
begin
New_Nodes_OK := New_Nodes_OK + 1;
Withn :=
Make_With_Clause (Loc,
Name => Build_Unit_Name (Nam));
@ -3002,8 +3001,6 @@ package body Sem_Ch10 is
if Nkind (Nam) = N_Expanded_Name then
Expand_With_Clause (Item, Prefix (Nam), N);
end if;
New_Nodes_OK := New_Nodes_OK - 1;
end Expand_With_Clause;
-----------------------
@ -3165,7 +3162,6 @@ package body Sem_Ch10 is
return;
end if;
New_Nodes_OK := New_Nodes_OK + 1;
Withn := Make_With_Clause (Loc, Name => Build_Unit_Name);
Set_Library_Unit (Withn, P);
@ -3183,8 +3179,6 @@ package body Sem_Ch10 is
if Is_Child_Spec (P_Unit) then
Implicit_With_On_Parent (P_Unit, N);
end if;
New_Nodes_OK := New_Nodes_OK - 1;
end Implicit_With_On_Parent;
--------------
@ -3734,8 +3728,6 @@ package body Sem_Ch10 is
-- Start of processing for Expand_Limited_With_Clause
begin
New_Nodes_OK := New_Nodes_OK + 1;
if Nkind (Nam) = N_Identifier then
-- Create node for name of withed unit
@ -3793,8 +3785,6 @@ package body Sem_Ch10 is
Install_Limited_Withed_Unit (Withn);
end if;
end if;
New_Nodes_OK := New_Nodes_OK - 1;
end Expand_Limited_With_Clause;
----------------------

8
gcc/ada/sem_ch6.adb
View File

@ -6963,7 +6963,10 @@ package body Sem_Ch6 is
-- is precisely evaluated in the pre-state. Otherwise return OK.
function Is_Trivial_Post_Or_Ensures (N : Node_Id) return Boolean;
-- Return whether node N is trivially "True" or "False"
-- Return True if node N is trivially "True" or "False", and it comes
-- from source. In particular, nodes that are statically known "True" or
-- "False" by the compiler but not written as such in source code are
-- not considered as trivial.
procedure Process_Contract_Cases (Spec : Node_Id);
-- This processes the Spec_CTC_List from Spec, processing any contract
@ -7064,7 +7067,8 @@ package body Sem_Ch6 is
return Is_Entity_Name (N)
and then (Entity (N) = Standard_True
or else
Entity (N) = Standard_False);
Entity (N) = Standard_False)
and then Comes_From_Source (N);
end Is_Trivial_Post_Or_Ensures;
----------------------------

78
gcc/ada/sem_elab.adb
View File

@ -182,16 +182,19 @@ package body Sem_Elab is
In_Init_Proc : Boolean := False);
-- This is the internal recursive routine that is called to check for
-- possible elaboration error. The argument N is a subprogram call or
-- generic instantiation to be checked, and E is the entity of the called
-- subprogram, or instantiated generic unit. The flag Outer_Scope is the
-- outer level scope for the original call. Inter_Unit_Only is set if the
-- call is only to be checked in the case where it is to another unit (and
-- skipped if within a unit). Generate_Warnings is set to False to suppress
-- warning messages about missing pragma Elaborate_All's. These messages
-- are not wanted for inner calls in the dynamic model. Note that an
-- instance of the Access attribute applied to a subprogram also generates
-- a call to this procedure (since the referenced subprogram may be called
-- later indirectly). Flag In_Init_Proc should be set whenever the current
-- generic instantiation, or 'Access attribute reference to be checked, and
-- E is the entity of the called subprogram, or instantiated generic unit,
-- or subprogram referenced by 'Access.
--
-- The flag Outer_Scope is the outer level scope for the original call.
-- Inter_Unit_Only is set if the call is only to be checked in the
-- case where it is to another unit (and skipped if within a unit).
-- Generate_Warnings is set to False to suppress warning messages about
-- missing pragma Elaborate_All's. These messages are not wanted for
-- inner calls in the dynamic model. Note that an instance of the Access
-- attribute applied to a subprogram also generates a call to this
-- procedure (since the referenced subprogram may be called later
-- indirectly). Flag In_Init_Proc should be set whenever the current
-- context is a type init proc.
procedure Check_Bad_Instantiation (N : Node_Id);
@ -519,6 +522,9 @@ package body Sem_Elab is
Inst_Case : constant Boolean := Nkind (N) in N_Generic_Instantiation;
-- Indicates if we have instantiation case
Access_Case : constant Boolean := Nkind (N) = N_Attribute_Reference;
-- Indicates if we have Access attribute case
Caller_Unit_Internal : Boolean;
Callee_Unit_Internal : Boolean;
@ -704,9 +710,9 @@ package body Sem_Elab is
Is_Internal_File_Name
(Unit_File_Name (Get_Source_Unit (E_Scope)));
-- Do not give a warning if the with'ed unit is internal
-- and this is the generic instantiation case (this saves a
-- lot of hassle dealing with the Text_IO special child units)
-- Do not give a warning if the with'ed unit is internal and this is
-- the generic instantiation case (this saves a lot of hassle dealing
-- with the Text_IO special child units)
if Callee_Unit_Internal and Inst_Case then
return;
@ -720,9 +726,9 @@ package body Sem_Elab is
(Unit_File_Name (Get_Source_Unit (C_Scope)));
end if;
-- Do not give a warning if the with'ed unit is internal
-- and the caller is not internal (since the binder always
-- elaborates internal units first).
-- Do not give a warning if the with'ed unit is internal and the
-- caller is not internal (since the binder always elaborates
-- internal units first).
if Callee_Unit_Internal and (not Caller_Unit_Internal) then
return;
@ -743,15 +749,15 @@ package body Sem_Elab is
end if;
-- If the call is in an instance, and the called entity is not
-- defined in the same instance, then the elaboration issue
-- focuses around the unit containing the template, it is
-- this unit which requires an Elaborate_All.
-- defined in the same instance, then the elaboration issue focuses
-- around the unit containing the template, it is this unit which
-- requires an Elaborate_All.
-- However, if we are doing dynamic elaboration, we need to
-- chase the call in the usual manner.
-- However, if we are doing dynamic elaboration, we need to chase the
-- call in the usual manner.
-- We do not handle the case of calling a generic formal correctly
-- in the static case. See test 4703-004 to explore this gap ???
-- We do not handle the case of calling a generic formal correctly in
-- the static case.???
Inst_Caller := Instantiation (Get_Source_File_Index (Sloc (N)));
Inst_Callee := Instantiation (Get_Source_File_Index (Sloc (Ent)));
@ -871,6 +877,8 @@ package body Sem_Elab is
Ent : Node_Or_Entity_Id);
-- Generate a call to Error_Msg_NE with parameters Msg_D or
-- Msg_S (for dynamic or static elaboration model), N and Ent.
-- Msg_D is suppressed for the attribute reference case, since
-- we never raise Program_Error for an attribute reference.
------------------
-- Elab_Warning --
@ -883,7 +891,9 @@ package body Sem_Elab is
is
begin
if Dynamic_Elaboration_Checks then
Error_Msg_NE (Msg_D, N, Ent);
if not Access_Case then
Error_Msg_NE (Msg_D, N, Ent);
end if;
else
Error_Msg_NE (Msg_S, N, Ent);
end if;
@ -892,11 +902,23 @@ package body Sem_Elab is
-- Start of processing for Generate_Elab_Warnings
begin
-- Instantiation case
if Inst_Case then
Elab_Warning
("instantiation of& may raise Program_Error?",
"info: instantiation of& during elaboration?", Ent);
-- Indirect call case, warning only in static elaboration
-- case, because the attribute reference itself cannot raise
-- an exception.
elsif Access_Case then
Elab_Warning
("", "info: access to& during elaboration?", Ent);
-- Subprogram call case
else
if Nkind (Name (N)) in N_Has_Entity
and then Is_Init_Proc (Entity (Name (N)))
@ -922,6 +944,7 @@ package body Sem_Elab is
("\missing pragma Elaborate for&?",
"\info: implicit pragma Elaborate for& generated?",
W_Scope);
else
Elab_Warning
("\missing pragma Elaborate_All for&?",
@ -960,7 +983,8 @@ package body Sem_Elab is
Insert_Elab_Check (N,
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Elaborated,
Prefix => New_Occurrence_Of (Spec_Entity (E_Scope), Loc)));
Prefix =>
New_Occurrence_Of (Spec_Entity (E_Scope), Loc)));
-- Prevent duplicate elaboration checks on the same call,
-- which can happen if the body enclosing the call appears
@ -990,9 +1014,7 @@ package body Sem_Elab is
-- Do not generate an Elaborate_All for finalization routines
-- which perform partial clean up as part of initialization.
elsif In_Init_Proc
and then Is_Finalization_Procedure (Ent)
then
elsif In_Init_Proc and then Is_Finalization_Procedure (Ent) then
null;
-- Here we need to generate an implicit elaborate all

2
gcc/ada/snames.ads-tmpl
View File

@ -854,6 +854,7 @@ package Snames is
Name_VADS_Size : constant Name_Id := N + $; -- GNAT
Name_Val : constant Name_Id := N + $;
Name_Valid : constant Name_Id := N + $;
Name_Valid_Scalars : constant Name_Id := N + $; -- GNAT
Name_Value_Size : constant Name_Id := N + $; -- GNAT
Name_Variable_Indexing : constant Name_Id := N + $; -- GNAT
Name_Version : constant Name_Id := N + $;
@ -1418,6 +1419,7 @@ package Snames is
Attribute_VADS_Size,
Attribute_Val,
Attribute_Valid,
Attribute_Valid_Scalars,
Attribute_Value_Size,
Attribute_Variable_Indexing,
Attribute_Version,

6
gcc/ada/switch-c.adb
View File

@ -634,12 +634,6 @@ package body Switch.C is
Ptr := Ptr + 1;
Usage_Requested := True;
-- Processing for H switch
when 'H' =>
Ptr := Ptr + 1;
HLO_Active := True;
-- Processing for i switch
when 'i' =>