Patchwork [Ada] Incorrect parameter mechanism due to convention C_Pass_By_Copy

login
register
mail settings
Submitter Arnaud Charlet
Date Aug. 6, 2012, 8:02 a.m.
Message ID <20120806080251.GA32158@adacore.com>
Download mbox | patch
Permalink /patch/175291/
State New
Headers show

Comments

Arnaud Charlet - Aug. 6, 2012, 8:02 a.m.
This patch corrects the Ada-C parameter passing mechanism for record types. OUT
and IN OUT parameters are now unconditionally passed by reference regardless of
whether C_Pass_By_Copy is in effect. IN parameters subject to the convention
are passed by copy, otherwise they are passed by reference.

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

--  utils.ads

with Interfaces.C;

package Utils is
   type Record_Type is record
      A : Interfaces.C.int;
   end record;
   pragma Convention (C_Pass_By_Copy, Record_Type);

   procedure Get_Data
     (Result    : out Interfaces.C.int;
      In_Param  :     Record_Type;
      Out_Param : out Record_Type);
   pragma Export (C, Get_Data, "get_data");
   pragma Export_Valued_Procedure (Get_Data);
end Utils;

--  utils.adb

with Ada.Text_IO; use Ada.Text_IO;

package body Utils is
   procedure Get_Data
     (Result    : out Interfaces.C.int;
      In_Param  :     Record_Type;
      Out_Param : out Record_Type)
   is
   begin
      Put_Line ("  In data:");
      Put_Line ("   record field :" & In_Param.A'Img);

      Result      := 0;
      Out_Param.A := 42;

      Put_Line ("  Returning data:");
      Put_Line ("   return code  :" & Result'Img);
      Put_Line ("   record field :" & Out_Param.A'Img);
   end Get_Data;
end Utils;

--  driver.c

#include <stdio.h>
#include <stdlib.h>

struct record_t {
        int a;
};

extern int get_data(struct record_t in_param, struct record_t *out_param);

int main()
{
        int ret;
        struct record_t in_data, out_data;

        printf("Initializing Ada Runtime\n");
        adainit();

        in_data.a = 4;

        printf("Passing data\n");
        printf(" record field : %d\n", in_data.a);

        ret = get_data(in_data,&out_data);

        printf("Returned data\n");
        printf(" return code  : %d\n", ret);
        printf(" record field : %d\n", out_data.a);
        printf("Expected value: 42\n");

        printf("Finalizing Ada Runtime\n");
        adafinal();
}

----------------------------
-- Compilation and output --
----------------------------

$ gcc -c driver.c
$ gnatmake -q -z utils -o driver -bargs -n -largs driver.o
$ ./driver
Initializing Ada Runtime
Passing data
 record field : 4
  In data:
   record field : 4
  Returning data:
   return code  : 0
   record field : 42
Returned data
 return code  : 0
 record field : 42
Expected value: 42
Finalizing Ada Runtime

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

2012-08-06  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_mech.adb (Set_Mechanisms): OUT and IN OUT parameters are
	now unconditionally passed by reference. IN parameters subject
	to convention C_Pass_By_Copy are passed by copy, otherwise they
	are passed by reference.

Patch

Index: sem_mech.adb
===================================================================
--- sem_mech.adb	(revision 190155)
+++ sem_mech.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1996-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1996-2012, 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- --
@@ -352,13 +352,13 @@ 
                   --    Access parameters (RM B.3(68))
                   --    Access to subprogram types (RM B.3(71))
 
-                  --  Note: in the case of access parameters, it is the
-                  --  pointer that is passed by value. In GNAT access
-                  --  parameters are treated as IN parameters of an
-                  --  anonymous access type, so this falls out free.
+                  --  Note: in the case of access parameters, it is the pointer
+                  --  that is passed by value. In GNAT access parameters are
+                  --  treated as IN parameters of an anonymous access type, so
+                  --  this falls out free.
 
-                  --  The bottom line is that all IN elementary types
-                  --  are passed by copy in GNAT.
+                  --  The bottom line is that all IN elementary types are
+                  --  passed by copy in GNAT.
 
                   if Is_Elementary_Type (Typ) then
                      if Ekind (Formal) = E_In_Parameter then
@@ -385,10 +385,21 @@ 
                      if Convention (Typ) /= Convention_C then
                         Set_Mechanism (Formal, By_Reference);
 
-                     --  If convention C_Pass_By_Copy was specified for
-                     --  the record type, then we pass by copy.
+                     --  OUT and IN OUT parameters of record types are passed
+                     --  by reference regardless of pragmas (RM B.3 (69/2)).
 
-                     elsif C_Pass_By_Copy (Typ) then
+                     elsif Ekind_In (Formal, E_Out_Parameter,
+                                             E_In_Out_Parameter)
+                     then
+                        Set_Mechanism (Formal, By_Reference);
+
+                     --  IN parameters of record types are passed by copy only
+                     --  when the related type has convention C_Pass_By_Copy
+                     --  (RM B.3 (68.1/2)).
+
+                     elsif Ekind (Formal) = E_In_Parameter
+                       and then C_Pass_By_Copy (Typ)
+                     then
                         Set_Mechanism (Formal, By_Copy);
 
                      --  Otherwise, for a C convention record, we set the