Skip to content

R
riscv-gcc-1
Commit 12f0c50c by Arnaud Charlet
Options

[multiple changes] 

2011-08-02  Geert Bosch  <bosch@adacore.com>

	* a-calfor.adb (Image): Simplify, removing unnecessary uses of 'Image.

2011-08-02  Eric Botcazou  <ebotcazou@adacore.com>

	* sem_type.adb (Covers): Move trivial case to the top and reuse the
	computed value of Base_Type.

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

	* restrict.adb (Check_Restriction): issue an error for any use of
	class-wide, even if the No_Dispatch restriction is not set.
	* sem_aggr.adb: Correct typos in comments and messages in formal mode
	* sem_ch3.adb (Process_Full_View): issue an error in formal mode is,
	when completing a private extension, the type named in the private part
	is not the same as that named in the visible part.
	* sem_res.adb (Resolve_Call): issue an error in formal mode on the use
	of an inherited primitive operations of a tagged type or type extension
	that returns the tagged type.
	* sem_util.adb, sem_util.ads (Is_Inherited_Operation_For_Type): new
	function which returns True for an implicit operation inherited by the
	derived type declaration for the argument type.
	(Is_SPARK_Object_Reference): move to appropriate place in alphabetic
	order.

From-SVN: r177135
parent fb86fe11
Showing with 278 additions and 257 deletions
gcc/ada/ChangeLog
2011-08-02 Geert Bosch <bosch@adacore.com>
* a-calfor.adb (Image): Simplify, removing unnecessary uses of 'Image.
2011-08-02 Eric Botcazou <ebotcazou@adacore.com>
* sem_type.adb (Covers): Move trivial case to the top and reuse the
computed value of Base_Type.
2011-08-02 Yannick Moy <moy@adacore.com>
* restrict.adb (Check_Restriction): issue an error for any use of
class-wide, even if the No_Dispatch restriction is not set.
* sem_aggr.adb: Correct typos in comments and messages in formal mode
* sem_ch3.adb (Process_Full_View): issue an error in formal mode is,
when completing a private extension, the type named in the private part
is not the same as that named in the visible part.
* sem_res.adb (Resolve_Call): issue an error in formal mode on the use
of an inherited primitive operations of a tagged type or type extension
that returns the tagged type.
* sem_util.adb, sem_util.ads (Is_Inherited_Operation_For_Type): new
function which returns True for an implicit operation inherited by the
derived type declaration for the argument type.
(Is_SPARK_Object_Reference): move to appropriate place in alphabetic
order.
2011-08-02 Ed Schonberg <schonberg@adacore.com>
* sem_ch5.adb (Pre_Analyze_Range): new procedure extracted from
......
gcc/ada/a-calfor.adb
......@@ -139,83 +139,53 @@ package body Ada.Calendar.Formatting is
(Elapsed_Time : Duration;
Include_Time_Fraction : Boolean := False) return String
is
To_Char : constant array (0 .. 9) of Character := "0123456789";
Hour : Hour_Number;
Minute : Minute_Number;
Second : Second_Number;
Sub_Second : Duration;
SS_Nat : Natural;
Low : Integer;
High : Integer;
-- Determine the two slice bounds for the result string depending on
-- whether the input is negative and whether fractions are requested.
First : constant Integer := (if Elapsed_Time < 0.0 then 1 else 2);
Last : constant Integer := (if Include_Time_Fraction then 12 else 9);
Result : String := "-00:00:00.00";
begin
Split (abs (Elapsed_Time), Hour, Minute, Second, Sub_Second);
-- Determine the two slice bounds for the result string depending on
-- whether the input is negative and whether fractions are requested.
-- Hour processing, positions 2 and 3
Low := (if Elapsed_Time < 0.0 then 1 else 2);
High := (if Include_Time_Fraction then 12 else 9);
Result (2) := To_Char (Hour / 10);
Result (3) := To_Char (Hour mod 10);
-- Prevent rounding when converting to natural
-- Minute processing, positions 5 and 6
Sub_Second := Sub_Second * 100.0;
Result (5) := To_Char (Minute / 10);
Result (6) := To_Char (Minute mod 10);
if Sub_Second > 0.0 then
Sub_Second := Sub_Second - 0.5;
end if;
-- Second processing, positions 8 and 9
SS_Nat := Natural (Sub_Second);
Result (8) := To_Char (Second / 10);
Result (9) := To_Char (Second mod 10);
declare
Hour_Str : constant String := Hour_Number'Image (Hour);
Minute_Str : constant String := Minute_Number'Image (Minute);
Second_Str : constant String := Second_Number'Image (Second);
SS_Str : constant String := Natural'Image (SS_Nat);
-- Optional sub second processing, positions 11 and 12
begin
-- Hour processing, positions 2 and 3
if Include_Time_Fraction and then Sub_Second > 0.0 then
if Hour < 10 then
Result (3) := Hour_Str (2);
else
Result (2) := Hour_Str (2);
Result (3) := Hour_Str (3);
end if;
-- Minute processing, positions 5 and 6
-- Prevent rounding up when converting to natural, avoiding the zero
-- case to prevent rounding down to a negative number.
if Minute < 10 then
Result (6) := Minute_Str (2);
else
Result (5) := Minute_Str (2);
Result (6) := Minute_Str (3);
end if;
SS_Nat := Natural (Duration'(Sub_Second * 100.0) - 0.5);
-- Second processing, positions 8 and 9
if Second < 10 then
Result (9) := Second_Str (2);
else
Result (8) := Second_Str (2);
Result (9) := Second_Str (3);
end if;
-- Optional sub second processing, positions 11 and 12
if Include_Time_Fraction then
if SS_Nat < 10 then
Result (12) := SS_Str (2);
else
Result (11) := SS_Str (2);
Result (12) := SS_Str (3);
end if;
end if;
Result (11) := To_Char (SS_Nat / 10);
Result (12) := To_Char (SS_Nat mod 10);
end if;
return Result (Low .. High);
end;
return Result (First .. Last);
end Image;
-----------
......@@ -227,6 +197,8 @@ package body Ada.Calendar.Formatting is
Include_Time_Fraction : Boolean := False;
Time_Zone : Time_Zones.Time_Offset := 0) return String
is
To_Char : constant array (0 .. 9) of Character := "0123456789";
Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
......@@ -237,99 +209,60 @@ package body Ada.Calendar.Formatting is
SS_Nat : Natural;
Leap_Second : Boolean;
-- The result length depends on whether fractions are requested.
Result : String := "0000-00-00 00:00:00.00";
Last : constant Positive
:= Result'Last - (if Include_Time_Fraction then 0 else 3);
begin
Split (Date, Year, Month, Day,
Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone);
-- Prevent rounding when converting to natural
Sub_Second := Sub_Second * 100.0;
if Sub_Second > 0.0 then
Sub_Second := Sub_Second - 0.5;
end if;
SS_Nat := Natural (Sub_Second);
-- Year processing, positions 1, 2, 3 and 4
declare
Year_Str : constant String := Year_Number'Image (Year);
Month_Str : constant String := Month_Number'Image (Month);
Day_Str : constant String := Day_Number'Image (Day);
Hour_Str : constant String := Hour_Number'Image (Hour);
Minute_Str : constant String := Minute_Number'Image (Minute);
Second_Str : constant String := Second_Number'Image (Second);
SS_Str : constant String := Natural'Image (SS_Nat);
Result (1) := To_Char (Year / 1000);
Result (2) := To_Char (Year / 100 mod 10);
Result (3) := To_Char (Year / 10 mod 10);
Result (4) := To_Char (Year mod 10);
begin
-- Year processing, positions 1, 2, 3 and 4
-- Month processing, positions 6 and 7
Result (1) := Year_Str (2);
Result (2) := Year_Str (3);
Result (3) := Year_Str (4);
Result (4) := Year_Str (5);
Result (6) := To_Char (Month / 10);
Result (7) := To_Char (Month mod 10);
-- Month processing, positions 6 and 7
-- Day processing, positions 9 and 10
if Month < 10 then
Result (7) := Month_Str (2);
else
Result (6) := Month_Str (2);
Result (7) := Month_Str (3);
end if;
Result (9) := To_Char (Day / 10);
Result (10) := To_Char (Day mod 10);
-- Day processing, positions 9 and 10
Result (12) := To_Char (Hour / 10);
Result (13) := To_Char (Hour mod 10);
if Day < 10 then
Result (10) := Day_Str (2);
else
Result (9) := Day_Str (2);
Result (10) := Day_Str (3);
end if;
-- Minute processing, positions 15 and 16
-- Hour processing, positions 12 and 13
Result (15) := To_Char (Minute / 10);
Result (16) := To_Char (Minute mod 10);
if Hour < 10 then
Result (13) := Hour_Str (2);
else
Result (12) := Hour_Str (2);
Result (13) := Hour_Str (3);
end if;
-- Second processing, positions 18 and 19
-- Minute processing, positions 15 and 16
Result (18) := To_Char (Second / 10);
Result (19) := To_Char (Second mod 10);
if Minute < 10 then
Result (16) := Minute_Str (2);
else
Result (15) := Minute_Str (2);
Result (16) := Minute_Str (3);
end if;
-- Optional sub second processing, positions 21 and 22
-- Second processing, positions 18 and 19
if Include_Time_Fraction and then Sub_Second > 0.0 then
if Second < 10 then
Result (19) := Second_Str (2);
else
Result (18) := Second_Str (2);
Result (19) := Second_Str (3);
end if;
-- Prevent rounding up when converting to natural, avoiding the zero
-- case to prevent rounding down to a negative number.
-- Optional sub second processing, positions 21 and 22
SS_Nat := Natural (Duration'(Sub_Second * 100.0) - 0.5);
if Include_Time_Fraction then
if SS_Nat < 10 then
Result (22) := SS_Str (2);
else
Result (21) := SS_Str (2);
Result (22) := SS_Str (3);
end if;
Result (21) := To_Char (SS_Nat / 10);
Result (22) := To_Char (SS_Nat mod 10);
end if;
return Result;
else
return Result (1 .. 19);
end if;
end;
return Result (Result'First .. Last);
end Image;
------------
......
gcc/ada/restrict.adb
......@@ -331,6 +331,13 @@ package body Restrict is
return;
end if;
-- In formal mode, issue an error for any use of class-wide, even if the
-- No_Dispatch restriction is not set.
if R = No_Dispatch then
Check_Formal_Restriction ("class-wide is not allowed", N);
end if;
if UI_Is_In_Int_Range (V) then
VV := Integer (UI_To_Int (V));
else
......
gcc/ada/sem_aggr.adb
......@@ -2375,11 +2375,11 @@ package body Sem_Aggr is
-- components of the given type mark.
-- b) If the ancestor part is an expression, it must be unambiguous, and
-- once we have its type we can also compute the needed components as in
-- once we have its type we can also compute the needed components as in
-- the previous case. In both cases, if the ancestor type is not the
-- immediate ancestor, we have to build this ancestor recursively.
-- In both cases discriminants of the ancestor type do not play a role in
-- In both cases, discriminants of the ancestor type do not play a role in
-- the resolution of the needed components, because inherited discriminants
-- cannot be used in a type extension. As a result we can compute
-- independently the list of components of the ancestor type and of the
......@@ -2483,13 +2483,12 @@ package body Sem_Aggr is
Analyze (A);
Check_Parameterless_Call (A);
-- In SPARK or ALFA, the ancestor part cannot be a subtype mark
-- In SPARK or ALFA, the ancestor part cannot be a type mark
if Is_Entity_Name (A)
and then Is_Type (Entity (A))
then
Check_Formal_Restriction
("ancestor part cannot be a subtype mark", A);
Check_Formal_Restriction ("ancestor part cannot be a type mark", A);
end if;
if not Is_Tagged_Type (Typ) then
......
gcc/ada/sem_ch3.adb
......@@ -17275,89 +17275,108 @@ package body Sem_Ch3 is
("parent of full type must descend from parent"
& " of private extension", Full_Indic);
-- Check the rules of 7.3(10): if the private extension inherits
-- known discriminants, then the full type must also inherit those
-- discriminants from the same (ancestor) type, and the parent
-- subtype of the full type must be constrained if and only if
-- the ancestor subtype of the private extension is constrained.
elsif No (Discriminant_Specifications (Parent (Priv_T)))
and then not Has_Unknown_Discriminants (Priv_T)
and then Has_Discriminants (Base_Type (Priv_Parent))
then
declare
Priv_Indic : constant Node_Id :=
Subtype_Indication (Parent (Priv_T));
-- First check a formal restriction, and then proceed with checking
-- Ada rules. Since the formal restriction is not a serious error, we
-- don't prevent further error detection for this check, hence the
-- ELSE.
Priv_Constr : constant Boolean :=
Is_Constrained (Priv_Parent)
or else
Nkind (Priv_Indic) = N_Subtype_Indication
or else Is_Constrained (Entity (Priv_Indic));
else
Full_Constr : constant Boolean :=
Is_Constrained (Full_Parent)
or else
Nkind (Full_Indic) = N_Subtype_Indication
or else Is_Constrained (Entity (Full_Indic));
-- In formal mode, when completing a private extension the type
-- named in the private part must be exactly the same as that
-- named in the visible part.
Priv_Discr : Entity_Id;
Full_Discr : Entity_Id;
if Priv_Parent /= Full_Parent then
Error_Msg_Name_1 := Chars (Priv_Parent);
Check_Formal_Restriction ("% expected", Full_Indic);
end if;
begin
Priv_Discr := First_Discriminant (Priv_Parent);
Full_Discr := First_Discriminant (Full_Parent);
while Present (Priv_Discr) and then Present (Full_Discr) loop
if Original_Record_Component (Priv_Discr) =
Original_Record_Component (Full_Discr)
or else
Corresponding_Discriminant (Priv_Discr) =
Corresponding_Discriminant (Full_Discr)
then
null;
else
exit;
end if;
-- Check the rules of 7.3(10): if the private extension inherits
-- known discriminants, then the full type must also inherit those
-- discriminants from the same (ancestor) type, and the parent
-- subtype of the full type must be constrained if and only if
-- the ancestor subtype of the private extension is constrained.
Next_Discriminant (Priv_Discr);
Next_Discriminant (Full_Discr);
end loop;
if No (Discriminant_Specifications (Parent (Priv_T)))
and then not Has_Unknown_Discriminants (Priv_T)
and then Has_Discriminants (Base_Type (Priv_Parent))
then
declare
Priv_Indic : constant Node_Id :=
Subtype_Indication (Parent (Priv_T));
Priv_Constr : constant Boolean :=
Is_Constrained (Priv_Parent)
or else
Nkind (Priv_Indic) = N_Subtype_Indication
or else
Is_Constrained (Entity (Priv_Indic));
Full_Constr : constant Boolean :=
Is_Constrained (Full_Parent)
or else
Nkind (Full_Indic) = N_Subtype_Indication
or else
Is_Constrained (Entity (Full_Indic));
Priv_Discr : Entity_Id;
Full_Discr : Entity_Id;
if Present (Priv_Discr) or else Present (Full_Discr) then
Error_Msg_N
("full view must inherit discriminants of the parent type"
& " used in the private extension", Full_Indic);
begin
Priv_Discr := First_Discriminant (Priv_Parent);
Full_Discr := First_Discriminant (Full_Parent);
while Present (Priv_Discr) and then Present (Full_Discr) loop
if Original_Record_Component (Priv_Discr) =
Original_Record_Component (Full_Discr)
or else
Corresponding_Discriminant (Priv_Discr) =
Corresponding_Discriminant (Full_Discr)
then
null;
else
exit;
end if;
elsif Priv_Constr and then not Full_Constr then
Error_Msg_N
("parent subtype of full type must be constrained",
Full_Indic);
Next_Discriminant (Priv_Discr);
Next_Discriminant (Full_Discr);
end loop;
elsif Full_Constr and then not Priv_Constr then
Error_Msg_N
("parent subtype of full type must be unconstrained",
Full_Indic);
end if;
end;
if Present (Priv_Discr) or else Present (Full_Discr) then
Error_Msg_N
("full view must inherit discriminants of the parent"
& " type used in the private extension", Full_Indic);
-- Check the rules of 7.3(12): if a partial view has neither known
-- or unknown discriminants, then the full type declaration shall
-- define a definite subtype.
elsif Priv_Constr and then not Full_Constr then
Error_Msg_N
("parent subtype of full type must be constrained",
Full_Indic);
elsif not Has_Unknown_Discriminants (Priv_T)
and then not Has_Discriminants (Priv_T)
and then not Is_Constrained (Full_T)
then
Error_Msg_N
("full view must define a constrained type if partial view"
& " has no discriminants", Full_T);
end if;
elsif Full_Constr and then not Priv_Constr then
Error_Msg_N
("parent subtype of full type must be unconstrained",
Full_Indic);
end if;
end;
-- Check the rules of 7.3(12): if a partial view has neither
-- known or unknown discriminants, then the full type
-- declaration shall define a definite subtype.
-- ??????? Do we implement the following properly ?????
-- If the ancestor subtype of a private extension has constrained
-- discriminants, then the parent subtype of the full view shall
-- impose a statically matching constraint on those discriminants
-- [7.3(13)].
elsif not Has_Unknown_Discriminants (Priv_T)
and then not Has_Discriminants (Priv_T)
and then not Is_Constrained (Full_T)
then
Error_Msg_N
("full view must define a constrained type if partial view"
& " has no discriminants", Full_T);
end if;
-- ??????? Do we implement the following properly ?????
-- If the ancestor subtype of a private extension has constrained
-- discriminants, then the parent subtype of the full view shall
-- impose a statically matching constraint on those discriminants
-- [7.3(13)].
end if;
else
-- For untagged types, verify that a type without discriminants
......
gcc/ada/sem_res.adb
......@@ -5734,6 +5734,22 @@ package body Sem_Res is
Check_For_Eliminated_Subprogram (Subp, Nam);
end if;
-- In formal mode, the primitive operations of a tagged type or type
-- extension do not include functions that return the tagged type.
-- Commented out as the call to Is_Inherited_Operation_For_Type may
-- cause an error because the type entity of the parent node of
-- Entity (Name (N) may not be set.
-- if Nkind (N) = N_Function_Call
-- and then Is_Tagged_Type (Etype (N))
-- and then Is_Entity_Name (Name (N))
-- and then Is_Inherited_Operation_For_Type
-- (Entity (Name (N)), Etype (N))
-- then
-- Check_Formal_Restriction ("function not inherited", N);
-- end if;
-- All done, evaluate call and deal with elaboration issues
Eval_Call (N);
......
gcc/ada/sem_type.adb
......@@ -737,22 +737,12 @@ package body Sem_Type is
else
raise Program_Error;
end if;
end if;
else
BT1 := Base_Type (T1);
BT2 := Base_Type (T2);
-- Handle underlying view of records with unknown discriminants
-- using the original entity that motivated the construction of
-- this underlying record view (see Build_Derived_Private_Type).
if Is_Underlying_Record_View (BT1) then
BT1 := Underlying_Record_View (BT1);
end if;
-- Trivial case: same types are always compatible
if Is_Underlying_Record_View (BT2) then
BT2 := Underlying_Record_View (BT2);
end if;
if T1 = T2 then
return True;
end if;
-- First check for Standard_Void_Type, which is special. Subsequent
......@@ -762,26 +752,38 @@ package body Sem_Type is
if (T1 = Standard_Void_Type) /= (T2 = Standard_Void_Type) then
return False;
end if;
BT1 := Base_Type (T1);
BT2 := Base_Type (T2);
-- Simplest case: same types are compatible, and types that have the
-- same base type and are not generic actuals are compatible. Generic
-- actuals belong to their class but are not compatible with other
-- types of their class, and in particular with other generic actuals.
-- They are however compatible with their own subtypes, and itypes
-- with the same base are compatible as well. Similarly, constrained
-- subtypes obtained from expressions of an unconstrained nominal type
-- are compatible with the base type (may lead to spurious ambiguities
-- in obscure cases ???)
-- Handle underlying view of records with unknown discriminants
-- using the original entity that motivated the construction of
-- this underlying record view (see Build_Derived_Private_Type).
if Is_Underlying_Record_View (BT1) then
BT1 := Underlying_Record_View (BT1);
end if;
if Is_Underlying_Record_View (BT2) then
BT2 := Underlying_Record_View (BT2);
end if;
-- Simplest case: types that have the same base type and are not generic
-- actuals are compatible. Generic actuals belong to their class but are
-- not compatible with other types of their class, and in particular
-- with other generic actuals. They are however compatible with their
-- own subtypes, and itypes with the same base are compatible as well.
-- Similarly, constrained subtypes obtained from expressions of an
-- unconstrained nominal type are compatible with the base type (may
-- lead to spurious ambiguities in obscure cases ???)
-- Generic actuals require special treatment to avoid spurious ambi-
-- guities in an instance, when two formal types are instantiated with
-- the same actual, so that different subprograms end up with the same
-- signature in the instance.
elsif T1 = T2 then
return True;
elsif BT1 = BT2
if BT1 = BT2
or else BT1 = T2
or else BT2 = T1
then
......@@ -830,7 +832,7 @@ package body Sem_Type is
and then Is_Interface (Etype (T1))
and then Is_Concurrent_Type (T2)
and then Interface_Present_In_Ancestor
(Typ => Base_Type (T2),
(Typ => BT2,
Iface => Etype (T1))
then
return True;
......@@ -889,7 +891,7 @@ package body Sem_Type is
elsif Is_Class_Wide_Type (T2)
and then
(Class_Wide_Type (T1) = T2
or else Base_Type (Root_Type (T2)) = Base_Type (T1))
or else Base_Type (Root_Type (T2)) = BT1)
then
return True;
......@@ -1037,7 +1039,7 @@ package body Sem_Type is
-- The actual type may be the result of a previous error
elsif Base_Type (T2) = Any_Type then
elsif BT2 = Any_Type then
return True;
-- A packed array type covers its corresponding non-packed type. This is
......
gcc/ada/sem_util.adb
......@@ -6745,6 +6745,18 @@ package body Sem_Util is
and then Is_Derived_Type (Etype (E)));
end Is_Inherited_Operation;
-------------------------------------
-- Is_Inherited_Operation_For_Type --
-------------------------------------
function Is_Inherited_Operation_For_Type
(E, Typ : Entity_Id) return Boolean
is
begin
return Is_Inherited_Operation (E)
and then Etype (Parent (E)) = Typ;
end Is_Inherited_Operation_For_Type;
-----------------------------
-- Is_Library_Level_Entity --
-----------------------------
......@@ -6845,27 +6857,6 @@ package body Sem_Util is
end if;
end Is_Object_Reference;
-------------------------------
-- Is_SPARK_Object_Reference --
-------------------------------
function Is_SPARK_Object_Reference (N : Node_Id) return Boolean is
begin
if Is_Entity_Name (N) then
return Present (Entity (N))
and then
(Ekind_In (Entity (N), E_Constant, E_Variable)
or else Ekind (Entity (N)) in Formal_Kind);
else
if Nkind (N) = N_Selected_Component then
return Is_SPARK_Object_Reference (Prefix (N));
else
return False;
end if;
end if;
end Is_SPARK_Object_Reference;
-----------------------------------
-- Is_OK_Variable_For_Out_Formal --
-----------------------------------
......@@ -7377,6 +7368,29 @@ package body Sem_Util is
end if;
end Is_Selector_Name;
-------------------------------
-- Is_SPARK_Object_Reference --
-------------------------------
function Is_SPARK_Object_Reference (N : Node_Id) return Boolean is
begin
if Is_Entity_Name (N) then
return Present (Entity (N))
and then
(Ekind_In (Entity (N), E_Constant, E_Variable)
or else Ekind (Entity (N)) in Formal_Kind);
else
case Nkind (N) is
when N_Selected_Component =>
return Is_SPARK_Object_Reference (Prefix (N));
when others =>
return False;
end case;
end if;
end Is_SPARK_Object_Reference;
------------------
-- Is_Statement --
------------------
......
gcc/ada/sem_util.ads
......@@ -748,7 +748,12 @@ package Sem_Util is
function Is_Inherited_Operation (E : Entity_Id) return Boolean;
-- E is a subprogram. Return True is E is an implicit operation inherited
-- by a derived type declarations.
-- by a derived type declaration.
function Is_Inherited_Operation_For_Type
(E, Typ : Entity_Id) return Boolean;
-- E is a subprogram. Return True is E is an implicit operation inherited
-- by the derived type declaration for type Typ.
function Is_LHS (N : Node_Id) return Boolean;
-- Returns True iff N is used as Name in an assignment statement
......@@ -766,9 +771,6 @@ package Sem_Util is
-- Determines if the tree referenced by N represents an object. Both
-- variable and constant objects return True (compare Is_Variable).
function Is_SPARK_Object_Reference (N : Node_Id) return Boolean;
-- Determines if the tree referenced by N represents an object in SPARK
function Is_OK_Variable_For_Out_Formal (AV : Node_Id) return Boolean;
-- Used to test if AV is an acceptable formal for an OUT or IN OUT formal.
-- Note that the Is_Variable function is not quite the right test because
......@@ -826,6 +828,9 @@ package Sem_Util is
-- represent use of the N_Identifier node for a true identifier, when
-- normally such nodes represent a direct name.
function Is_SPARK_Object_Reference (N : Node_Id) return Boolean;
-- Determines if the tree referenced by N represents an object in SPARK
function Is_Statement (N : Node_Id) return Boolean;
pragma Inline (Is_Statement);
-- Check if the node N is a statement node. Note that this includes
......
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