This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Ada] Duplicate copy of IN OUT parameter with -gnatVa


Thic patch modifies the expansion of actual parameters to account for a case
where a validation variable may act as the argument of a type conversion and
produce proper code to avoid a potential duplicate copy of the variable.

------------
-- Source --
------------

--  types.ads

package Types is
   type FD_Set (Size : Natural) is abstract tagged private;
   type FD_Set_Access is access all FD_Set'Class;

   procedure Next (Obj : FD_Set; Index : in out Positive) is abstract;

   type Set (Size : Natural) is new FD_Set with private;

   overriding procedure Next (Obj : Set; Index : in out Positive);

   type Socket_Set_Type is tagged private;

   procedure Initialize (Obj : in out Socket_Set_Type);

   type Socket_Count is new Natural;

   subtype Socket_Index is Socket_Count range 1 .. Socket_Count'Last;

   procedure Next (Set : Socket_Set_Type; Index : in out Socket_Index);

private
   type FD_Set (Size : Natural) is abstract tagged null record;

   type Set (Size : Natural) is new FD_Set (Size) with record
      Comp : Integer := 1;
   end record;

   type Socket_Set_Type is tagged record
      Poll : FD_Set_Access;
   end record;
end Types;

--  types.adb

package body Types is
   procedure Initialize (Obj : in out Socket_Set_Type) is
   begin
      Obj.Poll := new Set'(Size => 123, Comp => 456);
   end Initialize;

   procedure Next (Obj : Set; Index : in out Positive) is
   begin
      Index := Index + 1;
   end Next;

   procedure Next (Set : Socket_Set_Type; Index : in out Socket_Index) is
   begin
      Set.Poll.Next (Positive (Index));
   end Next;
end Types;

--  main.adb

with Ada.Text_IO; use Ada.Text_IO;
with Types;       use Types;

procedure Main is
   Set : Socket_Set_Type;
   Val : Socket_Index;

begin
   Set.Initialize;

   Val := 1;
   Set.Next (Val);

   if Val /= 2 then
      Put_Line ("ERROR");
   end if;
end Main;

-----------------
-- Compilation --
-----------------

$ gnatmake -q -gnatVa main.adb
$ ./main

Tested on x86_64-pc-linux-gnu, committed on trunk

2017-04-25  Hristian Kirtchev  <kirtchev@adacore.com>

	* checks.adb (Insert_Valid_Check): Code cleanup.
	* exp_ch6.adb (Add_Validation_Call_By_Copy_Code): New routine.
	(Expand_Actuals): Generate proper copy-back for a validation
	variable when it acts as the argument of a type conversion.
	* sem_util.adb (Is_Validation_Variable_Reference): Augment the
	predicate to operate on type qualifications.

Attachment: difs
Description: Text document


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]