This patch modifies the processing of controlled transient objects within case expressions represented by an Expression_With_Actions node. The inspection of an individual action must continue in case it denotes a complex expression, such as a case statement, which in turn may contain additional transients. ------------ -- Source -- ------------ -- pack.ads with Ada.Finalization; use Ada.Finalization; package Pack is function Next_Id return Natural; type Ctrl is new Controlled with record Id : Natural := 0; end record; procedure Adjust (Obj : in out Ctrl); procedure Finalize (Obj : in out Ctrl); procedure Initialize (Obj : in out Ctrl); function New_Ctrl return Ctrl; Empty : constant Ctrl := (Controlled with Id => 1); type Enum is (One, Two, Three); type Ctrl_Rec is record Comp : Ctrl; Kind : Enum; end record; procedure Proc (Obj : Ctrl_Rec); end Pack; -- pack.adb with Ada.Text_IO; use Ada.Text_IO; package body Pack is Id_Gen : Natural := 1; procedure Adjust (Obj : in out Ctrl) is Old_Id : constant Natural := Obj.Id; New_Id : Natural; begin if Old_Id = 0 then Put_Line (" adj: ERROR already finalized"); else New_Id := Old_Id * 100; Put_Line (" adj: " & Old_Id'Img & " ->" & New_Id'Img); Obj.Id := New_Id; end if; end Adjust; procedure Finalize (Obj : in out Ctrl) is Old_Id : constant Natural := Obj.Id; begin if Old_Id = 0 then Put_Line (" fin: ERROR already finalized"); else Put_Line (" fin: " & Old_Id'Img); Obj.Id := 0; end if; end Finalize; procedure Initialize (Obj : in out Ctrl) is New_Id : constant Natural := Next_Id; begin Put_Line (" ini: " & New_Id'Img); Obj.Id := New_Id; end Initialize; procedure Proc (Obj : Ctrl_Rec) is begin Put_Line ("proc : " & Obj.Comp.Id'Img); end Proc; function Next_Id return Natural is begin Id_Gen := Id_Gen + 1; return Id_Gen; end Next_Id; function New_Ctrl return Ctrl is Obj : Ctrl; begin return Obj; end New_Ctrl; end Pack; -- main.adb with Ada.Text_IO; use Ada.Text_IO; with Pack; use Pack; procedure Main is procedure Proc_Case_Expr (Mode : Enum) is begin Put_Line ("proc_case_expr: " & Mode'Img); Proc (case Mode is when One => (Kind => Two, Comp => Empty), when Two => (Kind => Three, Comp => Empty), when Three => (Kind => One, Comp => New_Ctrl)); end Proc_Case_Expr; procedure Proc_If_Expr (Mode : Enum) is begin Put_Line ("proc_if_expr: " & Mode'Img); Proc ((if Mode = One then (Kind => Two, Comp => Empty) elsif Mode = Two then (Kind => Three, Comp => Empty) else (Kind => One, Comp => New_Ctrl))); end Proc_If_Expr; begin Proc_Case_Expr (One); Proc_Case_Expr (Two); Proc_Case_Expr (Three); Proc_If_Expr (One); Proc_If_Expr (Two); Proc_If_Expr (Three); end Main; ---------------------------- -- Compilation and output -- ---------------------------- $ gnatmake -q main.adb $ ./main proc_case_expr: ONE adj: 1 -> 100 proc : 100 fin: 100 proc_case_expr: TWO adj: 1 -> 100 proc : 100 fin: 100 proc_case_expr: THREE ini: 2 adj: 2 -> 200 fin: 2 adj: 200 -> 20000 proc : 20000 fin: 20000 fin: 200 proc_if_expr: ONE adj: 1 -> 100 proc : 100 fin: 100 proc_if_expr: TWO adj: 1 -> 100 proc : 100 fin: 100 proc_if_expr: THREE ini: 3 adj: 3 -> 300 fin: 3 adj: 300 -> 30000 proc : 30000 fin: 30000 fin: 300 fin: 1 2018-01-11 Hristian Kirtchev <kirtchev@adacore.com> gcc/ada/ * exp_ch4.adb (Process_Action): Do not abandon the inspection of an individual action because the action may denote a complex expression, such as a case statement, which in turn may contain additional transient objects. From-SVN: r256486
Name |
Last commit
|
Last update |
---|---|---|
INSTALL | Loading commit data... | |
config | Loading commit data... | |
contrib | Loading commit data... | |
fixincludes | Loading commit data... | |
gcc | Loading commit data... | |
gnattools | Loading commit data... | |
gotools | Loading commit data... | |
include | Loading commit data... | |
intl | Loading commit data... | |
libada | Loading commit data... | |
libatomic | Loading commit data... | |
libbacktrace | Loading commit data... | |
libcc1 | Loading commit data... | |
libcpp | Loading commit data... | |
libdecnumber | Loading commit data... | |
libffi | Loading commit data... | |
libgcc | Loading commit data... | |
libgfortran | Loading commit data... | |
libgo | Loading commit data... | |
libgomp | Loading commit data... | |
libhsail-rt | Loading commit data... | |
libiberty | Loading commit data... | |
libitm | Loading commit data... | |
libmpx | Loading commit data... | |
libobjc | Loading commit data... | |
liboffloadmic | Loading commit data... | |
libquadmath | Loading commit data... | |
libsanitizer | Loading commit data... | |
libssp | Loading commit data... | |
libstdc++-v3 | Loading commit data... | |
libvtv | Loading commit data... | |
lto-plugin | Loading commit data... | |
maintainer-scripts | Loading commit data... | |
zlib | Loading commit data... | |
.dir-locals.el | Loading commit data... | |
.gitattributes | Loading commit data... | |
.gitignore | Loading commit data... | |
ABOUT-NLS | Loading commit data... | |
COPYING | Loading commit data... | |
COPYING.LIB | Loading commit data... | |
COPYING.RUNTIME | Loading commit data... | |
COPYING3 | Loading commit data... | |
COPYING3.LIB | Loading commit data... | |
ChangeLog | Loading commit data... | |
ChangeLog.jit | Loading commit data... | |
ChangeLog.tree-ssa | Loading commit data... | |
MAINTAINERS | Loading commit data... | |
Makefile.def | Loading commit data... | |
Makefile.in | Loading commit data... | |
Makefile.tpl | Loading commit data... | |
README | Loading commit data... | |
compile | Loading commit data... | |
config-ml.in | Loading commit data... | |
config.guess | Loading commit data... | |
config.rpath | Loading commit data... | |
config.sub | Loading commit data... | |
configure | Loading commit data... | |
configure.ac | Loading commit data... | |
depcomp | Loading commit data... | |
install-sh | Loading commit data... | |
libtool-ldflags | Loading commit data... | |
libtool.m4 | Loading commit data... | |
ltgcc.m4 | Loading commit data... | |
ltmain.sh | Loading commit data... | |
ltoptions.m4 | Loading commit data... | |
ltsugar.m4 | Loading commit data... | |
ltversion.m4 | Loading commit data... | |
lt~obsolete.m4 | Loading commit data... | |
missing | Loading commit data... | |
mkdep | Loading commit data... | |
mkinstalldirs | Loading commit data... | |
move-if-change | Loading commit data... | |
symlink-tree | Loading commit data... | |
ylwrap | Loading commit data... |