[multiple changes]

2010-10-25  Matthew Heaney  <heaney@adacore.com>

	* Makefile.rtl, impunit.adb: Added a-cobove (bounded vector container)
	to lists.
	* a-contai.ads: Added declaration of Capacity_Error exception.
	* a-cobove.ads, a-cobove.adb: New files.

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

	* uname.adb: Revert previous change, no longer needed after change
	in par-ch10.adb.

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

	* scos.ads: Minor comment fix.

2010-10-25  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch5.adb (Analyze_Assignment_Statement): Check dangerous order
	dependence.
	* sem_ch6.adb (Analyze_Procedure_Call_Statement): Ditto.
	* sem_res.adb (Analyze_Actuals): Add actual to list of actuals for
	current construct, for subsequent order dependence checking.
	(Resolve): Check order dependence on expressions that are not
	subexpressions.
	* sem_util.adb (Check_Order_Dependence): Code cleanup, to correspond
	to latest version of AI05-144-2.
	* sem_warn.adb (Warn_On_Overlapping_Actuals): Code cleanup.

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

	* sem_ch13.adb (Build_Static_Predicate): Moved out of
	Build_Predicate_Function.
	(Build_Static_Predicate): Complet rewrite for more general predicates

From-SVN: r165917
This commit is contained in:
Arnaud Charlet 2010-10-25 15:50:29 +02:00
parent 89ff4f167f
commit 1e194575d0
14 changed files with 3799 additions and 419 deletions

View File

@ -1,3 +1,38 @@
2010-10-25 Matthew Heaney <heaney@adacore.com>
* Makefile.rtl, impunit.adb: Added a-cobove (bounded vector container)
to lists.
* a-contai.ads: Added declaration of Capacity_Error exception.
* a-cobove.ads, a-cobove.adb: New files.
2010-10-25 Thomas Quinot <quinot@adacore.com>
* uname.adb: Revert previous change, no longer needed after change
in par-ch10.adb.
2010-10-25 Thomas Quinot <quinot@adacore.com>
* scos.ads: Minor comment fix.
2010-10-25 Ed Schonberg <schonberg@adacore.com>
* sem_ch5.adb (Analyze_Assignment_Statement): Check dangerous order
dependence.
* sem_ch6.adb (Analyze_Procedure_Call_Statement): Ditto.
* sem_res.adb (Analyze_Actuals): Add actual to list of actuals for
current construct, for subsequent order dependence checking.
(Resolve): Check order dependence on expressions that are not
subexpressions.
* sem_util.adb (Check_Order_Dependence): Code cleanup, to correspond
to latest version of AI05-144-2.
* sem_warn.adb (Warn_On_Overlapping_Actuals): Code cleanup.
2010-10-25 Robert Dewar <dewar@adacore.com>
* sem_ch13.adb (Build_Static_Predicate): Moved out of
Build_Predicate_Function.
(Build_Static_Predicate): Complet rewrite for more general predicates
2010-10-25 Richard Kenner <kenner@vlsi1.ultra.nyu.edu>
Eric Botcazou <ebotcazou@adacore.com>

View File

@ -114,6 +114,7 @@ GNATRTL_NONTASKING_OBJS= \
a-comlin$(objext) \
a-contai$(objext) \
a-convec$(objext) \
a-cobove$(objext) \
a-coorma$(objext) \
a-coormu$(objext) \
a-coorse$(objext) \

2439
gcc/ada/a-cobove.adb Normal file

File diff suppressed because it is too large Load Diff

369
gcc/ada/a-cobove.ads Normal file
View File

@ -0,0 +1,369 @@
------------------------------------------------------------------------------
-- --
-- GNAT LIBRARY COMPONENTS --
-- --
-- A D A . C O N T A I N E R S . B O U N D E D _ V E C T O R S --
-- --
-- S p e c --
-- --
-- Copyright (C) 2004-2010, 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/>. --
-- --
-- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------
private with Ada.Streams;
generic
type Index_Type is range <>;
type Element_Type is private;
with function "=" (Left, Right : Element_Type) return Boolean is <>;
package Ada.Containers.Bounded_Vectors is
pragma Pure;
pragma Remote_Types;
subtype Extended_Index is Index_Type'Base
range Index_Type'First - 1 ..
Index_Type'Min (Index_Type'Base'Last - 1, Index_Type'Last) + 1;
No_Index : constant Extended_Index := Extended_Index'First;
type Vector (Capacity : Count_Type) is tagged private;
pragma Preelaborable_Initialization (Vector);
type Cursor is private;
pragma Preelaborable_Initialization (Cursor);
Empty_Vector : constant Vector;
No_Element : constant Cursor;
overriding function "=" (Left, Right : Vector) return Boolean;
function To_Vector (Length : Count_Type) return Vector;
function To_Vector
(New_Item : Element_Type;
Length : Count_Type) return Vector;
function "&" (Left, Right : Vector) return Vector;
function "&" (Left : Vector; Right : Element_Type) return Vector;
function "&" (Left : Element_Type; Right : Vector) return Vector;
function "&" (Left, Right : Element_Type) return Vector;
function Capacity (Container : Vector) return Count_Type;
procedure Reserve_Capacity
(Container : in out Vector;
Capacity : Count_Type);
function Length (Container : Vector) return Count_Type;
procedure Set_Length
(Container : in out Vector;
Length : Count_Type);
function Is_Empty (Container : Vector) return Boolean;
procedure Clear (Container : in out Vector);
function To_Cursor
(Container : Vector;
Index : Extended_Index) return Cursor;
function To_Index (Position : Cursor) return Extended_Index;
function Element
(Container : Vector;
Index : Index_Type) return Element_Type;
function Element (Position : Cursor) return Element_Type;
procedure Replace_Element
(Container : in out Vector;
Index : Index_Type;
New_Item : Element_Type);
procedure Replace_Element
(Container : in out Vector;
Position : Cursor;
New_Item : Element_Type);
procedure Query_Element
(Container : Vector;
Index : Index_Type;
Process : not null access procedure (Element : Element_Type));
procedure Query_Element
(Position : Cursor;
Process : not null access procedure (Element : Element_Type));
procedure Update_Element
(Container : in out Vector;
Index : Index_Type;
Process : not null access procedure (Element : in out Element_Type));
procedure Update_Element
(Container : in out Vector;
Position : Cursor;
Process : not null access procedure (Element : in out Element_Type));
procedure Assign (Target : in out Vector; Source : Vector);
function Copy (Source : Vector; Capacity : Count_Type := 0) return Vector;
procedure Move (Target : in out Vector; Source : in out Vector);
procedure Insert
(Container : in out Vector;
Before : Extended_Index;
New_Item : Vector);
procedure Insert
(Container : in out Vector;
Before : Cursor;
New_Item : Vector);
procedure Insert
(Container : in out Vector;
Before : Cursor;
New_Item : Vector;
Position : out Cursor);
procedure Insert
(Container : in out Vector;
Before : Extended_Index;
New_Item : Element_Type;
Count : Count_Type := 1);
procedure Insert
(Container : in out Vector;
Before : Cursor;
New_Item : Element_Type;
Count : Count_Type := 1);
procedure Insert
(Container : in out Vector;
Before : Cursor;
New_Item : Element_Type;
Position : out Cursor;
Count : Count_Type := 1);
procedure Insert
(Container : in out Vector;
Before : Extended_Index;
Count : Count_Type := 1);
procedure Insert
(Container : in out Vector;
Before : Cursor;
Position : out Cursor;
Count : Count_Type := 1);
procedure Prepend
(Container : in out Vector;
New_Item : Vector);
procedure Prepend
(Container : in out Vector;
New_Item : Element_Type;
Count : Count_Type := 1);
procedure Append
(Container : in out Vector;
New_Item : Vector);
procedure Append
(Container : in out Vector;
New_Item : Element_Type;
Count : Count_Type := 1);
procedure Insert_Space
(Container : in out Vector;
Before : Extended_Index;
Count : Count_Type := 1);
procedure Insert_Space
(Container : in out Vector;
Before : Cursor;
Position : out Cursor;
Count : Count_Type := 1);
procedure Delete
(Container : in out Vector;
Index : Extended_Index;
Count : Count_Type := 1);
procedure Delete
(Container : in out Vector;
Position : in out Cursor;
Count : Count_Type := 1);
procedure Delete_First
(Container : in out Vector;
Count : Count_Type := 1);
procedure Delete_Last
(Container : in out Vector;
Count : Count_Type := 1);
procedure Reverse_Elements (Container : in out Vector);
procedure Swap (Container : in out Vector; I, J : Index_Type);
procedure Swap (Container : in out Vector; I, J : Cursor);
function First_Index (Container : Vector) return Index_Type;
function First (Container : Vector) return Cursor;
function First_Element (Container : Vector) return Element_Type;
function Last_Index (Container : Vector) return Extended_Index;
function Last (Container : Vector) return Cursor;
function Last_Element (Container : Vector) return Element_Type;
function Next (Position : Cursor) return Cursor;
procedure Next (Position : in out Cursor);
function Previous (Position : Cursor) return Cursor;
procedure Previous (Position : in out Cursor);
function Find_Index
(Container : Vector;
Item : Element_Type;
Index : Index_Type := Index_Type'First) return Extended_Index;
function Find
(Container : Vector;
Item : Element_Type;
Position : Cursor := No_Element) return Cursor;
function Reverse_Find_Index
(Container : Vector;
Item : Element_Type;
Index : Index_Type := Index_Type'Last) return Extended_Index;
function Reverse_Find
(Container : Vector;
Item : Element_Type;
Position : Cursor := No_Element) return Cursor;
function Contains
(Container : Vector;
Item : Element_Type) return Boolean;
function Has_Element (Position : Cursor) return Boolean;
procedure Iterate
(Container : Vector;
Process : not null access procedure (Position : Cursor));
procedure Reverse_Iterate
(Container : Vector;
Process : not null access procedure (Position : Cursor));
generic
with function "<" (Left, Right : Element_Type) return Boolean is <>;
package Generic_Sorting is
function Is_Sorted (Container : Vector) return Boolean;
procedure Sort (Container : in out Vector);
procedure Merge (Target : in out Vector; Source : in out Vector);
end Generic_Sorting;
private
pragma Inline (First_Index);
pragma Inline (Last_Index);
pragma Inline (Element);
pragma Inline (First_Element);
pragma Inline (Last_Element);
pragma Inline (Query_Element);
pragma Inline (Update_Element);
pragma Inline (Replace_Element);
pragma Inline (Is_Empty);
pragma Inline (Contains);
pragma Inline (Next);
pragma Inline (Previous);
type Elements_Array is array (Count_Type range <>) of Element_Type;
function "=" (L, R : Elements_Array) return Boolean is abstract;
type Vector (Capacity : Count_Type) is tagged record
Elements : Elements_Array (1 .. Capacity);
Last : Extended_Index := No_Index;
Busy : Natural := 0;
Lock : Natural := 0;
end record;
use Ada.Streams;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Container : Vector);
for Vector'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Container : out Vector);
for Vector'Read use Read;
type Vector_Access is access all Vector;
for Vector_Access'Storage_Size use 0;
type Cursor is record
Container : Vector_Access;
Index : Index_Type := Index_Type'First;
end record;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
Position : Cursor);
for Cursor'Write use Write;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
Position : out Cursor);
for Cursor'Read use Read;
Empty_Vector : constant Vector := (Capacity => 0, others => <>);
No_Element : constant Cursor := Cursor'(null, Index_Type'First);
end Ada.Containers.Bounded_Vectors;

View File

@ -19,4 +19,6 @@ package Ada.Containers is
type Hash_Type is mod 2**32;
type Count_Type is range 0 .. 2**31 - 1;
Capacity_Error : exception;
end Ada.Containers;

View File

@ -506,7 +506,8 @@ package body Impunit is
Non_Imp_File_Names_12 : constant File_List := (
"s-multip", -- System.Multiprocessors
"s-mudido"); -- System.Multiprocessors.Dispatching_Domains
"s-mudido", -- System.Multiprocessors.Dispatching_Domains
"a-cobove"); -- Ada.Containers.Bounded_Vectors
-----------------------
-- Alternative Units --

View File

@ -240,7 +240,7 @@ package SCOs is
-- expression ::= |sloc term term (if expr is OR or OR ELSE)
-- expression ::= !sloc term (if expr is NOT)
-- In the last four cases, sloc is the source location of the AND, OR,
-- In the last three cases, sloc is the source location of the AND, OR,
-- or NOT token, respectively.
-- term ::= element

File diff suppressed because it is too large Load Diff

View File

@ -662,6 +662,7 @@ package body Sem_Ch5 is
-- checks have been applied.
Note_Possible_Modification (Lhs, Sure => True);
Check_Order_Dependence;
-- ??? a real accessibility check is needed when ???

View File

@ -811,9 +811,8 @@ package body Sem_Ch6 is
end if;
-- Apply checks suggested by AI05-0144 (dangerous order dependence)
-- (Disabled for now)
-- Check_Order_Dependence;
Check_Order_Dependence;
end if;
end Analyze_Function_Return;
@ -1116,9 +1115,9 @@ package body Sem_Ch6 is
Analyze_Call (N);
Resolve (N, Standard_Void_Type);
-- Apply checks suggested by AI05-0144 (Disabled for now)
-- Apply checks suggested by AI05-0144
-- Check_Order_Dependence;
Check_Order_Dependence;
else
Analyze (N);

View File

@ -2744,6 +2744,18 @@ package body Sem_Res is
return;
end if;
-- AI05-144-2: Check dangerous order dependence within an expression
-- that is not a subexpression. Exclude RHS of an assignment, because
-- both sides may have side-effects and the check must be performed
-- over the statement.
if Nkind (Parent (N)) not in N_Subexpr
and then Nkind (Parent (N)) /= N_Assignment_Statement
and then Nkind (Parent (N)) /= N_Procedure_Call_Statement
then
Check_Order_Dependence;
end if;
-- The expression is definitely NOT overloaded at this point, so
-- we reset the Is_Overloaded flag to avoid any confusion when
-- reanalyzing the node.
@ -3529,12 +3541,10 @@ package body Sem_Res is
A_Typ := Etype (A);
F_Typ := Etype (F);
-- Save actual for subsequent check on order dependence,
-- and indicate whether actual is modifiable. For AI05-0144
-- Save actual for subsequent check on order dependence, and
-- indicate whether actual is modifiable. For AI05-0144-2.
-- Save_Actual (A,
-- Ekind (F) /= E_In_Parameter or else Is_Access_Type (F_Typ));
-- Why is this code commented out ???
Save_Actual (A, Ekind (F) /= E_In_Parameter);
-- For mode IN, if actual is an entity, and the type of the formal
-- has warnings suppressed, then we reset Never_Set_In_Source for
@ -8228,11 +8238,8 @@ package body Sem_Res is
R : constant Node_Id := Right_Opnd (N);
begin
-- Why are the calls to Check_Order_Dependence commented out ???
Resolve (L, B_Typ);
-- Check_Order_Dependence; -- For AI05-0144
Resolve (R, B_Typ);
-- Check_Order_Dependence; -- For AI05-0144
-- Check for issuing warning for always False assert/check, this happens
-- when assertions are turned off, in which case the pragma Assert/Check

View File

@ -101,12 +101,12 @@ package body Sem_Util is
-- whether the corresponding formal is OUT or IN OUT. Each top-level call
-- (procedure call, condition, assignment) examines all the actuals for a
-- possible order dependence. The table is reset after each such check.
-- The actuals to be checked in a call to Check_Order_Dependence are at
-- positions 1 .. Last.
type Actual_Name is record
Act : Node_Id;
Is_Writable : Boolean;
-- Comments needed???
end record;
package Actuals_In_Call is new Table.Table (
@ -1222,9 +1222,17 @@ package body Sem_Util is
Act2 : Node_Id;
begin
-- This could use comments ???
if Ada_Version < Ada_2012 then
return;
end if;
for J in 0 .. Actuals_In_Call.Last loop
-- Ada2012 AI04-0144-2 : dangerous order dependence.
-- Actuals in nested calls within a construct have been collected.
-- If one of them is writeable and overlaps with another one, evaluation
-- of the enclosing construct is non-deterministic.
-- This is illegal in Ada2012, but is treated as a warning for now.
for J in 1 .. Actuals_In_Call.Last loop
if Actuals_In_Call.Table (J).Is_Writable then
Act1 := Actuals_In_Call.Table (J).Act;
@ -1232,7 +1240,7 @@ package body Sem_Util is
Act1 := Prefix (Act1);
end if;
for K in 0 .. Actuals_In_Call.Last loop
for K in 1 .. Actuals_In_Call.Last loop
if K /= J then
Act2 := Actuals_In_Call.Table (K).Act;
@ -1248,15 +1256,19 @@ package body Sem_Util is
null;
elsif Denotes_Same_Object (Act1, Act2)
and then False
and then Parent (Act1) /= Parent (Act2)
then
Error_Msg_N ("?,mighty suspicious!!!", Act1);
Error_Msg_N (
"result may differ if evaluated "
& " after other actual in expression?", Act1);
end if;
end if;
end loop;
end if;
end loop;
-- Remove checked actuals from table.
Actuals_In_Call.Set_Last (0);
end Check_Order_Dependence;
@ -2350,49 +2362,105 @@ package body Sem_Util is
-------------------------
function Denotes_Same_Object (A1, A2 : Node_Id) return Boolean is
Obj1 : Node_Id := A1;
Obj2 : Node_Id := A2;
procedure Check_Renaming (Obj : in out Node_Id);
-- If an object is a renaming, examine renamed object. If is is a
-- dereference of a variable, or an indexed expression with non-
-- constant indices, no overlap check can be reported.
procedure Check_Renaming (Obj : in out Node_Id) is
begin
if Is_Entity_Name (Obj)
and then Present (Renamed_Entity (Entity (Obj)))
then
Obj := Renamed_Entity (Entity (Obj));
if Nkind (Obj) = N_Explicit_Dereference
and then Is_Variable (Prefix (Obj))
then
Obj := Empty;
elsif Nkind (Obj) = N_Indexed_Component then
declare
Indx : Node_Id;
begin
Indx := First (Expressions (Obj));
while Present (Indx) loop
if not Is_OK_Static_Expression (Indx) then
Obj := Empty;
exit;
end if;
Next_Index (Indx);
end loop;
end;
end if;
end if;
end Check_Renaming;
begin
Check_Renaming (Obj1);
Check_Renaming (Obj2);
if No (Obj1)
or else No (Obj2)
then
return False;
end if;
-- If we have entity names, then must be same entity
if Is_Entity_Name (A1) then
if Is_Entity_Name (A2) then
return Entity (A1) = Entity (A2);
if Is_Entity_Name (Obj1) then
if Is_Entity_Name (Obj2) then
return Entity (Obj1) = Entity (Obj2);
else
return False;
end if;
-- No match if not same node kind
elsif Nkind (A1) /= Nkind (A2) then
elsif Nkind (Obj1) /= Nkind (Obj2) then
return False;
-- For selected components, must have same prefix and selector
elsif Nkind (A1) = N_Selected_Component then
return Denotes_Same_Object (Prefix (A1), Prefix (A2))
elsif Nkind (Obj1) = N_Selected_Component then
return Denotes_Same_Object (Prefix (Obj1), Prefix (Obj2))
and then
Entity (Selector_Name (A1)) = Entity (Selector_Name (A2));
Entity (Selector_Name (Obj1)) = Entity (Selector_Name (Obj2));
-- For explicit dereferences, prefixes must be same
elsif Nkind (A1) = N_Explicit_Dereference then
return Denotes_Same_Object (Prefix (A1), Prefix (A2));
elsif Nkind (Obj1) = N_Explicit_Dereference then
return Denotes_Same_Object (Prefix (Obj1), Prefix (Obj2));
-- For indexed components, prefixes and all subscripts must be the same
elsif Nkind (A1) = N_Indexed_Component then
if Denotes_Same_Object (Prefix (A1), Prefix (A2)) then
elsif Nkind (Obj1) = N_Indexed_Component then
if Denotes_Same_Object (Prefix (Obj1), Prefix (Obj2)) then
declare
Indx1 : Node_Id;
Indx2 : Node_Id;
begin
Indx1 := First (Expressions (A1));
Indx2 := First (Expressions (A2));
Indx1 := First (Expressions (Obj1));
Indx2 := First (Expressions (Obj2));
while Present (Indx1) loop
-- Shouldn't we be checking that values are the same???
-- Indices must denote the same static value or the same
-- object.
if not Denotes_Same_Object (Indx1, Indx2) then
if Is_OK_Static_Expression (Indx1) then
if not Is_OK_Static_Expression (Indx2) then
return False;
elsif Expr_Value (Indx1) /= Expr_Value (Indx2) then
return False;
end if;
elsif not Denotes_Same_Object (Indx1, Indx2) then
return False;
end if;
@ -2408,21 +2476,19 @@ package body Sem_Util is
-- For slices, prefixes must match and bounds must match
elsif Nkind (A1) = N_Slice
and then Denotes_Same_Object (Prefix (A1), Prefix (A2))
elsif Nkind (Obj1) = N_Slice
and then Denotes_Same_Object (Prefix (Obj1), Prefix (Obj2))
then
declare
Lo1, Lo2, Hi1, Hi2 : Node_Id;
begin
Get_Index_Bounds (Etype (A1), Lo1, Hi1);
Get_Index_Bounds (Etype (A2), Lo2, Hi2);
Get_Index_Bounds (Etype (Obj1), Lo1, Hi1);
Get_Index_Bounds (Etype (Obj2), Lo2, Hi2);
-- Check whether bounds are statically identical. There is no
-- attempt to detect partial overlap of slices.
-- What about an array and a slice of an array???
return Denotes_Same_Object (Lo1, Lo2)
and then Denotes_Same_Object (Hi1, Hi2);
end;
@ -2430,8 +2496,8 @@ package body Sem_Util is
-- Literals will appear as indexes. Isn't this where we should check
-- Known_At_Compile_Time at least if we are generating warnings ???
elsif Nkind (A1) = N_Integer_Literal then
return Intval (A1) = Intval (A2);
elsif Nkind (Obj1) = N_Integer_Literal then
return Intval (Obj1) = Intval (Obj2);
else
return False;
@ -10696,7 +10762,10 @@ package body Sem_Util is
procedure Save_Actual (N : Node_Id; Writable : Boolean := False) is
begin
if Is_Entity_Name (N)
if Ada_Version < Ada_2012 then
return;
elsif Is_Entity_Name (N)
or else
Nkind_In (N, N_Indexed_Component, N_Selected_Component, N_Slice)
or else

View File

@ -3708,7 +3708,7 @@ package body Sem_Warn is
Form1 := First_Formal (Subp);
Act1 := First_Actual (N);
while Present (Form1) and then Present (Act1) loop
if Ekind (Form1) = E_In_Out_Parameter then
if Ekind (Form1) /= E_In_Parameter then
Form2 := First_Formal (Subp);
Act2 := First_Actual (N);
while Present (Form2) and then Present (Act2) loop
@ -3739,11 +3739,11 @@ package body Sem_Warn is
elsif Nkind (Act2) = N_Function_Call then
null;
-- If either type is elementary the aliasing is harmless.
-- If type is not by-copy we can assume that the aliasing
-- is intended.
elsif Is_Elementary_Type (Underlying_Type (Etype (Form1)))
or else
Is_Elementary_Type (Underlying_Type (Etype (Form2)))
elsif
Is_By_Reference_Type (Underlying_Type (Etype (Form1)))
then
null;
@ -3762,11 +3762,21 @@ package body Sem_Warn is
Next_Actual (Act);
end loop;
if Is_Elementary_Type (Etype (Act1))
and then Ekind (Form2) = E_In_Parameter
then
null; -- no real aliasing.
elsif Is_Elementary_Type (Etype (Act2))
and then Ekind (Form2) = E_In_Parameter
then
null; -- ditto
-- If the call was written in prefix notation, and
-- thus its prefix before rewriting was a selected
-- component, count only visible actuals in the call.
if Is_Entity_Name (First_Actual (N))
elsif Is_Entity_Name (First_Actual (N))
and then Nkind (Original_Node (N)) = Nkind (N)
and then Nkind (Name (Original_Node (N))) =
N_Selected_Component

View File

@ -225,10 +225,10 @@ package body Uname is
Kind : constant Node_Kind := Nkind (Node);
begin
-- Bail out on error node (guard against parse error)
-- Just ignore an error node (someone else will give a message)
if Node = Error then
raise Program_Error;
return;
-- Otherwise see what kind of node we have