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

[multiple changes] 

2011-08-03  Yannick Moy  <moy@adacore.com>

	* sem_ch6.adb (New_Overloaded_Entity): only issue error for SPARK
	restriction on overloaded entity if the entity is not an operator.

2011-08-03  Yannick Moy  <moy@adacore.com>

	* sem_ch7.adb, sem_res.adb, sem_attr.adb, restrict.adb,
	restrict.ads: Rename remaining Check_Formal_Restriction* into
	Check_SPARK_Restriction*.

2011-08-03  Emmanuel Briot  <briot@adacore.com>

	* prj-proc.adb, prj-part.adb, prj.adb, prj.ads, prj-nmsc.adb,
	prj-nmsc.ads, prj-err.adb (Project_Data): now discriminated on its
	qualifier.
	(Project_Empty): removed
	(Empty_Project): new parameter Qualifier
	This is used to have fields specific to aggregate projects, cleaner
	New field to store the list of aggregated projects.
	(Check_Aggregate_Project): removed
	(Process_Aggregated_Projects, Free): new subprograms.

From-SVN: r177243
This commit is contained in:
Arnaud Charlet 2011-08-03 11:17:28 +02:00
parent 3f5a8feea3
commit c4d67e2d73
14 changed files with 1215 additions and 1132 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
gcc/ada/ChangeLog
View File

@ -1,3 +1,26 @@
2011-08-03 Yannick Moy <moy@adacore.com>
* sem_ch6.adb (New_Overloaded_Entity): only issue error for SPARK
restriction on overloaded entity if the entity is not an operator.
2011-08-03 Yannick Moy <moy@adacore.com>
* sem_ch7.adb, sem_res.adb, sem_attr.adb, restrict.adb,
restrict.ads: Rename remaining Check_Formal_Restriction* into
Check_SPARK_Restriction*.
2011-08-03 Emmanuel Briot <briot@adacore.com>
* prj-proc.adb, prj-part.adb, prj.adb, prj.ads, prj-nmsc.adb,
prj-nmsc.ads, prj-err.adb (Project_Data): now discriminated on its
qualifier.
(Project_Empty): removed
(Empty_Project): new parameter Qualifier
This is used to have fields specific to aggregate projects, cleaner
New field to store the list of aggregated projects.
(Check_Aggregate_Project): removed
(Process_Aggregated_Projects, Free): new subprograms.
2011-08-03 Olivier Hainque <hainque@adacore.com>
* tracebak.c (STOP_FRAME ppc AIX): Stop at null return address as well.

6
gcc/ada/prj-err.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-2010, Free Software Foundation, Inc. --
-- Copyright (C) 2002-2011, 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,7 +78,7 @@ package body Prj.Err is
-- triggered)
if Current_Verbosity = High then
Write_Line ("ERROR: " & Msg);
Debug_Output ("ERROR: " & Msg);
end if;
-- If location of error is unknown, use the location of the project
@ -96,7 +96,7 @@ package body Prj.Err is
-- access to in any case.
if Current_Verbosity = High then
Write_Line ("Error in in-memory project, ignored");
Debug_Output ("Error in in-memory project, ignored");
end if;
return;

84
gcc/ada/prj-nmsc.adb
View File

@ -30,6 +30,7 @@ with Output; use Output;
with Prj.Com;
with Prj.Env; use Prj.Env;
with Prj.Err; use Prj.Err;
with Prj.Tree; use Prj.Tree;
with Prj.Util; use Prj.Util;
with Sinput.P;
with Snames; use Snames;
@ -196,8 +197,8 @@ package body Prj.Nmsc is
-- Free the memory occupied by Data
procedure Check
(Project : Project_Id;
Data : in out Tree_Processing_Data);
(Project : Project_Id;
Data : in out Tree_Processing_Data);
-- Process the naming scheme for a single project
procedure Initialize
@ -247,7 +248,8 @@ package body Prj.Nmsc is
-- expanded pattern was found (1 for the first element of Patterns and
-- all its matching directories, then 2,...).
-- We use a generic and not an access-to-subprogram because in some cases
-- this code is compiled with the restriction No_Implicit_Dynamic_Code
-- this code is compiled with the restriction No_Implicit_Dynamic_Code.
-- An error message is raised if a pattern does not match any file.
procedure Add_Source
(Id : out Source_Id;
@ -322,12 +324,6 @@ package body Prj.Nmsc is
-- Check the library attributes of project Project in project tree
-- and modify its data Data accordingly.
procedure Check_Aggregate_Project
(Project : Project_Id;
Data : in out Tree_Processing_Data);
-- Check aggregate projects attributes, and find the list of aggregated
-- projects. They are stored as a "project_files" language in Project.
procedure Check_Abstract_Project
(Project : Project_Id;
Data : in out Tree_Processing_Data);
@ -923,19 +919,27 @@ package body Prj.Nmsc is
end if;
end Canonical_Case_File_Name;
-----------------------------
-- Check_Aggregate_Project --
-----------------------------
---------------------------------
-- Process_Aggregated_Projects --
---------------------------------
procedure Check_Aggregate_Project
(Project : Project_Id;
Data : in out Tree_Processing_Data)
procedure Process_Aggregated_Projects
(Tree : Project_Tree_Ref;
Project : Project_Id;
Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
Flags : Processing_Flags)
is
Data : Tree_Processing_Data :=
(Tree => Tree,
Node_Tree => Node_Tree,
File_To_Source => Files_Htable.Nil,
Flags => Flags);
Project_Files : constant Prj.Variable_Value :=
Prj.Util.Value_Of
(Snames.Name_Project_Files,
Project.Decl.Attributes,
Data.Tree);
Tree);
Project_Path_For_Aggregate : Prj.Env.Project_Search_Path;
@ -954,7 +958,6 @@ package body Prj.Nmsc is
procedure Found_Project_File (Path : Path_Information; Rank : Natural) is
pragma Unreferenced (Rank);
Full_Path : Path_Name_Type;
begin
Debug_Output ("Aggregates: ", Name_Id (Path.Display_Name));
@ -963,30 +966,37 @@ package body Prj.Nmsc is
-- can only do this when processing the aggregate project, since the
-- exact list of project files or project directories can depend on
-- scenario variables.
-- We only load the projects explicitly here, but do not process
-- them. For the processing, Prj.Proc will take care of processing
-- them, within the same call to Recursive_Process (thus avoiding the
-- processing of a given project multiple times).
--
-- ??? We might already have loaded the project
Prj.Env.Find_Project
(Self => Project_Path_For_Aggregate,
Project_File_Name => Get_Name_String (Path.Name),
Directory => Get_Name_String (Project.Path.Name),
Path => Full_Path);
Add_Aggregated_Project (Project, Path => Path.Name);
end Found_Project_File;
-- Start of processing for Check_Aggregate_Project
begin
pragma Assert (Project.Qualifier = Aggregate);
if Project_Files.Default then
Error_Msg_Name_1 := Snames.Name_Project_Files;
Error_Msg
(Data.Flags,
(Flags,
"Attribute %% must be specified in aggregate project",
Project.Location, Project);
return;
end if;
-- The aggregated projects are only searched relative to the directory
-- of the aggregate project, not in the default project path.
Initialize_Empty (Project_Path_For_Aggregate);
Free (Project.Aggregated_Projects);
-- Look for aggregated projects. For similarity with source files and
-- dirs, the aggregated project files are not searched for on the
-- project path, and are only found through the path specified in
@ -1001,7 +1011,7 @@ package body Prj.Nmsc is
Resolve_Links => Opt.Follow_Links_For_Files);
Free (Project_Path_For_Aggregate);
end Check_Aggregate_Project;
end Process_Aggregated_Projects;
----------------------------
-- Check_Abstract_Project --
@ -1058,7 +1068,7 @@ package body Prj.Nmsc is
Prj_Data : Project_Processing_Data;
begin
Debug_Increase_Indent ("Check ", Project.Name);
Debug_Increase_Indent ("Check", Project.Name);
Initialize (Prj_Data, Project);
@ -1074,7 +1084,6 @@ package body Prj.Nmsc is
end if;
case Project.Qualifier is
when Aggregate => Check_Aggregate_Project (Project, Data);
when Dry => Check_Abstract_Project (Project, Data);
when others => null;
end case;
@ -5222,7 +5231,7 @@ package body Prj.Nmsc is
if Current_Verbosity = High then
if Project.Object_Directory = No_Path_Information then
Write_Line ("No object directory");
Debug_Output ("No object directory");
else
Write_Attr
("Object directory",
@ -7928,17 +7937,20 @@ package body Prj.Nmsc is
Element : String_Element;
begin
Debug_Increase_Indent ("Source_Dirs:");
if Project.Source_Dirs = Nil_String then
Debug_Output ("No source dirs");
else
Debug_Increase_Indent ("Source_Dirs:");
Current := Project.Source_Dirs;
while Current /= Nil_String loop
Element := In_Tree.String_Elements.Table (Current);
Write_Str (" ");
Write_Line (Get_Name_String (Element.Display_Value));
Current := Element.Next;
end loop;
Current := Project.Source_Dirs;
while Current /= Nil_String loop
Element := In_Tree.String_Elements.Table (Current);
Debug_Output (Get_Name_String (Element.Display_Value));
Current := Element.Next;
end loop;
Debug_Decrease_Indent ("end Source_Dirs.");
Debug_Decrease_Indent ("end Source_Dirs.");
end if;
end Show_Source_Dirs;
---------------------------

14
gcc/ada/prj-nmsc.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2000-2010, Free Software Foundation, Inc. --
-- Copyright (C) 2000-2011, 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- --
@ -42,4 +42,16 @@ private package Prj.Nmsc is
-- Project_Id which contains all the information about the project. This
-- information is only valid while the external references are preserved.
procedure Process_Aggregated_Projects
(Tree : Project_Tree_Ref;
Project : Project_Id;
Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
Flags : Processing_Flags);
-- Assuming Project is an aggregate project, find out (based on the
-- current external references) what are the projects it aggregates.
-- This has to be done in phase 1 of the processing, so that we know the
-- full list of languages required for root_project and its aggregated
-- projects. As a result, it cannot be done as part of
-- Process_Naming_Scheme.
end Prj.Nmsc;

2
gcc/ada/prj-part.adb
View File

@ -1870,7 +1870,7 @@ package body Prj.Part is
Tree.Restore_And_Free (Project_Comment_State);
Debug_Decrease_Indent ("Done parsing project");
Debug_Decrease_Indent;
end Parse_Single_Project;
-----------------------

1989
gcc/ada/prj-proc.adb
View File

File diff suppressed because it is too large Load Diff

119
gcc/ada/prj.adb
View File

@ -62,55 +62,6 @@ package body Prj is
All_Upper_Case => All_Upper_Case_Image'Access,
Mixed_Case => Mixed_Case_Image'Access);
Project_Empty : constant Project_Data :=
(Qualifier => Unspecified,
Externally_Built => False,
Config => Default_Project_Config,
Name => No_Name,
Display_Name => No_Name,
Path => No_Path_Information,
Virtual => False,
Location => No_Location,
Mains => Nil_String,
Directory => No_Path_Information,
Library => False,
Library_Dir => No_Path_Information,
Library_Src_Dir => No_Path_Information,
Library_ALI_Dir => No_Path_Information,
Library_Name => No_Name,
Library_Kind => Static,
Lib_Internal_Name => No_Name,
Standalone_Library => False,
Lib_Interface_ALIs => Nil_String,
Lib_Auto_Init => False,
Libgnarl_Needed => Unknown,
Symbol_Data => No_Symbols,
Interfaces_Defined => False,
Source_Dirs => Nil_String,
Source_Dir_Ranks => No_Number_List,
Object_Directory => No_Path_Information,
Library_TS => Empty_Time_Stamp,
Exec_Directory => No_Path_Information,
Extends => No_Project,
Extended_By => No_Project,
Languages => No_Language_Index,
Decl => No_Declarations,
Imported_Projects => null,
Include_Path_File => No_Path,
All_Imported_Projects => null,
Ada_Include_Path => null,
Ada_Objects_Path => null,
Objects_Path => null,
Objects_Path_File_With_Libs => No_Path,
Objects_Path_File_Without_Libs => No_Path,
Config_File_Name => No_Path,
Config_File_Temp => False,
Config_Checked => False,
Need_To_Build_Lib => False,
Has_Multi_Unit_Sources => False,
Depth => 0,
Unkept_Comments => False);
procedure Free (Project : in out Project_Id);
-- Free memory allocated for Project
@ -270,10 +221,20 @@ package body Prj is
-- Empty_Project --
-------------------
function Empty_Project return Project_Data is
function Empty_Project
(Qualifier : Project_Qualifier) return Project_Data is
begin
Prj.Initialize (Tree => No_Project_Tree);
return Project_Empty;
declare
Data : Project_Data (Qualifier => Qualifier);
begin
-- Only the fields for which no default value could be provided in
-- prj.ads are initialized below
Data.Config := Default_Project_Config;
return Data;
end;
end Empty_Project;
------------------
@ -440,6 +401,7 @@ package body Prj is
procedure For_Every_Project_Imported
(By : Project_Id;
With_State : in out State;
Include_Aggregated : Boolean := True;
Imported_First : Boolean := False)
is
use Project_Boolean_Htable;
@ -455,6 +417,7 @@ package body Prj is
procedure Recursive_Check (Project : Project_Id) is
List : Project_List;
Agg : Aggregated_Project_List;
begin
if not Get (Seen, Project) then
@ -464,13 +427,13 @@ package body Prj is
Action (Project, With_State);
end if;
-- Visited all extended projects
-- Visit all extended projects
if Project.Extends /= No_Project then
Recursive_Check (Project.Extends);
end if;
-- Visited all imported projects
-- Visit all imported projects
List := Project.Imported_Projects;
while List /= null loop
@ -478,6 +441,19 @@ package body Prj is
List := List.Next;
end loop;
-- Visit all aggregated projects
if Include_Aggregated
and then Project.Qualifier = Aggregate
then
Agg := Project.Aggregated_Projects;
while Agg /= null loop
pragma Assert (Agg.Project /= No_Project);
Recursive_Check (Agg.Project);
Agg := Agg.Next;
end loop;
end if;
if Imported_First then
Action (Project, With_State);
end if;
@ -729,6 +705,35 @@ package body Prj is
-- Free --
----------
procedure Free (List : in out Aggregated_Project_List) is
procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Aggregated_Project, Aggregated_Project_List);
Tmp : Aggregated_Project_List;
begin
while List /= null loop
Tmp := List.Next;
Unchecked_Free (List);
List := Tmp;
end loop;
end Free;
----------------------------
-- Add_Aggregated_Project --
----------------------------
procedure Add_Aggregated_Project
(Project : Project_Id; Path : Path_Name_Type) is
begin
Project.Aggregated_Projects := new Aggregated_Project'
(Path => Path,
Project => No_Project,
Next => Project.Aggregated_Projects);
end Add_Aggregated_Project;
----------
-- Free --
----------
procedure Free (Project : in out Project_Id) is
procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Project_Data, Project_Id);
@ -742,6 +747,14 @@ package body Prj is
Free_List (Project.All_Imported_Projects, Free_Project => False);
Free_List (Project.Languages);
case Project.Qualifier is
when Aggregate =>
Free (Project.Aggregated_Projects);
when others =>
null;
end case;
Unchecked_Free (Project);
end if;
end Free;

57
gcc/ada/prj.ads
View File

@ -1086,13 +1086,34 @@ package Prj is
Lib_Maj_Min_Id_Supported => False,
Auto_Init_Supported => False);
-------------------------
-- Aggregated projects --
-------------------------
type Aggregated_Project;
type Aggregated_Project_List is access all Aggregated_Project;
type Aggregated_Project is record
Path : Path_Name_Type;
Project : Project_Id;
Next : Aggregated_Project_List;
end record;
procedure Free (List : in out Aggregated_Project_List);
-- Free the memory used for List
procedure Add_Aggregated_Project
(Project : Project_Id; Path : Path_Name_Type);
-- Add a new aggregated project in Project.
-- The aggregated project has not been processed yet. This procedure should
-- the called while processing the aggregate project, and as a result
-- Prj.Proc.Process will then automatically process the aggregated projects
------------------
-- Project_Data --
------------------
-- The following record describes a project file representation
-- Note that it is not specified if the path names of directories (source,
-- object, library or exec directories) end with or without a directory
-- separator.
type Project_Data is record
type Project_Data (Qualifier : Project_Qualifier := Unspecified) is record
-------------
-- General --
@ -1104,9 +1125,6 @@ package Prj is
Display_Name : Name_Id := No_Name;
-- The name of the project with the spelling of its declaration
Qualifier : Project_Qualifier := Unspecified;
-- The eventual qualifier for this project
Externally_Built : Boolean := False;
-- True if the project is externally built. In such case, the Project
-- Manager will not modify anything in this project.
@ -1152,10 +1170,10 @@ package Prj is
-- The declarations (variables, attributes and packages) of this project
-- file.
Imported_Projects : Project_List;
Imported_Projects : Project_List := null;
-- The list of all directly imported projects, if any
All_Imported_Projects : Project_List;
All_Imported_Projects : Project_List := null;
-- The list of all projects imported directly or indirectly, if any.
-- This does not include the project itself.
@ -1295,9 +1313,21 @@ package Prj is
-- True if there are comments in the project sources that cannot be kept
-- in the project tree.
-----------------------------
-- qualifier-specific data --
-----------------------------
-- The following fields are only valid for specific types of projects.
case Qualifier is
when Aggregate =>
Aggregated_Projects : Aggregated_Project_List := null;
when others =>
null;
end case;
end record;
function Empty_Project return Project_Data;
function Empty_Project (Qualifier : Project_Qualifier) return Project_Data;
-- Return the representation of an empty project
function Is_Extending
@ -1432,6 +1462,7 @@ package Prj is
procedure For_Every_Project_Imported
(By : Project_Id;
With_State : in out State;
Include_Aggregated : Boolean := True;
Imported_First : Boolean := False);
-- Call Action for each project imported directly or indirectly by project
-- By, as well as extended projects.
@ -1448,6 +1479,10 @@ package Prj is
--
-- With_State may be used by Action to choose a behavior or to report some
-- global result.
--
-- If Include_Aggregated is True, then an aggregate project will recurse
-- into the projects it aggregates. Otherwise, the latter are never
-- returned
function Extend_Name
(File : File_Name_Type;

10
gcc/ada/restrict.adb
View File

@ -105,9 +105,9 @@ package body Restrict is
Check_Restriction (No_Elaboration_Code, N);
end Check_Elaboration_Code_Allowed;
------------------------------
-- Check_Formal_Restriction --
------------------------------
-----------------------------
-- Check_SPARK_Restriction --
-----------------------------
procedure Check_SPARK_Restriction
(Msg : String;
@ -139,7 +139,7 @@ package body Restrict is
end if;
end Check_SPARK_Restriction;
procedure Check_Formal_Restriction (Msg1, Msg2 : String; N : Node_Id) is
procedure Check_SPARK_Restriction (Msg1, Msg2 : String; N : Node_Id) is
Msg_Issued : Boolean;
Save_Error_Msg_Sloc : Source_Ptr;
begin
@ -166,7 +166,7 @@ package body Restrict is
Error_Msg_F (Msg2, N);
end if;
end if;
end Check_Formal_Restriction;
end Check_SPARK_Restriction;
-----------------------------------------
-- Check_Implicit_Dynamic_Code_Allowed --

4
gcc/ada/restrict.ads
View File

@ -265,8 +265,8 @@ package Restrict is
-- SPARK restriction is set, then an error is issued on N. Msg is appended
-- to the restriction failure message.
procedure Check_Formal_Restriction (Msg1, Msg2 : String; N : Node_Id);
-- Same as Check_Formal_Restriction except there is a continuation message
procedure Check_SPARK_Restriction (Msg1, Msg2 : String; N : Node_Id);
-- Same as Check_SPARK_Restriction except there is a continuation message
-- Msg2 following the initial message Msg1.
procedure Check_Implicit_Dynamic_Code_Allowed (N : Node_Id);

26
gcc/ada/sem_attr.adb
View File

@ -289,7 +289,7 @@ package body Sem_Attr is
-- Common processing for attributes Definite and Has_Discriminants.
-- Checks that prefix is generic indefinite formal type.
procedure Check_Formal_Restriction_On_Attribute;
procedure Check_SPARK_Restriction_On_Attribute;
-- Issue an error in formal mode because attribute N is allowed
procedure Check_Integer_Type;
@ -568,7 +568,7 @@ package body Sem_Attr is
-- Start of processing for Analyze_Access_Attribute
begin
Check_Formal_Restriction_On_Attribute;
Check_SPARK_Restriction_On_Attribute;
Check_E0;
if Nkind (P) = N_Character_Literal then
@ -1289,15 +1289,15 @@ package body Sem_Attr is
Check_E2;
end Check_Floating_Point_Type_2;
-------------------------------------------
-- Check_Formal_Restriction_On_Attribute --
-------------------------------------------
------------------------------------------
-- Check_SPARK_Restriction_On_Attribute --
------------------------------------------
procedure Check_Formal_Restriction_On_Attribute is
procedure Check_SPARK_Restriction_On_Attribute is
begin
Error_Msg_Name_1 := Aname;
Check_SPARK_Restriction ("attribute % is not allowed", P);
end Check_Formal_Restriction_On_Attribute;
end Check_SPARK_Restriction_On_Attribute;
------------------------
-- Check_Integer_Type --
@ -3266,7 +3266,7 @@ package body Sem_Attr is
when Attribute_Image => Image :
begin
Check_Formal_Restriction_On_Attribute;
Check_SPARK_Restriction_On_Attribute;
Check_Scalar_Type;
Set_Etype (N, Standard_String);
@ -4825,7 +4825,7 @@ package body Sem_Attr is
when Attribute_Value => Value :
begin
Check_Formal_Restriction_On_Attribute;
Check_SPARK_Restriction_On_Attribute;
Check_E1;
Check_Scalar_Type;
@ -4888,7 +4888,7 @@ package body Sem_Attr is
when Attribute_Wide_Image => Wide_Image :
begin
Check_Formal_Restriction_On_Attribute;
Check_SPARK_Restriction_On_Attribute;
Check_Scalar_Type;
Set_Etype (N, Standard_Wide_String);
Check_E1;
@ -4915,7 +4915,7 @@ package body Sem_Attr is
when Attribute_Wide_Value => Wide_Value :
begin
Check_Formal_Restriction_On_Attribute;
Check_SPARK_Restriction_On_Attribute;
Check_E1;
Check_Scalar_Type;
@ -4956,7 +4956,7 @@ package body Sem_Attr is
----------------
when Attribute_Wide_Width =>
Check_Formal_Restriction_On_Attribute;
Check_SPARK_Restriction_On_Attribute;
Check_E0;
Check_Scalar_Type;
Set_Etype (N, Universal_Integer);
@ -4966,7 +4966,7 @@ package body Sem_Attr is
-----------
when Attribute_Width =>
Check_Formal_Restriction_On_Attribute;
Check_SPARK_Restriction_On_Attribute;
Check_E0;
Check_Scalar_Type;
Set_Etype (N, Universal_Integer);

9
gcc/ada/sem_ch6.adb
View File

@ -8593,10 +8593,13 @@ package body Sem_Ch6 is
Check_Overriding_Indicator
(S, Overridden_Subp, Is_Primitive => Is_Primitive_Subp);
-- Overloading is not allowed in SPARK
-- Overloading is not allowed in SPARK, except for operators
Error_Msg_Sloc := Sloc (Homonym (S));
Check_SPARK_Restriction ("overloading not allowed with entity#", S);
if Nkind (S) /= N_Defining_Operator_Symbol then
Error_Msg_Sloc := Sloc (Homonym (S));
Check_SPARK_Restriction
("overloading not allowed with entity#", S);
end if;
-- If S is a derived operation for an untagged type then by
-- definition it's not a dispatching operation (even if the parent

2
gcc/ada/sem_ch7.adb
View File

@ -936,7 +936,7 @@ package body Sem_Ch7 is
else
Error_Msg_Sloc := Sloc (Previous);
Check_Formal_Restriction
Check_SPARK_Restriction
("at most one tagged type or type extension allowed",
"\\ previous declaration#",
Decl);

2
gcc/ada/sem_res.adb
View File

@ -5748,7 +5748,7 @@ package body Sem_Res is
-- and then Is_Inherited_Operation_For_Type
-- (Entity (Name (N)), Etype (N))
-- then
-- Check_Formal_Restriction ("function not inherited", N);
-- Check_SPARK_Restriction ("function not inherited", N);
-- end if;
-- Implement rule in 12.5.1 (23.3/2): In an instance, if the actual is