Skip to content

R
riscv-gcc-1
Commit 21d27997 by Robert Dewar Committed by Arnaud Charlet
Options

alloc.ads: Add entries for Obsolescent_Warnings table 

2008-04-08  Robert Dewar  <dewar@adacore.com>
	    Bob Duff  <duff@adacore.com>
	    Gary Dismukes  <dismukes@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>

	* alloc.ads: Add entries for Obsolescent_Warnings table

	* einfo.ads, einfo.adb: Minor reformatting.
	(Is_Discriminal): New subprogram.
	(Is_Prival): New subprogram.
	(Is_Protected_Component): New subprogram.
	(Is_Protected_Private): Removed.
	(Object_Ref, Set_Object_Ref): Removed.
	(Prival, Set_Prival): Change assertion.
	(Privals_Chain, Set_Privals_Chain): Removed.
	(Prival_Link, Set_Prival_Link): New subprogram.
	(Protected_Operation, Set_Protected_Operation): Removed.
	(Protection_Object, Set_Protection_Object): New subprogram.
	(Write_Field17_Name): Remove case for Object_Ref.
	(Write_Field20_Name): Add case for Prival_Link.
	(Write_Field22_Name): Remove case for Protected_Operation,
	Privals_Chain.
	Add case for Protection_Object.
	(Can_Use_Internal_Rep): Make this into a [base type only] attribute,
	so clients
	(Overlays_Constant): New flag
	(Is_Constant_Object): New predicate
	(Is_Standard_Character_Type): New predicate
	(Optimize_Alignment_Space): New flag
	(Optimize_Alignment_Time): New flag
	(Has_Postconditions): New flag
	(Obsolescent_Warrning): Field removed
	(Spec_PPC_List): New field
	(Relative_Deadline_Variable, Set_Relative_Deadline_Variable): Add
	subprograms to get and set the relative deadline associated to a task.

	* exp_attr.adb (May_Be_External_Call): Account for the case where the
	Access attribute is part of a named parameter association.
	(Expand_Access_To_Protected_Op): Test for the attribute occurring
	within an init proc and use that directly as the scope rather than
	traversing up to the protected operation's enclosing scope. Only apply
	assertion on Is_Open_Scopes in the case the scope traversal is done.
	For the init proc case use the address of the first formal (_init) as
	the protected object reference.
	Implement Invalid_Value attribute
	(Expand_N_Attribute_Reference): Case Attribute_Unrestricted_Access.
	contents of the dispatch table there is no need to duplicate the
	itypes associated with record types (i.e. the implicit full view
	of private types).
	Implement Enum_Val attribute
	(Expand_N_Attribute_Reference, case Old): Properly handle appearence
	within _Postconditions procedure
	(Expand_N_Attribute_Reference, case Result): Implement new attribute

	* exp_ch5.adb (Expand_N_Simple_Return_Statement): Handle case in which
	a return statement calls a function that is not available in
	configurable runtime.
	(Analyze_If_Statement): don't optimize simple True/False cases in -O0
	(Expand_Non_Function_Return): Generate call to _Postconditions proc
	(Expand_Simple_Function_Return): Ditto

	* frontend.adb: Add call to Sem_Aux.Initialize

	* sem_aux.ads, sem_aux.adb: New file.

	* par-prag.adb: Add entries for pragmas Precondition/Postcondition
	Add new Pragma_Relative_Deadline.
	Add support for pragmas Check and Check_Policy

	* sem_attr.ads, sem_attr.adb (Check_Not_CPP_Type): New subprogram.
	(Check_Stream_Attribute): Add missing check (not allowed in CPP types)
	(Analyze_Attribute): In case of attributes 'Alignment and 'size add
	missing check because they are not allowed in CPP tagged types.
	Add Sure parameter to Note_Possible_Modification calls
	Add implementation of Invalid_Value attribute
	Implement new attribute Has_Tagged_Values
	Implement Enum_Val attribute
	(Analyze_Attribute, case Range): Set Name_Req True for prefix of
	generated attributes.
	(Analyze_Attribute, case Result): If prefix of the attribute is
	overloaded, it always resolves to the enclosing function.
	(Analyze_Attribute, case Result): Properly deal with analysis when
	Postconditions are not active.
	(Resolve_Attribute, case Result): Properly deal with appearence during
	preanalysis in spec.
	Add processing for attribute Result

	* sem_ch6.ads, sem_ch6.adb (Check_Overriding_Indicator): Code cleanup
	for operators.
	(Analyze_Subprogram_Body): Install private_with_clauses when the body
	acts as a spec.
	(Check_Inline_Pragma): recognize an inline pragma that appears within
	the subprogram body to which it applies.
	(Analyze_Function_Return): Check that type of the expression of a return
	statement in a function with a class-wide result is not declared at a
	deeper level than the function.
	(Process_PPCs): Deal with enabling/disabling, using PPC_Enabled flag
	(Verify_Overriding_Indicator): Handle properly subprogram bodies for
	user- defined operators.
	(Install_Formals): Moved to spec to allow use from Sem_Prag for
	analysis of precondition/postcondition pragmas.
	(Analyze_Subprogram_Body.Last_Real_Spec_Entity): New name for
	Last_Formal, along with lots of comments on what this is about
	(Analyze_Subprogram_Body): Fix case where we move entities from the
	spec to the body when there are no body entities (now possible with
	precondition and postcondition pragmas).
	(Process_PPCs): New procedure
	(Analyze_Subprogram_Body): Add call to Process_PPCs

	* sem_ch8.adb (Use_One_Type): refine warning on a redundant use_type
	clause.
	(Pop_Scope): Restore Check_Policy_List on scope exit
	(Push_Scope): Save Check_Policy_List on scope entry
	Change name In_Default_Expression      => In_Spec_Expression
	Change name Analyze_Per_Use_Expression => Preanalyze_Spec_Expression
	Change name Pre_Analyze_And_Resolve    => Preanalyze_And_Resolve
	(Analyze_Object_Renaming): Allow 'Reference as object
	(Analyze_Pragma, case Restriction_Warnings): Call GNAT_Pragma
	(Process_Restrictions_Or_Restriction_Warnings): Check for bad spelling
	of restriction identifier.
	Add Sure parameter to Note_Possible_Modication calls

	* sem_prag.ads, sem_prag.adb (Analyze_Pragma, case Stream_Convert):
	Don't check for primitive operations when calling Rep_Item_Too_Late.
	(Process_Import_Or_Interface): Do not place flag on formal
	subprograms.
	(Analyze_Pragma, case Export): If the entity is a deferred constant,
	propagate information to full view, which is the one elaborated by the
	back-end.
	(Make_Inline): the pragma is effective if it applies to an internally
	generated subprogram declaration for a body that carries the pragma.
	(Analyze_Pragma, case Optimize_Alignment): Set new flag
	Optimize_Alignment_Local.
	(Analyze_PPC_In_Decl_Part): New procedure
	(Get_Pragma_Arg): Moved to outer level
	(Check_Precondition_Postcondition): Change to allow new visibility
	rules for package spec
	(Analyze_Pragma, case Check_Policy): Change placement rules to be
	same as pragma Suppress/Unsuppress.
	Change name In_Default_Expression      => In_Spec_Expression
	Change name Analyze_Per_Use_Expression => Preanalyze_Spec_Expression
	Change name Pre_Analyze_And_Resolve    => Preanalyze_And_Resolve
	(Check_Precondition_Postcondition): Do proper visibility preanalysis
	for the case of these pragmas appearing in the spec.
	(Check_Enabled): New function
	(Initialize): New procedure
	(Tree_Read): New procedure
	(Tree_Write): New procedure
	(Check_Precondition_Postcondition): New procedure
	Implement pragmas Check and Check_Policy
	Merge Assert processing with Check

	* sem_warn.adb (Warn_On_Known_Condition): Handle pragma Check
	New warning flag -gnatw.e

	* sinfo.ads, sinfo.adb (Has_Relative_Deadline_Pragma): New function
	returning whether a task (or main procedure) has a pragma
	Relative_Deadline.
	(Set_Has_Relative_Deadline_Pragma): Procedure to indicate that a task
	(or main procedure) has a pragma Relative_Deadline.
	Add Next_Pragma field to N_Pragma node
	(PPC_Enabled): New flag
	(Next_Pragma): Now used for Pre/Postcondition processing

	* snames.h, snames.ads, snames.adb: New standard name
	Inherit_Source_Path
	Add entry for 'Invalid_Value attribute
	Add entry for new attribute Has_Tagged_Values
	Add entry for Enum_Val attribute
	Add new standard names Aggregate, Configuration and Library.
	Add _Postconditions
	Add _Result
	Add Pragma_Precondition
	Add Pragma_Postcondition
	Add Attribute_Result
	New standard name Archive_Builder_Append_Option
	(Preset_Names): Add _relative_deadline and relative_deadline definitions
	There was also a missing non_preemptive_within_priorities.
	(Get_Pragma_Id, Is_Pragma_Name): Add support for pragma
	Relative_Deadline.
	Add support for pragmas Check and Check_Policy

	* tree_gen.adb: Call Sem_Aux.Tree_Write

	* tree_in.adb: Call Sem_Aux.Tree_Read

	* exp_ch11.adb (Expand_N_Raise_Statement): New Build_Location calling
	sequence

	* exp_intr.adb (Expand_Source_Info): New Build_Location calling
	sequence

	* exp_prag.adb (Expand_Pragma_Relative_Deadline): New procedure.
	(Expand_N_Pragma): Call the appropriate procedure for expanding pragma
	Relative_Deadline.
	(Expand_Pragma_Check): New procedure

	* sinput.ads, sinput.adb (Build_Location_String): Now appends to name
	buffer.

	* sinfo.adb (PPC_Enabled): New flag

From-SVN: r134010
parent 1ed69f61
Showing with 617 additions and 127 deletions
gcc/ada/alloc.ads
......@@ -99,6 +99,9 @@ package Alloc is
Nodes_Initial : constant := 50_000; -- Atree
Nodes_Increment : constant := 100;
Obsolescent_Warnings_Initial : constant := 50; -- Sem_Prag
Obsolescent_Warnings_Increment : constant := 200;
Orig_Nodes_Initial : constant := 50_000; -- Atree
Orig_Nodes_Increment : constant := 100;
......
gcc/ada/exp_ch11.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -1463,6 +1463,7 @@ package body Exp_Ch11 is
Id : Entity_Id := Entity (Name (N));
begin
Name_Len := 0;
Build_Location_String (Loc);
-- If the exception is a renaming, use the exception that it
......
gcc/ada/exp_intr.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -659,6 +659,8 @@ package body Exp_Intr is
-- String cases
else
Name_Len := 0;
case Nam is
when Name_File =>
Get_Decoded_Name_String
......@@ -668,12 +670,10 @@ package body Exp_Intr is
Build_Location_String (Loc);
when Name_Enclosing_Entity =>
Name_Len := 0;
Ent := Current_Scope;
-- Skip enclosing blocks to reach enclosing unit
Ent := Current_Scope;
while Present (Ent) loop
exit when Ekind (Ent) /= E_Block
and then Ekind (Ent) /= E_Loop;
......@@ -682,7 +682,6 @@ package body Exp_Intr is
-- Ent now points to the relevant defining entity
Name_Len := 0;
Write_Entity_Name (Ent);
when others =>
......@@ -690,7 +689,8 @@ package body Exp_Intr is
end case;
Rewrite (N,
Make_String_Literal (Loc, Strval => String_From_Name_Buffer));
Make_String_Literal (Loc,
Strval => String_From_Name_Buffer));
Analyze_And_Resolve (N, Standard_String);
end if;
......
gcc/ada/exp_prag.adb
......@@ -40,7 +40,6 @@ with Restrict; use Restrict;
with Rident; use Rident;
with Rtsfind; use Rtsfind;
with Sem; use Sem;
with Sem_Eval; use Sem_Eval;
with Sem_Res; use Sem_Res;
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
......@@ -60,16 +59,18 @@ package body Exp_Prag is
function Arg1 (N : Node_Id) return Node_Id;
function Arg2 (N : Node_Id) return Node_Id;
function Arg3 (N : Node_Id) return Node_Id;
-- Obtain specified pragma argument expression
procedure Expand_Pragma_Abort_Defer (N : Node_Id);
procedure Expand_Pragma_Assert (N : Node_Id);
procedure Expand_Pragma_Check (N : Node_Id);
procedure Expand_Pragma_Common_Object (N : Node_Id);
procedure Expand_Pragma_Import_Or_Interface (N : Node_Id);
procedure Expand_Pragma_Import_Export_Exception (N : Node_Id);
procedure Expand_Pragma_Inspection_Point (N : Node_Id);
procedure Expand_Pragma_Interrupt_Priority (N : Node_Id);
procedure Expand_Pragma_Psect_Object (N : Node_Id);
procedure Expand_Pragma_Relative_Deadline (N : Node_Id);
----------
-- Arg1 --
......@@ -93,9 +94,11 @@ package body Exp_Prag is
function Arg2 (N : Node_Id) return Node_Id is
Arg1 : constant Node_Id := First (Pragma_Argument_Associations (N));
begin
if No (Arg1) then
return Empty;
else
declare
Arg : constant Node_Id := Next (Arg1);
......@@ -111,6 +114,39 @@ package body Exp_Prag is
end if;
end Arg2;
----------
-- Arg3 --
----------
function Arg3 (N : Node_Id) return Node_Id is
Arg1 : constant Node_Id := First (Pragma_Argument_Associations (N));
begin
if No (Arg1) then
return Empty;
else
declare
Arg : Node_Id := Next (Arg1);
begin
if No (Arg) then
return Empty;
else
Next (Arg);
if Present (Arg)
and then Nkind (Arg) = N_Pragma_Argument_Association
then
return Expression (Arg);
else
return Arg;
end if;
end if;
end;
end if;
end Arg3;
---------------------
-- Expand_N_Pragma --
---------------------
......@@ -130,8 +166,8 @@ package body Exp_Prag is
when Pragma_Abort_Defer =>
Expand_Pragma_Abort_Defer (N);
when Pragma_Assert =>
Expand_Pragma_Assert (N);
when Pragma_Check =>
Expand_Pragma_Check (N);
when Pragma_Common_Object =>
Expand_Pragma_Common_Object (N);
......@@ -157,6 +193,9 @@ package body Exp_Prag is
when Pragma_Psect_Object =>
Expand_Pragma_Psect_Object (N);
when Pragma_Relative_Deadline =>
Expand_Pragma_Relative_Deadline (N);
-- All other pragmas need no expander action
when others => null;
......@@ -227,25 +266,25 @@ package body Exp_Prag is
end Expand_Pragma_Abort_Defer;
--------------------------
-- Expand_Pragma_Assert --
-- Expand_Pragma_Check --
--------------------------
procedure Expand_Pragma_Assert (N : Node_Id) is
procedure Expand_Pragma_Check (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
Cond : constant Node_Id := Arg1 (N);
Msg : String_Id;
Cond : constant Node_Id := Arg2 (N);
Nam : constant Name_Id := Chars (Arg1 (N));
Msg : Node_Id;
begin
-- We already know that assertions are enabled, because otherwise
-- the semantic pass dealt with rewriting the assertion (see Sem_Prag)
pragma Assert (Assertions_Enabled);
-- We already know that this check is enabled, because otherwise the
-- semantic pass dealt with rewriting the assertion (see Sem_Prag)
-- Since assertions are on, we rewrite the pragma with its
-- Since this check is enabled, we rewrite the pragma into a
-- corresponding if statement, and then analyze the statement
-- The normal case expansion transforms:
-- pragma Assert (condition [,message]);
-- pragma Check (name, condition [,message]);
-- into
......@@ -254,7 +293,9 @@ package body Exp_Prag is
-- end if;
-- where Str is the message if one is present, or the default of
-- file:line if no message is given.
-- name failed at file:line if no message is given (the "name failed
-- at" is omitted for name = Assertion, since it is redundant, given
-- that the name of the exception is Assert_Failure.
-- An alternative expansion is used when the No_Exception_Propagation
-- restriction is active and there is a local Assert_Failure handler.
......@@ -281,7 +322,7 @@ package body Exp_Prag is
-- Case where we generate a direct raise
if (Debug_Flag_Dot_G
or else Restriction_Active (No_Exception_Propagation))
or else Restriction_Active (No_Exception_Propagation))
and then Present (Find_Local_Handler (RTE (RE_Assert_Failure), N))
then
Rewrite (N,
......@@ -297,13 +338,29 @@ package body Exp_Prag is
-- Case where we call the procedure
else
-- First, we need to prepare the string literal
-- First, we need to prepare the string argument
-- If we have a message given, use it
if Present (Arg3 (N)) then
Msg := Arg3 (N);
-- Otherwise string is "name failed at location" except in the case
-- of Assertion where "name failed at" is omitted.
if Present (Arg2 (N)) then
Msg := Strval (Expr_Value_S (Arg2 (N)));
else
if Nam = Name_Assertion then
Name_Len := 0;
else
Get_Name_String (Nam);
Set_Casing (Identifier_Casing (Current_Source_File));
Add_Str_To_Name_Buffer (" failed at ");
end if;
Build_Location_String (Loc);
Msg := String_From_Name_Buffer;
Msg :=
Make_String_Literal (Loc,
Strval => String_From_Name_Buffer);
end if;
-- Now rewrite as an if statement
......@@ -317,8 +374,7 @@ package body Exp_Prag is
Make_Procedure_Call_Statement (Loc,
Name =>
New_Reference_To (RTE (RE_Raise_Assert_Failure), Loc),
Parameter_Associations => New_List (
Make_String_Literal (Loc, Msg))))));
Parameter_Associations => New_List (Msg)))));
end if;
Analyze (N);
......@@ -336,11 +392,13 @@ package body Exp_Prag is
and then Entity (Original_Node (Cond)) = Standard_False
then
return;
else
elsif Nam = Name_Assertion then
Error_Msg_N ("?assertion will fail at run-time", N);
else
Error_Msg_N ("?check will fail at run time", N);
end if;
end if;
end Expand_Pragma_Assert;
end Expand_Pragma_Check;
---------------------------------
-- Expand_Pragma_Common_Object --
......@@ -737,4 +795,39 @@ package body Exp_Prag is
procedure Expand_Pragma_Psect_Object (N : Node_Id)
renames Expand_Pragma_Common_Object;
-------------------------------------
-- Expand_Pragma_Relative_Deadline --
-------------------------------------
procedure Expand_Pragma_Relative_Deadline (N : Node_Id) is
P : constant Node_Id := Parent (N);
Loc : constant Source_Ptr := Sloc (N);
begin
-- Expand the pragma only in the case of the main subprogram. For tasks
-- the expansion is done in exp_ch9. Generate a call to Set_Deadline
-- at Clock plus the relative deadline specified in the pragma. Time
-- values are translated into Duration to allow for non-private
-- addition operation.
if Nkind (P) = N_Subprogram_Body then
Rewrite
(N,
Make_Procedure_Call_Statement (Loc,
Name => New_Reference_To (RTE (RE_Set_Deadline), Loc),
Parameter_Associations => New_List (
Unchecked_Convert_To (RTE (RO_RT_Time),
Make_Op_Add (Loc,
Left_Opnd =>
Make_Function_Call (Loc,
New_Reference_To (RTE (RO_RT_To_Duration), Loc),
New_List (Make_Function_Call (Loc,
New_Reference_To (RTE (RE_Clock), Loc)))),
Right_Opnd =>
Unchecked_Convert_To (Standard_Duration, Arg1 (N)))))));
Analyze (N);
end if;
end Expand_Pragma_Relative_Deadline;
end Exp_Prag;
gcc/ada/frontend.adb
......@@ -47,6 +47,7 @@ with Rtsfind;
with Sprint;
with Scn; use Scn;
with Sem; use Sem;
with Sem_Aux;
with Sem_Ch8; use Sem_Ch8;
with Sem_Elab; use Sem_Elab;
with Sem_Prag; use Sem_Prag;
......@@ -75,7 +76,9 @@ begin
Nlists.Initialize;
Elists.Initialize;
Lib.Load.Initialize;
Sem_Aux.Initialize;
Sem_Ch8.Initialize;
Sem_Prag.Initialize;
Fname.UF.Initialize;
Checks.Initialize;
Sem_Warn.Initialize;
......
gcc/ada/par-prag.adb
......@@ -1053,7 +1053,9 @@ begin
Pragma_Atomic |
Pragma_Atomic_Components |
Pragma_Attach_Handler |
Pragma_Check |
Pragma_Check_Name |
Pragma_Check_Policy |
Pragma_CIL_Constructor |
Pragma_Compile_Time_Error |
Pragma_Compile_Time_Warning |
......@@ -1141,6 +1143,8 @@ begin
Pragma_Preelaborable_Initialization |
Pragma_Polling |
Pragma_Persistent_BSS |
Pragma_Postcondition |
Pragma_Precondition |
Pragma_Preelaborate |
Pragma_Preelaborate_05 |
Pragma_Priority |
......@@ -1153,6 +1157,7 @@ begin
Pragma_Pure_05 |
Pragma_Pure_Function |
Pragma_Queuing_Policy |
Pragma_Relative_Deadline |
Pragma_Remote_Call_Interface |
Pragma_Remote_Types |
Pragma_Restricted_Run_Time |
......
gcc/ada/sem_attr.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -210,6 +210,21 @@ package Sem_Attr is
-- absence of an enumeration representation clause. This is a static
-- attribute (i.e. the result is static if the argument is static).
--------------
-- Enum_Val --
--------------
Attribute_Enum_Val => True,
-- For every enumeration subtype S, S'Enum_Val denotes a function
-- with the following specification:
--
-- function S'Enum_Val (Arg : universal_integer) return S'Base;
--
-- This function performs the inverse transformation to Enum_Rep. Given
-- a representation value for the type, it returns the corresponding
-- enumeration value. Constraint_Error is raised if no value of the
-- enumeration type corresponds to the given integer value.
-----------------
-- Fixed_Value --
-----------------
......@@ -276,6 +291,16 @@ package Sem_Attr is
-- attribute is primarily intended for use in implementation of the
-- standard input-output functions for fixed-point values.
Attribute_Invalid_Value => True,
-- For every scalar type, S'Invalid_Value designates an undefined value
-- of the type. If possible this value is an invalid value, and in fact
-- is identical to the value that would be set if Initialize_Scalars
-- mode were in effect (including the behavior of its value on
-- environment variables or binder switches). The intended use is
-- to set a value where intialization is required (e.g. as a result of
-- the coding standards in use), but logically no initialization is
-- needed, and the value should never be accessed.
------------------
-- Machine_Size --
------------------
......
gcc/ada/sem_aux.adb 0 → 100755
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ A U X --
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2008, 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- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING3. If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
package body Sem_Aux is
----------------
-- Initialize --
----------------
procedure Initialize is
begin
Obsolescent_Warnings.Init;
end Initialize;
---------------
-- Tree_Read --
---------------
procedure Tree_Read is
begin
Obsolescent_Warnings.Tree_Read;
end Tree_Read;
----------------
-- Tree_Write --
----------------
procedure Tree_Write is
begin
Obsolescent_Warnings.Tree_Write;
end Tree_Write;
end Sem_Aux;
gcc/ada/sem_aux.ads 0 → 100755
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ A U X --
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2008, 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- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING3. If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- Package containing utility procedures used throughout the compiler,
-- and also by ASIS so dependencies are limited to ASIS included packages.
-- Note: contents are minimal for now, the intent is to move stuff from
-- Sem_Util that meets the ASIS dependency requirements, and also stuff
-- from Einfo, where Einfo had excessive semantic knowledge of the tree.
with Alloc; use Alloc;
with Table;
with Types; use Types;
package Sem_Aux is
--------------------------------
-- Obsolescent Warnings Table --
--------------------------------
-- This table records entities for which a pragma Obsolescent with a
-- message argument has been processed.
type OWT_Record is record
Ent : Entity_Id;
-- The entity to which the pragma applies
Msg : String_Id;
-- The string containing the message
end record;
package Obsolescent_Warnings is new Table.Table (
Table_Component_Type => OWT_Record,
Table_Index_Type => Int,
Table_Low_Bound => 0,
Table_Initial => Alloc.Obsolescent_Warnings_Initial,
Table_Increment => Alloc.Obsolescent_Warnings_Increment,
Table_Name => "Obsolescent_Warnings");
-----------------
-- Subprograms --
-----------------
procedure Initialize;
-- Called at the start of compilation of each new main source file to
-- initialize the allocation of the Obsolescent_Warnings table. Note that
-- Initialize must not be called if Tree_Read is used.
procedure Tree_Read;
-- Initializes internal tables from current tree file using the relevant
-- Table.Tree_Read routines.
procedure Tree_Write;
-- Writes out internal tables to current tree file using the relevant
-- Table.Tree_Write routines.
end Sem_Aux;
gcc/ada/sem_ch6.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -100,6 +100,16 @@ package Sem_Ch6 is
-- formal access-to-subprogram type, indicating that mapping of types
-- is needed.
procedure Check_Overriding_Indicator
(Subp : Entity_Id;
Overridden_Subp : Entity_Id;
Is_Primitive : Boolean);
-- Verify the consistency of an overriding_indicator given for subprogram
-- declaration, body, renaming, or instantiation. Overridden_Subp is set
-- if the scope where we are introducing the subprogram contains a
-- type-conformant subprogram that becomes hidden by the new subprogram.
-- Is_Primitive indicates whether the subprogram is primitive.
procedure Check_Subtype_Conformant
(New_Id : Entity_Id;
Old_Id : Entity_Id;
......@@ -146,18 +156,23 @@ package Sem_Ch6 is
function Fully_Conformant_Expressions
(Given_E1 : Node_Id;
Given_E2 : Node_Id)
return Boolean;
Given_E2 : Node_Id) return Boolean;
-- Determines if two (non-empty) expressions are fully conformant
-- as defined by (RM 6.3.1(18-21))
function Fully_Conformant_Discrete_Subtypes
(Given_S1 : Node_Id;
Given_S2 : Node_Id)
return Boolean;
Given_S2 : Node_Id) return Boolean;
-- Determines if two subtype definitions are fully conformant. Used
-- for entry family conformance checks (RM 6.3.1 (24)).
procedure Install_Formals (Id : Entity_Id);
-- On entry to a subprogram body, make the formals visible. Note that
-- simply placing the subprogram on the scope stack is not sufficient:
-- the formals must become the current entities for their names. This
-- procedure is also used to get visibility to the formals when analyzing
-- preconditions and postconditions appearing in the spec.
function Mode_Conformant (New_Id, Old_Id : Entity_Id) return Boolean;
-- Determine whether two callable entities (subprograms, entries,
-- literals) are mode conformant (RM 6.3.1(15))
......
gcc/ada/sem_prag.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -26,13 +26,36 @@
-- Pragma handling is isolated in a separate package
-- (logically this processing belongs in chapter 4)
with Namet; use Namet;
with Types; use Types;
package Sem_Prag is
-----------------
-- Subprograms --
-----------------
procedure Analyze_PPC_In_Decl_Part (N : Node_Id; S : Entity_Id);
-- Special analyze routine for precondition/postcondition pragma that
-- appears within a declarative part where the pragma is associated
-- with a subprogram specification. N is the pragma node, and S is the
-- entity for the related subprogram. This procedure does a preanalysis
-- of the expressions in the pragma as "spec expressions" (see section
-- in Sem "Handling of Default and Per-Object Expressions...").
procedure Analyze_Pragma (N : Node_Id);
-- Analyze procedure for pragma reference node N
function Check_Enabled (Nam : Name_Id) return Boolean;
-- This function is used in connection with pragmas Assertion, Check,
-- Precondition, and Postcondition to determine if Check pragmas (or
-- corresponding Assert, Precondition, or Postcondition pragmas) are
-- currently active, as determined by the presence of -gnata on the
-- command line (which sets the default), and the appearence of pragmas
-- Check_Policy and Assertion_Policy as configuration pragmas either in
-- a configuration pragma file, or at the start of the current unit.
-- True is returned if the specified check is enabled.
function Delay_Config_Pragma_Analyze (N : Node_Id) return Boolean;
-- N is a pragma appearing in a configuration pragma file. Most such
-- pragmas are analyzed when the file is read, before parsing and analyzing
......@@ -43,6 +66,10 @@ package Sem_Prag is
-- True have their analysis delayed until after the main program is parsed
-- and analyzed.
procedure Initialize;
-- Initializes data structures used for pragma processing. Must be called
-- before analyzing each new main source program.
function Is_Non_Significant_Pragma_Reference (N : Node_Id) return Boolean;
-- The node N is a node for an entity and the issue is whether the
-- occurrence is a reference for the purposes of giving warnings about
......
gcc/ada/sem_warn.adb
......@@ -36,6 +36,7 @@ with Opt; use Opt;
with Rtsfind; use Rtsfind;
with Sem; use Sem;
with Sem_Ch8; use Sem_Ch8;
with Sem_Aux; use Sem_Aux;
with Sem_Eval; use Sem_Eval;
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
......@@ -2680,31 +2681,15 @@ package body Sem_Warn is
-- Output additional warning if present
declare
W : constant Node_Id := Obsolescent_Warning (E);
begin
if Present (W) then
-- This is a warning continuation to start on a new line
Name_Buffer (1) := '\';
Name_Buffer (2) := '\';
Name_Buffer (3) := '?';
Name_Len := 3;
-- Add characters to message, and output message. Note that
-- we quote every character of the message since we don't
-- want to process any insertions.
for J in 1 .. String_Length (Strval (W)) loop
Add_Char_To_Name_Buffer (''');
Add_Char_To_Name_Buffer
(Get_Character (Get_String_Char (Strval (W), J)));
end loop;
Error_Msg_N (Name_Buffer (1 .. Name_Len), N);
for J in Obsolescent_Warnings.First .. Obsolescent_Warnings.Last loop
if Obsolescent_Warnings.Table (J).Ent = E then
String_To_Name_Buffer (Obsolescent_Warnings.Table (J).Msg);
Error_Msg_Strlen := Name_Len;
Error_Msg_String (1 .. Name_Len) := Name_Buffer (1 .. Name_Len);
Error_Msg_N ("\\?~", N);
exit;
end if;
end;
end loop;
end Output_Obsolescent_Entity_Warnings;
----------------------------------
......@@ -2838,12 +2823,50 @@ package body Sem_Warn is
when 'C' =>
Warn_On_Unrepped_Components := False;
when 'e' =>
Address_Clause_Overlay_Warnings := True;
Check_Unreferenced := True;
Check_Unreferenced_Formals := True;
Check_Withs := True;
Constant_Condition_Warnings := True;
Elab_Warnings := True;
Implementation_Unit_Warnings := True;
Ineffective_Inline_Warnings := True;
Warn_On_Ada_2005_Compatibility := True;
Warn_On_All_Unread_Out_Parameters := True;
Warn_On_Assertion_Failure := True;
Warn_On_Assumed_Low_Bound := True;
Warn_On_Bad_Fixed_Value := True;
Warn_On_Constant := True;
Warn_On_Deleted_Code := True;
Warn_On_Dereference := True;
Warn_On_Export_Import := True;
Warn_On_Hiding := True;
Ineffective_Inline_Warnings := True;
Warn_On_Modified_Unread := True;
Warn_On_No_Value_Assigned := True;
Warn_On_Non_Local_Exception := True;
Warn_On_Object_Renames_Function := True;
Warn_On_Obsolescent_Feature := True;
Warn_On_Questionable_Missing_Parens := True;
Warn_On_Redundant_Constructs := True;
Warn_On_Unchecked_Conversion := True;
Warn_On_Unrecognized_Pragma := True;
Warn_On_Unrepped_Components := True;
Warn_On_Warnings_Off := True;
when 'o' =>
Warn_On_All_Unread_Out_Parameters := True;
when 'O' =>
Warn_On_All_Unread_Out_Parameters := False;
when 'p' =>
Warn_On_Parameter_Order := True;
when 'P' =>
Warn_On_Parameter_Order := False;
when 'r' =>
Warn_On_Object_Renames_Function := True;
......@@ -2892,10 +2915,11 @@ package body Sem_Warn is
Warn_On_Modified_Unread := True;
Warn_On_No_Value_Assigned := True;
Warn_On_Non_Local_Exception := True;
Warn_On_Object_Renames_Function := True;
Warn_On_Obsolescent_Feature := True;
Warn_On_Parameter_Order := True;
Warn_On_Questionable_Missing_Parens := True;
Warn_On_Redundant_Constructs := True;
Warn_On_Object_Renames_Function := True;
Warn_On_Unchecked_Conversion := True;
Warn_On_Unrecognized_Pragma := True;
Warn_On_Unrepped_Components := True;
......@@ -2922,6 +2946,7 @@ package body Sem_Warn is
Warn_On_Non_Local_Exception := False;
Warn_On_Obsolescent_Feature := False;
Warn_On_All_Unread_Out_Parameters := False;
Warn_On_Parameter_Order := False;
Warn_On_Questionable_Missing_Parens := False;
Warn_On_Redundant_Constructs := False;
Warn_On_Object_Renames_Function := False;
......@@ -3174,13 +3199,15 @@ package body Sem_Warn is
then
return;
-- Don't warn in assert pragma, since presumably tests in such
-- a context are very definitely intended, and might well be
-- Don't warn in assert or check pragma, since presumably tests in
-- such a context are very definitely intended, and might well be
-- known at compile time. Note that we have to test the original
-- node, since assert pragmas get rewritten at analysis time.
elsif Nkind (Original_Node (P)) = N_Pragma
and then Pragma_Name (Original_Node (P)) = Name_Assert
and then (Pragma_Name (Original_Node (P)) = Name_Assert
or else
Pragma_Name (Original_Node (P)) = Name_Check)
then
return;
end if;
......
gcc/ada/sinfo.adb
......@@ -1415,6 +1415,15 @@ package body Sinfo is
return Flag11 (N);
end Has_Private_View;
function Has_Relative_Deadline_Pragma
(N : Node_Id) return Boolean is
begin
pragma Assert (False
or else NT (N).Nkind = N_Subprogram_Body
or else NT (N).Nkind = N_Task_Definition);
return Flag9 (N);
end Has_Relative_Deadline_Pragma;
function Has_Self_Reference
(N : Node_Id) return Boolean is
begin
......@@ -1980,6 +1989,14 @@ package body Sinfo is
return Node4 (N);
end Next_Named_Actual;
function Next_Pragma
(N : Node_Id) return Node_Id is
begin
pragma Assert (False
or else NT (N).Nkind = N_Pragma);
return Node1 (N);
end Next_Pragma;
function Next_Rep_Item
(N : Node_Id) return Node_Id is
begin
......@@ -2184,6 +2201,14 @@ package body Sinfo is
return Node4 (N);
end Parent_Spec;
function PPC_Enabled
(N : Node_Id) return Boolean is
begin
pragma Assert (False
or else NT (N).Nkind = N_Pragma);
return Flag5 (N);
end PPC_Enabled;
function Position
(N : Node_Id) return Node_Id is
begin
......@@ -4154,6 +4179,15 @@ package body Sinfo is
Set_Flag11 (N, Val);
end Set_Has_Private_View;
procedure Set_Has_Relative_Deadline_Pragma
(N : Node_Id; Val : Boolean := True) is
begin
pragma Assert (False
or else NT (N).Nkind = N_Subprogram_Body
or else NT (N).Nkind = N_Task_Definition);
Set_Flag9 (N, Val);
end Set_Has_Relative_Deadline_Pragma;
procedure Set_Has_Self_Reference
(N : Node_Id; Val : Boolean := True) is
begin
......@@ -4719,6 +4753,14 @@ package body Sinfo is
Set_Node4 (N, Val); -- semantic field, no parent set
end Set_Next_Named_Actual;
procedure Set_Next_Pragma
(N : Node_Id; Val : Node_Id) is
begin
pragma Assert (False
or else NT (N).Nkind = N_Pragma);
Set_Node1 (N, Val); -- semantic field, no parent set
end Set_Next_Pragma;
procedure Set_Next_Rep_Item
(N : Node_Id; Val : Node_Id) is
begin
......@@ -4923,6 +4965,14 @@ package body Sinfo is
Set_Node4 (N, Val); -- semantic field, no parent set
end Set_Parent_Spec;
procedure Set_PPC_Enabled
(N : Node_Id; Val : Boolean := True) is
begin
pragma Assert (False
or else NT (N).Nkind = N_Pragma);
Set_Flag5 (N, Val);
end Set_PPC_Enabled;
procedure Set_Position
(N : Node_Id; Val : Node_Id) is
begin
......
gcc/ada/sinput.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -221,8 +221,6 @@ package body Sinput is
Ptr : Source_Ptr;
begin
Name_Len := 0;
-- Loop through instantiations
Ptr := Loc;
......@@ -765,17 +763,20 @@ package body Sinput is
null;
else
-- Free the buffer, we use Free here, because we used malloc
-- or realloc directly to allocate the tables. That is
-- because we were playing the big array trick. We need to
-- suppress the warning for freeing from an empty pool!
-- We have to recreate a proper pointer to the actual array
-- from the zero origin pointer stored in the source table.
Tmp1 :=
To_Source_Buffer_Ptr
(S.Source_Text (S.Source_First)'Address);
pragma Warnings (Off);
Free_Ptr (Tmp1);
-- Note: we are using free here, because we used malloc
-- or realloc directly to allocate the tables. That is
-- because we were playing the big array trick.
pragma Warnings (On);
if S.Lines_Table /= null then
Memory.Free (To_Address (S.Lines_Table));
......
gcc/ada/sinput.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -465,13 +465,13 @@ package Sinput is
-- that there definitely is a previous line in the source buffer.
procedure Build_Location_String (Loc : Source_Ptr);
-- This function builds a string literal of the form "name:line",
-- where name is the file name corresponding to Loc, and line is
-- the line number. In the event that instantiations are involved,
-- additional suffixes of the same form are appended after the
-- separating string " instantiated at ". The returned string is
-- stored in Name_Buffer, terminated by ASCII.Nul, with Name_Length
-- indicating the length not including the terminating Nul.
-- This function builds a string literal of the form "name:line", where
-- name is the file name corresponding to Loc, and line is the line number.
-- In the event that instantiations are involved, additional suffixes of
-- the same form are appended after the separating string " instantiated at
-- ". The returned string is appended to the Name_Buffer, terminated by
-- ASCII.NUL, with Name_Length indicating the length not including the
-- terminating Nul.
function Get_Column_Number (P : Source_Ptr) return Column_Number;
-- The ones-origin column number of the specified Source_Ptr value is
......
gcc/ada/snames.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -78,8 +78,11 @@ package body Snames is
"_local_final_list#" &
"_master#" &
"_object#" &
"_postconditions#" &
"_priority#" &
"_process_atsd#" &
"_relative_deadline#" &
"_result#" &
"_secondary_stack#" &
"_service#" &
"_size#" &
......@@ -145,7 +148,6 @@ package body Snames is
"_call#" &
"rci_name#" &
"receiver#" &
"result#" &
"rpc#" &
"subp_id#" &
"operation#" &
......@@ -182,6 +184,7 @@ package body Snames is
"assertion_policy#" &
"c_pass_by_copy#" &
"check_name#" &
"check_policy#" &
"compile_time_error#" &
"compile_time_warning#" &
"compiler_unit#" &
......@@ -207,8 +210,8 @@ package body Snames is
"no_strict_aliasing#" &
"normalize_scalars#" &
"optimize_alignment#" &
"polling#" &
"persistent_bss#" &
"polling#" &
"priority_specific_dispatching#" &
"profile#" &
"profile_warnings#" &
......@@ -239,6 +242,7 @@ package body Snames is
"atomic#" &
"atomic_components#" &
"attach_handler#" &
"check#" &
"cil_constructor#" &
"comment#" &
"common_object#" &
......@@ -299,6 +303,8 @@ package body Snames is
"pack#" &
"page#" &
"passive#" &
"postcondition#" &
"precondition#" &
"preelaborable_initialization#" &
"preelaborate#" &
"preelaborate_05#" &
......@@ -306,6 +312,7 @@ package body Snames is
"pure#" &
"pure_05#" &
"pure_function#" &
"relative_deadline#" &
"remote_call_interface#" &
"remote_types#" &
"share_generic#" &
......@@ -351,10 +358,10 @@ package body Snames is
"dll#" &
"win32#" &
"as_is#" &
"assertion#" &
"attribute_name#" &
"body_file_name#" &
"boolean_entry_barriers#" &
"check#" &
"casing#" &
"code#" &
"component#" &
......@@ -458,6 +465,7 @@ package body Snames is
"emax#" &
"enabled#" &
"enum_rep#" &
"enum_val#" &
"epsilon#" &
"exponent#" &
"external_tag#" &
......@@ -468,9 +476,11 @@ package body Snames is
"fore#" &
"has_access_values#" &
"has_discriminants#" &
"has_tagged_values#" &
"identity#" &
"img#" &
"integer_value#" &
"invalid_value#" &
"large#" &
"last#" &
"last_bit#" &
......@@ -505,6 +515,7 @@ package body Snames is
"priority#" &
"range#" &
"range_length#" &
"result#" &
"round#" &
"safe_emax#" &
"safe_first#" &
......@@ -576,6 +587,7 @@ package body Snames is
"priority_queuing#" &
"edf_across_priorities#" &
"fifo_within_priorities#" &
"non_preemptive_within_priorities#" &
"round_robin_within_priorities#" &
"access_check#" &
"accessibility_check#" &
......@@ -679,7 +691,9 @@ package body Snames is
"tagged#" &
"raise_exception#" &
"ada_roots#" &
"aggregate#" &
"archive_builder#" &
"archive_builder_append_option#" &
"archive_indexer#" &
"archive_suffix#" &
"binder#" &
......@@ -695,6 +709,7 @@ package body Snames is
"config_file_unique#" &
"config_spec_file_name#" &
"config_spec_file_name_pattern#" &
"configuration#" &
"cross_reference#" &
"default_language#" &
"default_switches#" &
......@@ -720,9 +735,11 @@ package body Snames is
"include_switches#" &
"include_path#" &
"include_path_file#" &
"inherit_source_path#" &
"language_kind#" &
"language_processing#" &
"languages#" &
"library#" &
"library_ali_dir#" &
"library_auto_init#" &
"library_auto_init_supported#" &
......@@ -941,6 +958,8 @@ package body Snames is
return Pragma_Interface;
elsif N = Name_Priority then
return Pragma_Priority;
elsif N = Name_Relative_Deadline then
return Pragma_Relative_Deadline;
elsif N = Name_Storage_Size then
return Pragma_Storage_Size;
elsif N = Name_Storage_Unit then
......@@ -1130,6 +1149,7 @@ package body Snames is
or else N = Name_AST_Entry
or else N = Name_Fast_Math
or else N = Name_Interface
or else N = Name_Relative_Deadline
or else N = Name_Priority
or else N = Name_Storage_Size
or else N = Name_Storage_Unit;
......
gcc/ada/snames.ads
This source diff could not be displayed because it is too large. You can view the blob instead.
gcc/ada/tree_gen.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -32,12 +32,19 @@ with Nlists;
with Opt;
with Osint.C;
with Repinfo;
with Sem_Aux;
with Sinput;
with Stand;
with Stringt;
with Uintp;
with Urealp;
with Tree_In;
pragma Warnings (Off, Tree_In);
-- We do not use Tree_In in the compiler, but it is small, and worth including
-- so that we get the proper license check for Tree_In when the compiler is
-- built. This will avoid adding bad dependencies to Tree_In and blowing ASIS.
procedure Tree_Gen is
begin
if Opt.Tree_Output then
......@@ -49,6 +56,7 @@ begin
Lib.Tree_Write;
Namet.Tree_Write;
Nlists.Tree_Write;
Sem_Aux.Tree_Write;
Sinput.Tree_Write;
Stand.Tree_Write;
Stringt.Tree_Write;
......
gcc/ada/tree_in.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-1999, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
......@@ -40,6 +40,7 @@ with Namet;
with Nlists;
with Opt;
with Repinfo;
with Sem_Aux;
with Sinput;
with Stand;
with Stringt;
......@@ -57,6 +58,7 @@ begin
Lib.Tree_Read;
Namet.Tree_Read;
Nlists.Tree_Read;
Sem_Aux.Tree_Read;
Sinput.Tree_Read;
Stand.Tree_Read;
Stringt.Tree_Read;
......
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