[multiple changes]
2014-01-22 Robert Dewar <dewar@adacore.com> * sem_aux.adb, sem_aux.ads, sem_ch3.adb (Has_Unconstrained_Elements): Moved to sem_aux.adb. 2014-01-22 Robert Dewar <dewar@adacore.com> * vms_data.ads: Minor reformatting. 2014-01-22 Robert Dewar <dewar@adacore.com> * debug.adb: Document messages affected by -gnatd.E including the new ones that relate to late definition of equality. * sem_ch6.adb (Check_Untagged_Equality): In Ada 2012 mode, if debug flag -gnatd.E is set, then generate warnings rather than errors. (Check_Untagged_Equality): In earlier versions of Ada, generate warnings if Warn_On_Ada_2012_Incompatibility flag is set. 2014-01-22 Robert Dewar <dewar@adacore.com> * sem_prag.adb (Usage_Error): Output additional messages for unconstrained OUT parameters lacking an input dependency. 2014-01-22 Robert Dewar <dewar@adacore.com> * sem_ch4.adb: Minor reformatting. 2014-01-22 Robert Dewar <dewar@adacore.com> * restrict.ads: Minor reformatting. * sem_res.adb (Resolve_Call): Check for SPARK_05 restriction that forbids a call from within a subprogram to the same subprogram. 2014-01-22 Thomas Quinot <quinot@adacore.com> * a-stream.ads (Read_SEA, Write_SEA): New subprograms, optimized stream attributes for Stream_Element_Array. * a-stream.adb (Read_SEA, Write_SEA): Bodies for the above. * rtsfind.adb (Check_CRT): Do not reject a reference to an entity defined in the current scope. From-SVN: r206929
This commit is contained in:
Arnaud Charlet
parent
d4129bfa7c
commit
b2834fbd22
|
|
@ -1,3 +1,45 @@
|
|||
2014-01-22 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* sem_aux.adb, sem_aux.ads, sem_ch3.adb (Has_Unconstrained_Elements):
|
||||
Moved to sem_aux.adb.
|
||||
|
||||
2014-01-22 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* vms_data.ads: Minor reformatting.
|
||||
|
||||
2014-01-22 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* debug.adb: Document messages affected by -gnatd.E including
|
||||
the new ones that relate to late definition of equality.
|
||||
* sem_ch6.adb (Check_Untagged_Equality): In Ada 2012 mode, if
|
||||
debug flag -gnatd.E is set, then generate warnings rather than
|
||||
errors.
|
||||
(Check_Untagged_Equality): In earlier versions of Ada,
|
||||
generate warnings if Warn_On_Ada_2012_Incompatibility flag is set.
|
||||
|
||||
2014-01-22 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* sem_prag.adb (Usage_Error): Output additional messages for
|
||||
unconstrained OUT parameters lacking an input dependency.
|
||||
|
||||
2014-01-22 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* sem_ch4.adb: Minor reformatting.
|
||||
|
||||
2014-01-22 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* restrict.ads: Minor reformatting.
|
||||
* sem_res.adb (Resolve_Call): Check for SPARK_05 restriction that
|
||||
forbids a call from within a subprogram to the same subprogram.
|
||||
|
||||
2014-01-22 Thomas Quinot <quinot@adacore.com>
|
||||
|
||||
* a-stream.ads (Read_SEA, Write_SEA): New subprograms, optimized
|
||||
stream attributes for Stream_Element_Array.
|
||||
* a-stream.adb (Read_SEA, Write_SEA): Bodies for the above.
|
||||
* rtsfind.adb (Check_CRT): Do not reject a reference to an entity
|
||||
defined in the current scope.
|
||||
|
||||
2014-01-22 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* debug.adb, exp_ch4.adb, erroutc.adb: Minor reformatting.
|
||||
|
|
|
|||
|
|
@ -0,0 +1,68 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNAT RUN-TIME COMPONENTS --
|
||||
-- --
|
||||
-- A D A . S T R E A M S --
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2013, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
-- apply solely to the contents of the part following the private keyword. --
|
||||
-- --
|
||||
-- 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. --
|
||||
-- --
|
||||
-- As a special exception under Section 7 of GPL version 3, you are granted --
|
||||
-- additional permissions described in the GCC Runtime Library Exception, --
|
||||
-- version 3.1, as published by the Free Software Foundation. --
|
||||
-- --
|
||||
-- You should have received a copy of the GNU General Public License and --
|
||||
-- a copy of the GCC Runtime Library Exception along with this program; --
|
||||
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
|
||||
-- <http://www.gnu.org/licenses/>. --
|
||||
-- --
|
||||
-- GNAT was originally developed by the GNAT team at New York University. --
|
||||
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with Ada.IO_Exceptions;
|
||||
|
||||
package body Ada.Streams is
|
||||
|
||||
--------------
|
||||
-- Read_SEA --
|
||||
--------------
|
||||
|
||||
procedure Read_SEA
|
||||
(S : access Root_Stream_Type'Class;
|
||||
V : out Stream_Element_Array)
|
||||
is
|
||||
Last : Stream_Element_Offset;
|
||||
begin
|
||||
Read (S.all, V, Last);
|
||||
if Last /= V'Last then
|
||||
raise Ada.IO_Exceptions.End_Error;
|
||||
end if;
|
||||
end Read_SEA;
|
||||
|
||||
---------------
|
||||
-- Write_SEA --
|
||||
---------------
|
||||
|
||||
procedure Write_SEA
|
||||
(S : access Root_Stream_Type'Class;
|
||||
V : Stream_Element_Array)
|
||||
is
|
||||
begin
|
||||
Write (S.all, V);
|
||||
end Write_SEA;
|
||||
|
||||
end Ada.Streams;
|
||||
|
|
@ -2,11 +2,11 @@
|
|||
-- --
|
||||
-- GNAT RUN-TIME COMPONENTS --
|
||||
-- --
|
||||
-- A D A . S T R E A M S --
|
||||
-- A D A . S T R E A M S --
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
|
|
@ -66,4 +66,19 @@ private
|
|||
|
||||
type Root_Stream_Type is abstract tagged limited null record;
|
||||
|
||||
-- Stream attributes for Stream_Element_Array: trivially call the
|
||||
-- corresponding stream primitive for the whole array, instead of doing
|
||||
-- so element by element.
|
||||
|
||||
procedure Read_SEA
|
||||
(S : access Root_Stream_Type'Class;
|
||||
V : out Stream_Element_Array);
|
||||
|
||||
procedure Write_SEA
|
||||
(S : access Root_Stream_Type'Class;
|
||||
V : Stream_Element_Array);
|
||||
|
||||
for Stream_Element_Array'Read use Read_SEA;
|
||||
for Stream_Element_Array'Write use Write_SEA;
|
||||
|
||||
end Ada.Streams;
|
||||
|
|
|
|||
|
|
@ -596,10 +596,16 @@ package body Debug is
|
|||
|
||||
-- d.E Turn selected errors into warnings. This debug switch causes a
|
||||
-- specific set of error messages into warnings. Setting this switch
|
||||
-- causes Opt.Error_To_Warning to be set to True. Right now the only
|
||||
-- error affected is the case of overlapping subprogram parameters
|
||||
-- which has become illegal in Ada 2012, but only generates a warning
|
||||
-- in earlier versions of Ada.
|
||||
-- causes Opt.Error_To_Warning to be set to True. The intention is
|
||||
-- that this be used for messages representing upwards incompatible
|
||||
-- changes to Ada 2012 that cause previously correct programs to be
|
||||
-- treated as illegal now. The following cases are affected:
|
||||
--
|
||||
-- Errors relating to overlapping subprogram parameters for cases
|
||||
-- other than IN OUT parameters to functions.
|
||||
--
|
||||
-- Errors relating to the new rules about not defining equality
|
||||
-- too late so that composition of equality can be assured.
|
||||
|
||||
-- d.F Sets GNATprove_Mode to True. This allows debugging the frontend in
|
||||
-- the special mode used by GNATprove.
|
||||
|
|
|
|||
|
|
@ -254,7 +254,7 @@ package Restrict is
|
|||
(Msg : String;
|
||||
N : Node_Id;
|
||||
Force : Boolean := False);
|
||||
-- Node N represents a construct not allowed in formal mode. If this is
|
||||
-- Node N represents a construct not allowed in SPARK_05 mode. If this is
|
||||
-- a source node, or if the restriction is forced (Force = True), and
|
||||
-- the SPARK_05 restriction is set, then an error is issued on N. Msg
|
||||
-- is appended to the restriction failure message.
|
||||
|
|
|
|||
|
|
@ -225,11 +225,18 @@ package body Rtsfind is
|
|||
-- Entity is available
|
||||
|
||||
else
|
||||
-- If in No_Run_Time mode and entity is not in one of the
|
||||
-- specially permitted units, raise the exception.
|
||||
-- If in No_Run_Time mode and entity is neither in the current unit
|
||||
-- nor in one of the specially permitted units, raise the exception.
|
||||
|
||||
if No_Run_Time_Mode
|
||||
and then not OK_No_Run_Time_Unit (U_Id)
|
||||
|
||||
-- If the entity being referenced is defined in the current scope,
|
||||
-- using it is always fine as such usage can never introduce any
|
||||
-- dependency on an additional unit.
|
||||
-- Why do we need to do this test ???
|
||||
|
||||
and then Scope (Eid) /= Current_Scope
|
||||
then
|
||||
Entity_Not_Defined (E);
|
||||
raise RE_Not_Available;
|
||||
|
|
|
|||
|
|
@ -624,6 +624,24 @@ package body Sem_Aux is
|
|||
return Present (Get_Rep_Pragma (E, Nam1, Nam2, Check_Parents));
|
||||
end Has_Rep_Pragma;
|
||||
|
||||
--------------------------------
|
||||
-- Has_Unconstrained_Elements --
|
||||
--------------------------------
|
||||
|
||||
function Has_Unconstrained_Elements (T : Entity_Id) return Boolean is
|
||||
U_T : constant Entity_Id := Underlying_Type (T);
|
||||
begin
|
||||
if No (U_T) then
|
||||
return False;
|
||||
elsif Is_Record_Type (U_T) then
|
||||
return Has_Discriminants (U_T) and then not Is_Constrained (U_T);
|
||||
elsif Is_Array_Type (U_T) then
|
||||
return Has_Unconstrained_Elements (Component_Type (U_T));
|
||||
else
|
||||
return False;
|
||||
end if;
|
||||
end Has_Unconstrained_Elements;
|
||||
|
||||
---------------------
|
||||
-- In_Generic_Body --
|
||||
---------------------
|
||||
|
|
|
|||
|
|
@ -246,6 +246,10 @@ package Sem_Aux is
|
|||
-- the given names then True is returned, otherwise False indicates that no
|
||||
-- matching entry was found.
|
||||
|
||||
function Has_Unconstrained_Elements (T : Entity_Id) return Boolean;
|
||||
-- True if T has discriminants and is unconstrained, or is an array type
|
||||
-- whose element type Has_Unconstrained_Elements.
|
||||
|
||||
function In_Generic_Body (Id : Entity_Id) return Boolean;
|
||||
-- Determine whether entity Id appears inside a generic body
|
||||
|
||||
|
|
|
|||
|
|
@ -2991,11 +2991,6 @@ package body Sem_Ch3 is
|
|||
-- or a variant record type is encountered, Check_Restrictions is called
|
||||
-- indicating the count is unknown.
|
||||
|
||||
function Has_Unconstrained_Elements (T : Entity_Id) return Boolean;
|
||||
-- True if T has discriminants and is unconstrained, or is an array
|
||||
-- type whose element type Has_Unconstrained_Elements. Shouldn't this
|
||||
-- be in sem_util???
|
||||
|
||||
-----------------
|
||||
-- Count_Tasks --
|
||||
-----------------
|
||||
|
|
@ -3050,24 +3045,6 @@ package body Sem_Ch3 is
|
|||
end if;
|
||||
end Count_Tasks;
|
||||
|
||||
--------------------------------
|
||||
-- Has_Unconstrained_Elements --
|
||||
--------------------------------
|
||||
|
||||
function Has_Unconstrained_Elements (T : Entity_Id) return Boolean is
|
||||
U_T : constant Entity_Id := Underlying_Type (T);
|
||||
begin
|
||||
if No (U_T) then
|
||||
return False;
|
||||
elsif Is_Record_Type (U_T) then
|
||||
return Has_Discriminants (U_T) and then not Is_Constrained (U_T);
|
||||
elsif Is_Array_Type (U_T) then
|
||||
return Has_Unconstrained_Elements (Component_Type (U_T));
|
||||
else
|
||||
return False;
|
||||
end if;
|
||||
end Has_Unconstrained_Elements;
|
||||
|
||||
-- Start of processing for Analyze_Object_Declaration
|
||||
|
||||
begin
|
||||
|
|
|
|||
|
|
@ -1045,14 +1045,14 @@ package body Sem_Ch4 is
|
|||
and then Ekind (Designated_Type (Etype (Nam))) = E_Subprogram_Type
|
||||
and then
|
||||
(not Name_Denotes_Function
|
||||
or else Nkind (N) = N_Procedure_Call_Statement
|
||||
or else
|
||||
(Nkind (Parent (N)) /= N_Explicit_Dereference
|
||||
and then Is_Entity_Name (Nam)
|
||||
and then No (First_Formal (Entity (Nam)))
|
||||
and then not
|
||||
Is_Array_Type (Etype (Designated_Type (Etype (Nam))))
|
||||
and then Present (Actuals)))
|
||||
or else Nkind (N) = N_Procedure_Call_Statement
|
||||
or else
|
||||
(Nkind (Parent (N)) /= N_Explicit_Dereference
|
||||
and then Is_Entity_Name (Nam)
|
||||
and then No (First_Formal (Entity (Nam)))
|
||||
and then not
|
||||
Is_Array_Type (Etype (Designated_Type (Etype (Nam))))
|
||||
and then Present (Actuals)))
|
||||
then
|
||||
Nam_Ent := Designated_Type (Etype (Nam));
|
||||
Insert_Explicit_Dereference (Nam);
|
||||
|
|
|
|||
|
|
@ -193,7 +193,10 @@ package body Sem_Ch6 is
|
|||
-- must appear before the type is frozen, and have the same visibility as
|
||||
-- that of the type. This procedure checks that this rule is met, and
|
||||
-- otherwise emits an error on the subprogram declaration and a warning
|
||||
-- on the earlier freeze point if it is easy to locate.
|
||||
-- on the earlier freeze point if it is easy to locate. In Ada 2012 mode,
|
||||
-- this routine outputs errors (or warnings if -gnatd.E is set). In earlier
|
||||
-- versions of Ada, warnings are output if Warn_On_Ada_2012_Incompatibility
|
||||
-- is set, otherwise the call has no effect.
|
||||
|
||||
procedure Enter_Overloaded_Entity (S : Entity_Id);
|
||||
-- This procedure makes S, a new overloaded entity, into the first visible
|
||||
|
|
@ -8198,63 +8201,140 @@ package body Sem_Ch6 is
|
|||
Obj_Decl : Node_Id;
|
||||
|
||||
begin
|
||||
if Nkind (Decl) = N_Subprogram_Declaration
|
||||
and then Is_Record_Type (Typ)
|
||||
and then not Is_Tagged_Type (Typ)
|
||||
-- This check applies only if we have a subprogram declaration with a
|
||||
-- non-tagged record type.
|
||||
|
||||
if Nkind (Decl) /= N_Subprogram_Declaration
|
||||
or else not Is_Record_Type (Typ)
|
||||
or else Is_Tagged_Type (Typ)
|
||||
then
|
||||
-- If the type is not declared in a package, or if we are in the
|
||||
-- body of the package or in some other scope, the new operation is
|
||||
-- not primitive, and therefore legal, though suspicious. If the
|
||||
-- type is a generic actual (sub)type, the operation is not primitive
|
||||
-- either because the base type is declared elsewhere.
|
||||
return;
|
||||
end if;
|
||||
|
||||
if Is_Frozen (Typ) then
|
||||
if Ekind (Scope (Typ)) /= E_Package
|
||||
or else Scope (Typ) /= Current_Scope
|
||||
then
|
||||
null;
|
||||
-- In Ada 2012 case, we will output errors or warnings depending on
|
||||
-- the setting of debug flag -gnatd.E.
|
||||
|
||||
elsif Is_Generic_Actual_Type (Typ) then
|
||||
null;
|
||||
if Ada_Version >= Ada_2012 then
|
||||
Error_Msg_Warn := Debug_Flag_Dot_EE;
|
||||
|
||||
elsif In_Package_Body (Scope (Typ)) then
|
||||
-- In earlier versions of Ada, nothing to do unless we are warning on
|
||||
-- Ada 2012 incompatibilities (Warn_On_Ada_2012_Incompatibility set).
|
||||
|
||||
else
|
||||
if not Warn_On_Ada_2012_Compatibility then
|
||||
return;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Cases where the type has already been frozen
|
||||
|
||||
if Is_Frozen (Typ) then
|
||||
|
||||
-- If the type is not declared in a package, or if we are in the body
|
||||
-- of the package or in some other scope, the new operation is not
|
||||
-- primitive, and therefore legal, though suspicious. Should we
|
||||
-- generate a warning in this case ???
|
||||
|
||||
if Ekind (Scope (Typ)) /= E_Package
|
||||
or else Scope (Typ) /= Current_Scope
|
||||
then
|
||||
return;
|
||||
|
||||
-- If the type is a generic actual (sub)type, the operation is not
|
||||
-- primitive either because the base type is declared elsewhere.
|
||||
|
||||
elsif Is_Generic_Actual_Type (Typ) then
|
||||
return;
|
||||
|
||||
-- Here we have a definite error of declaration after freezing
|
||||
|
||||
else
|
||||
if Ada_Version >= Ada_2012 then
|
||||
Error_Msg_NE
|
||||
("equality operator must be declared "
|
||||
& "before type& is frozen", Eq_Op, Typ);
|
||||
Error_Msg_N
|
||||
("\move declaration to package spec", Eq_Op);
|
||||
("equality operator must be declared before type& is "
|
||||
& "frozen (RM 4.5.2 (9.8)) (Ada 2012)<<", Eq_Op, Typ);
|
||||
|
||||
-- In Ada 2012 mode with error turned to warning, output one
|
||||
-- more warning to warn that the equality operation may not
|
||||
-- compose. This is the consequence of ignoring the error.
|
||||
|
||||
if Error_Msg_Warn then
|
||||
Error_Msg_N ("\equality operation may not compose??", Eq_Op);
|
||||
end if;
|
||||
|
||||
else
|
||||
Error_Msg_NE
|
||||
("equality operator must be declared "
|
||||
& "before type& is frozen", Eq_Op, Typ);
|
||||
("equality operator must be declared before type& is "
|
||||
& "frozen (RM 4.5.2 (9.8)) (Ada 2012)?y?", Eq_Op, Typ);
|
||||
end if;
|
||||
|
||||
-- If we are in the package body, we could just move the
|
||||
-- declaration to the package spec, so add a message saying that.
|
||||
|
||||
if In_Package_Body (Scope (Typ)) then
|
||||
if Ada_Version >= Ada_2012 then
|
||||
Error_Msg_N
|
||||
("\move declaration to package spec<<", Eq_Op);
|
||||
else
|
||||
Error_Msg_N
|
||||
("\move declaration to package spec (Ada 2012)?y?", Eq_Op);
|
||||
end if;
|
||||
|
||||
-- Otherwise try to find the freezing point
|
||||
|
||||
else
|
||||
Obj_Decl := Next (Parent (Typ));
|
||||
while Present (Obj_Decl) and then Obj_Decl /= Decl loop
|
||||
if Nkind (Obj_Decl) = N_Object_Declaration
|
||||
and then Etype (Defining_Identifier (Obj_Decl)) = Typ
|
||||
then
|
||||
Error_Msg_NE
|
||||
("type& is frozen by declaration??", Obj_Decl, Typ);
|
||||
Error_Msg_N
|
||||
("\an equality operator cannot be declared after this "
|
||||
& "point (RM 4.5.2 (9.8)) (Ada 2012))??", Obj_Decl);
|
||||
-- Freezing point, output warnings
|
||||
|
||||
if Ada_Version >= Ada_2012 then
|
||||
Error_Msg_NE
|
||||
("type& is frozen by declaration??", Obj_Decl, Typ);
|
||||
Error_Msg_N
|
||||
("\an equality operator cannot be declared after "
|
||||
& "this point??",
|
||||
Obj_Decl);
|
||||
else
|
||||
Error_Msg_NE
|
||||
("type& is frozen by declaration (Ada 2012)?y?",
|
||||
Obj_Decl, Typ);
|
||||
Error_Msg_N
|
||||
("\an equality operator cannot be declared after "
|
||||
& "this point (Ada 2012)?y?",
|
||||
Obj_Decl);
|
||||
end if;
|
||||
|
||||
exit;
|
||||
end if;
|
||||
|
||||
Next (Obj_Decl);
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
elsif not In_Same_List (Parent (Typ), Decl)
|
||||
and then not Is_Limited_Type (Typ)
|
||||
then
|
||||
|
||||
-- This makes it illegal to have a primitive equality declared in
|
||||
-- the private part if the type is visible.
|
||||
|
||||
Error_Msg_N ("equality operator appears too late", Eq_Op);
|
||||
end if;
|
||||
|
||||
-- Here if type is not frozen yet. It is illegal to have a primitive
|
||||
-- equality declared in the private part if the type is visible.
|
||||
|
||||
elsif not In_Same_List (Parent (Typ), Decl)
|
||||
and then not Is_Limited_Type (Typ)
|
||||
then
|
||||
-- Shouldn't we give an RM reference here???
|
||||
|
||||
if Ada_Version >= Ada_2012 then
|
||||
Error_Msg_N
|
||||
("equality operator appears too late<<", Eq_Op);
|
||||
else
|
||||
Error_Msg_N
|
||||
("equality operator appears too late (Ada 2012)?y?", Eq_Op);
|
||||
end if;
|
||||
|
||||
-- No error detected
|
||||
|
||||
else
|
||||
return;
|
||||
end if;
|
||||
end Check_Untagged_Equality;
|
||||
|
||||
|
|
@ -10796,10 +10876,7 @@ package body Sem_Ch6 is
|
|||
and then not Is_Dispatching_Operation (S)
|
||||
then
|
||||
Make_Inequality_Operator (S);
|
||||
|
||||
if Ada_Version >= Ada_2012 then
|
||||
Check_Untagged_Equality (S);
|
||||
end if;
|
||||
Check_Untagged_Equality (S);
|
||||
end if;
|
||||
end New_Overloaded_Entity;
|
||||
|
||||
|
|
|
|||
|
|
@ -1114,11 +1114,57 @@ package body Sem_Prag is
|
|||
-----------------
|
||||
|
||||
procedure Usage_Error (Item : Node_Id; Item_Id : Entity_Id) is
|
||||
Typ : constant Entity_Id := Etype (Item_Id);
|
||||
|
||||
begin
|
||||
-- Input case
|
||||
|
||||
if Is_Input then
|
||||
Error_Msg_NE
|
||||
("item & must appear in at least one input list of aspect "
|
||||
& "Depends", Item, Item_Id);
|
||||
|
||||
-- Case of OUT parameter for which Is_Input is set
|
||||
|
||||
if Nkind (Item) = N_Defining_Identifier
|
||||
and then Ekind (Item) = E_Out_Parameter
|
||||
then
|
||||
-- One case is an unconstrained array where the bounds
|
||||
-- must be read, if we have this case, output a message
|
||||
-- indicating why the OUT parameter is read.
|
||||
|
||||
if Is_Array_Type (Typ)
|
||||
and then not Is_Constrained (Typ)
|
||||
then
|
||||
Error_Msg_NE
|
||||
("\& is an unconstrained array type, so bounds must be "
|
||||
& "read", Item, Typ);
|
||||
|
||||
-- Another case is an unconstrained discriminated record
|
||||
-- type where the constrained flag must be read (and if
|
||||
-- set, the discriminants). Again output a message.
|
||||
|
||||
elsif Is_Record_Type (Typ)
|
||||
and then Has_Discriminants (Typ)
|
||||
and then not Is_Constrained (Typ)
|
||||
then
|
||||
Error_Msg_NE
|
||||
("\& is an unconstrained discriminated record type",
|
||||
Item, Typ);
|
||||
Error_Msg_N
|
||||
("\constrained flag and possible discriminants must be "
|
||||
& "read", Item);
|
||||
|
||||
-- Not clear if there are other cases. Anyway, we will
|
||||
-- simply ignore any other cases.
|
||||
|
||||
else
|
||||
null;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Output case
|
||||
|
||||
else
|
||||
Error_Msg_NE
|
||||
("item & must appear in exactly one output list of aspect "
|
||||
|
|
|
|||
|
|
@ -5279,8 +5279,7 @@ package body Sem_Res is
|
|||
is
|
||||
Subp_Alias : constant Entity_Id := Alias (S);
|
||||
begin
|
||||
return S = E
|
||||
or else (Present (Subp_Alias) and then Subp_Alias = E);
|
||||
return S = E or else (Present (Subp_Alias) and then Subp_Alias = E);
|
||||
end Same_Or_Aliased_Subprograms;
|
||||
|
||||
-- Start of processing for Resolve_Call
|
||||
|
|
@ -5630,6 +5629,16 @@ package body Sem_Res is
|
|||
if Comes_From_Source (N) then
|
||||
Scop := Current_Scope;
|
||||
|
||||
-- Check violation of SPARK_05 restriction which does not permit
|
||||
-- a subprogram body to contain a call to the subprogram directly.
|
||||
|
||||
if Restriction_Check_Required (SPARK_05)
|
||||
and then Same_Or_Aliased_Subprograms (Nam, Scop)
|
||||
then
|
||||
Check_SPARK_Restriction
|
||||
("subprogram may not contain direct call to itself", N);
|
||||
end if;
|
||||
|
||||
-- Issue warning for possible infinite recursion in the absence
|
||||
-- of the No_Recursion restriction.
|
||||
|
||||
|
|
|
|||
|
|
@ -3368,7 +3368,8 @@ package VMS_Data is
|
|||
-- switch -gnat??. See below for list of these
|
||||
-- equivalent switch names.
|
||||
--
|
||||
-- NOTAG_WARNINGS Turns off warning tag output (default setting).
|
||||
-- NOTAG_WARNINGS Turns off warning tag output (default
|
||||
-- setting).
|
||||
--
|
||||
-- The remaining entries control individual warning categories. If one
|
||||
-- of these options is preceded by NO (e.g. NOAVOID_GAPS), then the
|
||||
|
|
|
|||
Loading…
Reference in New Issue