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 ...@@ -1577,7 +1577,14 @@ package body Exp_Ch5 is
-- suppressed in this case). It is unnecessary but harmless in -- suppressed in this case). It is unnecessary but harmless in
-- other cases. -- 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); F := First_Discriminant (R_Typ);
while Present (F) loop while Present (F) loop
......
...@@ -29,8 +29,8 @@ ...@@ -29,8 +29,8 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- This package provides facilities for getting command line arguments -- This package provides facilities for getting command-line arguments from
-- from a text file, called a "response file". -- a text file, called a "response file".
-- --
-- Using a response file allow passing a set of arguments to an executable -- 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. -- longer than the maximum allowed by the system on the command line.
......
...@@ -1772,7 +1772,7 @@ package body Make is ...@@ -1772,7 +1772,7 @@ package body Make is
(Data : out Compilation_Data; (Data : out Compilation_Data;
OK : out Boolean) OK : out Boolean)
is is
Pid : Process_Id; Pid : Process_Id;
begin begin
pragma Assert (Outstanding_Compiles > 0); pragma Assert (Outstanding_Compiles > 0);
...@@ -1790,7 +1790,7 @@ package body Make is ...@@ -1790,7 +1790,7 @@ package body Make is
for J in Running_Compile'First .. Outstanding_Compiles loop for J in Running_Compile'First .. Outstanding_Compiles loop
if Pid = Running_Compile (J).Pid then 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 -- If a mapping file was used by this compilation, get its file
-- name for reuse by a subsequent compilation. -- name for reuse by a subsequent compilation.
......
...@@ -4108,15 +4108,22 @@ package body Sem_Aggr is ...@@ -4108,15 +4108,22 @@ package body Sem_Aggr is
begin begin
Assoc := First (Component_Associations (N)); Assoc := First (Component_Associations (N));
while Present (Assoc) loop while Present (Assoc) loop
if List_Length (Choices (Assoc)) > 1 then if Nkind (Assoc) = N_Iterated_Component_Association then
Check_SPARK_05_Restriction Error_Msg_N ("iterated component association can only "
("component association in record aggregate must " & "appear in an array aggregate", N);
& "contain a single choice", Assoc); raise Unrecoverable_Error;
end if;
if Nkind (First (Choices (Assoc))) = N_Others_Choice then else
Check_SPARK_05_Restriction if List_Length (Choices (Assoc)) > 1 then
("record aggregate cannot contain OTHERS", Assoc); 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; end if;
Assoc := Next (Assoc); Assoc := Next (Assoc);
......
...@@ -21932,6 +21932,17 @@ package body Sem_Ch3 is ...@@ -21932,6 +21932,17 @@ package body Sem_Ch3 is
Next_Discriminant (Comp); Next_Discriminant (Comp);
end loop; 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 elsif Nkind (N) = N_Component_Declaration then
Comp := First_Component (Typ); Comp := First_Component (Typ);
while Present (Comp) loop while Present (Comp) loop
......
...@@ -3782,9 +3782,10 @@ package body Sem_Ch8 is ...@@ -3782,9 +3782,10 @@ package body Sem_Ch8 is
-- before setting its previous use clause. -- before setting its previous use clause.
if Ekind (Pack) = E_Package if Ekind (Pack) = E_Package
and then Present (Current_Use_Clause (Pack)) and then Present (Current_Use_Clause (Pack))
and then Current_Use_Clause (Pack) /= N and then Current_Use_Clause (Pack) /= N
and then No (Prev_Use_Clause (N)) and then No (Prev_Use_Clause (N))
and then Prev_Use_Clause (Current_Use_Clause (Pack)) /= N
then then
Set_Prev_Use_Clause (N, Current_Use_Clause (Pack)); Set_Prev_Use_Clause (N, Current_Use_Clause (Pack));
end if; 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