Skip to content

R
riscv-gcc-1
Commit 2d4e0553 by Arnaud Charlet
Options

[multiple changes] 

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

	* einfo.ads, einfo.adb (Has_Predicates): Flag is now on all entities
	(simplifies code).
	* exp_ch13.adb (Build_Predicate_Function): Output info msgs for
	inheritance.
	* sem_ch13.adb (Analyze_Aspect_Specifications): Make sure we have a
	freeze node for entities for which a predicate is specified.
	(Analyze_Aspect_Specifications): Avoid duplicate calls
	* sem_ch3.adb (Analyze_Full_Type_Declaration): Remove attempt to avoid
	duplicate calls to Analye_Aspect_Specifications.

2010-10-22  Thomas Quinot  <quinot@adacore.com>

	* a-exextr.adb, atree.ads, freeze.adb: Minor reformatting.

From-SVN: r165804
parent 50ea5861
Showing with 80 additions and 41 deletions
gcc/ada/ChangeLog
2010-10-22 Robert Dewar <dewar@adacore.com>
* einfo.ads, einfo.adb (Has_Predicates): Flag is now on all entities
(simplifies code).
* exp_ch13.adb (Build_Predicate_Function): Output info msgs for
inheritance.
* sem_ch13.adb (Analyze_Aspect_Specifications): Make sure we have a
freeze node for entities for which a predicate is specified.
(Analyze_Aspect_Specifications): Avoid duplicate calls
* sem_ch3.adb (Analyze_Full_Type_Declaration): Remove attempt to avoid
duplicate calls to Analye_Aspect_Specifications.
2010-10-22 Thomas Quinot <quinot@adacore.com>
* a-exextr.adb, atree.ads, freeze.adb: Minor reformatting.
2010-10-21 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb: Minor reformatting.
......
gcc/ada/a-exextr.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -53,8 +53,7 @@ package body Exception_Traces is
pragma Export
(Ada, Raise_Hook_Initialized, "__gnat_exception_actions_initialized");
procedure Last_Chance_Handler
(Except : Exception_Occurrence);
procedure Last_Chance_Handler (Except : Exception_Occurrence);
pragma Import (C, Last_Chance_Handler, "__gnat_last_chance_handler");
pragma No_Return (Last_Chance_Handler);
-- Users can replace the default version of this routine,
......
gcc/ada/atree.ads
......@@ -537,9 +537,8 @@ package Atree is
function Parent (N : Node_Id) return Node_Id;
pragma Inline (Parent);
-- Returns the parent of a node if the node is not a list member, or
-- else the parent of the list containing the node if the node is a
-- list member.
-- Returns the parent of a node if the node is not a list member, or else
-- the parent of the list containing the node if the node is a list member.
function No (N : Node_Id) return Boolean;
pragma Inline (No);
......
gcc/ada/einfo.adb
......@@ -1411,7 +1411,6 @@ package body Einfo is
function Has_Predicates (Id : E) return B is
begin
pragma Assert (Is_Type (Id) or else Is_Subprogram (Id));
return Flag250 (Id);
end Has_Predicates;
......@@ -3863,9 +3862,6 @@ package body Einfo is
procedure Set_Has_Predicates (Id : E; V : B := True) is
begin
pragma Assert (Is_Type (Id)
or else Ekind (Id) = E_Function
or else Ekind (Id) = E_Void);
Set_Flag250 (Id, V);
end Set_Has_Predicates;
......
gcc/ada/einfo.ads
......@@ -1674,11 +1674,11 @@ package Einfo is
-- such an object and no warning is generated.
-- Has_Predicates (Flag250)
-- Present in type and subtype entities and in subprogram entities. Set
-- if a pragma Predicate or Predicate aspect applies to the type, or if
-- it inherits a Predicate aspect from its parent or progenitor types.
-- Also set in the predicate function entity, to distinguish it among
-- entries in the Subprograms_For_Type.
-- Present in all entities. Set in type and subtype entities if a pragma
-- Predicate or Predicate aspect applies to the type, or if it inherits a
-- Predicate aspect from its parent or progenitor types. Also set in the
-- predicate function entity, to distinguish it among entries in the
-- Subprograms_For_Type.
-- Has_Primitive_Operations (Flag120) [base type only]
-- Present in all type entities. Set if at least one primitive operation
......@@ -4666,6 +4666,7 @@ package Einfo is
-- Has_Pragma_Thread_Local_Storage (Flag169)
-- Has_Pragma_Unmodified (Flag233)
-- Has_Pragma_Unreferenced (Flag180)
-- Has_Predicates (Flag250)
-- Has_Private_Declaration (Flag155)
-- Has_Qualified_Name (Flag161)
-- Has_Stream_Size_Clause (Flag184)
......@@ -4778,7 +4779,6 @@ package Einfo is
-- Has_Object_Size_Clause (Flag172)
-- Has_Pragma_Preelab_Init (Flag221)
-- Has_Pragma_Unreferenced_Objects (Flag212)
-- Has_Predicates (Flag250)
-- Has_Primitive_Operations (Flag120) (base type only)
-- Has_Size_Clause (Flag29)
-- Has_Specified_Layout (Flag100) (base type only)
......@@ -5138,7 +5138,6 @@ package Einfo is
-- Has_Missing_Return (Flag142)
-- Has_Nested_Block_With_Handler (Flag101)
-- Has_Postconditions (Flag240)
-- Has_Predicates (Flag250)
-- Has_Recursive_Call (Flag143)
-- Has_Subprogram_Descriptor (Flag93)
-- Is_Abstract_Subprogram (Flag19) (non-generic case only)
......@@ -5271,7 +5270,6 @@ package Einfo is
-- Subprograms_For_Type (Node29)
-- Has_Invariants (Flag232)
-- Has_Postconditions (Flag240)
-- Has_Predicates (Flag250)
-- Is_Machine_Code_Subprogram (Flag137)
-- Is_Pure (Flag44)
-- Is_Intrinsic_Subprogram (Flag64)
......@@ -5403,7 +5401,6 @@ package Einfo is
-- Has_Master_Entity (Flag21)
-- Has_Nested_Block_With_Handler (Flag101)
-- Has_Postconditions (Flag240)
-- Has_Predicates (Flag250)
-- Has_Subprogram_Descriptor (Flag93)
-- Is_Abstract_Subprogram (Flag19) (non-generic case only)
-- Is_Asynchronous (Flag81)
......
gcc/ada/exp_ch13.adb
......@@ -27,6 +27,7 @@ with Atree; use Atree;
with Checks; use Checks;
with Einfo; use Einfo;
with Elists; use Elists;
with Errout; use Errout;
with Exp_Ch3; use Exp_Ch3;
with Exp_Ch6; use Exp_Ch6;
with Exp_Imgv; use Exp_Imgv;
......@@ -126,12 +127,17 @@ package body Exp_Ch13 is
begin
if Present (T) and then Present (Predicate_Function (T)) then
-- Build the call to the predicate function of T
Exp :=
Make_Predicate_Call
(T,
Convert_To (T,
Make_Identifier (Loc, Chars => Object_Name)));
-- Add call to evolving expression, using AND THEN if needed
if No (Expr) then
Expr := Exp;
else
......@@ -140,6 +146,14 @@ package body Exp_Ch13 is
Left_Opnd => Relocate_Node (Expr),
Right_Opnd => Exp);
end if;
-- Output info message on inheritance if required
if Opt.List_Inherited_Aspects then
Error_Msg_Sloc := Sloc (Predicate_Function (T));
Error_Msg_Node_2 := T;
Error_Msg_N ("?info: & inherits predicate from & at #", Typ);
end if;
end if;
end Add_Call;
......@@ -200,24 +214,27 @@ package body Exp_Ch13 is
Arg1 := Get_Pragma_Arg (Arg1);
Arg2 := Get_Pragma_Arg (Arg2);
-- We need to replace any occurrences of the name of the type
-- with references to the object. We do this by first doing a
-- preanalysis, to identify all the entities, then we traverse
-- looking for the type entity, doing the needed substitution.
-- The preanalysis is done with the special OK_To_Reference
-- flag set on the type, so that if we get an occurrence of
-- this type, it will be recognized as legitimate.
Set_OK_To_Reference (Typ, True);
Preanalyze_Spec_Expression (Arg2, Standard_Boolean);
Set_OK_To_Reference (Typ, False);
Replace_Type (Arg2);
-- See if this predicate pragma is for the current type
if Entity (Arg1) = Typ then
-- We have a match, add the expression
-- We have a match, this entry is for our subtype
-- First We need to replace any occurrences of the name of
-- the type with references to the object. We do this by
-- first doing a preanalysis, to identify all the entities,
-- then we traverse looking for the type entity, doing the
-- needed substitution. The preanalysis is done with the
-- special OK_To_Reference flag set on the type, so that if
-- we get an occurrence of this type, it will be recognized
-- as legitimate.
Set_OK_To_Reference (Typ, True);
Preanalyze_Spec_Expression (Arg2, Standard_Boolean);
Set_OK_To_Reference (Typ, False);
Replace_Type (Arg2);
-- OK, replacement complete, now we can add the expression
if No (Expr) then
Expr := Relocate_Node (Arg2);
......
gcc/ada/freeze.adb
......@@ -3464,9 +3464,9 @@ package body Freeze is
end;
end if;
-- If any of the index types was an enumeration type with
-- a non-standard rep clause, then we indicate that the
-- array type is always packed (even if it is not bit packed).
-- If any of the index types was an enumeration type with a
-- non-standard rep clause, then we indicate that the array
-- type is always packed (even if it is not bit packed).
if Non_Standard_Enum then
Set_Has_Non_Standard_Rep (Base_Type (E));
......
gcc/ada/sem_ch13.adb
......@@ -658,10 +658,21 @@ package body Sem_Ch13 is
-- Set True if delay is required
begin
-- Return if no aspects
if L = No_List then
return;
end if;
-- Return if already analyzed (avoids duplicate calls in some cases
-- where type declarations get rewritten and proessed twice).
if Analyzed (N) then
return;
end if;
-- Loop through apsects
Aspect := First (L);
while Present (Aspect) loop
declare
......@@ -1068,6 +1079,12 @@ package body Sem_Ch13 is
Set_From_Aspect_Specification (Aitem, True);
-- Make sure we have a freeze node (it might otherwise be
-- missing in cases like subtype X is Y, and we would not
-- have a place to build the predicate function).
Ensure_Freeze_Node (E);
-- For Predicate case, insert immediately after the entity
-- declaration. We do not have to worry about delay issues
-- since the pragma processing takes care of this.
......
gcc/ada/sem_ch3.adb
......@@ -2403,9 +2403,7 @@ package body Sem_Ch3 is
Set_Optimize_Alignment_Flags (Def_Id);
Check_Eliminated (Def_Id);
if Nkind (N) = N_Full_Type_Declaration then
Analyze_Aspect_Specifications (N, Def_Id, Aspect_Specifications (N));
end if;
Analyze_Aspect_Specifications (N, Def_Id, Aspect_Specifications (N));
end Analyze_Full_Type_Declaration;
----------------------------------
......@@ -4215,8 +4213,8 @@ package body Sem_Ch3 is
Set_Optimize_Alignment_Flags (Id);
Check_Eliminated (Id);
<<Leave>>
Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
<<Leave>>
Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
end Analyze_Subtype_Declaration;
--------------------------------
......
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