[multiple changes]

2010-10-26  Robert Dewar  <dewar@adacore.com>

	* exp_ch3.adb: Fix typo, comment updates.
	* namet.adb: Minor comment additions.
	* einfo.ads: Minor comment update.

2010-10-26  Javier Miranda  <miranda@adacore.com>

	* einfo.adb (Set_Dispatch_Table_Wrappers): Complete the assertion.

2010-10-26  Robert Dewar  <dewar@adacore.com>

	* par.adb, par-ch13.adb (Aspect_Specifications_Present): Add Strict
	parameter.

From-SVN: r165955
This commit is contained in:
Arnaud Charlet 2010-10-26 14:56:43 +02:00
parent 329b9f810d
commit 3923140473
6 changed files with 47 additions and 15 deletions

View File

@ -3302,7 +3302,12 @@ package body Einfo is
procedure Set_Dispatch_Table_Wrappers (Id : E; V : L) is
begin
pragma Assert (Is_Tagged_Type (Id) and then Is_Base_Type (Id));
pragma Assert (Is_Tagged_Type (Id)
and then Is_Base_Type (Id)
and then Ekind_In (Id, E_Record_Type,
E_Record_Subtype,
E_Record_Type_With_Private,
E_Record_Subtype_With_Private));
Set_Elist26 (Id, V);
end Set_Dispatch_Table_Wrappers;

View File

@ -1651,7 +1651,9 @@ package Einfo is
-- Has_Pragma_Pure_Function (Flag179)
-- Present in all entities. If set, indicates that a valid pragma
-- Pure_Function was given for the entity. In some cases, we need to
-- know that Is_Pure was explicitly set using this pragma.
-- know that Is_Pure was explicitly set using this pragma. We also set
-- this flag for some internal entities that we know should be treated
-- as pure for optimization purposes.
-- Has_Pragma_Thread_Local_Storage (Flag169)
-- Present in all entities. If set, indicates that a valid pragma

View File

@ -5861,13 +5861,18 @@ package body Exp_Ch3 is
Alternatives => Lst))));
Set_TSS (Typ, Fent);
Set_Is_Pure (Fent);
-- The Pure flag will be reset is the current context is not pure.
-- For optimization purposes and constant-folding, indicate that the
-- Rep_To_Pos function can be considered free of side effects.
-- Set Pure flag (it will be reset if the current context is not Pure).
-- We also pretend there was a pragma Pure_Function so that for purposes
-- of optimization and constant-folding, we will consider the function
-- Pure even if we are not in a Pure context).
Set_Is_Pure (Fent);
Set_Has_Pragma_Pure_Function (Fent);
-- Unless we are in -gnatD mode, where we are debugging generated code,
-- this is an internal entity for which we don't need debug info.
if not Debug_Generated_Code then
Set_Debug_Info_Off (Fent);
end if;

View File

@ -140,9 +140,14 @@ package body Namet is
Verbosity : constant Int range 1 .. 3 := 1;
pragma Warnings (Off, Verbosity);
-- 1 => print basic summary information
-- 2 => in addition print number of entries per hash chain
-- 3 => in addition print content of entries
-- This constant indicates the level of verbosity in the output from
-- this procedure. Currently this can only be changed by editing the
-- declaration above and recompiling. That's good enough in practice,
-- since we very rarely need to use this debug option. Settings are:
--
-- 1 => print basic summary information
-- 2 => in addition print number of entries per hash chain
-- 3 => in addition print content of entries
Zero : constant Int := Character'Pos ('0');

View File

@ -39,7 +39,9 @@ package body Ch13 is
-- Aspect_Specifications_Present --
-----------------------------------
function Aspect_Specifications_Present return Boolean is
function Aspect_Specifications_Present
(Strict : Boolean := Ada_Version < Ada_2012) return Boolean
is
Scan_State : Saved_Scan_State;
Result : Boolean;
@ -52,7 +54,12 @@ package body Ch13 is
if Token = Tok_Semicolon then
Scan; -- past semicolon
if Aspect_Specifications_Present then
-- The recursive test is set Strict, since we already have one
-- error (the unexpected semicolon), so we will ignore that semicolon
-- only if we absolutely definitely have an aspect specification
-- following it.
if Aspect_Specifications_Present (Strict => True) then
Error_Msg_SP ("|extra "";"" ignored");
return True;
@ -79,13 +86,14 @@ package body Ch13 is
if Token /= Tok_Identifier then
Result := False;
-- In Ada 2012 mode, we are less strict, and we consider that we have
-- This is where we pay attention to the Strict mode. Normally when we
-- are in Ada 2012 mode, Strict is False, and we consider that we have
-- an aspect specification if the identifier is an aspect name (even if
-- not followed by =>) or the identifier is not an aspect name but is
-- followed by =>. P_Aspect_Specifications will generate messages if the
-- aspect specification is ill-formed.
elsif Ada_Version >= Ada_2012 then
elsif not Strict then
if Get_Aspect_Id (Token_Name) /= No_Aspect then
Result := True;
else

View File

@ -848,14 +848,21 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
package Ch13 is
function P_Representation_Clause return Node_Id;
function Aspect_Specifications_Present return Boolean;
function Aspect_Specifications_Present
(Strict : Boolean := Ada_Version < Ada_2012) return Boolean;
-- This function tests whether the next keyword is WITH followed by
-- something that looks reasonably like an aspect specification. If so,
-- True is returned. Otherwise False is returned. In either case control
-- returns with the token pointer unchanged (i.e. pointing to the WITH
-- token in the case where True is returned). This function takes care
-- of generating appropriate messages if aspect specifications appear
-- in versions of Ada prior to Ada 2012.
-- in versions of Ada prior to Ada 2012. The parameter strict can be
-- set to True, to be rather strict about considering something to be
-- an aspect speficiation. If Strict is False, then the circuitry is
-- rather more generous in considering something ill-formed to be an
-- attempt at an aspect speciciation. The default is more strict for
-- Ada versions before Ada 2012 (where aspect specifications are not
-- permitted).
procedure P_Aspect_Specifications (Decl : Node_Id);
-- This subprogram is called with the current token pointing to either a