[Ada] Spurious errors with -gnatE and -gnatwl

[Arnaud Charlet <charlet at adacore dot com>]

This patch removes spurious errors triggered by the switches -gnatE (Dynamic
elaboration) and -gnatwl (list elaboration warnings) when the elaboration
call is appears in the prefix of an access attribute.

Compiling

   gcc -c dds-translator.adb -gnatE -gnatwl

must yield:

   dds-translator-generated_code.adb:12:63:
        info: access to "endian_translate" during elaboration
   dds-translator-generated_code.adb:12:63:
        info: implicit pragma Elaborate_All for
            "x86_translate.acft_attitude_command" generated
   dds-translator-generated_code.adb:12:63:
        info: "init" called at dds-translator.adb:50
   dds-translator-display_list_generated_code.adb:10:68:
        info: access to "endian_translate" during elaboration
   dds-translator-display_list_generated_code.adb:10:68:
        info: implicit pragma Elaborate_All for
            "x86_translate.display_list_cb_fixed_repeat" generated
   dds-translator-display_list_generated_code.adb:10:68:
        info: "display_list_init" called at dds-translator.adb:51

---
WITH system;
PACKAGE dds.translator IS
   PRAGMA Elaborate_Body;
   TYPE translator_access IS
      ACCESS PROCEDURE (address : system.address; size_in_bytes : natural);

   PROCEDURE init_it;
END dds.translator;
---
WITH interfaces;
WITH system;
PACKAGE BODY dds.translator is
   max_msg_id : CONSTANT := 16_384;

   bits_per_long  : CONSTANT := 32;
   TYPE unsigned_long IS NEW interfaces.unsigned_32;
   FOR unsigned_long'size USE bits_per_long;

   TYPE msg_ids IS NEW unsigned_long;
   SUBTYPE valid_msg_ids IS msg_ids RANGE 1 .. max_msg_id;

   TYPE translator_infos IS RECORD
      operator      : translator_access;
      max_size_in_bytes : natural;
   END RECORD;
   TYPE translators IS ARRAY (valid_msg_ids) OF translator_infos;
   PACKAGE generated_code IS
      translate : translators := (OTHERS => (NULL, 0));
      PROCEDURE init;
   END generated_code;
   PACKAGE BODY generated_code IS SEPARATE;
   USE generated_code;

   TYPE display_list_translator_access IS
      ACCESS PROCEDURE (address : system.address; size_in_bytes : natural);
   TYPE display_list_translator_infos IS RECORD
      operator          : display_list_translator_access;
      max_size_in_bytes : natural;
   END RECORD;

   TYPE display_list_translators IS
       ARRAY (valid_msg_ids) OF display_list_translator_infos;
   PACKAGE display_list_generated_code IS
      display_list_translate : display_list_translators :=
          (OTHERS => (NULL, 0));
      PROCEDURE display_list_init;
   END display_list_generated_code;
   PACKAGE BODY display_list_generated_code IS SEPARATE;
   USE display_list_generated_code;

   PROCEDURE init_it is
   begin
      init;
      display_list_init;
   END init_it;

BEGIN
   init;
   display_list_init;
END dds.translator;
---
PACKAGE dds is

END dds;
---
PACKAGE numeric.types IS

   TYPE integers IS RANGE -2_147_483_648 .. +2_147_483_647;

   SUBTYPE integer32s IS integers;

   SUBTYPE uinteger16s IS integers RANGE 0 .. 65_535;
   SUBTYPE unsigned_halfword IS uinteger16s;
   SUBTYPE int_unsigned_16_bit IS uinteger16s;

   SUBTYPE integer16s IS integers RANGE -32_768 .. +32_767;
   SUBTYPE single_integer IS integer16s;
   SUBTYPE signed_halfword IS integer16s;

   SUBTYPE uinteger8s IS integers RANGE 0 .. 255;
   SUBTYPE int_unsigned_8_bit IS uinteger8s;

   SUBTYPE integer8s IS integers RANGE -128 .. 127;
   SUBTYPE int_8_bit IS integer8s;

END numeric.types;
---
PACKAGE numeric IS
   PRAGMA pure;
END numeric;
---
WITH system;
PACKAGE x86_translate.acft_attitude_command IS

    id            : CONSTANT := 4736;
    byte_count    : CONSTANT := 16 + 16;
    message_name  : CONSTANT String := "ACFT_ATTITUDE_COMMAND";

    PROCEDURE endian_translate
       (msg_address : system.address; size_in_bytes:natural);

END x86_translate.acft_attitude_command;
---
WITH system;

PACKAGE x86_translate.display_list_cb_fixed_repeat IS

    id            : CONSTANT := 111;
    byte_count    : CONSTANT := 4;
    message_name  : CONSTANT String := "display_list_CB_FIXED_REPEAT";

    PROCEDURE endian_translate
       (msg_address : system.address; size_in_bytes:natural);

END x86_translate.display_list_cb_fixed_repeat;

WITH numeric.types;
WITH system;

PACKAGE x86_translate IS
   FUNCTION tr (n : numeric.types.integers; bits : natural)
                RETURN numeric.types.integers;

   -- Aggregate types or special cases

   PROCEDURE tr (address : system.address; bits: natural);

END x86_translate;
---
WITH x86_translate.display_list_cb_fixed_repeat;
SEPARATE (dds.translator)
PACKAGE BODY display_list_generated_code IS

   PROCEDURE display_list_init IS
   BEGIN
      -- Adacore
     display_list_translate (x86_translate.display_list_cb_fixed_repeat.id) :=
       (x86_translate.display_list_cb_fixed_repeat.endian_translate'access,
          x86_translate.display_list_cb_fixed_repeat.byte_count);
   END;
END display_list_generated_code;
---
WITH x86_translate.acft_attitude_command;

SEPARATE(dds.translator)
PACKAGE BODY generated_code IS

   PROCEDURE init IS
   BEGIN

      -- Adacore
      translate (x86_translate.acft_attitude_command.id) :=
         (x86_translate.acft_attitude_command.endian_translate'access,
          x86_translate.acft_attitude_command.byte_count);
   END;
END generated_code;

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

2015-10-26  Ed Schonberg  <schonberg@adacore.com>

	* sem_elab.adb (Elab_Warning): Under dynamic elaboration, when
	elaboration warnings are enabled, emit proper warning header
	when triggered by an access attribute.

Attachment: difs
Description: Text document