Commit ccd0ed95 by Pierre-Marie de Rodat

[multiple changes]

2017-09-29  Justin Squirek  <squirek@adacore.com>

	* sem_ch8.adb (Analyze_Use_Package): Add sanity check to avoid
	circularities in the use-clause chain.

2017-09-29  Javier Miranda  <miranda@adacore.com>

	* sem_ch3.adb (Replace_Components): Update references to discriminants
	located in variant parts inherited from the parent type.

2017-09-29  Javier Miranda  <miranda@adacore.com>

	* exp_ch5.adb (Expand_Assign_Record): Do not generate code to copy
	discriminants if the target is an Unchecked_Union record type.

2017-09-29  Ed Schonberg  <schonberg@adacore.com>

	* sem_aggr.adb (Resolve_Record_Aggregate): Reject the use of an
	iterated component association in an aggregate for a record type.

2017-09-29  Piotr Trojanek  <trojanek@adacore.com>

	* make.adb: Minor whitespace fixes.
	* libgnat/s-resfil.ads: Minor reformatting.

From-SVN: r253288
parent 1dce26a1
......@@ -1577,7 +1577,14 @@ package body Exp_Ch5 is
-- suppressed in this case). It is unnecessary but harmless in
-- other cases.
if Has_Discriminants (L_Typ) then
-- Special case: no copy if the target has no discriminants.
if Has_Discriminants (L_Typ)
and then Is_Unchecked_Union (Base_Type (L_Typ))
then
null;
elsif Has_Discriminants (L_Typ) then
F := First_Discriminant (R_Typ);
while Present (F) loop
......
......@@ -29,8 +29,8 @@
-- --
------------------------------------------------------------------------------
-- This package provides facilities for getting command line arguments
-- from a text file, called a "response file".
-- This package provides facilities for getting command-line arguments from
-- a text file, called a "response file".
--
-- Using a response file allow passing a set of arguments to an executable
-- longer than the maximum allowed by the system on the command line.
......
......@@ -1772,7 +1772,7 @@ package body Make is
(Data : out Compilation_Data;
OK : out Boolean)
is
Pid : Process_Id;
Pid : Process_Id;
begin
pragma Assert (Outstanding_Compiles > 0);
......@@ -1790,7 +1790,7 @@ package body Make is
for J in Running_Compile'First .. Outstanding_Compiles loop
if Pid = Running_Compile (J).Pid then
Data := Running_Compile (J);
Data := Running_Compile (J);
-- If a mapping file was used by this compilation, get its file
-- name for reuse by a subsequent compilation.
......
......@@ -4108,15 +4108,22 @@ package body Sem_Aggr is
begin
Assoc := First (Component_Associations (N));
while Present (Assoc) loop
if List_Length (Choices (Assoc)) > 1 then
Check_SPARK_05_Restriction
("component association in record aggregate must "
& "contain a single choice", Assoc);
end if;
if Nkind (Assoc) = N_Iterated_Component_Association then
Error_Msg_N ("iterated component association can only "
& "appear in an array aggregate", N);
raise Unrecoverable_Error;
if Nkind (First (Choices (Assoc))) = N_Others_Choice then
Check_SPARK_05_Restriction
("record aggregate cannot contain OTHERS", Assoc);
else
if List_Length (Choices (Assoc)) > 1 then
Check_SPARK_05_Restriction
("component association in record aggregate must "
& "contain a single choice", Assoc);
end if;
if Nkind (First (Choices (Assoc))) = N_Others_Choice then
Check_SPARK_05_Restriction
("record aggregate cannot contain OTHERS", Assoc);
end if;
end if;
Assoc := Next (Assoc);
......
......@@ -21932,6 +21932,17 @@ package body Sem_Ch3 is
Next_Discriminant (Comp);
end loop;
elsif Nkind (N) = N_Variant_Part then
Comp := First_Discriminant (Typ);
while Present (Comp) loop
if Chars (Comp) = Chars (Name (N)) then
Set_Entity (Name (N), Comp);
exit;
end if;
Next_Component (Comp);
end loop;
elsif Nkind (N) = N_Component_Declaration then
Comp := First_Component (Typ);
while Present (Comp) loop
......
......@@ -3782,9 +3782,10 @@ package body Sem_Ch8 is
-- before setting its previous use clause.
if Ekind (Pack) = E_Package
and then Present (Current_Use_Clause (Pack))
and then Current_Use_Clause (Pack) /= N
and then No (Prev_Use_Clause (N))
and then Present (Current_Use_Clause (Pack))
and then Current_Use_Clause (Pack) /= N
and then No (Prev_Use_Clause (N))
and then Prev_Use_Clause (Current_Use_Clause (Pack)) /= N
then
Set_Prev_Use_Clause (N, Current_Use_Clause (Pack));
end if;
......
-- { dg-do compile }
procedure Unchecked_Union2 is
type small_array is array (0 .. 2) of Integer;
type big_array is array (0 .. 3) of Integer;
type small_record is record
field1 : aliased Integer := 0;
field2 : aliased small_array := (0, 0, 0);
end record;
type big_record is record
field1 : aliased Integer := 0;
field2 : aliased big_array := (0, 0, 0, 0);
end record;
type myUnion (discr : Integer := 0) is record
case discr is
when 0 =>
record1 : aliased small_record;
when others =>
record2 : aliased big_record;
end case;
end record;
type UU_myUnion3 (discr : Integer := 0) is new myUnion (discr); -- Test
pragma Unchecked_Union (UU_myUnion3);
pragma Convention (C, UU_myUnion3);
procedure Convert (A : in UU_myUnion3; B : out UU_myUnion3);
pragma Import (C, Convert);
begin
null;
end Unchecked_Union2;
-- { dg-do compile }
procedure Unchecked_Union3 is
type small_array is array (0 .. 2) of Integer;
type big_array is array (0 .. 3) of Integer;
type small_record is record
field1 : aliased Integer := 0;
field2 : aliased small_array := (0, 0, 0);
end record;
type big_record is record
field1 : aliased Integer := 0;
field2 : aliased big_array := (0, 0, 0, 0);
end record;
type myUnion (discr : Integer := 0) is record
case discr is
when 0 =>
record1 : aliased small_record;
when others =>
record2 : aliased big_record;
end case;
end record;
type UU_myUnion1 is new myUnion;
pragma Unchecked_Union (UU_myUnion1);
pragma Convention (C, UU_myUnion1);
procedure Convert (A : in myUnion; B : out UU_myUnion1) is
L : UU_myUnion1 := UU_myUnion1 (A); -- Test
begin
B := L;
end Convert;
begin
null;
end Unchecked_Union3;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment