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 <schonb...@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.
Index: sem_elab.adb
===================================================================
--- sem_elab.adb (revision 229313)
+++ sem_elab.adb (working copy)
@@ -548,6 +548,12 @@
if Msg_D /= "" and then Elab_Warnings then
Error_Msg_NE (Msg_D, N, Ent);
end if;
+
+ -- In the access case emit first warning message as well,
+ -- otherwise list of calls will appear as errors.
+
+ elsif Elab_Warnings then
+ Error_Msg_NE (Msg_S, N, Ent);
end if;
-- Static elaboration checks, info message
